summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorKeith Seitz <keiths@redhat.com>2002-09-24 19:55:43 +0000
committerKeith Seitz <keiths@redhat.com>2002-09-24 19:55:43 +0000
commit0e8f9dd357b81ada6f8f4a215b928d63ca983f97 (patch)
tree7474a17bfcb82d128f44269ac686c462e2fc191e
parente18731d328254b7e926369741b282fbffc840ea5 (diff)
downloadgdb-0e8f9dd357b81ada6f8f4a215b928d63ca983f97.tar.gz
import tcl 8.4.0
-rw-r--r--tcl/ChangeLog7881
-rw-r--r--tcl/ChangeLog.19992698
-rw-r--r--tcl/ChangeLog.20002583
-rw-r--r--tcl/ChangeLog.20013738
-rw-r--r--tcl/README161
-rw-r--r--tcl/changes691
-rw-r--r--tcl/compat/README1
-rw-r--r--tcl/compat/license.terms7
-rw-r--r--tcl/compat/strftime.c74
-rw-r--r--tcl/compat/string.h5
-rw-r--r--tcl/compat/strstr.c2
-rw-r--r--tcl/compat/strtod.c17
-rw-r--r--tcl/compat/strtol.c12
-rw-r--r--tcl/compat/strtoll.c111
-rw-r--r--tcl/compat/strtoul.c61
-rw-r--r--tcl/compat/strtoull.c261
-rw-r--r--tcl/compat/tclErrno.h165
-rw-r--r--tcl/doc/Access.317
-rw-r--r--tcl/doc/AddErrInfo.310
-rw-r--r--tcl/doc/Alloc.342
-rw-r--r--tcl/doc/AllowExc.310
-rw-r--r--tcl/doc/AssocData.34
-rw-r--r--tcl/doc/Async.37
-rw-r--r--tcl/doc/Backslash.32
-rw-r--r--tcl/doc/BoolObj.36
-rw-r--r--tcl/doc/ByteArrObj.32
-rw-r--r--tcl/doc/ChnlStack.311
-rw-r--r--tcl/doc/CmdCmplt.34
-rw-r--r--tcl/doc/Concat.34
-rw-r--r--tcl/doc/CrtChannel.3268
-rw-r--r--tcl/doc/CrtCommand.36
-rw-r--r--tcl/doc/CrtInterp.38
-rw-r--r--tcl/doc/CrtMathFnc.363
-rw-r--r--tcl/doc/CrtObjCmd.362
-rw-r--r--tcl/doc/CrtSlave.340
-rw-r--r--tcl/doc/CrtTrace.3176
-rw-r--r--tcl/doc/DString.34
-rw-r--r--tcl/doc/DetachPids.319
-rw-r--r--tcl/doc/DumpActiveMemory.311
-rw-r--r--tcl/doc/Encoding.38
-rw-r--r--tcl/doc/Environment.336
-rw-r--r--tcl/doc/Eval.331
-rw-r--r--tcl/doc/Exit.31
-rw-r--r--tcl/doc/ExprLong.311
-rw-r--r--tcl/doc/ExprLongObj.34
-rw-r--r--tcl/doc/FileSystem.31341
-rw-r--r--tcl/doc/FindExec.35
-rw-r--r--tcl/doc/GetCwd.32
-rw-r--r--tcl/doc/GetHostName.33
-rw-r--r--tcl/doc/GetIndex.319
-rw-r--r--tcl/doc/GetInt.33
-rw-r--r--tcl/doc/GetOpnFl.33
-rw-r--r--tcl/doc/GetStdChan.38
-rw-r--r--tcl/doc/GetTime.353
-rw-r--r--tcl/doc/GetVersion.32
-rw-r--r--tcl/doc/Hash.3175
-rw-r--r--tcl/doc/InitStubs.38
-rw-r--r--tcl/doc/IntObj.389
-rw-r--r--tcl/doc/Interp.31
-rw-r--r--tcl/doc/LinkVar.327
-rw-r--r--tcl/doc/Macintosh.3111
-rw-r--r--tcl/doc/Notifier.35
-rw-r--r--tcl/doc/Object.31
-rw-r--r--tcl/doc/ObjectType.312
-rw-r--r--tcl/doc/OpenFileChnl.3171
-rw-r--r--tcl/doc/OpenTcp.35
-rw-r--r--tcl/doc/Panic.3108
-rw-r--r--tcl/doc/ParseCmd.354
-rw-r--r--tcl/doc/PkgRequire.315
-rw-r--r--tcl/doc/Preserve.39
-rw-r--r--tcl/doc/RecEvalObj.31
-rw-r--r--tcl/doc/RecordEval.33
-rw-r--r--tcl/doc/RegExp.315
-rw-r--r--tcl/doc/SetErrno.320
-rw-r--r--tcl/doc/SetResult.33
-rw-r--r--tcl/doc/SetVar.319
-rw-r--r--tcl/doc/Signal.338
-rw-r--r--tcl/doc/SplitList.39
-rw-r--r--tcl/doc/SplitPath.39
-rw-r--r--tcl/doc/StaticPkg.33
-rw-r--r--tcl/doc/StdChannels.3122
-rw-r--r--tcl/doc/StrMatch.37
-rw-r--r--tcl/doc/StringObj.369
-rw-r--r--tcl/doc/SubstObj.371
-rw-r--r--tcl/doc/TCL_MEM_DEBUG.313
-rw-r--r--tcl/doc/Tcl.n7
-rw-r--r--tcl/doc/Tcl_Main.3124
-rw-r--r--tcl/doc/Thread.328
-rw-r--r--tcl/doc/TraceCmd.3170
-rw-r--r--tcl/doc/TraceVar.356
-rw-r--r--tcl/doc/Translate.33
-rw-r--r--tcl/doc/UniCharIsAlpha.392
-rw-r--r--tcl/doc/UpVar.311
-rw-r--r--tcl/doc/Utf.367
-rw-r--r--tcl/doc/WrongNumArgs.36
-rw-r--r--tcl/doc/after.n2
-rw-r--r--tcl/doc/append.n3
-rw-r--r--tcl/doc/array.n36
-rw-r--r--tcl/doc/bgerror.n65
-rw-r--r--tcl/doc/binary.n69
-rw-r--r--tcl/doc/break.n3
-rw-r--r--tcl/doc/case.n3
-rw-r--r--tcl/doc/catch.n3
-rw-r--r--tcl/doc/cd.n3
-rw-r--r--tcl/doc/clock.n125
-rw-r--r--tcl/doc/close.n15
-rw-r--r--tcl/doc/concat.n22
-rw-r--r--tcl/doc/continue.n3
-rw-r--r--tcl/doc/dde.n70
-rw-r--r--tcl/doc/encoding.n2
-rw-r--r--tcl/doc/eof.n10
-rw-r--r--tcl/doc/error.n3
-rw-r--r--tcl/doc/eval.n5
-rw-r--r--tcl/doc/exec.n46
-rw-r--r--tcl/doc/exit.n3
-rw-r--r--tcl/doc/expr.n81
-rw-r--r--tcl/doc/fblocked.n9
-rw-r--r--tcl/doc/fconfigure.n224
-rw-r--r--tcl/doc/fcopy.n13
-rw-r--r--tcl/doc/file.n143
-rw-r--r--tcl/doc/fileevent.n28
-rw-r--r--tcl/doc/filename.n30
-rw-r--r--tcl/doc/flush.n13
-rw-r--r--tcl/doc/for.n3
-rw-r--r--tcl/doc/foreach.n4
-rw-r--r--tcl/doc/format.n24
-rw-r--r--tcl/doc/gets.n11
-rw-r--r--tcl/doc/glob.n47
-rw-r--r--tcl/doc/global.n3
-rw-r--r--tcl/doc/http.n42
-rw-r--r--tcl/doc/if.n3
-rw-r--r--tcl/doc/incr.n3
-rw-r--r--tcl/doc/info.n39
-rw-r--r--tcl/doc/interp.n104
-rw-r--r--tcl/doc/join.n3
-rw-r--r--tcl/doc/lappend.n8
-rw-r--r--tcl/doc/library.n6
-rw-r--r--tcl/doc/license.terms7
-rw-r--r--tcl/doc/lindex.n68
-rw-r--r--tcl/doc/linsert.n8
-rw-r--r--tcl/doc/list.n11
-rw-r--r--tcl/doc/llength.n7
-rw-r--r--tcl/doc/load.n3
-rw-r--r--tcl/doc/lrange.n7
-rw-r--r--tcl/doc/lreplace.n7
-rw-r--r--tcl/doc/lsearch.n108
-rw-r--r--tcl/doc/lset.n110
-rw-r--r--tcl/doc/lsort.n114
-rw-r--r--tcl/doc/man.macros2
-rw-r--r--tcl/doc/memory.n67
-rw-r--r--tcl/doc/msgcat.n119
-rw-r--r--tcl/doc/namespace.n22
-rw-r--r--tcl/doc/open.n61
-rw-r--r--tcl/doc/package.n10
-rw-r--r--tcl/doc/packagens.n6
-rw-r--r--tcl/doc/pid.n3
-rw-r--r--tcl/doc/pkgMkIndex.n11
-rw-r--r--tcl/doc/proc.n3
-rw-r--r--tcl/doc/puts.n15
-rw-r--r--tcl/doc/pwd.n3
-rw-r--r--tcl/doc/read.n54
-rw-r--r--tcl/doc/regexp.n12
-rw-r--r--tcl/doc/registry.n4
-rw-r--r--tcl/doc/regsub.n36
-rw-r--r--tcl/doc/rename.n3
-rw-r--r--tcl/doc/resource.n4
-rw-r--r--tcl/doc/return.n3
-rw-r--r--tcl/doc/safe.n2
-rw-r--r--tcl/doc/scan.n74
-rw-r--r--tcl/doc/seek.n13
-rw-r--r--tcl/doc/set.n3
-rw-r--r--tcl/doc/socket.n8
-rw-r--r--tcl/doc/source.n16
-rw-r--r--tcl/doc/split.n3
-rw-r--r--tcl/doc/string.n267
-rw-r--r--tcl/doc/subst.n89
-rw-r--r--tcl/doc/switch.n3
-rw-r--r--tcl/doc/tclsh.115
-rw-r--r--tcl/doc/tcltest.n1508
-rw-r--r--tcl/doc/tclvars.n28
-rw-r--r--tcl/doc/tell.n10
-rw-r--r--tcl/doc/time.n3
-rw-r--r--tcl/doc/trace.n373
-rw-r--r--tcl/doc/unknown.n12
-rw-r--r--tcl/doc/unset.n21
-rw-r--r--tcl/doc/update.n4
-rw-r--r--tcl/doc/uplevel.n2
-rw-r--r--tcl/doc/upvar.n2
-rw-r--r--tcl/doc/variable.n5
-rw-r--r--tcl/doc/vwait.n3
-rw-r--r--tcl/doc/while.n3
-rw-r--r--tcl/generic/regc_cvec.c186
-rw-r--r--tcl/generic/regc_locale.c1119
-rw-r--r--tcl/generic/tcl.decls886
-rw-r--r--tcl/generic/tcl.h1065
-rw-r--r--tcl/generic/tclAlloc.c17
-rw-r--r--tcl/generic/tclAsync.c155
-rw-r--r--tcl/generic/tclBasic.c2206
-rw-r--r--tcl/generic/tclBinary.c229
-rw-r--r--tcl/generic/tclCkalloc.c316
-rw-r--r--tcl/generic/tclClock.c25
-rw-r--r--tcl/generic/tclCmdAH.c808
-rw-r--r--tcl/generic/tclCmdIL.c1108
-rw-r--r--tcl/generic/tclCmdMZ.c3051
-rw-r--r--tcl/generic/tclCompCmds.c2544
-rw-r--r--tcl/generic/tclCompExpr.c185
-rw-r--r--tcl/generic/tclCompile.c529
-rw-r--r--tcl/generic/tclCompile.h220
-rw-r--r--tcl/generic/tclDate.c20
-rw-r--r--tcl/generic/tclDecls.h1384
-rw-r--r--tcl/generic/tclEncoding.c164
-rw-r--r--tcl/generic/tclEnv.c163
-rw-r--r--tcl/generic/tclEvent.c83
-rw-r--r--tcl/generic/tclExecute.c6540
-rw-r--r--tcl/generic/tclFCmd.c613
-rw-r--r--tcl/generic/tclFileName.c1666
-rw-r--r--tcl/generic/tclGet.c15
-rw-r--r--tcl/generic/tclGetDate.y20
-rw-r--r--tcl/generic/tclHash.c993
-rw-r--r--tcl/generic/tclHistory.c2
-rw-r--r--tcl/generic/tclIO.c1806
-rw-r--r--tcl/generic/tclIO.h19
-rw-r--r--tcl/generic/tclIOCmd.c125
-rw-r--r--tcl/generic/tclIOGT.c162
-rw-r--r--tcl/generic/tclIOSock.c8
-rw-r--r--tcl/generic/tclIOUtil.c4650
-rw-r--r--tcl/generic/tclIndexObj.c245
-rw-r--r--tcl/generic/tclInitScript.h7
-rw-r--r--tcl/generic/tclInt.decls502
-rw-r--r--tcl/generic/tclInt.h740
-rw-r--r--tcl/generic/tclIntDecls.h537
-rw-r--r--tcl/generic/tclIntPlatDecls.h127
-rw-r--r--tcl/generic/tclInterp.c312
-rw-r--r--tcl/generic/tclLink.c252
-rw-r--r--tcl/generic/tclListObj.c639
-rw-r--r--tcl/generic/tclLiteral.c54
-rw-r--r--tcl/generic/tclLoad.c61
-rw-r--r--tcl/generic/tclLoadNone.c57
-rw-r--r--tcl/generic/tclMain.c548
-rw-r--r--tcl/generic/tclNamesp.c186
-rw-r--r--tcl/generic/tclNotify.c24
-rw-r--r--tcl/generic/tclObj.c1418
-rw-r--r--tcl/generic/tclPanic.c31
-rw-r--r--tcl/generic/tclParse.c1844
-rw-r--r--tcl/generic/tclParseExpr.c649
-rw-r--r--tcl/generic/tclPipe.c31
-rw-r--r--tcl/generic/tclPkg.c139
-rw-r--r--tcl/generic/tclPlatDecls.h44
-rw-r--r--tcl/generic/tclPort.h20
-rw-r--r--tcl/generic/tclPosixStr.c15
-rw-r--r--tcl/generic/tclProc.c234
-rw-r--r--tcl/generic/tclRegexp.c23
-rw-r--r--tcl/generic/tclResolve.c12
-rw-r--r--tcl/generic/tclResult.c2
-rw-r--r--tcl/generic/tclScan.c144
-rw-r--r--tcl/generic/tclStringObj.c343
-rw-r--r--tcl/generic/tclStubInit.c185
-rw-r--r--tcl/generic/tclStubLib.c6
-rw-r--r--tcl/generic/tclTest.c1655
-rw-r--r--tcl/generic/tclTestObj.c48
-rw-r--r--tcl/generic/tclThread.c1
-rw-r--r--tcl/generic/tclThreadAlloc.c955
-rw-r--r--tcl/generic/tclThreadJoin.c311
-rw-r--r--tcl/generic/tclThreadTest.c114
-rw-r--r--tcl/generic/tclTimer.c26
-rw-r--r--tcl/generic/tclUniData.c1070
-rw-r--r--tcl/generic/tclUtf.c444
-rw-r--r--tcl/generic/tclUtil.c644
-rw-r--r--tcl/generic/tclVar.c3482
-rw-r--r--tcl/library/auto.tcl78
-rw-r--r--tcl/library/dde/pkgIndex.tcl6
-rw-r--r--tcl/library/encoding/cp1250.enc4
-rw-r--r--tcl/library/encoding/cp1251.enc2
-rw-r--r--tcl/library/encoding/cp1252.enc4
-rw-r--r--tcl/library/encoding/cp1253.enc2
-rw-r--r--tcl/library/encoding/cp1254.enc2
-rw-r--r--tcl/library/encoding/cp1255.enc10
-rw-r--r--tcl/library/encoding/cp1256.enc10
-rw-r--r--tcl/library/encoding/cp1257.enc2
-rw-r--r--tcl/library/encoding/cp1258.enc6
-rw-r--r--tcl/library/encoding/cp874.enc2
-rw-r--r--tcl/library/encoding/cp936.enc2
-rw-r--r--tcl/library/encoding/cp949.enc2
-rw-r--r--tcl/library/encoding/cp950.enc2
-rw-r--r--tcl/library/encoding/ebcdic.enc19
-rw-r--r--tcl/library/encoding/iso2022-jp.enc2
-rw-r--r--tcl/library/encoding/iso2022.enc4
-rw-r--r--tcl/library/encoding/iso8859-10.enc20
-rw-r--r--tcl/library/encoding/iso8859-13.enc20
-rw-r--r--tcl/library/encoding/iso8859-14.enc20
-rw-r--r--tcl/library/encoding/iso8859-15.enc20
-rw-r--r--tcl/library/encoding/iso8859-16.enc20
-rw-r--r--tcl/library/encoding/iso8859-6.enc2
-rw-r--r--tcl/library/encoding/iso8859-7.enc2
-rw-r--r--tcl/library/encoding/iso8859-8.enc4
-rw-r--r--tcl/library/encoding/koi8-u.enc20
-rw-r--r--tcl/library/encoding/macCroatian.enc4
-rw-r--r--tcl/library/encoding/macCyrillic.enc6
-rw-r--r--tcl/library/encoding/macGreek.enc2
-rw-r--r--tcl/library/encoding/macIceland.enc4
-rw-r--r--tcl/library/encoding/macRoman.enc4
-rw-r--r--tcl/library/encoding/macTurkish.enc2
-rw-r--r--tcl/library/encoding/tis-620.enc20
-rw-r--r--tcl/library/history.tcl7
-rw-r--r--tcl/library/http/http.tcl914
-rw-r--r--tcl/library/http/pkgIndex.tcl12
-rw-r--r--tcl/library/init.tcl257
-rw-r--r--tcl/library/ldAout.tcl2
-rw-r--r--tcl/library/license.terms7
-rw-r--r--tcl/library/msgcat/msgcat.tcl457
-rw-r--r--tcl/library/msgcat/pkgIndex.tcl2
-rw-r--r--tcl/library/opt/optparse.tcl1092
-rw-r--r--tcl/library/opt/pkgIndex.tcl12
-rw-r--r--tcl/library/package.tcl60
-rw-r--r--tcl/library/reg/pkgIndex.tcl8
-rw-r--r--tcl/library/safe.tcl22
-rw-r--r--tcl/library/tcltest/pkgIndex.tcl12
-rw-r--r--tcl/library/tcltest/tcltest.tcl3259
-rw-r--r--tcl/license.terms7
-rw-r--r--tcl/mac/MW_TclAppleScriptHeader.pch11
-rw-r--r--tcl/mac/MW_TclBuildLibHeader.h7
-rw-r--r--tcl/mac/MW_TclBuildLibHeader.pch35
-rw-r--r--tcl/mac/MW_TclHeader.pch18
-rw-r--r--tcl/mac/MW_TclHeaderCommon.h54
-rw-r--r--tcl/mac/MW_TclStaticHeader.h7
-rw-r--r--tcl/mac/MW_TclStaticHeader.pch35
-rw-r--r--tcl/mac/MW_TclTestHeader.pch25
-rw-r--r--tcl/mac/README30
-rw-r--r--tcl/mac/license.terms7
-rw-r--r--tcl/mac/tclMac.h10
-rw-r--r--tcl/mac/tclMacAlloc.c172
-rw-r--r--tcl/mac/tclMacAppInit.c3
-rw-r--r--tcl/mac/tclMacApplication.r50
-rw-r--r--tcl/mac/tclMacBOAMain.c57
-rw-r--r--tcl/mac/tclMacChan.c68
-rw-r--r--tcl/mac/tclMacCommonPch.h21
-rw-r--r--tcl/mac/tclMacFCmd.c454
-rw-r--r--tcl/mac/tclMacFile.c779
-rw-r--r--tcl/mac/tclMacInit.c134
-rw-r--r--tcl/mac/tclMacInt.h25
-rw-r--r--tcl/mac/tclMacLibrary.c9
-rw-r--r--tcl/mac/tclMacLibrary.r28
-rw-r--r--tcl/mac/tclMacLoad.c240
-rw-r--r--tcl/mac/tclMacMath.h2
-rw-r--r--tcl/mac/tclMacNotify.c8
-rw-r--r--tcl/mac/tclMacOSA.c28
-rw-r--r--tcl/mac/tclMacOSA.r26
-rw-r--r--tcl/mac/tclMacPanic.c99
-rw-r--r--tcl/mac/tclMacPort.h66
-rw-r--r--tcl/mac/tclMacProjects.sea.hqx6915
-rw-r--r--tcl/mac/tclMacResource.c68
-rw-r--r--tcl/mac/tclMacResource.r50
-rw-r--r--tcl/mac/tclMacSock.c72
-rw-r--r--tcl/mac/tclMacTclCode.r12
-rw-r--r--tcl/mac/tclMacTest.c2
-rw-r--r--tcl/mac/tclMacThrd.c46
-rw-r--r--tcl/mac/tclMacTime.c238
-rw-r--r--tcl/mac/tclMacUnix.c2
-rw-r--r--tcl/mac/tclMacUtil.c72
-rw-r--r--tcl/macosx/Makefile74
-rw-r--r--tcl/macosx/Tcl.pbproj/jingham.pbxuser405
-rw-r--r--tcl/macosx/Tcl.pbproj/project.pbxproj1313
-rw-r--r--tcl/macosx/tclMacOSXBundle.c128
-rw-r--r--tcl/tests/README109
-rw-r--r--tcl/tests/all.tcl53
-rw-r--r--tcl/tests/append.test62
-rw-r--r--tcl/tests/appendComp.test362
-rw-r--r--tcl/tests/assocd.test1
-rw-r--r--tcl/tests/async.test1
-rw-r--r--tcl/tests/autoMkindex.test154
-rw-r--r--tcl/tests/basic.test195
-rw-r--r--tcl/tests/binary.test42
-rw-r--r--tcl/tests/case.test1
-rw-r--r--tcl/tests/clock.test46
-rw-r--r--tcl/tests/cmdAH.test460
-rw-r--r--tcl/tests/cmdIL.test23
-rw-r--r--tcl/tests/cmdInfo.test52
-rw-r--r--tcl/tests/cmdMZ.test69
-rw-r--r--tcl/tests/compExpr-old.test475
-rw-r--r--tcl/tests/compExpr.test43
-rw-r--r--tcl/tests/compile.test170
-rw-r--r--tcl/tests/concat.test1
-rw-r--r--tcl/tests/dcall.test1
-rw-r--r--tcl/tests/dstring.test1
-rw-r--r--tcl/tests/encoding.test190
-rw-r--r--tcl/tests/env.test43
-rw-r--r--tcl/tests/error.test3
-rw-r--r--tcl/tests/eval.test1
-rw-r--r--tcl/tests/event.test97
-rw-r--r--tcl/tests/exec.test514
-rw-r--r--tcl/tests/execute.test154
-rw-r--r--tcl/tests/expr-old.test128
-rw-r--r--tcl/tests/expr.test220
-rw-r--r--tcl/tests/fCmd.test476
-rw-r--r--tcl/tests/fileName.test875
-rw-r--r--tcl/tests/fileSystem.test396
-rw-r--r--tcl/tests/for-old.test1
-rw-r--r--tcl/tests/for.test34
-rw-r--r--tcl/tests/foreach.test12
-rw-r--r--tcl/tests/format.test65
-rw-r--r--tcl/tests/get.test13
-rw-r--r--tcl/tests/history.test1
-rw-r--r--tcl/tests/http.test74
-rw-r--r--tcl/tests/httpd3
-rw-r--r--tcl/tests/httpold.test85
-rw-r--r--tcl/tests/if-old.test1
-rw-r--r--tcl/tests/if.test90
-rw-r--r--tcl/tests/incr-old.test1
-rw-r--r--tcl/tests/incr.test1
-rw-r--r--tcl/tests/indexObj.test39
-rw-r--r--tcl/tests/info.test88
-rw-r--r--tcl/tests/init.test75
-rw-r--r--tcl/tests/interp.test654
-rw-r--r--tcl/tests/io.test2807
-rw-r--r--tcl/tests/ioCmd.test179
-rw-r--r--tcl/tests/ioUtil.test204
-rw-r--r--tcl/tests/iogt.test178
-rw-r--r--tcl/tests/join.test1
-rw-r--r--tcl/tests/license.terms7
-rw-r--r--tcl/tests/lindex.test492
-rw-r--r--tcl/tests/link.test233
-rw-r--r--tcl/tests/linsert.test1
-rw-r--r--tcl/tests/list.test1
-rw-r--r--tcl/tests/listObj.test1
-rw-r--r--tcl/tests/llength.test1
-rw-r--r--tcl/tests/load.test19
-rw-r--r--tcl/tests/lrange.test1
-rw-r--r--tcl/tests/lreplace.test1
-rw-r--r--tcl/tests/lsearch.test264
-rw-r--r--tcl/tests/lset.test457
-rw-r--r--tcl/tests/lsetComp.test433
-rw-r--r--tcl/tests/macFCmd.test35
-rw-r--r--tcl/tests/main.test1181
-rw-r--r--tcl/tests/misc.test1
-rw-r--r--tcl/tests/msgcat.test866
-rw-r--r--tcl/tests/namespace-old.test7
-rw-r--r--tcl/tests/namespace.test103
-rw-r--r--tcl/tests/obj.test84
-rw-r--r--tcl/tests/opt.test1
-rw-r--r--tcl/tests/osa.test1
-rw-r--r--tcl/tests/package.test1
-rw-r--r--tcl/tests/parse.test5
-rw-r--r--tcl/tests/parseExpr.test409
-rw-r--r--tcl/tests/parseOld.test136
-rw-r--r--tcl/tests/pid.test6
-rw-r--r--tcl/tests/pkg.test9
-rw-r--r--tcl/tests/pkgMkIndex.test397
-rw-r--r--tcl/tests/platform.test24
-rw-r--r--tcl/tests/proc-old.test59
-rw-r--r--tcl/tests/proc.test25
-rw-r--r--tcl/tests/pwd.test1
-rw-r--r--tcl/tests/reg.test19
-rw-r--r--tcl/tests/regexp.test84
-rw-r--r--tcl/tests/regexpComp.test803
-rw-r--r--tcl/tests/registry.test5
-rw-r--r--tcl/tests/rename.test4
-rw-r--r--tcl/tests/resource.test1
-rw-r--r--tcl/tests/result.test4
-rw-r--r--tcl/tests/safe.test27
-rw-r--r--tcl/tests/scan.test67
-rw-r--r--tcl/tests/security.test1
-rw-r--r--tcl/tests/set-old.test133
-rw-r--r--tcl/tests/set.test1
-rw-r--r--tcl/tests/socket.test349
-rw-r--r--tcl/tests/source.test66
-rw-r--r--tcl/tests/split.test2
-rw-r--r--tcl/tests/stack.test39
-rw-r--r--tcl/tests/string.test135
-rw-r--r--tcl/tests/stringComp.test673
-rw-r--r--tcl/tests/stringObj.test1
-rw-r--r--tcl/tests/subst.test126
-rw-r--r--tcl/tests/switch.test48
-rw-r--r--tcl/tests/tcltest.test1644
-rw-r--r--tcl/tests/thread.test34
-rw-r--r--tcl/tests/timer.test1
-rw-r--r--tcl/tests/trace.test1448
-rw-r--r--tcl/tests/unixFCmd.test81
-rw-r--r--tcl/tests/unixFile.test24
-rw-r--r--tcl/tests/unixInit.test231
-rw-r--r--tcl/tests/unixNotfy.test30
-rw-r--r--tcl/tests/unknown.test1
-rw-r--r--tcl/tests/uplevel.test16
-rw-r--r--tcl/tests/upvar.test1
-rw-r--r--tcl/tests/utf.test39
-rw-r--r--tcl/tests/util.test135
-rw-r--r--tcl/tests/var.test24
-rw-r--r--tcl/tests/while-old.test1
-rw-r--r--tcl/tests/while.test30
-rw-r--r--tcl/tests/winConsole.test1
-rw-r--r--tcl/tests/winDde.test47
-rw-r--r--tcl/tests/winFCmd.test114
-rw-r--r--tcl/tests/winFile.test23
-rw-r--r--tcl/tests/winNotify.test1
-rw-r--r--tcl/tests/winPipe.test300
-rw-r--r--tcl/tests/winTime.test27
-rw-r--r--tcl/tools/checkLibraryDoc.tcl1
-rwxr-xr-xtcl/tools/configure104
-rw-r--r--tcl/tools/configure.in4
-rw-r--r--tcl/tools/eolFix.tcl78
-rw-r--r--tcl/tools/feather.bmpbin0 -> 2102 bytes
-rw-r--r--tcl/tools/genStubs.tcl83
-rw-r--r--tcl/tools/genWinImage.tcl1
-rw-r--r--tcl/tools/man2help.tcl37
-rw-r--r--tcl/tools/man2help2.tcl39
-rw-r--r--tcl/tools/man2html.tcl2
-rw-r--r--tcl/tools/man2tcl.c8
-rw-r--r--tcl/tools/tcl.hpj.in7
-rw-r--r--tcl/tools/tcl.wse.in4733
-rw-r--r--tcl/tools/tclSplash.bmpbin162030 -> 162030 bytes
-rwxr-xr-xtcl/tools/tcltk-man2html.tcl234
-rw-r--r--tcl/tools/uniClass.tcl56
-rw-r--r--tcl/tools/uniParse.tcl4
-rw-r--r--tcl/unix/Makefile.in448
-rw-r--r--tcl/unix/README74
-rw-r--r--tcl/unix/aclocal.m41
-rwxr-xr-xtcl/unix/configure3836
-rwxr-xr-xtcl/unix/configure.in417
-rw-r--r--tcl/unix/dltest/Makefile.in29
-rw-r--r--tcl/unix/dltest/README13
-rw-r--r--tcl/unix/dltest/pkga.c2
-rw-r--r--tcl/unix/dltest/pkgb.c2
-rw-r--r--tcl/unix/dltest/pkgc.c2
-rw-r--r--tcl/unix/dltest/pkgd.c2
-rw-r--r--tcl/unix/dltest/pkge.c2
-rw-r--r--tcl/unix/dltest/pkgf.c1
-rwxr-xr-xtcl/unix/install-sh5
-rwxr-xr-xtcl/unix/ldAix1
-rwxr-xr-xtcl/unix/mkLinks2452
-rw-r--r--tcl/unix/tcl.m41280
-rw-r--r--tcl/unix/tcl.spec8
-rw-r--r--tcl/unix/tclAppInit.c15
-rw-r--r--tcl/unix/tclConfig.sh.in24
-rw-r--r--tcl/unix/tclLoadAix.c1
-rw-r--r--tcl/unix/tclLoadAout.c103
-rw-r--r--tcl/unix/tclLoadDl.c105
-rw-r--r--tcl/unix/tclLoadDld.c80
-rw-r--r--tcl/unix/tclLoadDyld.c190
-rw-r--r--tcl/unix/tclLoadNext.c88
-rw-r--r--tcl/unix/tclLoadOSF.c75
-rw-r--r--tcl/unix/tclLoadShl.c101
-rw-r--r--tcl/unix/tclUnixChan.c1472
-rw-r--r--tcl/unix/tclUnixEvent.c5
-rw-r--r--tcl/unix/tclUnixFCmd.c515
-rw-r--r--tcl/unix/tclUnixFile.c672
-rw-r--r--tcl/unix/tclUnixInit.c510
-rw-r--r--tcl/unix/tclUnixNotfy.c4
-rw-r--r--tcl/unix/tclUnixPipe.c143
-rw-r--r--tcl/unix/tclUnixPort.h113
-rw-r--r--tcl/unix/tclUnixSock.c18
-rw-r--r--tcl/unix/tclUnixTest.c35
-rw-r--r--tcl/unix/tclUnixThrd.c237
-rw-r--r--tcl/unix/tclUnixTime.c126
-rw-r--r--tcl/unix/tclXtTest.c5
-rw-r--r--tcl/win/Makefile.in191
-rw-r--r--tcl/win/README98
-rw-r--r--tcl/win/aclocal.m41
-rw-r--r--tcl/win/buildall.vc.bat36
-rw-r--r--tcl/win/cat.c2
-rw-r--r--tcl/win/coffbase.txt24
-rwxr-xr-xtcl/win/configure1758
-rwxr-xr-xtcl/win/configure.in242
-rw-r--r--tcl/win/license.terms9
-rw-r--r--tcl/win/makefile.bc954
-rw-r--r--tcl/win/makefile.vc1323
-rw-r--r--tcl/win/nmakehlp.c297
-rw-r--r--tcl/win/rules.vc263
-rw-r--r--tcl/win/stub16.c3
-rw-r--r--tcl/win/tcl.dsp1600
-rw-r--r--tcl/win/tcl.dsw30
-rw-r--r--tcl/win/tcl.hpj.in20
-rw-r--r--tcl/win/tcl.m4415
-rw-r--r--tcl/win/tcl.rc48
-rw-r--r--tcl/win/tclAppInit.c2
-rw-r--r--tcl/win/tclConfig.sh.in23
-rw-r--r--tcl/win/tclWin32Dll.c115
-rw-r--r--tcl/win/tclWinChan.c357
-rw-r--r--tcl/win/tclWinConsole.c27
-rw-r--r--tcl/win/tclWinDde.c144
-rw-r--r--tcl/win/tclWinError.c6
-rw-r--r--tcl/win/tclWinFCmd.c754
-rw-r--r--tcl/win/tclWinFile.c1966
-rw-r--r--tcl/win/tclWinInit.c245
-rw-r--r--tcl/win/tclWinInt.h27
-rw-r--r--tcl/win/tclWinLoad.c97
-rw-r--r--tcl/win/tclWinMtherr.c11
-rw-r--r--tcl/win/tclWinNotify.c55
-rw-r--r--tcl/win/tclWinPipe.c173
-rw-r--r--tcl/win/tclWinPort.h204
-rw-r--r--tcl/win/tclWinReg.c82
-rw-r--r--tcl/win/tclWinSerial.c1367
-rw-r--r--tcl/win/tclWinSock.c93
-rw-r--r--tcl/win/tclWinTest.c76
-rw-r--r--tcl/win/tclWinThrd.c166
-rw-r--r--tcl/win/tclWinThrd.h2
-rw-r--r--tcl/win/tclWinTime.c430
-rw-r--r--tcl/win/tclsh.rc46
596 files changed, 107776 insertions, 43581 deletions
diff --git a/tcl/ChangeLog b/tcl/ChangeLog
index 17a6b9308bd..2884fcf180c 100644
--- a/tcl/ChangeLog
+++ b/tcl/ChangeLog
@@ -1,5260 +1,4073 @@
-2001-08-08 Mo DeJong <mdejong@redhat.com>
+2002-09-10 Daniel Steffen <das@users.sourceforge.net>
- * cygtcl.m4 (TCL_TOOL_PATH, TCL_TOOL_SHARED_LIB_LONGNAME):
- Raise an error if the CYGPATH variable is not defined when
- TCL_TOOL_PATH is invoked. Add cygwin to the list of hosts
- that do not use a "lib" prefix for shared library names.
- * unix/configure: Regen.
- * win/configure: Regen.
-
-2001-08-06 Mo DeJong <mdejong@redhat.com>
-
- * cygtcl.m4 (TCL_TOOL_STATIC_LIB_LONGNAME,
- TCL_TOOL_SHARED_LIB_LONGNAME,
- TCL_TOOL_LIB_SHORTNAME): Use TCL_VENDOR_PREFIX instead
- of VENDORPREFIX to support using these macros in
- extensions that load tclConfig.sh.
- * unix/configure: Regen.
- * unix/configure.in: Subst VENDORPREFIX into tclConfig.sh.
- * unix/tclConfig.sh.in: Add TCL_VENDOR_PREFIX.
- * win/configure: Regen.
- * win/tcl.m4 (SC_CONFIG_CFLAGS): Set vendor prefix to "rh"
- instead of "sn" when compiling with VC++ or gcc. When
- compiling with Cygwin set the prefix to "cyg". Set the
- TCL_VENDOR_PREFIX to support the tcl tool macros in Tcl.
- * win/tclConfig.sh.in: Add TCL_VENDOR_PREFIX.
-
-2001-08-06 Mo DeJong <mdejong@redhat.com>
-
- * win/Makefile.in: Subst DDE_DLL_FILE, DDE_LIB_FILE, REG_DLL_FILE,
- REG_LIB_FILE, and PIPE_DLL_FILE from the configure script instead
- of figuring them out in the Makefile.
- * win/configure: Regen.
- * win/configure.in: Use TCL_TOOL_STATIC_LIB_LONGNAME and
- TCL_TOOL_SHARED_LIB_LONGNAME macros to figure out values for
- DDE_DLL_FILE, DDE_LIB_FILE, REG_DLL_FILE, REG_LIB_FILE, and
- PIPE_DLL_FILE and subst them into the Makefile.
-
-2001-08-01 Mo DeJong <mdejong@redhat.com>
-
- * cygtcl.m4 (TCL_TOOL_STATIC_LIB_LONGNAME,
- TCL_TOOL_SHARED_LIB_LONGNAME): Rename
- TCL_TOOL_LIB_LONGNAME to TCL_TOOL_STATIC_LIB_LONGNAME.
- Add new TCL_TOOL_SHARED_LIB_LONGNAME to construct
- shared library names in a cross platform way.
- * unix/configure: Regen.
- * unix/configure.in: Use TCL_TOOL_SHARED_LIB_LONGNAME
- and TCL_TOOL_STATIC_LIB_LONGNAME to generate lib names.
- * win/configure: Regen.
- * win/configure.in: Use TCL_TOOL_SHARED_LIB_LONGNAME
- and TCL_TOOL_STATIC_LIB_LONGNAME to generate lib names.
-
-2001-07-24 Mo DeJong <mdejong@redhat.com>
-
- * win/configure:
- * win/tcl.m4 (SC_CONFIG_CFLAGS): Don't pass explicit
- Cygwin libs on the command line since linking is now
- done using $CC and not $LD.
-
-2001-07-24 Mo DeJong <mdejong@redhat.com>
-
- * win/tclWinThrd.c (Tcl_CreateThread, TclpThreadExit):
- When building under Cygwin, call CreateThread instead
- of _beginthreadex and call ExitThread instead of
- _endthreadex. Cygwin does not support these msvcrt
- methods and does not suffer from the memory leak
- problems that prompted their use.
-
-2001-07-24 Mo DeJong <mdejong@redhat.com>
-
- * win/configure: Regen.
- * win/tcl.m4 (SC_CONFIG_CFLAGS): Check for bug in
- Cygwin version of windres and work around that
- case by passing a POSIX path instead of a Windows
- native path. One can't always pass a POSIX path
- because the mingw native toolchain accepts only
- Windows native paths.
+ * 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.
-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.
-
-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.
-
-2001-07-16 Mo DeJong <mdejong@redhat.com>
-
- * win/tclWinConsole.c:
- * win/tclWinPipe.c:
- * win/tclWinPort.h:
- * 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.
-
-2001-07-12 Mo DeJong <mdejong@redhat.com>
-
- * unix/Makefile.in:
- * unix/configure: Regen.
- * unix/configure.in:
- * unix/tcl.m4:
- * win/Makefile.in:
- * win/configure: Regen.
- * win/configure.in:
- * win/tcl.m4:
- Revert ill-conceived EXTRA_CFLAGS changes made on 2001-07-09.
- The change ended up causing big problems with the
- tclConfig.sh file since it exported EXTRA_CFLAGS and did
- not deal with the debug/non-debug case.
-
-2001-07-11 Mo DeJong <mdejong@redhat.com>
-
- * unix/configure: Regen.
- * unix/tcl.m4 (SC_CONFIG_CFLAGS): Avoid using AC_CHECK_TOOL
- since Tcl's configure script is not setup properly.
-
-2001-07-11 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.
- * win/configure: Regen.
- * win/tcl.m4 (SC_CONFIG_CFLAGS): Pass AR arguments in
- STLIB_LD to better match the Unix implementation. Don't
- bother defining AR when using VC++ since it is not used.
-
-2001-07-10 Mo DeJong <mdejong@redhat.com>
-
- * win/configure:
- * win/tcl.m4 (SC_CONFIG_CFLAGS): Use STLIB_LD in MAKE_LIB instead
- of AR which can be overridden on the make command line.
-
-2001-07-09 Mo DeJong <mdejong@redhat.com>
-
- * win/configure:
- * win/tcl.m4 (SC_CONFIG_CFLAGS): Fix quoting of CYGPATH
- argument to AC_CHECK_PROG.
-
-2001-07-09 Mo DeJong <mdejong@redhat.com>
-
- * unix/Makefile.in: Add EXTRA_CFLAGS_DEBUG and EXTRA_CFLAGS_OPTIMIZE
- variables. These two do not actually differ in the unix version
- but are there to keep in sync with the Windows version.
- * unix/configure: Regen.
- * unix/configure.in: Don't subst EXTRA_CFLAGS. Subst EXTRA_CFLAGS_DEFAULT,
- EXTRA_CFLAGS_DEBUG, and EXTRA_CFLAGS_OPTIMIZE.
- * unix/tcl.m4 (SC_ENABLE_SYMBOLS, SC_CONFIG_CFLAGS): Define
- EXTRA_CFLAGS_DEFAULT based on the --enable-smbols option.
- Set EXTRA_CFLAGS_DEBUG instead of EXTRA_CFLAGS and then set
- EXTRA_CFLAGS_OPTIMIZE to the value of EXTRA_CFLAGS_DEBUG since
- they are the same under Unix.
- * win/Makefile.in: Add EXTRA_CFLAGS_DEBUG and EXTRA_CFLAGS_OPTIMIZE
- variables. This is needed so that the proper runtime lib gets linked
- into VC++ produced .obj files when CFLAGS is reset on the command line.
- * win/configure: Regen.
- * win/configure.in: Don't subst EXTRA_CFLAGS. Subst EXTRA_CFLAGS_DEFAULT,
- EXTRA_CFLAGS_DEBUG, and EXTRA_CFLAGS_OPTIMIZE.
- * win/tcl.m4 :(SC_ENABLE_SYMBOLS, SC_CONFIG_CFLAGS): Define
- EXTRA_CFLAGS_DEFAULT based on the --enable-smbols option. Set
- EXTRA_CFLAGS_DEBUG and EXTRA_CFLAGS_OPTIMIZE based on the runtime
- option when compiled with VC++.
-
-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 uses main() as the executable
- entry point when both WinMain() and main() are available.
-
-2001-07-06 Mo DeJong <mdejong@redhat.com>
-
- * unix/configure: Regen.
- * unix/configure.in: Replace call to SC_ENABLE_GCC with
- AC_PROG_CC so that CC passed in from the caller is respected.
- * unix/tcl.m4: Remove the unused SC_ENABLE_GCC macro.
- * win/configure: Regen.
- * win/configure.in: Replace call to SC_ENABLE_GCC with
- AC_PROG_CC so that CC passed in from the caller is respected.
- * win/tcl.m4: Remove unused SC_ENABLE_GCC macro.
-
-2001-07-06 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/configure: Regen.
- * win/configure.in: Subst DEPARG.
- * win/tcl.m4 (SC_CONFIG_CFLAGS): Set DEPARG based
- on CYGPATH.
-
-2001-06-26 Mo DeJong <mdejong@redhat.com>
-
- * cygtcl.m4 (TCL_TOOL_PATH): Use CYGPATH variable instead of
- invoking cygpath directly. Handle cross compile by not
- using CYGPATH when set to echo.
- * unix/configure: Regen.
- * win/Makefile.in: Remove PATHTYPE variable.
- * win/configure: regen.
- * win/configure.in: Remove PATHTYPE subst + extra CYGPATH subst.
- * win/tcl.m4 (SC_CONFIG_CFLAGS): Remove PATHTYPE variable. Search
- for cygpath in the PATH and set CYGPATH="cygpath -w" if found.
- Remove old cross compiling hack.
-
-2001-06-26 Mo DeJong <mdejong@redhat.com>
-
- * win/Makefile.in: Don't use VPSEP in the VPATH,
- just use : as the spearator.
- * win/configure: Regen.
- * win/configure.in: Don't subst VPSEP.
- * win/tcl.m4 (SC_CONFIG_CFLAGS): Remove VPSEP.
-
-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.
-
-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/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.
- * 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.
+ * macosx/Tcl.pbproj/project.pbxproj:
+ * macosx/Makefile: added support for building Tcl as an embedded
+ 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>
-2001-06-22 Mo DeJong <mdejong@redhat.com>
+ *** 8.4.0 TAGGED FOR RELEASE ***
- * configure: Regen.
- * configure.in: When a windows32 host is detected
- configure in the win subdirectory.
- * cygtcl.m4 (TCL_TOOL_PATH, TCL_TOOL_LIB_LONGNAME,
- TCL_TOOL_LIB_SHORTNAME, TCL_TOOL_LIB_SPEC):
- Add support for mingw32 and windows32 hosts. Remove
- check for cygwin since we are really cross compiling
- when building win32 executables.
- * unix/configure: Regen.
- * win/configure: Regen.
+2002-09-06 Don Porter <dgp@users.sourceforge.net>
-2001-06-22 Mo DeJong <mdejong@redhat.com>
+ * doc/file.n: Format correction, and clarified [file normalize]
+ returns an absolute path.
- * 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.
+ * doc/tcltest.n: Added examples section, as long promised.
-2001-06-20 Mo DeJong <mdejong@redhat.com>
+2002-09-06 Reinhard Max <max@suse.de>
- * generic/tcl.h: Define __WIN32__ when __MINGW32__
- is defined to support building under Cygwin gcc
- with the -mno-cygwin flag.
+ * tests/tcltest.test: Added nonRoot flag to tests 8.3, 8.4, and 8.12.
-2001-06-14 Mo DeJong <mdejong@redhat.com>
+2002-09-05 Don Porter <dgp@users.sourceforge.net>
- * unix/Makefile.in: Avoid burning install TCL_LIBRARY into
- tclUnixInit.o at compile time.
- * unix/tclUnixInit.c (TclpInitLibraryPath): Fix location
- independence by searching for Tcl library in share/tclX.X
- instead of lib/tclX.X. This logic is no longer effected by a
- burned in TCL_LIBRARY.
- * win/tclWinInit.c (TclpInitLibraryPath): Search for Tcl library
- in share/tclX.X instead of lib/tclX.X. Remove a couple of
- Cygnus local hacks since they were not doing anything useful.
+ * doc/tcltest.n: Clarified phrasing.
-2001-06-08 Mo DeJong <mdejong@redhat.com>
+ * 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]
- * win/Makefile.in: Set TCL_LIBRARY to
- $INSTALL/share/tcl8.3 instead of
- $INSTALL/lib/tcl8.3.
+ * generic/tclVar.c (TclDeleteVars): Corrected logic for setting the
+ TCL_INTERP_DESTROYED flag when calling variable traces. [Tk Bug 605121]
-2001-06-08 Mo DeJong <mdejong@redhat.com>
+2002-09-04 Miguel Sofer <msofer@users.sourceforge.net>
- * win/tclConfig.sh.in: Correct the definition
- of TCL_LIB_FULL_PATH. It was inclosed in `
- characters instead of ' characters.
+ * generic/tclVar.c (DeleteArray): leak plug [Bug 604239]. Thanks
+ to dkf and dgp for the long and difficult discussion in the chat.
-2001-06-05 Mo DeJong <mdejong@redhat.com>
+2002-09-03 Jeff Hobbs <jeffh@ActiveState.com>
- * unix/configure: Regen.
- * unix/tcl.m4 (SC_CONFIG_CFLAGS): Add a TCL_LIB_SUFFIX variable
- to make the TCL_TOOL_LIB_SHORTNAME macro happy.
- * unix/tclConfig.sh.in: Add TCL_LIB_SUFFIX variable.
+ * generic/tclVar.c (Tcl_UpVar2): code cleanup to not use goto
-2001-06-05 Mo DeJong <mdejong@redhat.com>
+ * unix/configure: remove -pthread from LIBS on FreeBSD in thread
+ * unix/tcl.m4: enabled build. [Bug #602849]
- * cygtcl.m4 (TCL_TOOL_LIB_PATH): Call TCL_TOOL_PATH so that a
- Windows native path is generated for PATH variables.
- * unix/configure: Regen.
- * win/configure: Regen.
+2002-09-03 Miguel Sofer <msofer@users.sourceforge.net>
-2001-06-01 Mo DeJong <mdejong@redhat.com>
+ * generic/tclInterp.c (AliasCreate): a Tcl_Obj was leaked on error
+ return from TclPreventAliasLoop.
+
+2002-09-03 Daniel Steffen <das@users.sourceforge.net>
- * cygtcl.m4 (TCL_TOOL_PATH, TCL_TOOL_LIB_SHORTNAME): Check that argument to
- TCL_TOOL_PATH is not "". Use new TCL_LIB_SUFFIX variable in the
- TCL_TOOL_LIB_SHORTNAME macro under Windows.
- * unix/configure: Regen.
- * win/configure: Regen.
- * win/configure.in: Don't subst SHLIB_SUFFIX.
- * win/tcl.m4 (SC_CONFIG_CFLAGS): Set TCL_LIB_SUFFIX so that Tcl
- sees the same variable name that an extension will.
- * win/tclConfig.sh.in: Set the TCL_SHLIB_SUFFIX and TCL_LIB_SUFFIX vars.
+ * macosx/Tcl.pbproj/project.pbxproj: Bumped version number to
+ 8.4.0 and updated copyright info.
-2001-05-30 Mo DeJong <mdejong@redhat.com>
+2002-09-03 Miguel Sofer <msofer@users.sourceforge.net>
- * unix/configure: Regen.
- * unix/tcl.m4 (SC_PATH_TCLCONFIG, SC_PATH_TKCONFIG):
- Check in win subdirectory in addition to unix subdirectory for
- tclConfig.sh and tkConfig.sh files.
+ * generic/tclVar.c (Tcl_UpVar2): a Tcl_Obj was being leaked on
+ error return from TclGetFrame.
-2001-05-30 Mo DeJong <mdejong@redhat.com>
+2002-09-03 Don Porter <dgp@users.sourceforge.net>
- * cygtcl.m4: Add FIXME note.
- * unix/configure: Regen.
- * unix/tcl.m4 (SC_PATH_TCLCONFIG, SC_PATH_TKCONFIG):
- Generate an error instead of a warning if the Tcl, or Tk
- configuration files cannot be found.
+ * changes: Updated changes for 8.4.0 release.
-2001-05-26 Mo DeJong <mdejong@redhat.com>
+2002-09-02 Jeff Hobbs <jeffh@ActiveState.com>
- * cygtcl.m4 (TCL_TOOL_PATH, TCL_TOOL_LIB_LONGNAME,
- TCL_TOOL_LIB_SHORTNAME, TCL_TOOL_LIB_SPEC): Create cross
- platform versions of the TCL_TOOL* macros.
- * unix/aclocal.m4: Include ../cygtcl.m4.
- * unix/configure: Regen.
- * unix/tcl.m4 (TCL_TOOL_PATH, TCL_TOOL_LIB_LONGNAME,
- TCL_TOOL_LIB_SHORTNAME, TCL_TOOL_LIB_SPEC): Remove macros.
- * win/aclocal.m4: Include ../cygtcl.m4.
- * win/configure: Regen.
- * win/tcl.m4 (TCL_TOOL_PATH, TCL_TOOL_LIB_LONGNAME,
- TCL_TOOL_LIB_SHORTNAME, TCL_TOOL_LIB_SPEC): Remove macros.
-
-2001-05-24 Mo DeJong <mdejong@redhat.com>
+ * unix/tclUnixFile.c (TclpObjLink): removed unnecessary/unfreed
+ extra native char*.
- * unix/configure: Regen.
- * unix/configure.in: Add missing TCL_LIB_FULL_PATH
- variable.
+ * unix/tclUnixChan.c (Tcl_MakeTcpClientChannel): make sure to init
+ flags field of TcpState ptr to 0.
-2001-05-11 Mo DeJong <mdejong@redhat.com>
+ * unix/configure:
+ * unix/tcl.m4: added 64-bit gcc compilation support on HP-11.
+ [Patch #601051] (martin)
+ * README: Bumped version number to 8.4.0
+ * generic/tcl.h:
+ * tools/tcl.wse.in:
* unix/configure:
- * unix/tcl.m4 (SC_ENABLE_SYMBOLS):
+ * unix/configure.in:
+ * unix/tcl.spec:
+ * win/README.binary:
* win/configure:
- * win/tcl.m4 (SC_ENABLE_SYMBOLS): Back port of CFLAGS_DEFAULT fix
- from Tcl 8.4. A Makefile variable name is now used for the CFLAGS.
-
-2001-05-09 Mo DeJong <mdejong@redhat.com>
-
- * win/tcl.m4 (TCL_TOOL_PATH): Assign literal macro
- value to a tmp variable before running cygpath
- thus avoiding a problem with a quoted argument.
-
-2001-05-09 Mo DeJong <mdejong@redhat.com>
-
- * unix/Makefile.in: Use TCL_STUB_LIB_FILE instead of
- STUB_LIB_FILE subst when defining STUB_LIB_FILE.
- * unix/configure: Regen.
- * unix/configure.in: Use new path macros.
- * unix/tcl.m4 (TCL_TOOL_LIB_LONGNAME, TCL_TOOL_LIB_SHORTNAME,
- TCL_TOOL_LIB_SPEC, TCL_TOOL_LIB_PATH): Add macros
- to deal with library path translations.
- * win/Makefile.in: Add FIXME note.
- * win/configure: Regen.
- * win/configure.in: Use new path macros.
- * win/tcl.m4 (TCL_TOOL_LIB_LONGNAME, TCL_TOOL_LIB_SHORTNAME,
- TCL_TOOL_LIB_SPEC, TCL_TOOL_LIB_PATH): Add macros
- to deal with library path translations.
-
-2001-04-09 Mo DeJong <mdejong@redhat.com>
-
- * unix/configure: Regen.
- * unix/tcl.m4: Add placeholder TCL_TOOL_PATH macro.
- * win/configure: Regen.
- * win/configure.in: Set TCL_LIB_FLAG, TCL_BUILD_LIB_SPEC,
- TCL_LIB_SPEC, TCL_LIB_FULL_PATH and subst them.
- * win/tcl.m4: Add TCL_TOOL_PATH macro, it will call
- cygpath -w and replace \ with / to create a native
- Windows path that VC++ will understand.
- * win/tclConfig.sh.in: Add TCL_LIB_FULL_PATH variable.
-
-2001-04-05 Mo DeJong <mdejong@redhat.com>
-
- * win/configure: Regen.
- * win/configure.in: Subst the TCL_LIB_VERSIONS_OK variable.
- * win/tcl.m4: Add Cygnus local search for tcl8.1/win directory. Add
- TCL_LIB_VERSIONS_OK variable, it will get substituted into the
- tclConfig.sh file. Remve the SC_PROG_TCLSH macro.
-
-2001-04-05 Mo DeJong <mdejong@redhat.com>
-
- * generic/tclAlloc.c:
- * win/tclWinPort.h:
- Check for #define of WIN32 instead of VC++ specific symbol.
-
-2001-03-31 Mo DeJong <mdejong@redhat.com>
-
- * unix/Makefile.in: Remove second
- assignment to SCRIPT_INSTALL_DIR
- variable. This seems to have been
- a merge error. It was installing
- Tcl lib files in the lib directory
- instead of share/tcl8.3.
-
-2001-03-28 Ian Roxborough <irox@redhat.com>
-
- * unix/tclConfig.sh.in: Set TCL_CFLAGS to CFLAGS,
- otherwise tclConfig.sh won't work correctly.
-
-2000-09-15 Syd Polk <spolk@redhat.com>
-
- * Updated for the 8.3.2 release.
-
-2000-08-08 Jeff Hobbs <hobbs@ajubasolutions.com>
-
- 8.3.2 RELEASE finalized
-
- * changes: updated for release notes version of ChangeLog
-
- * library/msgcat1.0/pkgIndex.tcl:
- * library/msgcat1.0/msgcat.tcl: bumped msgcat version to 1.1.
-
-2000-08-07 Jeff Hobbs <hobbs@ajubasolutions.com>
-
- * doc/ChnlStack.3:
- * 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.
-
- * BACKPORTED FROM 8.4 (HEAD) BRANCH:
-
- * 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.
-
- * doc/DumpActiveMemory.3: Man page for Tcl_DumpActiveMemory,
- Tcl_InitMemory, and Tcl_ValidateAllMemory [Bug: 1816, 1835].
-
- * doc/Init.3: Man page for Tcl_Init [Bug: 1820].
-
- * unix/Makefile.in: add tclsh.ico and tcl.spec to dist target
-
- * 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).
-
- * doc/AddErrInfo.3:
- * doc/ChnlStack.3:
- * doc/Exit.3:
- * doc/GetIndex.3:
- * doc/Notifier.3:
- * doc/Object.3:
- * doc/RegExp.3:
- * doc/SetResult.3:
- * doc/SplitList.3:
- * doc/Thread.3: Added missing entries to NAME section.
-
- * doc/AddErrInfo.3:
- * doc/CrtObjCmd.3:
- * doc/RecEvalObj.3: Changed Tcl_EvalObj to Tcl_EvalObjEx
-
- * doc/library.n: Added entries for auto_qualify and auto_import
- [Bug: 1271].
- * 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].
-
- * doc/expr.n: Added documentation for each of the math library
- functions that expr supports [Bug: 1054].
-
- * doc/regsub.n: correct regsub docs [Bug: 5346]
-
- * doc/scan.n: minor doc fixes [Bug: 5396]
-
- * doc/RegExp.3: Replaced instances of "Tcl_GetRegExpInfo" with
- "Tcl_RegExpGetInfo", the correct name of the function [Bug: 5901].
-
- * doc/package.n: Corrected information about [package forget]
- arguments [Bug: 5418].
-
- * generic/tclCkalloc.c: Fixed some function headers.
-
- * tests/clock.test: Added test for "2 days 2 hours ago" style
- specifications.
-
- * 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/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]
-
- * library/init.tcl (auto_import): added check to see if a valid
- pattern was coming in, to avoid simple error cases [Bug: 3326]
-
- * library/history.tcl: Corrected an off-by-one error in HistIndex,
- which was causing [history redo] to start its search at the wrong
- event index. [Bug: 1269].
-
- * generic/tclPosixStr.c (Tcl_SignalMsg): clarified #defines for
- Linux on Sparc to compile correctly. [Bug: 5364]
-
- * generic/tclEnv.c: cast cleanup [Bug: 5624]
- * win/tclWinFCmd.c: cast cleanup [Bug: 5627]
-
- * generic/tclIndexObj.c (Tcl_GetIndexFromObjStruct): Corrected
- caching of the index ptr to account for offsets != sizeof(char *).
- [Bug: 5153]
-
- * tests/opt.test:
- * library/opt0.4/optparse.tcl: Applied patch from [Bug: 5922], which
- corrected an incorrect use of [string match].
-
- * tests/stringObj.test: Tweaked tests to avoid hardcoded
- high-ASCII characters (which will fail in multibyte locales);
- instead used \uXXXX syntax. [Bug: 3842].
-
-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/tclTest.c (TestChannelCmd): added some lint init'ing of
- statePtr and chan vars.
-
-2000-07-28 Mo DeJong <mdejong@redhat.com>
-
- * win/Makefile.in:
* win/configure.in:
- * win/tcl.m4:
- * win/tclConfig.sh.in: Back port of gcc for windows
- build system from 8.4.
-
-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.
-
- * 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,
- Tcl_ChannelGetOptionProc, Tcl_ChannelWatchProc,
- Tcl_ChannelGetHandleProc, Tcl_ChannelFlushProc,
- and Tcl_ChannelHandlerProc. These should be used to access the
- Tcl_ChannelType structure instead of direct pointer dereferencing.
- * unix/Makefile.in: undid 07-25 Makefile.in changes because we
- don't really want to force all private makefiles on everyone.
- This needs to be addressed again in the future. Best possible
- solution is to create a tcl/ subdir in the installing include dir
- (as is done already with the lib dir).
+ * 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]
- * tests/iogt.test: added RCS string, marked tests 2.* to be
- unixOnly due to underlying system differences.
+ * win/tclWinConsole.c (ConsoleCloseProc): only wait on writable
+ pipe if there was something to write. This may prevent infinite
+ wait on exit.
- * tests/all.tcl: corrected additional sets by Kupries for testing.
+ * tests/exec.test: marked exec-18.1 unixOnly until the Windows
+ incompatability (in the test, not the core) can be resolved.
-2000-07-26 Syd Polk <spolk@redhat.com>
+ * tests/http.test (http-3.11): added close $fp that was causing an
+ error on Windows because the file was not closed before deleting.
- * win/tcl.m4: Building libraries is significantly different on Cygwin
- now; rewhacked.
- * win/configure.in: Ditto.
- * win/Makefile.in: Ditto.
- * win/configure: Regenerated.
- * win/tclWinPort.h: tchar.h and direct.h are not defined on Cygwin,
- nor or they needed.
+ * unix/tclUnixInit.c (Tcl_MacOSXGetLibraryPath): made this static
+ function only appear when HAVE_CFBUNDLE is defined.
+2002-08-31 Daniel Steffen <das@users.sourceforge.net>
-2000-07-25 Brent Welch <welch@ajubasolutions.com>
+ * unix/tcl.m4: added TK_SHLIB_LD_EXTRAS analogue of existing
+ TCL_SHLIB_LD_EXTRAS for linker settings only used when linking Tk.
- * unix/Makefile.in: Need to install all the Tcl headers because
- Itcl depends on internal headers.
+ * unix/configure: regen
-2000-07-25 Andreas Kupries <a.kupries@westend.com>
+2002-08-31 Daniel Steffen <das@users.sourceforge.net>
- * 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.
+ *** macosx-8-4-branch merged into the mainline [tcl patch #602770] ***
- * generic/tclIO.h: (line 139f) struct Channel, added a buffer
- queue, to hold data pushed back when stacking a transformation.
+ * generic/tcl.decls: added new macosx specific entry to stubs table.
- * 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.
-
- * generic/tcl.decls: New public API 'Tcl_ChannelBuffered'. S.a.
-
-2000-07-19 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.
-
-2000-07-18 Brent Welch <welch@ajubasolutions.com>
-
- * win/Makefile.in: Added rules for static tcldde and tclreg libraries.
-
-2000-07-17 Jeff Hobbs <hobbs@scriptics.com>
-
- * README:
- * win/README:
- * win/README.binary:
- * win/configure.in:
- * unix/configure.in:
- * unix/tcl.spec:
- * tools/tcl.wse.in:
- * generic/tcl.h (TCL_RELEASE_SERIAL): updated to patchlevel 8.3.2
-
- * unix/Makefile.in:
- * win/Makefile.in:
- * win/makefile.vc: added tclIOGT.c to objects list to compile.
-
- * generic/tclStubInit.c:
- * 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
- TclChannelTransform.
-
- * generic/tclIO.h: new file that contains the main internal
- structures of Tcl_Channel code to allow for multiple files to
- access them.
- * generic/tclTest.c:
- * generic/tclIO.c: broke into 3 files - tclIO.c core code, tclIO.h
- header code, and tclIOGT.c - the giot test code from Kupries. The
- channel test code also moved to tclTest.c.
- * 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.
-
-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).
-
- * win/tclWinChan.c: updated fileChannelType to v2 channel struct
- * win/tclWinConsole.c: updated consoleChannelType to v2 channel struct
- * win/tclWinPipe.c: updated pipeChannelType to v2 channel struct
- * win/tclWinSerial.c: updated serialChannelType to v2 channel struct
- * win/tclWinSock.c: updated tcpChannelType to v2 channel struct
-
-2000-07-11 Brent Welch <welch@ajubasolutions.com>
-
- * win/tclConfig.sh.in: 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.
-
- * 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/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).
-
-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 :(.
-
- * 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).
-
- test suite: failures of iogt-[345].0
+ * 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.
-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).
- * 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.
-
-2000-06-16 Syd Polk <spolk@redhat.com>
-
- * generic/tclEnv.c win/tclWin32Dll.c: Fix impurePtr to work with
- modern Cygwin.
- * win/tcl.m4: Use --compat-implib.
- * win/configure: Regenerate.
-
-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.
-
-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.
-
-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.
-
-2000-04-26 Jeff Hobbs <hobbs@scriptics.com>
-
- 8.3.1 RELEASE
+ * 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.
- * README:
- * mac/README:
- * tools/tcl.wse.in:
- * unix/README:
- * unix/tcl.spec:
- * win/README:
- * win/README.binary: Updating URLs to reference dev.scriptics.com
+ * 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.
-2000-04-25 Jeff Hobbs <hobbs@scriptics.com>
+ * 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:
- * win/Makefile.in:
- * win/makefile.vc: updated for http change and some cleanup
- * library/http2.[13]: moved dir http2.1 to http2.3 to match version
-
- * doc/Utf.3: clarified docs for Tcl_(UniChar|Utf)AtIndex
-
- * unix/tclUnixThrd.c: removed {}s around PTHREAD_MUTEX_INITIALIZER
- [Bug: 5254]
-
- * unix/tclLoadDyld.c (TclpLoadFile): removed use of interp->result
+ * 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.
-2000-04-25 Eric Melski <ericm@scriptics.com>
+ * macosx/tclMacOSXBundle.c (new): support for finding Tcl extension
+ packaged as 'bundles' in the standard Mac OSX library locations.
- * unix/mkLinks:
- * doc/AddErrInfo.3: Added information about Tcl_LogCommandInfo
- [Bug: 1818].
+ * unix/tclUnixInit.c: added support for findig the tcl script
+ library inside Tcl packaged as a framework on Mac OSX.
-2000-04-24 Eric Melski <ericm@scriptics.com>
+ * macosx/Tcl.pbproj/jingham.pbxuser (new):
+ * macosx/Tcl.pbproj/project.pbxproj (new): project for Apple's
+ ProjectBuilder IDE.
- * unix/mkLinks:
- * doc/OpenFileChnl.3: Added man entry for Tcl_Ungets [Bug: 1834].
+ * macosx/Makefile (new): simple makefile for building the project
+ from the command line via the ProjectBuilder tool 'pbxbuild'.
- * unix/mkLinks:
- * doc/SourceRCFile.3: Man page for Tcl_SourceRCFile [Bug: 1833].
+ * unix/configure:
+ * generic/tclStubInit.c:
+ * generic/tclPlatDecls.h: regen
- * unix/mkLinks:
- * doc/ParseCmd.3: Added documentation for Tcl_ParseVar [Bug: 1828].
+2002-08-29 Andreas Kupries <andreas_kupries@users.sourceforge.net>
-2000-04-24 Jeff Hobbs <hobbs@scriptics.com>
+ * win/tclWinThrd.c (TclpFinalizeThreadData, TclWinFreeAllocCache):
+ Applied patch for bug #599428, provided by Miguel Sofer
+ <msofer@users.sourceforge.net>.
- * 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]
+2002-08-28 David Gravereaux <davygrvy@pobox.com>
- * unix/tclUnixThrd.c (Tcl_MutexLock): minor comment fixes.
+ * 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]
-2000-04-23 Jim Ingham <jingham@cygnus.com>
+ * unix/configure: regen'd
- These changes make some error handling marginally better for Mac
- sockets. It is still somewhat flakey, however.
+2002-08-28 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * 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
- experimenting with MacTCP.
+ * doc/eval.n: Added mention of list command and corrected "SEE ALSO".
-2000-04-22 Jim Ingham <jingham@cygnus.com>
+ * 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.
- * library/package.tcl (tclPkgUnknown): Fixed a typo in the Mac package
- search part of tclPkgUnknown.
+2002-08-26 Miguel Sofer <msofer@users.sourceforge.net>
-2000-04-21 Sandeep Tamhankar <sandeep@scriptics.com>
+ * 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.
- * 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).
+2002-08-26 Miguel Sofer <msofer@users.sourceforge.net>
-2000-04-21 Brent Welch <welch@scriptics.com>
+ * generic/tclThreadAlloc.c: small optimisation, reducing the
+ new allocator's overhead.
+
+2002-08-23 Miguel Sofer <msofer@users.sourceforge.net>
- * 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.
+ * generic/tclObj.c (USE_THREAD_ALLOC): fixed leak [Bug 597936].
+ Thanks to Zoran Vasiljevic.
-2000-04-20 Jeff Hobbs <hobbs@scriptics.com>
+2002-08-23 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclAlloc.c: wrapped caddr_t define to not be done on Unix
- * unix/tclUnixPort.h: added Tclp*Alloc defines to allow the use of
- USE_TCLALLOC on Unix. [Bug: 4731]
+ * generic/tclThreadAlloc.c (USE_THREAD_ALLOC): moving objects
+ between caches as a block, instead of one-by-one.
-2000-04-19 Jeff Hobbs <hobbs@scriptics.com>
+2002-08-22 Miguel Sofer <msofer@users.sourceforge.net>
- * 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]
+ * generic/tclBasic.c:
+ * generic/tclCmdMZ.c: fix for freed memory r/w in delete traces
+ [Bug 589863], patch by Hemang Lavana.
- * win/Makefile.in: expanded cleanup target for help files
+2002-08-20 Andreas Kupries <andreas_kupries@users.sourceforge.net>
- * doc/Thread.3: minor macro cleanup
+ * 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.
- * generic/tclFileName.c (SplitUnixPath): added support for QNX
- node ids.
+2002-08-20 Don Porter <dgp@users.sourceforge.net>
-2000-04-18 Jeff Hobbs <hobbs@scriptics.com>
+ * generic/tclCkalloc.c: CONSTified MemoryCmd and CheckmemCmd.
- * README:
- * generic/tcl.h:
+ * README: Bumped version number to 8.4b3 to distinguish
+ * generic/tcl.h: HEAD from the 8.4b2 release.
* tools/tcl.wse.in:
* unix/configure.in:
* unix/tcl.spec:
+ * win/README.binary:
* win/configure.in:
- * win/README.binary: bumped version to 8.3.1
-
- * win/tcl.hpj.in: updated copyright date
-
- * generic/tclEnv.c: environment support for Mac OS/X
- * unix/tclUnixPort.h: environment support for Mac OS/X
- * unix/tclLoadDyld.c: new file for Mac OS/X dl functions
- * 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]
-
- * generic/tclEvent.c (TclInitSubsystems): Moved tclLibraryPath to
- thread-local storage to prevent thread-related race condition.
- [Bug: 5033]
- * unix/tclAppInit.c (main): removed #ifdef TCL_TEST that sets the
- library path as it was unnecessary and conflicts with move of
- tclLibraryPath to thread-local storage.
-
-2000-04-18 Scott Redman <redman@scriptics.com>
-
- * 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.
-
-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.
-
-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]
-
- * doc/AppInit.3:
- * doc/Async.3:
- * doc/BackgdErr.3:
- * doc/CrtChannel.3:
- * doc/CrtInterp.3:
- * doc/CrtMathFnc.3:
- * doc/DString.3:
- * doc/Eval.3:
- * doc/ExprLong.3:
- * doc/GetInt.3:
- * doc/GetOpnFl.3:
- * doc/Interp.3:
- * doc/LinkVar.3:
- * doc/OpenFileChnl.3:
- * doc/OpenTcp.3:
- * doc/PkgRequire.3:
- * doc/RecordEval.3:
- * doc/SetResult.3:
- * doc/SplitList.3:
- * doc/StaticPkg.3:
- * doc/TraceVar.3:
- * doc/Translate.3:
- * doc/UpVar.3:
- * doc/load.n: removed or updated references to interp->result use.
-
-2000-04-13 Jeff Hobbs <hobbs@scriptics.com>
- * doc/regexp.n: doc clarification [Bug: 5037]
- * doc/update.n: typo fix [Bug: 4996]
-
- * unix/tcl.m4 (SC_ENABLE_THREADS): enhanced the detection of
- pthread_mutex_init [Bug: 4359] and (SC_CONFIG_CFLAGS) added
- --enable-64bit-vis switch for Sparc VIS compilation [Bug: 4995]
-
-2000-04-12 Jeff Hobbs <hobbs@scriptics.com>
+ * unix/configure: autoconf
+ * win/configure:
- * doc/dde.n: corrected dde poke docs. [Bug: 4991]
+ * library/http/http.tcl: Corrected installation directory of
+ * 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
+ * unix/Makefile.in: updates to match increasing version
+ * win/Makefile.in: numbers. [Bug 597450]
+ * win/makefile.bc:
+ * win/makefile.vc:
-2000-04-11 Eric Melski <ericm@scriptics.com>
+2002-08-19 Andreas Kupries <andreas_kupries@users.sourceforge.net>
- * win/tclWinPipe.c: Added "CONST" keyword to declaration of char
- *native in TclpCreateTempFile, to supress compiler warnings.
+ * unix/tclUnixTest.c (TestfilehandlerCmd): Changed
+ readable/writable to the more common readable|writable.
-2000-04-10 Brent Welch <welch@scriptics.com>
+ Fixes SF #596034 reported by Larry Virden
+ <lvirden@users.sourceforge.net>.
- * 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
+2002-08-16 Donal K. Fellows <fellowsd@cs.man.ac.uk>
-2000-04-10 Eric Melski <ericm@scriptics.com>
+ * 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.
+ * 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.
- * win/tclWinPipe.c (TclpCreateTempFile): Added conversion of
- contents string from UTF to native encoding [Bug: 4030].
+2002-08-14 Miguel Sofer <msofer@users.sourceforge.net>
- * tests/regexp.test: Added tests for infinite looping in [regexp
- -all].
+ * generic/tclInt.h:
+ * 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.
- * generic/tclCmdMZ.c: Fixed infinite loop bug with [regexp -all]
- [Bug: 4981].
-
- * tests/*.test: Changed all occurances of "namespace import
- ::tcltest" to "namespace import -force ::tcltest" [Bug: 3948].
-
-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.
-
-2000-04-09 Jeff Hobbs <hobbs@scriptics.com>
-
- * tests/reg.test (matchexpected): corrected tests to use tcltest
- constraint types to skip certain tests.
-
- * 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).
-
-2000-04-08 Andreas Kupries <a.kupries@westend.com>
-
- * Overall change: Definition of a public API for the creation of
- 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.
-
- * 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.
-
- * win/tclWinThrd.c:
- * mac/tclMacThrd.c: Renamed TclpThreadCreate to Tcl_CreateThread,
- 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.
-
- * generic/tclThreadTest.c (line 363): See below.
-
- * 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).
-
- * 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]
-
- * 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.
+2002-08-12 Miguel Sofer <msofer@users.sourceforge.net>
-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: ??].
-
-2000-03-04 Brent Welch <welch@scriptics.com>
-
- * {win,unix}/Makefile.in: added dependency of tclStubInit.c on
- tcl.decls and tclInt.decls
- * generic/tclThread.c: Tweak so this compiles w/out TCL_THREADS
- * generic/{tcl.decls,tclStubInit.c}: Just touched the tcl.decls and
- regenerated the tclStubInit.c file
-
-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.
-
-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].
-
- * generic/tclInt.h: Removed definitions of TclFinalizeMutex and
- TclFinalizeCondition.
-
- * 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/tclNotify.c: Changed usage of TclFinalizeMutex to
- Tcl_MutexFinalize.
-
- * 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.
+ * generic/tclCmdMZ.c: fixing UMR in delete traces, [Bug 589863].
+
+2002-08-08 David Gravereaux <davygrvy@pobox.com>
- * doc/Thread.3: Added description the new API's.
+ * tools/man2help.tcl: Fixed $argv handling bug where if -bitmap
+ wasn't specified $argc was off by one.
-2000-04-03 Jeff Hobbs <hobbs@scriptics.com>
+2002-08-08 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclCmdIL.c (InfoVarsCmd): checked for non-NULL procPtr
- to prevent itcl info override crash [Bug: 4064]
+ * tests/uplevel.test: added 6.1 to test [uplevel] with shadowed
+ commands [Bug 524383]
- * tests/foreach.test:
- * tests/namespace.test:
- * tests/var.test: Added lsorts to avoid random sorted return
- problems. [Bug: 2682]
+ * tests/subst.test: added 5.8-10 as further tests for [Bug 495207]
- * tests/fileName.test: fixed 14.1 test fragility [Bug: 1482]
+2002-08-08 Don Porter <dgp@users.sourceforge.net>
- * tools/man2help2.tcl: fixed winhelp cross-linking error [Bug: 4156]
- improved translation to winhelp [Bug: 3679]
+ * tests/README: Noted removal of defs.tcl.
- * unix/Makefile.in (MAN_INSTALL_DIR): patch to accept --mandir
- correctly [Bug: 4085]
+2002-08-08 Jeff Hobbs <jeffh@ActiveState.com>
- * unix/dltest/pkg[a-e].c: Cleaned up test packages [Bug: 2293]
+ * doc/lsearch.n: corrected lsearch docs to use -inline in examples.
-2000-04-03 Eric Melski <ericm@scriptics.com>
+ *** 8.4b2 TAGGED FOR RELEASE ***
- * unix/tclUnixFCmd.c (SetGroupAttribute):
- * unix/tclUnixFCmd.c (SetOwnerAttribute): Added (uid_t) and (gid_t)
- casts to avoid compiler warnings.
+ * 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)
+ (CopyRenameOneFile): this is currently disabled by default until
+ further issues with such behavior (like relative links) can be
+ handled correctly.
-2000-03-31 Eric Melski <ericm@scriptics.com>
+ * tests/README: slight wording improvements
- * 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].
+2002-08-07 Miguel Sofer <msofer@users.sourceforge.net>
- * 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].
- (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.)
+ * docs/BoolObj.3: added description of valid string reps for a
+ 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]
+
+2002-08-07 Miguel Sofer <msofer@users.sourceforge.net>
-2000-03-30 Jeff Hobbs <hobbs@scriptics.com>
+ * generic/tclCompile.h:
+ * generic/tclObj.c: making tclCmdNameType static ([Bug 584567],
+ Don Porter).
+
+2002-08-07 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclBasic.c (Tcl_DeleteCommandFromToken): Added comments
- noting the need to pair ckalloc with ckfree. [Bug: 4262]
+ * 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]
* generic/tclIntPlatDecls.h:
- * generic/tclStubInit.c:
- * win/tclWin32Dll.c: removed TclWinSynchSpawn (vestige of Win32s
- support).
-
- * win/tclWinReg.c: made use of TclWinGetPlatformId instead of
- getting info again
-
- * win/tclWinPort.h:
- * win/Makefile.in:
- * win/configure.in:
- * win/tcl.m4: Added support for gcc/mingw on Windows [Bug: 4234]
-
-2000-03-29 Jeff Hobbs <hobbs@scriptics.com>
-
- * generic/tclCompile.c (TclCleanupByteCode): made ByteCode cleanup
- more aware of TCL_BYTECODE_PRECOMPILED flagged structs (gen'd by
- tbcload), to correctly clean them up.
-
- * generic/tclClock.c (FormatClock): moved check for empty format
- earlier, commented 0 result return value
-
-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.
-
-2000-03-27 Jeff Hobbs <hobbs@scriptics.com>
-
- * tests/httpd: removed unnecessary 'puts stderr "Post Dispatch"'
-
- * 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.
-
- * 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/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.
-
-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.
-
-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.
-
- * 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).
-
-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.
-
- * 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".
-
- * 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).
-
-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.
-
-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.
-
-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
-
- * 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]
-
- * 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.
- Previously it would fail to recognize 000000 as an ISO base.
-
-2000-02-14 Eric Melski <ericm@scriptics.com>
-
- * unix/Makefile.in: Added rpm target to generate Tcl binary RPM.
-
- * unix/tcl.spec: RPM specification file for a Tcl binary RPM for
- Linux.
-
-2000-02-10 Jeff Hobbs <hobbs@scriptics.com>
-
- 8.3.0 RELEASE
-
- * changes: updated for 8.3.0 release
-
- * 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
-
- * 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]
-
- * 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
- 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...
-
- 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/tclGetDate.y (Message): Added a grammar rule for "next
- monthname" so that we can handle "next january" and similar
- constructs (bug #4146).
-
-2000-02-08 Jeff Hobbs <hobbs@scriptics.com>
-
- * README:
- * tools/tcl.wse.in:
- * unix/configure.in:
- * win/configure.in:
- * win/README:
- * win/README.binary:
- * generic/tcl.h (TCL_RELEASE_SERIAL): Moved to 8.3.0 patchlevel
-
- * doc/library.n:
- * library/auto.tcl: fixed crufty puts code and docs [Bug: 4122]
-
- * library/tcltest1.0/tcltest.tcl: correctly protected searchDirectory
- list to allow dirnames with spaces
-
- * unix/tcl.m4: changed all -fpic to -fPIC
-
- * generic/tclDecls.h:
- * generic/tcl.decls: change Tcl_GetOpenFile to use decl of 'int
- forWriting' instead of 'int write' to avoid shadowing [Bug: 4121]
-
- * 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]
-
- * 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:
- * 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
- 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
-
-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.
-
-2000-02-01 Jeff Hobbs <hobbs@scriptics.com>
-
- * win/Makefile.in (install-*): reduced verbosity of install
-
- * generic/tclFileName.c (Tcl_JoinPath): improved support for special
- QNX node id prefixes in pathnames [Bug: 4053]
-
- * library/http1.0/http.tcl:
- * library/http2.1/http.tcl: The query data POSTed was newline
- terminated when it shouldn't be altered [Bug: 4089]
-
-2000-01-31 Eric Melski <ericm@scriptics.com>
-
- * 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/auto.tcl: "Fixed" issues with $ in files to be auto indexed.
-
- * doc/Package.n: New man page for package::create function.
-
- * doc/pkgMkIndex.n: Added additional information.
-
- * doc/library.n: Added additional qualification regarding auto_mkindex.
-
-2000-01-28 Eric Melski <ericm@scriptics.com>
-
- * 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).
-
- * 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).
-
- * 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).
-
-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.
-
-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.
- * library/tcltest1.0/pkgIndex.tcl: Added normalizePath.
- * tests/all.tcl: Changed code to use normalizePath.
+ * generic/tclStubInit.c: Regen.
+
+2002-08-05 Don Porter <dgp@users.sourceforge.net>
+
+ * 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
+ corrected tcltest package bumped to version 2.2.
+
+ * 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/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
+
+2002-08-01 Miguel Sofer <msofer@users.sourceforge.net>
+
+ * generic/tclExecute.c: bugfix (reading freed memory). Testsuite
+ passed on linux/i386, compile-13.1 hung on linux/alpha.
+
+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.
+
+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.
+
+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.
+
+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.
+
+2002-07-31 Miguel Sofer <msofer@users.sourceforge.net>
+
+ * generic/tclInterp.c: signed/unsigned comparison warning fixed
+ (Vince Darley).
+
+2002-07-31 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * unix/tcl.m4 (SC_BUGGY_STRTOD): Enabled caching of test results.
+
+ * 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]
+
+2002-07-30 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ * 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.
+
+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/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]
-2000-01-27 Eric Melski <ericm@scriptics.com>
+2002-07-29 Reinhard Max <max@suse.de>
- * tests/pkg/samename.tcl: test file for bug #1983
+ * unix/tcl.m4 (SC_SERIAL_PORT): Fixed detection for cases when
+ configure's stdin is not a tty.
- * 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.
- 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).
-
-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/info.n: Added further information about differences between
- "namespace which" and "info exists".
-
- * doc/SetErrno.3: Added descriptions of ErrnoId() and ErrnoMsg()
- functions.
-
-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]
-
- * 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/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]
-
- * doc/glob.n: clarified Mac path separator determination docs.
-
- * win/makefile.vc: added some support for building helpfile on Windows
+ * unix/tclUnixPort.h:
+ * generic/tclIOSock.c: Changed size_t to socklen_t in
+ socket-related function calls.
-2000-01-23 Jeff Hobbs <hobbs@scriptics.com>
+ * unix/configure.in: Added test and fallback definition
+ for socklen_t.
+
+ * unix/configure: generated.
- * library/init.tcl (auto_execok): added 'start' to list of
- recognized built-in commands for COMSPEC on NT. [Bug: 2858]
+2002-07-29 Miguel Sofer <msofer@users.sourceforge.net>
- * unix/tclUnixPort.h: moved include of <utime.h> lower since some
- systems (UTS) require sys/types.h to be included first [Bug: 4031]
+ * generic/tclObj.c: fixed a comment
- * unix/tclUnixChan.c (CreateSocketAddress): changed comparison
- with -1 to 0xFFFFFFFF, to ensure 32 bit comparison even on 64 bit
- systems. [Bug: 3878]
+ * 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.
+ * 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
+ pvgoran@users.sf.net for tracking this down.
+
+2002-07-28 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclFileName.c: improved guessing of path separator
- for the Mac. (Darley)
+ * 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].
+ * tests/interp.test:
+ * tests/stack.test: adapted to the new error message.
+ * 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/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/tclConfig.sh.in: Add TCL_CC_SEARCH_FLAGS.
- * generic/tclInt.h:
- * generic/tcl.decls: moved Tcl_ProcObjCmd to stubs table [Bug: 3827]
- and removed 'register' from stub definition of
- Tcl_AppendUnicodeToObj [Bug: 4038]
+2002-07-26 Miguel Sofer <msofer@users.sourceforge.net>
-2000-01-21 Eric Melski <ericm@scriptics.com>
+ * 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>
- * unix/mkLinks:
- * doc/GetHostName.3: Man page for Tcl_GetHostName (bug #1817).
+ * generic/tclVar.c (TclObjLookupVar): leak fix and improved
+ comments.
- * doc/lreplace.n: Corrected man page with respect to treatment of
- empty lists, and "prettied up" the page. (bug #1705).
+2002-07-26 Jeff Hobbs <jeffh@ActiveState.com>
-2000-01-20 Eric Melski <ericm@scriptics.com>
+ * generic/tclVar.c (TclLookupVar): removed early returns that
+ prevented the parens from being restored. also removed goto label
+ as it was not necessary.
- * tests/namespace.test: Added test for undefined variables with
- namespace which (bug #956).
+2002-07-24 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclNamesp.c: Added check for undefined variables in
- NamespaceWhichCmd (bug #956).
+ * generic/tclExecute.c:
+ * tests/expr-old.test: fix for erroneous error messages in [expr],
+ [Bug 587140] reported by Martin Lemburg.
- * tests/var.test: Added tests for corrected variable behavior
- (bug #981).
+2002-07-25 Joe English <jenglish@users.sourceforge.net>
+ * generic/tclProc.c: fix for Tk Bug #219218 "error handling
+ with bgerror in Tk"
- * doc/upvar.n: Expanded explanation of upvar behavior with respect to
- variable traces. (bugs 3917 1433 2110).
+2002-07-24 Miguel Sofer <msofer@users.sourceforge.net>
- * 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).
+ * generic/tclExecute.c: restoring full TCL_COMPILE_DEBUG
+ functionality.
-2000-01-20 Jeff Hobbs <hobbs@scriptics.com>
+2002-07-24 Don Porter <dgp@users.sourceforge.net>
- * 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
+ * tests/unixInit.test: relaxed unixInit-3.1 to accept iso8859-15
+ as a valid C encoding. [Bug 575336]
- * unix/tclUnixNotfy.c (Tcl_InitNotifier): added cast for tsdPtr
+2002-07-24 Miguel Sofer <msofer@users.sourceforge.net>
- * tests/set.test: added test for complex array elem name compiling
- * generic/tclCompCmds.c (TclCompileSetCmd): Fixed parsing of array
- elements during compiling, and slightly optimised same [Bug: 3889]
+ * 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.
- * doc/tclvars.n: added definitions for tcl_(non)wordchars
+2002-07-24 Daniel Steffen <das@users.sourceforge.net>
- * doc/vwait.n: added notes about requirement for vwait var being
- globally scoped [Bug: 3329]
+ * unix/Makefile.in:
+ * 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).
- * library/word.tcl: changed tcl_(non)wordchars settings to use
- new unicode regexp char class escapes instead of char sequences
+2002-07-23 Joe English <jenglish@users.sourceforge.net>
-2000-01-14 Eric Melski <ericm@scriptics.com>
+ * 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/http.n: Package version updated to 2.4.
- * tests/var.test: Added a test for the array multiple delete
- protection in Tcl_UnsetVar2.
+2002-07-23 Mo DeJong <mdejong@users.sourceforge.net>
- * 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/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/tclUnixTime.c: New clock format format.
+2002-07-23 Mo DeJong <mdejong@users.sourceforge.net>
- * compat/strftime.c: New clock format format.
+ * unix/Makefile.in: Combine ranlib tests and
+ avoid printing unless ranlib is actually run.
- * generic/tclGetDate.y: New clock scan format.
+2002-07-23 Mo DeJong <mdejong@users.sourceforge.net>
-2000-01-13 Jeff Hobbs <hobbs@scriptics.com>
+ * 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.
- * changes: updated changes file to reflect 8.3b2 mods
+2002-07-22 Vince Darley <vincentdarley@users.sourceforge.net>
- * README:
+ * 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:
- * tools/tcl.wse.in:
- * unix/configure.in:
- * unix/tcl.m4:
- * win/README.binary:
- * win/configure.in: updated to patchlevel 8.3b2
-
- * generic/regexec.c: added var initialization to prevent compiler
- warning
-
-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.
-
- * 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.
-
-2000-01-12 Eric Melski <ericm@scriptics.com>
-
- * tests/clock.test: Added tests for "next <day-of-week>" and
- "<day-of-week>"
- Added tests for "monday 1 week ago", etc, from RFE #3671.
-
- * doc/tests/clock.test: Added numerous tests for clock scan.
-
- * doc/generic/tclGetDate.y: Fixed some shift/reduce conflicts in
- clock grammar.
+ * 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>
- * doc/doc/clock.n: Added documentation for new supported clock
- scan formats and additional explanation of daylight savings time
- correction algorithm.
+ * tests/expr.test (expr-22.*): Added tests to help detect the
+ corrected handling.
+ * generic/tclExecute.c (IllegalExprOperandType): Improved error
+ message generated when attempting to manipulate Inf and NaN values.
+ * generic/tclParseExpr.c (GetLexeme): Allowed parser to recognise
+ 'Inf' as a floating-point number. [Bug 218000]
-2000-01-12 Jeff Hobbs <hobbs@scriptics.com>
+2002-07-21 Don Porter <dgp@users.sourceforge.net>
- * doc/file.n:
- * tests/unixFCmd.test:
- * unix/tclUnixFCmd.c: added support for symbolic permissions
- setting in SetPermissionsAttribute (file attr $file -perm ...)
- [Bug: 3970]
+ * tclIOUtil.c: Silence compiler warning. [Bug 584408].
- * generic/tclClock.c: fixed support for 64bit handling of clock
- values [Bug: 1806]
+2002-07-19 Vince Darley <vincentdarley@users.sourceforge.net>
- * generic/tclThreadTest.c: upped a buffer size to hold double
+ * generic/tclIOUtil.c: fix to GetFilesystemRecord
+ * win/tclWinFile.c:
+ * unix/tclUnixFile.c: fix to subtle problem with links shown
+ up by latest tclkit builds.
- * tests/info.test:
- * generic/tclCmdIL.c: fixed 'info procs ::namesp::*' behavior (Dejong)
+2002-07-19 Mo DeJong <mdejong@users.sourceforge.net>
- * generic/tclNamesp.c: made imported commands also import their
- compile proc [Bug: 2100]
-
- * tests/expr.test:
- * unix/Makefile.in:
+ * unix/configure:
* 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
- 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]
-
-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/tclDate.c: Fixed compiler warning issues.
-
-2000-01-10 Jeff Hobbs <hobbs@scriptics.com>
-
- * 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]
+ * 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]
- * generic/tcl.h: noted need to change win/tcl.m4 and
- tools/tclSplash.bmp for minor version changes
+2002-07-19 Vince Darley <vincentdarley@users.sourceforge.net>
- * library/http2.1/http.tcl: trim value for $state(meta) key
+ * unix/Makefile.in: fix to build on MacOS X [Bug 529801], bug
+ report and fix from jcw.
- * unix/tclUnixFile.c: fixed signature style on functions
+2002-07-19 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * unix/Makefile.in: made sure tcl.m4 would be installed with dist
+ * win/tclWinSerial.c (no_timeout): Made this variable static.
- * unix/tcl.m4: added ELF support for NetBSD [Bug: 3959]
+ * 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.
-2000-01-10 Eric Melski <ericm@scriptics.com>
+ * generic/tclCompExpr.c (operatorTable):
+ * unix/tclUnixTime.c (tmKey):
+ * generic/tclIOUtil.c (theFilesystemEpoch, filesystemWantToModify,
+ filesystemIteratorsInProgress, filesystemOkToModify): Made these
+ variables static.
- * generic/tclGetDate.y: Added rules for ISO 8601 formats (BUG #847):
- CCYY-MM-DD
- CCYYMMDD
- YY-MM-DD
- YYMMDD
- CCYYMMDDTHHMMSS
- CCYYMMDD HHMMSS
- CCYYMMDDTHH:MM:SS
- Fixed "clock scan <number>" to scan the number as an hour for the
- current day, rather than a minute after 00:00 for the current day
- (bug #2732).
-
+ * unix/tclUnixFile.c: Renamed nativeFilesystem to
+ * win/tclWinFile.c: tclNativeFilesystem and declared
+ * generic/tclIOUtil.c: it properly in tclInt.h
+ * generic/tclInt.h:
-2000-01-07 Eric Melski <ericm@scriptics.com>
+ * generic/tclUtf.c (totalBytes): Made this array static and const.
- * generic/tclClock.c: Changed switch in Tcl_ClockObjCmd to use
- enumerated values instead of constants. (ie, COMMAND_SCAN instead
- of 3).
+ * 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.
-1999-12-22 Jeff Hobbs <hobbs@scriptics.com>
+ * license.terms: Added AS to list of copyright holders; it's only
+ fair for the current gatekeepers to be listed here!
- * changes: updated changes file
- * tools/tclSplash.bmp: updated to show 8.3
+ * tests/cmdMZ.test: Renamed constraint for clarity. [Bug#583427]
+ Added tests for the [time] command, which was previously only
+ indirectly tested!
-1999-12-21 Jeff Hobbs <hobbs@scriptics.com>
+2002-07-18 Vince Darley <vincentdarley@users.sourceforge.net>
- * README:
+ * generic/tclInt.h:
* generic/tcl.h:
- * mac/README:
- * unix/configure.in:
- * tools/tcl.wse.in:
- * win/README.binary:
- * win/configure.in: updated to patch level 8.3b1
+ * */*Load*.c: added comments on changes of 07/17 and
+ replaced clientData with Tcl_LoadHandle in all locations.
- * unix/Makefile.in: added -srcdir=... for 'make html'
+ * generic/tclFCmd.c:
+ * 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.
+
+2002-07-17 Miguel Sofer <msofer@users.sourceforge.net>
- * 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
+ * generic/tclBasic.c (CallCommandTraces): delete traces now
+ receive the FQ old name of the command.
+ [Bug 582532] (Don Porter)
- * doc/lsort.n: added -unique docs
- * tests/cmdIL.test:
- * generic/tclCmdIL.c: added -unique option to lsort
+2002-07-18 Vince Darley <vincentdarley@users.sourceforge.net>
- * generic/tclThreadTest.c: changed thread ids to longs [Bug: 3902]
+ * 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>
- * mac/tclMacOSA.c: fixed applescript for I18N [Bug: 3644]
+ * generic/tclVar.c (DupParsedVarName): nasty bug fixed, reported
+ by Vince Darley.
- * win/mkd.bat:
- * win/rmd.bat: removed necessity of tag.txt [Bug: 3874]
+2002-07-17 Miguel Sofer <msofer@users.sourceforge.net>
- * win/tclWinThrd.c: changed CreateThread to _beginthreadex and
- ExitThread to _endthreadex
+ * generic/tclVar.c (TclPtrIncrVar): missing CONST in declarations,
+ 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>
-1999-12-12 Jeff Hobbs <hobbs@scriptics.com>
+ * generic/tclInt.h:
+ * generic/tclIOUtil.c:
+ * generic/tclLoadNone.c:
+ * unix/tclLoadAout.c:
+ * unix/tclLoadDl.c:
+ * unix/tclLoadDld.c:
+ * unix/tclLoadDyld.c:
+ * unix/tclLoadNext.c:
+ * 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.
+
+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.
+
+2002-07-17 Miguel Sofer <msofer@users.sourceforge.net>
- * doc/glob.n:
- * tests/fileName.test:
* generic/tclInt.decls:
- * generic/tclInt.h:
* generic/tclIntDecls.h:
* generic/tclStubInit.c:
- * generic/tclEncoding.c:
- * generic/tclFileName.c:
- * 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
- TclpMatchFilesTypes, extended TclGlob and TclDoGlob and added
- 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/tclCmdMZ.c:
- * generic/tclExecute.c: optimized INST_TRY_CVT_TO_NUMERIC to
- recognize boolean objects. (Spjuth) [Bug: 2815]
-
- * 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]
-
- * 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]
-
-1999-12-09 Jeff Hobbs <hobbs@scriptics.com>
-
- * win/aclocal.m4: made it just include tcl.m4
-
- * doc/exec.n:
- * doc/open.n:
- * win/tclWin32Dll.c:
- * win/tclWinChan.c:
- * 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/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)
-
-1999-12-07 Jeff Hobbs <hobbs@scriptics.com>
+ * generic/tclVar.c: removing the now redundant functions to access
+ indexed variables: Tcl(Get|Set|Incr)IndexedScalar() and
+ Tcl(Get|Set|Incr)ElementOfIndexedArray().
- * tests/io.test: removed 'knownBug' tests that were for
- unsupported0, which is now fcopy (that already has tests)
+2002-07-17 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * mac/tclMacPort.h: added utime.h include
+ * generic/tclExecute.c (TclExecuteByteCode): Minor fixes to make
+ this file compile with SunPro CC...
- * generic/tclDate.c:
- * unix/Makefile.in: fixed make gendate to swap const with CONST
- so it uses the Tcl defined CONST type [Bug: 3521]
+2002-07-17 Miguel Sofer <msofer@users.sourceforge.net>
- * 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/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.
+ * generic/tclVar.c: removed local declarations; moved all special
+ accessor functions for indexed variables to the end of the file -
+ they are unused and ready for removal, but left there for the time
+ being as they are in the internal stubs table.
- * 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]
-
- * tests/env.test: removed knownBug limitation from working test
- * tests/all.tcl: ensured that ::tcltest::testsDirectory would be
- set to an absolute path
-
- * tests/expr-old.test:
- * tests/parseExpr.test:
- * tests/string.test:
- * generic/tclGet.c:
- * generic/tclInt.h:
- * generic/tclObj.c:
- * 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]
-
- * 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:
- expr 1 + {[string length abc]}
- 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
- expr 1 + {[mindless error]}
- from seg faulting, and only affects optimizations for
- degenerate cases [Bug: 3737]
-
-1999-12-01 Scott Redman <redman@scriptics.com>
-
- * generic/tcl.decls :
- * 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.
-
- * generic/tclEncoding.c:
- * generic/tclEvent.c: Moved encoding-related startup code from
- tclEvent.c into the more appropriate tclEncoding.c.
+ ** WARNING FOR BYTECODE MAINTAINERS **
+ TCL_COMPILE_DEBUG is currently not functional; will be fixed ASAP.
-1999-11-30 Jeff Hobbs <hobbs@scriptics.com>
-
- * 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.
-
- * 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
-
- * unix/tclUnixPipe.c: fixed PipeBlockModeProc to properly set
- 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]
-
-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]
-
- * 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.
-
-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.
-
- * tools/tcl.wse.in: added tcltest1.0 library to distribution list
-
- * doc/http.n:
- * library/http2.1/http.tcl:
- * library/http2.1/pkgIndex.tcl: updated http package to 2.2
-
-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
-
- * 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/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]
-
- * doc/scan.n:
- * tests/scan.test:
- * generic/tclScan.c: finished support for inline scan by
- supporting XPG identifiers.
+2002-07-16 Mo DeJong <mdejong@users.sourceforge.net>
- * 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]
+ * unix/Makefile.in:
+ * win/Makefile.in: Add a more descriptive warning
+ in the event `make genstubs` needs to be rerun.
- * generic/tclBasic.c: removed extra decr of numLevels in
- Tcl_EvalObjEx that could cause seg fault. (mjansen@wendt.de)
+2002-07-16 Mo DeJong <mdejong@users.sourceforge.net>
- * generic/tclEvent.c: fixed possible lack of MutexUnlock in
- Tcl_DeleteExitHandler [Bug: 3545]
+ * 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/tcl.m4: Added better pthreads library check and inclusion
- of _THREAD_SAFE in --enable-threads case
- Added support for gcc config on SCO
+2002-07-16 Mo DeJong <mdejong@users.sourceforge.net>
- * doc/glob.n: added note about ..../ glob behavior on Win9*
- * doc/tcltest.n: fixed minor example errors [Bug: 3551]
+ * unix/configure: Regen.
+ * unix/configure.in: Remove useless subst of TCL_BIN_DIR.
-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.
+2002-07-15 Miguel Sofer <msofer@users.sourceforge.net>
-1999-11-09 Jeff Hobbs <hobbs@scriptics.com>
+ * generic/tclVar.c: inaccurate comment fixed
+
+2002-07-15 Miguel Sofer <msofer@users.sourceforge.net>
- * doc/open.n: corrected docs for 'a' open mode.
+ * 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/tclIOUtil.c: changed Tcl_Alloc to ckalloc
+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.
+
+ * generic/tclInt.decls:
* generic/tclInt.h:
- * generic/tclObj.c: rolled back changes from 1999-10-29
- Purify noted new leaks with that code
-
- * 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
-
- * 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
-
-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
-
- * generic/tclStringObj.c: fixed Tcl_AppendStringsToObjVA so it only
- 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
-
- * tests/incr.test:
- * tests/set.test:
- * 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
- * win/tclWinPort.h: added sys/utime.h to includes
- * 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)
-
-1999-10-20 Jeff Hobbs <hobbs@scriptics.com>
-
- * 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/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
-
- * tests/string.test:
- * 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]
-
-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.
-
- 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]
+ * 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.
- 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.
+ * tests/set-old.test:
+ * tests/var.test: slight modification of error messages due to the
+ modifications in the tclVar.c code.
- * tests/autoMkindex.test:
- * tests/pkgMkIndex.test: Explicitly cd to
- ::tcltest::testsDirectory at the beginning of the test run
+2002-07-15 Don Porter <dgp@users.sourceforge.net>
- * tests/basic.test: Use version information defined in tcltest
- instead of hardcoded version number
+ * tests/unixInit.test: Improved constraints to protect /tmp.
+ [Bug 581403]
- * tests/socket.test: package require tcltest before attempting to
- use variable defined in tcltest namespace
+2002-07-15 Vince Darley <vincentdarley@users.sourceforge.net>
- * tests/unixInit.test:
- * tests/unixNotfy.test: Added explicit exits needed to avoid
- problems when the tests area run in wish.
+ * 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.
+ * generic/tclIOUtil.c: comment cleanup and code speedup.
-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]
-
-1999-10-12 Jeff Hobbs <hobbs@scriptics.com>
-
- * generic/regc_color.c:
- * generic/regc_cvec.c:
- * generic/regc_lex.c:
- * generic/regc_locale.c:
- * generic/regcomp.c:
- * generic/regcustom.h:
- * generic/regerrs.h:
- * generic/regex.h:
- * generic/regexec.c:
- * generic/regguts.h:
- * 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.
-
- * 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)
- * 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/tclUnixTest.c: fixed mem leak in findexecutable test command
-
-1999-10-05 Jeff Hobbs <hobbs@scriptics.com>
-
- * {win,mac,unix,tools,}/README:
- * win/README.binary:
- * win/makefile.vc:
- * {win,unix}/configure.in:
- * generic/tcl.h:
- * library/init.tcl: updated to 8.3a1 from 8.2.0.
+2002-07-14 Don Porter <dgp@users.sourceforge.net>
- * 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.
+ * generic/tclInt.h: Removed declarations that duplicated entries
+ in the (internal) stub table.
- * generic/tclNamesp.c:
- * generic/tclVar.c:
- * generic/tclCmdIL.c: fixed comment typos
-
- * 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)
-
-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]
-
-1999-09-20 Jeff Hobbs <hobbs@scriptics.com>
-
- * tests/env.test:
- * 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]
-
-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/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]
-
- * 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]
+ * library/tcltest/tcltest.tcl: Corrected errors in handling of
+ configuration options -constraints and -limitconstraints.
-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]
-
- * tests/format.test:
- * generic/tclCmdAH.c: fixed translation of %0#s in format [Bug: 2605]
-
- * doc/msgcat.n: fixed \\ bug in example [Bug: 2548]
+ * README: Bumped HEAD to version 8.4b2 so we can
+ * generic/tcl.h: distinguish it from the 8.4b1 release.
+ * tools/tcl.wse.in:
+ * unix/configure*:
+ * unix/tcl.spec:
+ * win/README.binary:
+ * win/configure*:
- * unix/tcl.m4:
- * unix/aclocal.m4: added fix for FreeBSD-[1-2] recognition
- [Bug: 2070] and fix for IRIX SHLIB_LB_LIBS. [Bug: 2610]
+2002-07-11 Vince Darley <vincentdarley@users.sourceforge.net>
- * 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]
+ * 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.
-1999-09-14 Jeff Hobbs <hobbs@scriptics.com>
+2002-07-11 Don Porter <dgp@users.sourceforge.net>
- * 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]
+ * library/tcltest/tcltest.tcl: Corrected reaction to existing but
+ false ::tcl_interactive.
- * doc/regexp.n:
- * doc/regsub.n:
- * tests/regexp.test:
- * generic/tclCmdMZ.c: add -start switch to regexp and regsub
- with docs and tests
+ * doc/Hash.3: Overlooked CONST documentation update.
- * 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.
+2002-07-11 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * generic/tclCmdMZ.c: fixed illegal ref for \[0-9] substitutions
- in regsub [Bug: 2723]
+ * 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/tclCmdMZ.c: changed [string equal] to return an Int
- type object (was a Boolean)
+2002-07-11 Miguel Sofer <msofer@users.sourceforge.net>
-1999-09-01 Jennifer Hom <jenn@scriptics.com>
+ * 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.
- * 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)
+2002-07-11 Donal K. Fellows <fellowsd@cs.man.ac.uk>
-1999-09-01 Jeff Hobbs <hobbs@scriptics.com>
+ * tests/cmdAH.test: [file attr -perm] is Unix-only, so add [catch]
+ when not inside a suitably-protected test.
- * 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]
- * unix/aclocal.m4:
- * unix/tcl.m4: adjusted fix from 8-21 to add -bnoentry to the
- AIX-* case and readjusted the range
+2002-07-10 Donal K. Fellows <fellowsd@cs.man.ac.uk>
-1999-08-31 Jennifer Hom <jenn@scriptics.com>
+ * 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.
- * library/tcltest1.0/tcltest.tcl:
- * doc/tcltest.n:
- * tests/README: Modified testConstraints variable so that it isn't
- unset every time ::tcltest::initConstraints is called and cleaned up
- documentation in the README file and the man page.
+2002-07-10 Don Porter <dgp@users.sourceforge.net>
-1999-08-27 Jennifer Hom <jenn@scriptics.com>
+ * tests/tcltest.test: Greatly reduced the number of [exec]s, using
+ slave interps instead.
+ * library/tcltest/tcltest.tcl: Fixed bug uncovered in the conversion
+ where a message was written to stdout instead of [outputChannel].
+ * tests/basic.test: Cleaned up, constrained, and reduced the
+ * tests/compile.test: amount of [exec] usage in the test suite.
+ * tests/encoding.test:
* tests/env.test:
+ * tests/event.test:
* tests/exec.test:
* tests/io.test:
- * tests/event.test:
- * tests/tcltest.test: Added 'exit' calls to scripts that the tests
- 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.
-
-1999-08-26 Jennifer Hom <jenn@scriptics.com>
-
+ * tests/ioCmd.test:
+ * tests/regexp.test:
+ * tests/regexpComp.test:
+ * tests/socket.test:
* 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.
+ * tests/unixInit.test:
+ * tests/winDde.test:
+ * tests/winPipe.test:
-1999-08-23 Jennifer Hom <jenn@scriptics.com>
+2002-07-10 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * tests/tcltest.test: Added additional tests for -tmpdir, marked
- all tests that use exec as unixOrPc.
+ * tests/cmdAH.test: Removed [exec] of Unix utilities. [Bug 579211]
- * 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.
-
-1999-08-21 Jeff Hobbs <hobbs@scriptics.com>
-
- * unix/aclocal.m4: Changed AIX-4.[2-9] check to AIX-4.[1-9]
- [Bug: 1909]
+ * 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]
-1999-08-20 Jeff Hobbs <hobbs@scriptics.com>
+2002-07-08 Andreas Kupries <andreas_kupries@users.sourceforge.net>
- * generic/tclPosixStr.c: fixed typo [Bug: 2592]
+ * 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.
- * doc/*: fixed various nroff bugs in man pages [Bug: 2503 2588]
+2002-07-08 Don Porter <dgp@users.sourceforge.net>
-1999-08-19 Jeff Hobbs <hobbs@scriptics.com>
-
- * 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]
+ * doc/tcltest.n: Fixed incompatibility in [viewFile].
+ * library/tcltest/tcltest.tcl: Corrected docs. Bumped to 2.2.1.
+ * library/tcltest/pkgIndex.tcl: [Bug 578163]
- * generic/tclIO.c: changed Tcl_GetChannelNames* to use style guide
- headers (pleases HP cc)
+2002-07-08 Vince Darley <vincentdarley@users.sourceforge.net>
-1999-08-18 Jeff Hobbs <hobbs@scriptics.com>
-
- * 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.
-
- * 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]
-
- * 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:
- * library/ldAout.tcl:
- * library/package.tcl:
- * 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).
-
-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!
-
-1999-08-13 Scott Redman <redman@scriptics.com>
-
- * /: 8.2.0 tagged for final release
-
-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.
-
- * 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]
-
-1999-08-12 Scott Redman <redman@scriptics.com>
-
- * win/tclWinSerial.c: Applied patch from Petteri Kettunen to
- remove compiler warning.
-
-1999-08-10 Scott Redman <redman@scriptics.com>
-
- * generic/tclAlloc.c:
- * generic/tclCmdIL.c:
- * generic/tclIO.c:
- * generic/tclThread.c:
- * win/tclWinThrd.c:
- * unix/tclUnixThrd.c: Fixed Brent's changes so that they work on
- Windows (and he fixed the bug in the Unix thread implementation).
-
-1999-08-09 Brent Welch <welch@scriptics.com>
-
- * generic/tcl.decls:
- * generic/tclAlloc.c:
- * generic/tclCkalloc.c:
- * generic/tclCmdIL.c:
- * generic/tclDecls.h:
- * generic/tclIO.c:
- * generic/tclInt.decls:
- * generic/tclIntDecls.h:
- * generic/tclStubInit.c:
- * 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.
-
-1999-08-09 Jeff Hobbs <hobbs@scriptics.com>
-
- * tests/string.test: added largest_int proc to adapt for >32 bit
- 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/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]
-
-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]
-
-1999-08-04 Scott Stanton <stanton@scriptics.com>
-
- * tests/reg.test: Added test for REG_EXPECT bug fixed by Henry's
- patch.
-
- * generic/regc_nfa.c:
- * generic/regcomp.c:
- * generic/rege_dfa.c:
- * 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]
-
-1999-08-03 Scott Redman <redman@scriptics.com>
-
- * win/tclWinInt.h: Remove function declarations in header that was
- moved to tclInt.decls file in previous changes.
-
-1999-08-02 Scott Redman <redman@scriptics.com>
-
- * unix/configure.in:
- * win/configure.in: Change beta level to b2.
-
+ * tests/fCmd.test:
+ * tests/fileName.test: tests which rely on 'file link' need a
+ constraint so they don't run on older Windows OS. [Bug 578158]
+ * generic/tclIOUtil.c:
* generic/tcl.h:
- * generic/tcl.decls:
- * generic/tclDecls.h:
* generic/tclInt.h:
- * generic/tclInt.decls:
- * 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.
-
-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.
-
-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).
-
-1999-07-30 Jeff Hobbs <hobbs@scriptics.com>
+ * generic/tclTest.c:
+ * mac/tclMacChan.c:
+ * 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]
+
+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].
+
+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.
+ * tests/clock.test: Added a test for that.
+
+2002-07-05 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * unix/Makefile.in (ro-test,ddd,GDB,DDD): Created new targets to
+ allow running the test suite with a read-only current directory,
+ running under ddd instead of gdb, and factored out some executable
+ 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/env.test:
- * generic/tclInt.decls: added declaractions necessary for the
- Tcl test code to work wth stubs [Bug: 2445]
+2002-07-05 Jeff Hobbs <jeffh@ActiveState.com>
-1999-07-30 <redman@scriptics.com>
+ *** 8.4b1 TAGGED FOR RELEASE ***
- * 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.
+2002-07-04 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * win/tclWinSock.c: Applied small patch to get thread-specific
- data after initializing the socket driver.
+ * tests/cmdMZ.test (cmdMZ-1.4):
+ * tests/cmdAH.test: More fixing of writable-current-dir
+ assumption. [Bug 575824]
- * unix/tclUnixThrd.c: Applied patch to fix threads on Irix 6.5.
- Patch from James Dennett. [Bug: 2450]
+2002-07-04 Miguel Sofer <msofer@users.sourceforge.net>
- * tests/info.test: Enable test for tclParse.c change (info
- complete).
+ * tests/basic.test: Same issue as below; fixed [Bug 575817]
-1999-07-30 <hobbs@scriptics.com>
+2002-07-04 Andreas Kupries <andreas_kupries@users.sourceforge.net>
- * tclIO.c: added fix for Kupries' trf patch [Bug: 2386]
+ * tests/socket.test:
+ * tests/winPipe.test:
+ * tests/pid.test: Fixed SF Bug #575848. See below for a
+ description the general problem.
- * tclParse.c: fixed bug in info complete regarding nested square
- brackets [Bug: 2382, 2466]
-
-1999-07-29 <redman@scriptics.com>
+ * All the bugs below are instances of the same problem: The
+ testsuite assumes [pwd] = [temporaryDirectory] and writable.
- * 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]
+ * tests/iogt.test: Fixed bug #575860.
+ * tests/io.test: Fixed bug #575862.
+ * tests/exec.test:
+ * tests/ioCmd.test: Fixed bug #575836.
- * unix/mkLinks.tcl: Applied patch to avoid linking pack.n to
- pack-old.n. Patch from Don Porter. [Bug: 2469]
+2002-07-03 Don Porter <dgp@users.sourceforge.net>
- * 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.
+ * 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.
-1999-07-28 <jenn@scriptics.com>
+ * unix/Makefile.in: removed tests/pkg/* from `make dist`
- * 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.
+ * tests/pkg/circ1.tcl: removed
+ * tests/pkg/circ2.tcl: removed
+ * tests/pkg/circ3.tcl: removed
+ * tests/pkg/global.tcl: removed
+ * tests/pkg/import.tcl: removed
+ * tests/pkg/pkg1.tcl: removed
+ * tests/pkg/pkg2_a.tcl: removed
+ * tests/pkg/pkg2_b.tcl: removed
+ * tests/pkg/pkg3.tcl: removed
+ * tests/pkg/pkg4.tcl: removed
+ * tests/pkg/pkg5.tcl: removed
+ * tests/pkg/pkga.tcl: removed
+ * tests/pkg/samename.tcl: removed
+ * tests/pkg/simple.tcl: removed
+ * 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.
-1999-07-27 <redman@scriptics.com>
+ * tests/main.test: Cheap fix for [Bugs 575851, 575858]. Avoid
+ * tests/tcltest.test: non-writable . by [cd [temporaryDirectory]].
- * tools/tclSplash.bmp: Updated Windows installer bitmap
- to ready Tcl/Tk Version 8.2.
+ * library/auto.tcl: Fix [tcl_findLibrary] to be sure it sets
+ $varName only if a successful library script is found.
+ [Bug 577033]
-1999-07-26 <redman@scriptics.com>
+2002-07-03 Miguel Sofer <msofer@users.sourceforge.net>
- * 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.
+ * 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].
- * 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.
+2002-07-02 Joe English <jenglish@users.sourceforge.net>
- * 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.
+ * doc/tcltest.n: Markup fixes, spellcheck.
- * 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).
+2002-07-02 Don Porter <dgp@users.sourceforge.net>
-1999-07-26 Jennifer Hom <jenn@scriptics.com>
+ * doc/tcltest.n: more refinements of the documentation.
- * tests/tcltest.test:
- * library/tcltest1.0/tcltest.tcl:
- * doc/tcltest.n: Cleaned up code in ::tcltest::PrintError, revised
- documentation, and added tests for the tcltest package.
+ * library/tcltest/tcltest.tcl: Added trace to be sure the stdio
+ constraint is updated whenever the [interpreter] changes.
-1999-07-23 <redman@scriptics.com>
+ * 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/http.test:
+ * tests/io.test:
- * 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]
+ * library/tcltest/tcltest.tcl: Simplified logic of
+ [GetMatchingFiles] and [GetMatchingDirectories], removing
+ special case processing.
-1999-07-22 <redman@scriptics.com>
+ * doc/tcltest.n: More documentation updates. Reference sections
+ are complete. Only examples need adding.
- * Changed version to 8.2b2.
+2002-07-02 Vince Darley <vincentdarley@users.sourceforge.net>
- * win/tclWinSock.c: Fixed hang with threads enabled, fixed
- semaphores with threads disabled.
+ * tests/fCmd.test:
+ * generic/tclCmdAH.c: clearer error msgs for 'file link',
+ as per the man page.
- * 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/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]
-
- * 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]
-
-1999-07-21 <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]
+2002-07-01 Joe English <jenglish@users.sourceforge.net>
+ * doc/Access.3:
+ * doc/AddErrInfo.3:
+ * doc/Alloc.3:
+ * doc/Backslash.3:
+ * doc/CrtChannel.3:
+ * doc/CrtSlave.3:
+ * doc/Encoding.3:
+ * doc/Eval.3:
+ * doc/FileSystem.3:
+ * doc/Notifier.3:
+ * doc/OpenFileChnl.3:
+ * doc/ParseCmd.3:
+ * doc/RegExp.3:
+ * doc/Tcl_Main.3:
+ * doc/Thread.3:
+ * doc/TraceCmd.3:
* 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).
-
- * unix/Makefile.in: Added the Windows configure script to the
- distribution file list, already shipping configure.in and the .m4
- files, but needed the configure script itself.
-
- * win/makefile.vc: Changed version number of DDE package in VC++
- makefile to use 1.1 instead of 1.0.
+ * doc/WrongNumArgs.3:
+ * doc/binary.n:
+ * doc/clock.n:
+ * doc/expr.n:
+ * doc/fconfigure.n:
+ * doc/glob.n:
+ * doc/http.n:
+ * doc/interp.n:
+ * doc/lsearch.n:
+ * doc/lset.n:
+ * doc/msgcat.n:
+ * doc/packagens.n:
+ * doc/pkgMkIndex.n:
+ * doc/registry.n:
+ * doc/resource.n:
+ * doc/safe.n:
+ * doc/scan.n:
+ * doc/tclvars.n: Spell-check, fixed typos (Updates from Larry Virden).
- * doc/open.n: Added documentation of \\.\comX notation for opening
- serial ports on Windows (alternative to comX:).
-
- * 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]
+2002-07-01 Donal K. Fellows <fellowsd@cs.man.ac.uk>
-1999-07-21 <jpeek@scriptics.com>
+ * unix/tcl.m4 (SC_CONFIG_CFLAGS): Made Solaris use gcc for linking
+ 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]
- * README: Small tweaks to clean up typos and wording.
+2002-07-01 Don Porter <dgp@users.sourceforge.net>
-1999-07-20 Melissa Hirschl <hershey@matisse.scriptics.com>
+ * doc/tcltest.n: more work in progress updating tcltest docs.
- * generic/tclInitScript.h:
- * 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.
- * unix/tclWinInit.c: just updated some comments.
+ * 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.
-1999-07-19 Melissa Hirschl <hershey@matisse.scriptics.com>
+ * tests/pkg/samename.tcl: restored. needed by pkgMkIndex.test.
- * library/http2.1/http.tcl: updated -useragent text to say version
- 2.1.
+ * library/tcltest/tcltest.tcl: restored writeability testing of
+ -tmpdir, augmented by a special exception for the deafault value.
-1999-07-16 <redman@scriptics.com>
+2002-07-01 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * generic/tcl.decls:
- * generic/tclDecls.h:
- * 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.
-
- * tools/tcl.hpj.in: Change version number of .cnt file referenced
- in .HPJ file.
+ * doc/concat.n: Documented the *real* behaviour of [concat]!
-1999-07-15 <redman@scriptics.com>
-
- * tools/tcl.wse.in: Fixed naming of target files for Windows.
+2002-06-30 Don Porter <dgp@users.sourceforge.net>
-1999-07-14 <jpeek@scriptics.com>
+ * doc/tcltest.n: more work in progress updating tcltest docs.
- * doc/re_syntax.n: Deleted sentence as suggested by Scott S.
+ * tests/README: Updated the instructions on running and
+ * 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:
-1999-07-12 <jpeek@scriptics.com>
+ * library/tcltest/tcltest.tcl: Stopped checking for writeability
+ of -tmpdir value because no default directory can be guaranteed to
+ be writeable.
- * doc/re_syntax.n: Removed two notes to myself (oops), cleaned
- up wording, fixed changebars, made two examples easier to read.
+ * 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.
-1999-07-11 <redman@scriptics.com>
+ * 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/io.test: to "-debug 1" operations to debug test
+ * tests/iogt.test: calls to (make|remove)(File|Directory).
- * 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
- version numbers in the makefile to reflect the change to 8.2b1.
+ * unix/mkLinks: `make mklinks` on 6-27 commits.
-1999-07-09 <redman@scriptics.com>
+2002-06-28 Miguel Sofer <msofer@users.sourceforge.net>
- * 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 <stanton@scriptics.com>
+ * 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.
- * tests/string.test:
- * generic/tclCmdMZ.c: Fixed bug in string range bounds checking
- code.
+2002-06-28 Don Porter <dgp@users.sourceforge.net>
-1999-07-08 Jennifer Hom <jenn@scriptics.com>
+ * 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]
- * 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.
+2002-06-28 Donal K. Fellows <fellowsd@cs.man.ac.uk>
-1999-07-08 <stanton@scriptics.com>
+ * 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/tclUnixChan.c:
+ * unix/tclUnixPort.h:
- * win/Makefile.in: Added tcltest target so runtest works
- properly. Added missing names to the clean/distclean targets.
+ * 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.
- * tests/reg.test:
- * generic/rege_dfa.c: Applied fix supplied by Henry Spencer for
- bug in DFA state caching under lookahead conditions. [Bug: 2318]
+2002-06-27 Don Porter <dgp@users.sourceforge.net>
-1999-07-07 <stanton@scriptics.com>
+ * doc/dde.n: Work in progress updating the documentation
+ * doc/http.n: of the packages that come bundled with
+ * doc/msgcat.n: the Tcl source distribution, notably tcltest.
+ * doc/registry.n:
+ * doc/tcltest.n:
- * doc/fconfigure.n: Clarified default buffering behavior for the
- standard channels. [Bug: 2335]
+ * library/tcltest/tcltest.tcl: Made sure that the TCLTEST_OPTIONS
+ environment variablle configures tcltest at package load time.
-1999-07-06 <redman@scriptics.com>
+2002-06-26 Vince Darley <vincentdarley@users.sourceforge.net>
- * 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]
+ * 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.
+
+2002-06-26 Reinhard Max <max@suse.de>
-1999-07-06 <welch@scriptics.com>
+ * unix/tclUnixTime.c: Make [clock format] respect locale settings.
+ * tests/clock.test: Bug #565880. ***POTENTIAL INCOMPATIBILITY***
- * 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!)
+2002-06-26 Miguel Sofer <msofer@users.sourceforge.net>
-1999-07-03 <welch@scriptics.com>
+ * doc/CrtInterp.3:
+ * doc/StringObj.3: clarifications by Don Porter, bugs #493995 and
+ #500930.
+
+2002-06-24 Don Porter <dgp@users.sourceforge.net>
- * 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.
+ * 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]
-1999-07-03 <welch@scriptics.com>
+2002-06-25 Reinhard Max <max@suse.de>
- * generic/tclNotify.c:
- * unix/tclUnixNotfy.c:
- * 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.
+ * 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/mkLinks.tcl: Default is still hardlinks and no compression.
-1999-07-03 <welch@scriptics.com>
+ * unix/mkLinks: generated
+ * unix/configure:
- * 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.
+ * unix/README: Added documentation for the new features.
-1999-07-01 <redman@scriptics.com>
+ * unix/tcl.m4 (SC_PATH_TCLCONFIG): Replaced ${exec_prefix}/lib by
+ ${libdir}.
- * generic/tclCmdAH.c:
- * generic/tclFCmd.c: Call TclStat instead of TclpStat in order to
- allow Tcl_Stat hooks to work properly.
+2002-06-25 Donal K. Fellows <fellowsd@cs.man.ac.uk>
-1999-06-29 Jennifer Hom <jenn@scriptics.com>
+ * 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.
- * 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.
+2002-06-24 Don Porter <dgp@users.sourceforge.net>
-1999-06-28 <redman@scriptics.com>
+ * library/tcltest/tcltest.tcl: Implementation of TIP 101. Adds
+ * tests/parseOld.test: and exports a [configure] command
+ * tests/tcltest.test: from tcltest.
- * 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.
+2002-06-22 Don Porter <dgp@users.sourceforge.net>
-1999-06-26 <redman@scriptics.com>
+ * changes: updated changes file for 8.4b1 release.
- * 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]
+ * 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
+ * tests/compile.test: -limitConstraints 1 only tests the
+ * 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/fCmd.test:
+ * tests/format.test:
+ * tests/http.test:
+ * tests/httpold.test:
+ * tests/ioUtil.test:
+ * tests/link.test:
+ * tests/load.test:
+ * tests/namespace.test:
+ * tests/pkgMkIndex.test:
+ * tests/reg.test:
+ * tests/result.test:
+ * tests/scan.test:
+ * tests/stack.test:
-1999-06-25 Jennifer Hom <jenn@scriptics.com>
+2002-06-22 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * unix/Makefile.in:
- * win/Makefile.in:
- * 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
- 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.
-
-1999-06-25 <stanton@scriptics.com>
+ * 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.
- * tests/reg.test:
- * generic/regexec.c: Fixed bugs in non-greedy quantifiers.
+2002-06-21 Joe English <jenglish@users.sourceforge.net>
-1999-06-23 <jpeek@scriptics.com>
+ * generic/tclCompExpr.c:
+ * generic/tclParseExpr.c: LogSyntaxError() should reset
+ the interpreter result [Bug 550142 "Tcl_ExprObj -> abort"]
- * doc/re_syntax.n:
- * doc/switch.n:
- * doc/lsearch.n:
- * 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.
+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.vc: to installation on Windows.
-1999-06-23 <stanton@scriptics.com>
+ * library/init.tcl: Corrected comments and namespace style
+ issues. Thanks to Bruce Stephens. [Bug 572025]
- * unix/Makefile.in: Changed install-doc to install-man.
+2002-06-21 Vince Darley <vincentdarley@users.sourceforge.net>
- * tools/uniParse.tcl:
- * tools/uniClass.tcl:
- * tools/README:
- * tests/string.test:
- * generic/regc_locale.c:
- * 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"
- definitions of character classes.
+ * 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:
+ * generic/tcl.h:
+ * generic/tcl.decls:
+ * doc/FileSystem.3:
+ * doc/file.n:
+ * mac/tclMacFile.c:
+ * unix/tclUnixFile.c:
+ * win/tclWinFile.c: Also enhanced speed of 'file normalize' on
+ Windows.
-1999-06-21 <stanton@scriptics.com>
+2002-06-20 Miguel Sofer <msofer@users.sourceforge.net>
- * unix/tclUnixThrd.c (TclpThreadCreate): Fixed memory leak where
- thread attributes were not being released. [Bug: 2254]
+ * generic/tclBasic.c (TclEvalObjvInternal): fix for [Bug 571385]
+ in the implementation of TIP#62 (command tracing). Vince Darley,
+ Hemang Lavana & Don Porter: thanks.
-1999-06-17 <stanton@scriptics.com>
+2002-06-20 Miguel Sofer <msofer@users.sourceforge.net>
- * tests/regexp.test:
- * generic/tclCmdMZ.c:
- * generic/tclCmdIL.c: Changed to use new regexp interfaces. Added
- -expanded, -line, -linestop, and -lineanchor switches to regsub.
+ * generic/tclExecute.c (TclCompEvalObj): clarified and simplified
+ the logic for compilation/recompilation.
- * 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.
+2002-06-19 Joe English <jenglish@users.sourceforge.net>
+ * doc/file.n: Fixed indentation. No substantive changes.
- * generic/regcomp.c: lint
+2002-06-19 Jeff Hobbs <jeffh@ActiveState.com>
- * tests/reg.test:
- * generic/regex.h:
- * generic/regc_lex.c: Added REG_BOSONLY flag to allow Expect to
- iterate through a string an only find matches that start at the
- current position within the string.
+ * generic/tclCmdMZ.c (Tcl_RegexpObjCmd): get the resultPtr again
+ as the Tcl_ObjSetVar2 may cause the result to change.
+ [Patch #558324] (watson)
-1999-06-16 <wart@scriptics.com>
+2002-06-19 Miguel Sofer <msofer@users.sourceforge.net>
- * unix/configure.in:
- * unix/Makefile.in:
- * unix/tcl.m4:
- * unix/aclocal.m4: Numerous build changes to make Tcl conform to the
- proposed TEA spec
+ * generic/tclExecute.c (TEBC): removing unused "for(;;)" loop;
+ improved comments; re-indentation.
-1999-06-16 Melissa Hirschl <hershey@matisse.scriptics.com>
+2002-06-18 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclVar.c (Tcl_VariableObjCmd): fixed premature increment
- in loop that was causing out-of-bounds reads on array "varName".
+ * generic/tclExecute.c (TEBC):
+ - elimination of duplicated code in the non-immediate INST_INCR
+ 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.
-1999-06-16 <stanton@scriptics.com>
+ 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.
- * 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]
+2002-06-18 Miguel Sofer <msofer@users.sourceforge.net>
-1999-06-14 Melissa Hirschl <hershey@matisse.scriptics.com>
+ * generic/tclExecute.c (TEBC, INST_DONE): small bug in the panic
+ code for tcl-stack corruption.
- * doc/StringObj.3
- * test/stringObj.test
- * unix/Makefile.in
- * 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,
- Tcl_AppendUnicodeToObj.
+2002-06-17 David Gravereaux <davygrvy@pobox.com>
-1999-06-09 <stanton@scriptics.com>
+ Trims to support the removal of RESOURCE_INCLUDED from rc
+ scripts from FR #565088.
- * generic/tclUnicodeObj.c: Lots of cleanup and simplification.
- Fixed several memory bugs. Added TclAppendUnicodeToObj.
+ * generic/tcl.h: moved the #ifndef RC_INVOKED start block up in
+ the file. rc scripts don't need to know thread mutexes.
- * generic/tclInt.h: Added declarations for various Unicode string
- functions.
+ * win/tcl.rc:
+ * win/tclsh.rc: removed the #define RESOURCE_INCLUDED to let the
+ built-in -DRC_INVOKED to the work.
- * generic/tclRegexp.c:
- * 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.
+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).
+ * generic/tcl.h: This includes enter/leave tracing as well
+ * generic/tclBasic.c: as inter-procedure stepping.
* generic/tclCmdMZ.c:
- * tests/string.test: Fixed bug where string map failed on null
- strings.
-
- * generic/regexec.c:
- * unix/tclUnixNotfy.c: lint
-
- * tools/genStubs.tcl: Changed to always write output in LF mode.
-
-1999-06-08 <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.
-
-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.
-
- * unix/Makefile.in:
- * win/Makefile.in:
- * win/Makefile.vc:
- * tests/unicode.test:
+ * generic/tclCompile.c:
+ * generic/tclExecute.c:
+ * generic/tclInt.decls:
* generic/tclInt.h:
- * generic/tclObj.c:
- * generic/tclUnicodeObj.c: added a new object type to store the
- 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.
-
-1999-06-04 <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.
-
-1999-06-03 <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]
-
-1999-06-02 <stanton@scriptics.com>
-
- * generic/tclUtf.c (Tcl_UtfNcasecmp): Fixed incorrect computation
- of relative ordering. [Bug: 2135]
-
-1999-06-01 <stanton@scriptics.com>
-
- * unix/configure.in: Fixed various small configure.in patches
- submitted by Jan Nijtmans. [Bug: 2121]
-
- * tests/reg.test:
- * generic/regc_color.c:
- * generic/regc_cvec.c:
- * generic/regc_lex.c:
- * generic/regc_locale.c:
- * generic/regc_nfa.c:
- * generic/regcomp.c:
- * generic/regcustom.h:
- * generic/rege_dfa.c:
- * generic/regerror.c:
- * generic/regerrs.h:
- * generic/regex.h:
- * generic/regexec.c:
- * generic/regfree.c:
- * generic/regfronts.c:
- * generic/regguts.h:
- * generic/tclCmdMZ.c:
- * 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]
-
-1999-05-28 <stanton@scriptics.com>
-
- * generic/tclObj.c: Changed to eliminate use of isupper/tolower in
- favor of the Unicode versions.
-
- * win/Makefile.in:
- * win/configure.in: Added preliminary TEA implementation.
+ * generic/tclIntDecls.h:
+ * generic/tclStubInit.c:
+ * generic/tclVar.c:
+ * tests/trace.test:
- * win/tclWinDde.c: Fixed bug where dde calls were being passed an
- invalid dde handle because Initialize had not been called.
- [Bug: 2124]
+2002-06-17 Andreas Kupries <andreas_kupries@users.sourceforge.net>
-1999-05-26 <redman@scriptic.com>
+ * 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.
- * generic/tclThreadTest.c: Fixed race condition in testthread
- code that showed up in the WinNT test suite intermittently.
+2002-06-17 Joe English <jenglish@users.sourceforge.net>
- * 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).
+ * 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.
-1999-05-24 <stanton@scriptics.com>
+2002-06-17 Don Porter <dgp@users.sourceforge.net>
- * tools/genStubs.tcl: Changed to allow a list of platforms instead
- of just one at a time.
+ * doc/msgcat.n: Corrected en_UK references to en_GB. UK is not
+ a country designation recognized in ISO 3166.
- * generic/tcl.decls:
- * generic/tclCmdMZ.c:
- * generic/tclDecls.h:
- * generic/tclInt.decls:
- * generic/tclIntDecls.h:
- * generic/tclPort.h:
- * generic/tclStubInit.c:
- * generic/tclStubLib.c: Various header file related changes and other
- lint to try to get the Mac builds working.
+ * library/msgcat/msgcat.tcl: More Windows Registry locale codes
+ from Bruno Haible.
-1999-05-21 <redman@scriptics.com>
+ * 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]
- * 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]
+2002-06-16 Miguel Sofer <msofer@users.sourceforge.net>
-1999-05-20 <redman@scriptics.com>
+ * generic/tclCompile.c (TclCompileTokens): a better algorithm for
+ the previous bug fix.
- * 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 <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.
+2002-06-16 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclUtil.c:
- * doc/StrMatch.3: Added Tcl_StringCaseMatch() implementation to
- support case-insensitive globbing.
+ * generic/tclCompile.c (TclCompileTokens):
+ * tests/compile.test: [Bug 569438] in the processing of dollar
+ variables; report by Georgios Petasis.
- * 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.
+2002-06-16 Miguel Sofer <msofer@users.sourceforge.net>
-1999-05-19 <redman@scriptics.com>
+ * 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/tcl.h: Add extern "C" block around entire header file for
- C++ compilers to fix linkage issues. Submitted by Don Porter and
- Paul Duffin.
+2002-06-14 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclRegexp.c: Fix bug when the regexp cache is empty
- and an empty pattern is used in regexp ( such as {} or "" ).
+ * 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.
-1999-05-18 <stanton@scriptics.com>
+2002-06-14 David Gravereaux <davygrvy@pobox.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/rules.vc: The test for compiler optimizations was in error.
+ Thanks goes to Roy Terry <royterry@earthlink.net> for his
+ assistance with this.
-1999-05-14 <stanton@scriptics.com>
+2002-06-14 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * generic/tclCmdAH.c (Tcl_ForObjCmd): Fixed crash caused by
- failure to reset the result before evaluating the test
- expression.
+ * 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.
-1999-05-14 <surles@scriptics.com>
+2002-06-13 Miguel Sofer <msofer@users.sourceforge.net>
- * 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/tclExecute.c (TclExecuteByteCode): consolidated code for
+ the conditional branch instructions.
-1999-05-14 <redman@scriptics.com>
+2002-06-13 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclDate.c: Applied patch to fix 100-year and 400-year
- boundaries in leap year code, from Isaac Hollander. [Bug: 2066]
+ * generic/tclExecute.c (TclExecuteByteCode): fixed the previous
+ patch - wouldn't compile with TCL_COMPILE_DEBUG set.
-1999-05-13 <stanton@scriptics.com>
+2002-06-13 Miguel Sofer <msofer@users.sourceforge.net>
- * 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]
+ * 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/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]
+2002-06-13 Miguel Sofer <msofer@users.sourceforge.net>
-1999-05-12 <stanton@scriptics.com>
+ * 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.
+ * 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].
- * doc/tclsh.1: Updated references to rc script names to accurately
- reflect the platform differences on Windows.
-
- * tests/regexp.test:
- * 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]
-
- * 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 <stanton@scriptics.com>
-
- * win/winDumpExts.c:
- * win/makefile.vc: Removed incorrect patch. [Bug: 1998]
+ ***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 ...
- * 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]
-
- * generic/tclLoadNone.c: Updated to use current interfaces, added
- TclpUnloadFile. [Bug: 2003]
-
- * win/winDumpExts.c:
- * win/makefile.vc: Changed to emit library name in defs
- file. [Bug: 1998]
-
- * unix/configure.in: Added fix for OS/390. [Bug: 1976]
-
-1999-05-06 <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.
-
- * tests/http.test: Unset "data" array before running tests to
- avoid failures due to previous tests.
-
- * doc/string.n:
- * tests/cmdIL.test:
- * tests/cmdMZ.test:
- * tests/error.test:
- * tests/ioCmd.test:
- * tests/lindex.test:
- * tests/linsert.test:
- * tests/lrange.test:
- * tests/lreplace.test:
- * 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.
-
- * doc/Utf.3:
- * generic/tclStubInit.c:
- * generic/tclDecls.h:
- * generic/tclUtf.c:
- * generic/tcl.decls: Added Tcl_UtfNcmp and Tcl_UtfNcasecmp.
-
-1999-05-05 <stanton@scriptics.com>
+2002-06-13 Vince Darley <vincentdarley@users.sourceforge.net>
- * win/makefile.vc: Added encoding directory to install-libraries
- target.
-
-1999-05-03 <stanton@scriptics.com>
-
- * 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.
-
- * tests/cmdIL.test:
- * tests/cmdMZ.test:
- * tests/error.test:
- * tests/lindex.test:
- * tests/linsert.test:
- * tests/lrange.test:
- * 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]
+ * tests/fCmd.test:
+ * tests/winFile.test:
+ * tests/fileSystem.test:
+ * generic/tclTest.c:
+ * generic/tclCmdAH.c:
+ * generic/tclIOUtil.c:
+ * 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).
- * tests/binary.test:
- * generic/tclBinary.c (DupByteArrayInternalRep): Fixed bug where
- type was not being set in duplicated object. [Bug: 1975, 2047]
+2002-06-12 Miguel Sofer <msofer@users.sourceforge.net>
-1999-04-30 <stanton@scriptics.com>
-
- * Changed version to 8.1.1.
+ * tclBasic.c (Tcl_DeleteTrace): fixed [Bug 568123] (thanks to
+ Hemang Lavana)
-1999-04-30 <stanton@scriptics.com>
-
- * Merged changes from 8.1.0 branch:
+2002-06-12 Jeff Hobbs <jeffh@ActiveState.com>
- * generic/tclParse.c: Fixed memory leak in CommandComplete.
-
- * generic/tclPlatDecls.h:
- * generic/tclIntPlatDecls.h:
- * 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]
+ * 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.
- * Lots of documentation and other release engineering fixes.
+2002-06-12 Vince Darley <vincentdarley@users.sourceforge.net>
-1999-04-28 <stanton@scriptics.com>
-
- * mac/tclMacResource.c:
- * 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.
-
-1999-04-27 <stanton@scriptics.com>
-
- * generic/tclLiteral.c (TclHideLiteral): Fixed so hidden literals
- get duplicated to avoid accidental sharing in the global object
- table.
+ * 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.
+
+ * 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.
+ Note: symlinks cannot yet be created in pure Tcl.
+
+2002-06-11 Miguel Sofer <msofer@users.sourceforge.net>
-1999-04-23 <stanton@scriptics.com>
+ * generic/tclBasic.c:
+ * generic/tclCompCmds.c:
+ * generic/tclInt.h: reverted the new compilation functions;
+ replaced by a more general approach described below.
- * generic/tclStubInit.c:
- * tools/genStubs.tcl: Changed to avoid the need for forward
- declarations in stub initializers.
+ * 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].
-1999-04-23 <stanton@scriptics.com>
+2002-06-11 Miguel Sofer <msofer@users.sourceforge.net>
- * library/encoding/koi8-r.enc:
- * tools/encoding/koi8-r.txt: Added support for the koi8-r Cyrillic
- encoding. [Bug: 1771]
+ * doc/global.n:
+ * doc/info.n:
+ * test/info.test:
+ * generic/tclCmdIL.c: fix for [Bug 567386], [info locals] was
+ reporting some linked variables.
+
+ * 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.
-1999-04-22 <stanton@scriptics.com>
+2002-06-11 Miguel Sofer <msofer@users.sourceforge.net>
- * 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.
+ * generic/tclExecute.c: optimised algorithm for exception range
+ lookup; part of [Patch 453709].
- * 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.
+2002-06-10 Vince Darley <vincentdarley@users.sourceforge.net>
- * generic/tclEvent.c: lint
+ * 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.
- * 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.
+2002-06-07 Don Porter <dgp@users.sourceforge.net>
-1999-04-22 Scott Stanton <stanton@scriptics.com>
+ * tests/tcltest.test: More corrections to test suite so that tests
+ of failing [test]s don't show up themselves as failing tests.
- * 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/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
- found used by tcl_findLibrary.
+2002-06-07 Donal K. Fellows <fellowsd@cs.man.ac.uk>
-1999-04-22 <redman@scriptics.com>
+ * 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...
- * 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.
-
-1999-04-15 <stanton@scriptics.com>
+ * 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]
+ * 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.
- * Merged 8.1 back into the main trunk
+2002-06-06 Mo DeJong <mdejong@users.sourceforge.net>
-1999-04-13 <stanton@scriptics.com>
+ * unix/dltest/Makefile.in: Remove hard coded CFLAGS=-g
+ and add CFLAGS_DEBUG, CFLAGS_OPTIMIZE, and
+ CFLAGS_DEFAULT varaibles. [Tcl bug 565488]
- * library/encoding/gb2312.enc:
- * library/encoding/euc-cn.enc:
- * 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]
+2002-06-06 Don Porter <dgp@users.sourceforge.net>
-1999-04-13 <redman@scriptics.com>
+ * tests/tcltest.test: Corrections to test suite so that tests
+ of failing [test]s don't show up themselves as failing tests.
- * 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]
+ * tests/io.test: Fixed up namespace variable resolution issues
+ revealed by running test suite with "-singleproc 1".
-1999-04-09 <redman@scriptics.com>
+ * doc/tcltest.n:
+ * library/tcltest/tcltest.tcl:
+ * tests/tcltest.test: Several updates to tcltest.
+ 1) changed to lazy initialization of test constraints
+ 2) deprecated [initConstraintsHook]
+ 3) repaired badly broken [limitConstraints].
+ 4) deprecated [threadReap] and [mainThread]
+ [Patch 512214, Bug 558742, Bug 461000, Bug 534903]
+
+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/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/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).
+
+2002-06-05 Don Porter <dgp@users.sourceforge.net>
+
+ * doc/Tcl_Main.3: Documented $tcl_rcFileName and added more
+ clarifications about the intended use of Tcl_Main(). [Bug 505651]
+
+2002-06-05 Daniel Steffen <das@users.sourceforge.net>
+
+ * 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
+ conversion of text resource contents.
+ * tests/macFCmd.test (macFCmd-1.2): allow CWIE creator.
+
+2002-06-04 Don Porter <dgp@users.sourceforge.net>
+
+ * 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
+ [tcltest::Eval] revealed by calling [tcltest::test] from a non-global
+ namespace, and namespace errors in init.test.
+
+2002-06-04 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * win/README: Update msys+mingw URL.
+
+2002-06-03 Don Porter <dgp@users.sourceforge.net>
- * 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]
+ * 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]
-1999-04-06 <stanton@scriptics.com>
+2002-06-03 Miguel Sofer <msofer@users.sourceforge.net>
- * tests/unixNotfy.test: Fixed hang in tests when built with thread
- support.
+ * doc/namespace.n: added description of [namepace forget]
+ behaviour for unqualified patterns [Bug 559268]
- * tests/httpold.test: Fixed broken test that didn't wait long
- enough for events to arrive.
+2002-06-03 Miguel Sofer <msofer@users.sourceforge.net>
- * tests/unixInit.test: Fixed race condition in test.
+ * generic/tclExecute.c: reverting an accidental modification in
+ the last commit.
- * tests/unixInit.test:
- * tests/fileName.test: Minor test nits.
-
- * unix/tclUnixInit.c (TclpSetInitialEncodings): Fixed bad initial
- encoding string.
-
-1999-04-06 <surles@scriptics.com>
+2002-06-03 Miguel Sofer <msofer@users.sourceforge.net>
- * 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:
- * generic/tclWinInit.h:
- * generic/tclUnixInit.h:
- * 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]
+ * doc/Tcl.n: clarify the empty variable name issue ([Bug 549285]
+ reported by Tom Krehbiel, patch by Don Porter).
-1999-04-05 <stanton@scriptics.com>
+2002-05-31 Don Porter <dgp@users.sourceforge.net>
- * tests/io.test: Minor test cleanup.
-
- * 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]
-
- * unix/configure.in: Fixed BSD/OS 4.* configuration to support
- shared libraries properly. [Bug: 1730]
-
-1999-04-05 <redman@scriptics.com>
+ * library/package.tcl: Fixed leak of slave interp in [pkg_mkIndex].
+ Thanks to Helmut for report. [Bug 550534]
- * win/tclWinDde.c: decrease timeout value for DDE calls to 30k
- [Bug: 1639]
+ * tests/io.test:
+ * tests/main.test: Use the "stdio" constraint to control whether
+ an [open "|[interpreter]"] is attempted.
+
+ * generic/tclExecute.c (TclMathInProgress,TclExecuteByteCode
+ 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].
+ * unix/configure: regen
+
+2002-05-30 Miguel Sofer <msofer@users.sourceforge.net>
+
+ * generic/tclCompExpr.c:
+ * generic/tclCompile.c:
+ * generic/tclCompile.h: removed exprIsJustVarRef and
+ exprIsComparison from the ExprInfo and CompileEnv structs. These
+ were set, but not used since dec 1999 [Bug 562383].
+
+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.
+
+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):
+ * 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).
+
+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.
+
+2002-05-29 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * 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/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>
- * generic/tcl.decls:
- * generic/tcl.h:
- * generic/tclDecls.h:
* generic/tclInt.decls:
- * generic/tclInt.h:
* 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).
-
- * 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.
-
-1999-04-05 <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]
-
- * tests/platform.test:
- * tests/fileName.test: Fixed broken tests.
-
- * 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.
-
- * 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.
-
-1999-04-02 <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.
+ * generic/tclUtf.c: added TclpUtfNcmp2 private command that
+ 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).
+
+ * 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/tclCompCmds.c (TclCompileStringCmd): removed error
+ creation in code that no longer throws an error.
-1999-04-02 <redman@scriptics.com>
-
- * doc/dde.n:
- * 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.
-
-1999-04-02 <stanton@scriptics.com>
-
- * tests/expr.test:
- * tests/for-old.test:
- * tests/for.test:
- * tests/foreach.test:
- * tests/format.test:
- * tests/httpold.test:
- * tests/if.test:
- * tests/init.test:
- * tests/interp.test:
- * tests/while.test: Added some tests for known bugs (marked with
- knownBug constraint), and cleaned up a few bad tests.
-
- * generic/regc_locale.c:
- * generic/regcustom.h:
- * generic/tcl.decls:
- * generic/tclCmdIL.c:
- * generic/tclCmdMZ.c:
- * generic/tclInt.h:
- * generic/tclRegexp.c:
- * generic/tclScan.c:
- * 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:
- Tcl_UtfToUniCharDString, Tcl_UniCharToUtfDString,
- Tcl_UniCharLen, Tcl_UniCharNcmp, Tcl_UniCharIsAlnum,
- Tcl_UniCharIsAlpha, Tcl_UniCharIsDigit, Tcl_UniCharIsLower,
- Tcl_UniCharIsSpace, Tcl_UniCharIsUpper, Tcl_UniCharIsWordChar
-
-1999-04-01 <stanton@scriptics.com>
-
- * tests/registry.test:
- * 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]
+ * tests/string.test:
+ * tests/stringComp.test: added more string comparison checks.
- * generic/tclInt.h: Removed duplicate declarations.
+ * tests/clock.test: better qualified 9.1 constraint check for %s.
- * generic/tclInt.decls:
- * generic/tcl.decls: Added Tcl_WinUtfToTChar and Tcl_WinTCharToUtf
- to the tclPlat table.
+2002-05-28 Jeff Hobbs <jeffh@ActiveState.com>
-1999-04-01 <redman@scriptics.com>
+ * generic/tclThreadAlloc.c (TclpRealloc, TclpFree): protect
+ against the case when NULL is based.
- * generic/tcl.decls:
- * generic/tcl.h:
- * generic/tclBasic.c:
- * generic/tclDecls.h:
- * generic/StubInit.c:
- * 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).
+ * tests/clock.test: added clock-9.1
+ * compat/strftime.c:
+ * 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]
+
+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]
+
+2002-05-27 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * win/tclWinError.c: Added comment on conversion of
+ ERROR_NEGATIVE_SEEK because that is a mapping that really belongs,
+ and not a catch-all case.
+ * win/tclWinPort.h (EOVERFLOW): Should be either EFBIG or EINVAL
+ * generic/tclPosixStr.c (Tcl_ErrnoId, Tcl_ErrnoMsg): EOVERFLOW can
+ potentially be a synonym for EINVAL.
+
+2002-05-24 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ === Changes due to TIP#91 ===
+
+ * win/tclWinPort.h: Added declaration of EOVERFLOW.
+ * doc/CrtChannel.3: Added documentation of wideSeekProc.
+ * 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.)
+ * 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.
+ * 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.
+ (HaveVersion): New function to do version checking.
+ (Tcl_ChannelBlockModeProc, Tcl_ChannelFlushProc)
+ (Tcl_ChannelHandlerProc): Made these functions use HaveVersion for
+ ease of future maintainability.
+ (Tcl_ChannelBlockModeProc): Obvious lookup function.
+ * generic/tcl.h (Tcl_ChannelType): New wideSeekProc field, and
+ seekProc type restored to old interpretation.
+ (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.
+
+2002-05-21 Mo DeJong <mdejong@users.sourceforge.net>
-1999-03-31 <redman@scriptics.com>
+ * 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]
- * 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.
+2002-05-20 Daniel Steffen <das@users.sourceforge.net>
-1999-03-30 <stanton@scriptics.com>
+ * generic/tclInt.h: added prototype for TclpFilesystemPathType().
+ * mac/tclMacChan.c: use MSL provided creator type if available
+ instead of the default 'MPW '.
- * unix/Makefile.in: Removed trailing backslash that broke the
- "depend" target.
+2002-05-16 Joe English <jenglish@users.sf.net>
- * unix/tclUnixInit.c (TclpSetInitialEncodings): Changed to avoid
- calling setlocale(). We now look directly at env(LANG) and
- env(LC_CTYPE) instead. [Bug: 1636]
+ * doc/CrtObjCmd.3:
+ Added Tcl_GetCommandFromObj, Tcl_GetCommandFullName
+ (Tcl Bug #547987, #414921)
- * 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.
+2002-05-14 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * 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]
+ * 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.
-1999-03-29 <stanton@scriptics.com>
+2002-05-13 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * generic/tclFileName.c:
- * generic/tclDecls.h:
- * generic/tcl.decls: Added CONST to Tcl_JoinPath and
- Tcl_TranslateFileName.
+ * 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...
-1999-03-29 <redman@scriptics.com>
+2002-05-13 Vince Darley <vincentdarley@users.sourceforge.net>
- * tools/genStubs.tcl:
- * unix/configure.in:
- * unix/Makefile.in:
- * win/makefile.vc:
- * generic/tcl.h:
- * generic/tclBasic.c:
- * 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/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]
+ * win/tclWinChan.c: fix comment referring to wrong function.
-1999-03-27 <redman@scriptics.com>
-
- * win/makefile.bc: Removed makefile for Borland compiler, no
- longer supported.
-
-1999-03-26 <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.
+2002-05-10 Don Porter <dgp@users.sourceforge.net>
-1999-03-26 <suresh@scriptics.com>
+ * 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].
- * 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.
+2002-05-08 David Gravereaux <davygrvy@pobox.com>
-1999-03-25 <stanton@scriptics.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.
- * 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]
-
- * 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]
-
- * generic/tclPkg.c (Tcl_PkgRequireEx): Fixed broken clientData
- initialization in package code.
+2002-05-08 David Gravereaux <davygrvy@pobox.com>
- * unix/Makefile.in (dist): Added tcl.decls and tclInt.decls to
- source distribution. [Bug: 1571]
+ * tools/man2tcl.c:
+ * tools/man2help2.tcl: Proper source of macro error mis-
+ understanding single-quote as the leading macro command found
+ and repaired.
- * 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]
+ * doc/file.n: Reverted to prior state before I messed with
+ it.
-1999-03-24 <stanton@scriptics.com>
+2002-05-08 Don Porter <dgp@users.sourceforge.net>
- * 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]
+ * library/tcltest/tcltest.tcl: Corrected [uplevel] quoting when
+ [source]-ing test script in subdirectories.
+ * 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.
-1999-03-24 <redman@scriptics.com>
+2002-05-07 David Gravereaux <davygrvy@pobox.com>
- * generic/tclAlloc.c:
- * 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/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 <stanton@scriptics.com>
-
- * tools/tcl.wse: Fixed file association to look in the right place
- for the wish icon. [Bug: 1544]
-
- * tests/winNotify.test:
- * tests/ioCmd.test:
- * tests/event.test: Changed to use new style conditionals.
-
- * tests/encoding.test: Fixed nonportable test.
-
- * unix/dltest/configure.in:
- * 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]
+ -- 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/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.
- * generic/tclInt.h:
- * generic/tcl.decls: Renamed TclpAlertNotifier back to
- Tcl_AlertNotifier since it is part of the public notifier driver
- API.
+ * doc/file.n:
+ * doc/TraceCmd.3: winhelp conversion tools where understanding
+ a ' as the first character on a line to be an unknown macro.
+ Not knowing how to repair tools/man2tcl.c, I decided to rearrange
+ the text in the docs instead.
-1999-03-23 <redman@scriptics.com>
+2002-05-07 Vince Darley <vincentdarley@users.sourceforge.net>
- * 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.
+ * generic/tclFileName.c: fix to similar segfault when using
+ 'glob -types nonsense -dir dirname -join * *'. [Bug 553320]
- * 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.
-
-1999-03-22 <stanton@scriptics.com>
-
- * tests/reg.test:
- * generic/regc_color.c: Applied regexp bug fix from Henry Spencer.
-
-1999-03-19 <redman@scriptics.com>
+ * 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 '['.
+
+2002-05-07 Miguel Sofer <msofer@users.sourceforge.net>
+
+ * tests/basic.test: Fix for [Bug 549607]
+ * tests/encoding.test: Fix for [Bug 549610]
+ These are testsuite bugs that caused failures when the filename
+ contained spaces. Report & fix by Kevin Kenny.
+
+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.
+ * 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.
+ * 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".
+ * doc/file.n: clarified documentation.
+ * 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.
+
+2002-04-26 Jeff Hobbs <jeffh@ActiveState.com>
- * generic/tclCmdIL.c: Fixed the initialization of an array so that
- the Sun 5.0 C compiler wouldn't complain.
+ * unix/configure:
+ * unix/tcl.m4: change HP-11 SHLIB_LD_LIBS from "" to ${LIBS} so
+ that the .sl knows its dependent libs.
- * 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 <stanton@scriptics.com>
+2002-04-26 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * 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.
+ * 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]
- * win/makefile.vc: Regularized usage of mkd and rmd and rm.
+2002-04-24 Jeff Hobbs <jeffh@ActiveState.com>
- * library/encoding/shiftjis.enc:
- * tools/encoding/shiftjis.txt: Missing/incorrect characters in
- shift-jis table. [Bug: 1008, 1526]
+ * generic/tclInt.h: corrected TclRememberJoinableThread decl to
+ use VOID instead of void.
+ * generic/tclThreadJoin.c: noted that this code isn't needed on Unix.
- * generic/tclInt.decls:
- * generic/tcl.decls: Eliminated use of "string" and "list" from
- argument lists to avoid conflicts with C++ STL. [Bug: 1181]
+2002-04-23 Jeff Hobbs <jeffh@ActiveState.com>
- * win/tclWinFile.c (TclpMatchFiles): Changed to ignore the
- FS_CASE_IS_PRESERVED bit and always return exactly what we get
- from the system.
+ * doc/exec.n:
+ * doc/tclvars.n: doc updates [Patch #509426] (gravereaux)
-1999-03-17 <stanton@GASPODE>
+2002-04-24 Daniel Steffen <das@users.sourceforge.net>
- * win/README.binary:
- * win/README:
- * unix/configure.in:
- * generic/tcl.h:
- * README: Updated version to 8.1b3.
-
-1999-03-14 <stanton@GASPODE>
-
- * win/tclWinConsole.c:
- * 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.
-
- * generic/tclIntDecls.h:
- * generic/tclIntPlatDecls.h:
- * generic/tclIntPlatStubs.c:
- * generic/tclIntStubs.c:
- * generic/tclPlatDecls.h:
- * generic/tclPlatStubs.c:
- * generic/tclStubInit.c:
- * generic/tclStubs.c: Fixed bad eol characters.
-
- * generic/tclInt.decls: Changed "const" to "CONST" in
- declarations for better portability.
+ * 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.
- * generic/tcl.decls: Renamed panic and panicVA to Tcl_Panic and
- Tcl_PanicVA in the stub files.
+2002-04-23 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * generic/tclInterp.c (Tcl_MakeSafe): Remove tcl_platform(user)
- from safe interps.
+ * doc/TraceCmd.3: New file that documents Tcl_CommandTraceInfo,
+ Tcl_TraceCommand and Tcl_UntraceCommand [Bug 414927]
-1999-03-11 <stanton@GASPODE>
+2002-04-22 Jeff Hobbs <jeffh@ActiveState.com>
+ * generic/tclAlloc.c:
+ * generic/tclInt.h:
+ * generic/tclThreadAlloc.c (new):
* 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.
-
- * generic/tcl.h: Changed magic number so it doesn't match the plus
- patch, at Jan's request.
-
- * unix/tclConfig.sh.in:
- * unix/dltest/Makefile.in:
- * unix/dltest/configure.in:
- * unix/dltest/pkga.c:
- * unix/dltest/pkgb.c:
- * 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.
-
-1999-03-10 <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.
+ * 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).
- * mac/tclMacNotify.c:
- * generic/tclNotify.c:
- * generic/tclInt.h:
- * win/tclWinNotify.c:
- * generic/tcl.h: Renamed Tcl_AlertNotifier to TclpAlertNotifier.
+ * generic/tclIOUtil.c (Tcl_FSRegister, Tcl_FSUnregister):
+ corrected calling of Tcl_ConditionWait to ensure that there would
+ be a condition to wait upon.
- * generic/tclInt.decls: Added TclWinAddProcess to make it possible
- for expect to use Tcl_WaitForPid(). This patch is from Gordon
- Chaffee.
+ * generic/tclCmdAH.c (Tcl_FileObjCmd): added cast in FILE_SIZE.
- * 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.
+ * win/tclWinFCmd.c (DoDeleteFile): check return of setattr API
+ calls in file deletion for correct Win32 API handling.
- * generic/tcl.decls: Fixed declarations of reserved slots.
-
-1999-03-10 <redman@scriptic.com>
+ * win/Makefile.in: correct dependencies for shell, gdb, runtest
+ targets.
- * generic/tclCompile.h: Ensure that the ByteCode struct is binary
- compatible with the version in 8.0.6.
+ * 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.
- * 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).
+2002-04-19 Don Porter <dgp@users.sourceforge.net>
-1999-03-09 <stanton@GASPODE>
+ * generic/tclMain.c (Tcl_Main): Free the memory allocated for the
+ startup script path. [Bug 543549]
- * Integrated changes from Tcl 8.0 including:
- stubs mechanism
- configure patches from Jan Nijtmans
- rename of panic to Tcl_Panic
-
-1999-03-08 <lfb@scriptics.com>
+ * 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.
- * win/tclWin32Dll.c: Removed Dll instance from thread-local
- storage.
+ * 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]
-1999-03-08 <stanton@GASPODE>
-
- * generic/tcl.h: Moved Tcl_Mutex, etc. macros above the inclusion
- of tclDecls.h to avoid macro conflicts.
+2002-04-20 Daniel Steffen <das@users.sourceforge.net>
- * generic/tclInt.h:
- * generic/regc_color.c:
- * generic/regcomp.c:
- * generic/tclCmdIL.c:
- * generic/tclCmdAH.c:
- * generic/tclIOCmd.c:
- * generic/tclParse.c:
- * generic/tclStringObj.c:
- * unix/tclUnixNotfy.c: Cleaned up various compiler warnings,
- eliminated UCHAR bugs.
-
- * unix/tclUnixNotfy.c:
- * unix/tclUnixThrd.c:
- * generic/tclThreadTest.c:
- * mac/tclMacThrd.c: Changed TclpCondition*() to Tcl_Condition*().
-
- * INTEGRATED PATCHES FROM 8.0.6:
-
- * generic/tcl.decls:
- * generic/tcl.h:
- * generic/tclBasic.c:
- * generic/tclDecls.h:
* generic/tclInt.decls:
- * generic/tclInt.h:
- * generic/tclIntDecls.h:
* generic/tclIntPlatDecls.h:
- * generic/tclIntPlatStubs.c:
- * generic/tclIntStubs.c:
- * generic/tclPlatDecls.h:
- * generic/tclPlatStubs.c:
* generic/tclStubInit.c:
- * generic/tclStubLib.c:
- * generic/tclStubs.c:
- * tools/genStubs.tcl:
- * unix/configure.in:
- * 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.
+ * 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)
- * unix/Makefile.in:
- * unix/configure.in:
- * unix/ldAix: Enhanced AIX shared library support.
+2002-04-19 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * win/tclWinSock.c: Removed a bunch of extraneous PASCAL FAR
- attributes from internal functions.
+ * tests/lindex.test (lindex-3.7):
+ * generic/tclUtil.c (TclGetIntForIndex): Stopped indexes from
+ hitting wide ints. [Bug #526717]
- * win/tclWinReg.c: Changed registry package to use stubs mechanism
- so it no longer depends on the specific version of Tcl.
+2002-04-18 Miguel Sofer <msofer@users.sourceforge.net>
- * doc/AddErrInfo.3:
- * doc/Eval.3:
- * doc/PkgRequire.3:
- * doc/SetResult.3:
- * doc/StringObj.3:
- * generic/tcl.h:
- * generic/tclBasic.c:
- * 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.
-
- * doc/package.n:
- * doc/PkgRequire.3:
- * generic/tclPkg.c: Added Tcl_PkgProvideEx, Tcl_RequireEx,
- 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.
-
- * generic/tclPanic.c:
- * generic/panic.c: Renamed panic to Tcl_Panic.
-
-1999-02-25 <redman@scriptics.com>
-
- * 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/tclWinSerial.c: New code to properly deal with fileevents
- and nonblocking mode on serial ports.
+ * generic/tclNamesp.c:
+ * tests/info.test: [Bug 545325] info level didn't report
+ namespace eval, bug report by Richard Suchenwirth.
- * win/tclWinPipe.c:
- * win/tclWinPort.h: Exported functions to allow creation of pipe
- channels from tclWinChan.c
+2002-04-18 Don Porter <dgp@users.sourceforge.net>
- * 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).
+ * 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]
-1999-02-11 <stanton@GASPODE>
+2002-04-18 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * README:
- * generic/tcl.h:
- * win/README.binary:
- * win/README:
- * unix/configure.in:
- * mac/README: Updated version numbers to 8.1b2.
+ * generic/tclCmdIL.c (InfoBodyCmd):
+ * tests/info.test (info-2.6): Proc bodies without string reps
+ would report as empty [Bug #545644]
-1999-02-10 <stanton@GASPODE>
+ * 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.
- * 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".
+2002-04-18 Miguel Sofer <msofer@users.sourceforge.net>
- * 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/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.
-1999-02-10 <stanton@GASPODE>
+2002-04-17 Jeff Hobbs <jeffh@ActiveState.com>
- INTEGRATED PATCHES FROM 8.0.5b2:
+ * generic/tclEncoding.c (EscapeFromUtfProc):
+ * generic/tclIO.c (WriteChars, Tcl_Close): corrected the handling
+ of outputting end escapes for escape-based encodings.
+ [Bug #526524] (yamamoto)
- * test/winPipe.test: Changed to remove echoArgs.tcl temporary file
- when done.
-
- * 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]
-
- * 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/tcl.h: Moved Tcl_AppInit declaration to end and cleared
- out TCL_STORAGE_CLASS so it is not declared with a declspec().
+2002-04-17 Don Porter <dgp@users.sourceforge.net>
- * tests/interp.test:
- * generic/tclInterp.c (DeleteAlias): Changed to use
- Tcl_DeleteCommandFromToken so we handle renames properly. This
- avoids senseless panic. [Bug: 736]
+ * 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.
- * 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]
+ * 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]
- * 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: Fixed bug in namespace tail computation.
- Fixed bug where upvar could resurrect a namespace variable whose
- namespace had been deleted.
+2002-04-16 Don Porter <dgp@users.sourceforge.net>
- * generic/tclCompile.c (TclCompileExprCmd): Eliminated yet another
- bogus optimization in expression compilation.
+ * 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]
- * 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]
-
- * 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]
-
- * generic/tclCompile.c (CompileExprWord): Fixed exception stack
- overflow bug caused by missing statement. [Bug: 928]
-
- * generic/tclIOCmd.c:
- * 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]
-
- * 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]
-
- * win/tclWinReg.c:
- * doc/registry.n: Added support for HKEY_PERFORMANCE_DATA and
- 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]
-
-1999-02-01 <stanton@GASPODE>
+2002-04-15 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclBasic.c:
- * generic/tclCmdAH.c:
- * generic/tclCmdIL.c:
- * generic/tclCmdMZ.c:
- * generic/tclExecute.c:
- * generic/tclHistory.c:
- * generic/tclIO.c:
- * generic/tclIOUtil.c:
- * generic/tclInterp.c:
- * generic/tclMain.c:
- * generic/tclNamesp.c:
- * generic/tclParse.c:
* 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.
-
-1999-01-28 <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.
-
-1998-12-11 === Tcl 8.1b1 Release ===
+ * tests/proc-old.test: Improved stack trace for TCL_BREAK and
+ TCL_CONTINUE returns from procs. Patch by Don Porter
+ [Bug 536955].
-1998-12-10 <stanton@GASPODE>
-
-2000-03-21 Syd Polk <spolk@cygnus.com>
-
- * configure.in: Check for cygwin, not cygwin32.
- * configure: Regenerate.
-
- * generic/tclInitScript.h: Added newline at end of file to make
- current gcc happy.
-
-1999-12-06 Mo DeJong <mdejong@cygnus.com>
-
- * win/Makefile.in: added cl flags needed for VC++ 6.0
-
-1999-06-21 Syd Polk <spolk@cygnus.com>
-
- * generic/tclIO.c: Bug fixes from Scriptics to get exit status
- correct on pipe channels.
-
-1999-04-22 Syd Polk <spolk@cygnus.com>
-
- * unix/Makefile.in: Don't install tcl.h for install-libaries.
-
-1999-02-16 Syd Polk <spolk@cygnus.com>
-
- * win/configure.in: TCL_SRC_DIR needs to have forward slashes
- for the MS build.
- * win/configure: Regenerate.
- * win/tclWinInit.c: Stupid Visual C++ compiler has limit on
- number of characters in string constant.
-
-1999-02-11 Syd Polk <spolk@cygnus.com>
-
- * generic/tclInitScript.h: The tclInit proc that Jim Ingham wrote
- blew MS's string buffer away, so I hacked the original in for the
- Microsoft build, which only SN is using anyway. Yuck.
-
-1999-02-08 Syd Polk <spolk@cygnus.com>
-
- * unix/configure.in: Fixed problem with test in --enable-symbols.
- * unix/configure: Regenerated.
- * library/auto.tcl: Fixed a problem with the regsub inside of
- auto_mkindex since the regsub semantics changed.
-
-1999-02-04 James Ingham <jingham@cygnus.com>
-
- * generic/tclInitScript.h: Change the tclInit proc to find the Tcl
- library in both build & install trees.
- * library/auto.tcl (tcl_findLibrary): Change tcl_findLibrary to
- search around the executible for the tclConfig.sh, and then use
- this to find the source tree. This works in many more cases than
- the Scriptics version.
-
- * configure.in: If no value is given for --enable-symbols, use the
- value from AC_PROG_CC, this adds -g for gcc.
-
-1999-01-19 Ben Elliston <bje@cygnus.com>
-
- * tools/encoding/shiftjis.txt: Map tilde in ShiftJIS to tilde in
- Unicode.
-
- * library/encoding/shiftjis.enc: Regenerate.
-
-1998-12-21 Syd Polk <spolk@cygnus.com>
-
- * generic/tclCompExpr.c: Remove another instance of string
- blasting.
-
- * generic/tclLiteral.c (TclDeleteLiteralTable): Make code
- that detects infinite loops exit gracefully in production
- build and panic in development build.
-
-1998-12-21 Khamis Abuelkomboz <khamis@cygnus.com>
-
- * generic/tclLiteral.c (TclDeleteLiteralTable): added a daemon to catch
- a hanging bug by deleteing a literal.
-
-1998-12-19 Syd Polk <spolk@cygnus.com>
-
- * generic/tclCompile.c (tclCompileScript): Localize modifying
- the compiled string to the call which needs it. This prevents
- the string getting hashed incorrectly later.
-
- * generic/tclAlloc.c: Latest patch from Scriptics.
-
-1998-12-16 Syd Polk <spolk@cygnus.com>
-
- * tools/encoding/shiftjis.txt: Unicode character 0xFF5E
- was missing from the shiftjis table.
- * library/encoding/shiftjis.enc: Regnerated.
-
-1998-12-16 Ben Elliston <bje@sanguine.cygnus.com>
-
- * generic/tclBasic.c (builtInCmds): Add `encoding'. Patch from
- Scriptics.
+ * 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.
- * generic/tclCmdAH.c (Tcl_EncodingObjCmd): New function. Patch
- from Scriptics.
+2002-04-15 Don Porter <dgp@users.sourceforge.net>
- * generic/tclEncoding.c: Changed at the same time as the rest of
- these files, so it might be important. Patch from Scriptics.
+ * tests/socket.test: Increased timeout values so that tests have
+ time to successfully complete even on slow/busy machines. [Bug 523470]
- * doc/encoding.n: New file. From Scriptics.
+ * 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.
+
+2002-04-11 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tclNotify.c (TclFinalizeNotifier): remove remaining
+ 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:
+ 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.
+
+2002-04-08 Daniel Steffen <das@users.sourceforge.net>
+
+ * generic/tcl.h: no <sys/types.h> on mac.
+ * mac/tclMacFile.c: minor fixes to Vince's changes from 03-24.
+ * 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.
+ * 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.
-1998-12-03 Syd Polk <spolk@cygnus.com>
+2002-04-06 Jeff Hobbs <jeffh@ActiveState.com>
- * generic/tclIO.c: Integrated more complete fix to
- channel problem from Scott Stanton at Scriptics.
+ * 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.
-1998-12-02 Syd Polk <spolk@cygnus.com>
+2002-04-05 Don Porter <dgp@users.sourceforge.net>
- * generic/tclIO.c: Fixed problem when writing out to a
- channel set to -crlf translations.
+ * 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]
-1998-12-02 Ian Roxborough <irox@cygnus.com>
+2002-04-03 Jeff Hobbs <jeffh@ActiveState.com>
- * win/tclWinChan.c: Merged in WishCon0.1 Changes to
- support pipe IO at console level of a WishShell.
+ * library/tcltest/tcltest.tcl: added getMatchingFiles back (alias
+ to GetMatchingFiles), which was a public function in tcltest 1.0.
-1998-11-24 Syd Polk <spolk@cygnus.com>
+2002-04-01 Vince Darley <vincentdarley@users.sourceforge.net>
- * win/Makefile.in: Under MSVC, use the Tcl dumpexts method
- to generate exports.
- * win/tclWinPort.h tclWinSock.c: Do not #define PASCAL away.
- It is needed in calls to DLLs.
+ * 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.
+ * 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.
+
+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.
+
+2002-03-29 Don Porter <dgp@users.sourceforge.net>
+
+ * doc/AllowExc.3:
+ * 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]
+
+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.
+
+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]
-1998-11-18 Syd Polk <spolk@cygnus.com>
+ * doc/SetVar.3:
+ * doc/TraceVar.3:
+ * doc/UpVar.3: .AP macro syntax repair.
- * generic/tclAlloc.c: Made sure that blocks are allocated on
- eight-byte boundaries.
- * unix/tclUnixPort.h: Added a CYGNUS LOCAL comment.
+2002-03-27 David Gravereaux <davygrvy@pobox.com>
-1998-11-09 Ben Elliston <bje@cygnus.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]
- * generic/tclVar.c (TclGetIndexedScalar): Fix a general problem
- with compiled local variables that are upvar'ed. Contributed by
- Scott Stanton <stanton@scriptics.com>.
+2002-03-27 David Gravereaux <davygrvy@pobox.com>
-1998-11-04 Ian Roxborough <irox@cygnus.com>
+ * win/.cvsignore:
+ * win/buildall.vc.bat:
+ * 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/tclWinPort.h: #endif in the wrong place and missing ')'.
-
-1998-11-06 Syd Polk <spolk@cygnus.com>
-
- * win/tclWinPort.h: Updated from Scriptics. Tcl_Realloc no longer
- fails with blocks that are more than 64K.
-
-1998-11-04 Ian Roxborough <irox@cygnus.com>
-
- * generic/panic.c (panic): Removed a #define _DEBUG,
- under MSVC if you want an exception Breakpoint instead
- of a panic dialog, CFLAGS must contain -D_DEBUG.
-
-1998-11-03 Ian Roxborough <irox@cygnus.com>
-
- * generic/panic.c (panic): If compiling with Microsoft, have this
- generate an exception Breakpoint.
-
-1998-11-03 Syd Polk <spolk@cygnus.com>
-
- * generic/panic.c: If compiling with Microsoft, have this generate
- a core dump so that we can actually see where it is happening when
- we have co stdout/stderr.
-
-1998-10-29 Syd Polk <spolk@cygnus.com>
-
- * win/configure.in: Removed check for caddr_t. This configure.in
- is not really ready for autoheader and the other garbage.
- * win/configure: Regenerated.
- * generic/tclAlloc.c: Put declaration of caddr_t inside of
- #ifdef _MSC_VER. It appears that this is the only compiler that
- is missing this typedef.
-
-1998-10-29 Syd Polk <spolk@cygnus.com>
-
- * win/Makefile.in: The directory for encodings is called 'encoding',
- not 'encodings'.
-
-1998-10-29 Syd Polk <spolk@cygnus.com>
-
- * unix/configure.in: Fix merge problem with socket libraries. Run
- autoconf test for caddr_t.
- * unix/configure: Regenerate.
- * win/configure.in Run autoconf test for caddr_t.
- * win/configure: Regnerate.
- * generic/tclAlloc.c: Remove declaration of caddr_t. Should be
- provided by configure now.
-
-1998-10-28 Syd Polk <spolk@cygnus.com>
-
- * unix/Makefile.in: Install encodings from make install.
- * win/Makefile.in: Install encodings from make install.
-
-1998-10-28 Ben Elliston <bje@cygnus.com>
-
- * win/configure.in (TCL_BUILD_INCLUDES): Remove. Do not subst.
- * win/configure: Regenerate.
-
-1998-10-26 Syd Polk <spolk@cygnus.com>
-
- * win/Makefile.in: Fix references to old opt0.1 library.
-
-1998-10-20 Syd Polk <spolk@cygnus.com>
-
- * unix/Makefile.in: Fix references to old opt0.1 library.
+ 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
+ repair for [Bug 533862].
-1998-10-19 Ben Elliston <bje@cygnus.com>
+2002-03-28 Miguel Sofer <msofer@users.sourceforge.net>
- * unix/configure.in: Compute a value for @TCL_BUILD_INCLUDES@.
+ * generic/tclBasic.c (Tcl_EvalEx): passing the correct commandSize
+ to TclEvalObjvInternal. [Bug 219362], fix by David Knoll.
- * unix/configure: Regenerate.
+2002-03-28 Miguel Sofer <msofer@users.sourceforge.net>
- * unix/tclConfig.sh.in (TCL_BUILD_INCLUDES): Set.
-
- * win/configure.in: Compute a value for @TCL_BUILD_INCLUDES@.
+ * generic/tclBasic.c (Tcl_EvalEx):
+ * tests/basic.test: avoid exceptional returns at level 0
+ [Bug 219181]
- * win/configure: Regenerate.
+2002-03-27 Don Porter <dgp@users.sourceforge.net>
-1998-10-14 Syd Polk <spolk@cygnus.com>
+ * doc/tcltest.n ([mainThread]):
+ * library/tcltest/tcltest.tcl:
+ * tests/tcltest.test: Major code cleanup to deal with whitespace,
+ coding conventions, and namespace issues, with several minor bugs
+ fixed in the process.
- * win/configure.in Makefile.in: More fixes for the tcl8.l build
- * win/configure: Regenerated
+ * tests/main.test: Added missing [after cancel]s.
-1998-10-14 Syd Polk <spolk@cygnus.com>
+2002-03-25 Don Porter <dgp@users.sourceforge.net>
- * generic/tclCmdIL.c (SortCompare}: Support as much of the old
- comparison semantics as possible. It is now possible to do
- lsort -command {foo bar} {1 3 45}.
- * tests/cmdIL.test (cmdIL-3.16}: Restore test.
+ * tests/main.test: Removed workarounds for Bug 495977.
-1998-10-08 Syd Polk <spolk@cygnus.com>
+ * 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]
+ 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]
+ Corrected faulty variable initialization. [Bug 534845]
- * generic/tclCmdIL.c (SortCompare): Make the comparison callback
- object based for performance.
- * tests/cmdIL.test (cmdIL-3.16): Test relied on incorrect behavior
- of old string based comparison callback, which was a bug. Corrected
- test.
- * unix/configure.in: Minor fixes for gcc
- * unix/configure: Regenerated
- * unix/dltest/configure.in: GCC needs -f writeable-strings
- * unix/dltest/Makefile.in: Fixed invalid TCL_CFLAGS reference
- * unix/dltest/configure: Regenerated.
+2002-03-25 Miguel Sofer <msofer@users.sourceforge.net>
-1998-10-01 Ben Elliston <bje@cygnus.com>
+ * doc/CrtTrace.3: small doc correction
+ * generic/tclBasic.c (Tcl_DeleteTrace): Allow NULL callback on
+ trace deletions [Bug 534728] (Hemang Lavana).
- * generic/tclCmdIL.c (InfoEncodingsCmd): New function. Implement a
- Tcl ``info encodings'' command.
- (Tcl_InfoObjCmd): Detect ``encodings'' subcommand.
+2002-03-24 Miguel Sofer <msofer@users.sourceforge.net>
- * doc/info.n: Update documentation.
-
-1998-09-29 Syd Polk <spolk@cygnus.com>
+ * generic/tclBasic.c (Tcl_EvalObjv): replaced obscure, incorrect
+ code as described in [Bug 533907] (Don Porter).
- * win/Makefile.in: Still some hard-coded references to 8.0.
- Fix problems with try and except
- * win/configure.in: Likewise
- * win/configure: Regenerated
- * win/tclWin32Dll.c: try and except not supported under gcc.
+2002-03-24 Don Porter <dgp@users.sourceforge.net>
-1998-09-28 Syd Polk <spolk@cygnus.com>
-
- * generic/tclClock.c: timezone needs to be declared somewhere
- * win/Makefile.in: Fixed OBJEXT problems
- * win/tclWinFile.c win/tclWinInit.c: Fixed merge problems
- * win/tclWinPipe.c: Removed Cygnus thread stuff to use the tcl 8.1
- thread stuff instead.
+ * library/tcltest/tcltest.tcl: Use [interpreter] to set/query the
+ executable currently running the tcltest package. [Bug 454050]
-1998-09-28 Syd Polk <spolk@cygnus.com>
+ * library/tcltest/tcltest.tcl: Allow non-proc commands to be used
+ as the customization hooks. [Bug 495662]
- * win/configure.in: Merged from 4.2 branch
- * win/configure: Regenerated
- * win/Makefile.in: Updated for tcl8.1.
+2002-03-24 Vince Darley <vincentdarley@users.sourceforge.net>
-Wed Aut 19 17:48:00 PDT 1998 Syd Polk <spolk@cygnus.com>
+ * generic/tclFilename.c:
+ * generic/tclFCmd.c:
+ * generic/tclTest.c:
+ * generic/tcl.h:
+ * generic/tclIOUtil.c:
+ * win/tclWinFile.c:
+ * win/tclWinFCmd.c:
+ * win/tclWinPipe.c:
+ * unix/tclUnixFile.c:
+ * unix/tclUnixFCmd.c:
+ * mac/tclMacFile.c:
+ * doc/FileSystem.3:
+ * 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
- * 8.1 integration continues.
-
-Thu Apr 30 18:10:15 1998 Geoffrey Noer <noer@cygnus.com>
-
- * win/Makefile.in: invoke gcc instead of ld when producing
- dlls. Pass the linker options down via args to -Wl options.
+ ***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.
-Mon Apr 20 11:40:23 MEST 1998 Khamis Abuelkomboz <khamis@cygnus.com>
- *tcl/win tclWinPipe.c
- (PipeWatchProc): Mask PipeThread using (LPTHREAD_START_ROUTINE) to
- remind bogus messages.
+2002-03-22 Miguel Sofer <msofer@users.sourceforge.net>
-Tue Apr 7 16:36:49 1998 Ian Lance Taylor <ian@cygnus.com>
-
- * win/tclWinFile.c: If __CYGWIN32__, call chdir rather than
- SetCurrentDirectory, so that the cygwin32 DLL knows the current
- directory when doing path munging.
-
-Sat Mar 21 21:18:06 1998 Elena Zannoni <ezannoni@kwikemart.cygnus.com>
+ * tests/basic.test (basic-46.1): adding test for [Bug 533758],
+ fixed earlier today.
- Merged changes from Foundry (list follows in reverse chronological
- order)
-
- - Tom Tromey <tromey@cygnus.com>
- * library/init.tcl (auto_execok): If ide_cygwin_path command is
- defined, the convert PATH environment variable to Win32 path list
- before use.
- * win/stub16.c: Include <string.h>.
- * win/tclWinInit.c (TclPlatformInit): Don't look in registry to
- find default tcl_library setting.
-
- - Ian Lance Taylor <ian@cygnus.com>
- * win/Makefile.in ($(TCLDLL)): Don't generate relocs for debugging
- information.
- ($(TCLPLUGINDLL), $(TCLREGDLL)): Likewise.
- * generic/tclIOUtil.c (Tcl_EvalFile): Put the newly allocated
- buffer into an object and use Tcl_EvalObj, rather than having
- Tcl_Eval copy the buffer.
- * generic/tclEnv.c (TclSetEnv): Don't set the env array if the
- value is the same as the one we are trying to set.
-
-Sat Feb 21 08:59:00 1998 Chris Provenzano <proven@cygnus.com>
-
- * Makefile.in, unix/Makefile.in
- Don't set shell to /bin/sh. Set it to @SHELL@
-
- * configure: Regenerated with support for @SHELL@ substitution
-
-Mon Feb 9 16:02:47 1998 Ian Lance Taylor <ian@cygnus.com>
-
- * win/configure.in: Call AC_PROG_RANLIB so that TCL_RANLIB gets
- set correctly in tclConfig.sh.
- * win/configure: Rebuild.
-
-Tue Jan 20 19:24:22 1998 Ian Lance Taylor <ian@cygnus.com>
-
- * win/tclWinChan.c (TclGetDefaultStdChannel): Check for error
- return from Tcl_MakeFileChannel.
-
-Tue Dec 23 16:25:02 1997 Ian Lance Taylor <ian@cygnus.com>
-
- * win/Makefile.in ($(TCLDLL)): Don't generate relocs for debugging
- information.
- ($(TCLPLUGINDLL), $(TCLREGDLL)): Likewise.
-
-Wed Nov 5 00:50:32 1997 Martin M. Hunt <hunt@cygnus.com>
-
- * library/word.tcl: Always use Motif-style selections.
-
-Tue Oct 28 17:44:15 1997 Martin M. Hunt <hunt@cygnus.com>
-
- * win/tclWinChan.c (Tcl_OpenFileChannel): Patch "winchan.txt"
- from net. Fixes problems with PC-NFS access.
-
- * win/tclWinSock.c (Tcl_GetHostName): Fix problem where
- [info hostname] crashes on NT 4.0 machines that do not have
- networking installed. Patch from Darrel Schneider
- <darrel@gemstone.com>
-
-Tue Oct 28 16:31:46 1997 Ian Lance Taylor <ian@cygnus.com>
-
- * Makefile.in (install-minimal): New target.
- * win/Makefile.in (install-minimal): New target.
-
-Wed Oct 15 18:58:32 1997 Ian Lance Taylor <ian@cygnus.com>
-
- * win/tclWinPort.h: If __CYGWIN32__, define TclpAlloc, TclpFree,
- and TclpRealloc rather than TclpSysAlloc, TclpSysFree, and
- TclpSysRealloc.
- * win/Makefile.in (TCLOBJS): Remove tclAlloc.o.
-
-Thu Sep 25 02:57:00 1997 Martin M. Hunt <hunt@cygnus.com>
+2002-03-22 Jeff Hobbs <jeffh@ActiveState.com>
- * generic/tclCmdAH.c (Tcl_FormatObjCmd): This fixes an
- off-by-one error in the format command that can lead to memory
- corruption on some systems, most notable little endian systems,
- such as Intel. Patch "format.txt" from patches archive.
+ * win/tclWinInt.h: moved undef of TCL_STORAGE_CLASS. [Bug #478579]
- * unix/tclUnixChan.c (TcpGetOptionProc): Applied patch
- "unixchan.txt" from patches archive.
+2002-03-22 Miguel Sofer <msofer@users.sourceforge.net>
-Tue Sep 23 14:31:01 1997 Tom Tromey <tromey@cygnus.com>
+ * 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.
- * generic/tclStringObj.c (Tcl_DbNewStringObj): Don't die if
- bytes==NULL. From schoenw@gaertner.de (Juergen Schoenwaelder).
+2002-03-21 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * generic/tclIO.c (Tcl_SetChannelOption): Allow output translation
- mode to be "auto". From Dave Dykstra <dwd@bell-labs.com>.
+ * doc/expr.n: Improved documentation for ceil and floor [Bug 530535]
-Thu Sep 4 11:29:14 1997 Martin M. Hunt <hunt@cygnus.com>
+2002-03-20 Don Porter <dgp@users.sourceforge.net>
- * generic/tclIO.c: Applied patch "io.txt" from the
- patches archive.
-
-Tue Sep 2 16:49:16 PDT 1997 Khamis Abuelkomboz <khamis@cygnus.com>
- * library/menu.tcl
- In this file I have found two bugs:
- One in focus policy (wrong function call)
- and the main error was by the tkMenuUnpost procedure (toplevel problem).
- Generaly this script doesn't work correctly at all and I don't
- know if we have the latest version of this file.
-
-Thu Aug 28 17:20:57 1997 Ian Lance Taylor <ian@cygnus.com>
-
- * win/Makefile.in (install-libraries): Install http2.0 and
- opt0.1.
-
- * generic/tclEnv.c (TclCygwin32Putenv): Call unsetenv rather than
- putenv to remove the variable.
-
- * generic/tclAlloc.c: Don't define caddr_t if __CYGWIN32__.
-
-Thu Aug 28 15:31:05 MET DST 1997 Zsolt Koppany <zkoppany@multix.de>
- * generic/tclCompile.c generic/tclEnv.c generic/tclTestObj.c
- unix/tclUnixFCmd.c
-
- * Memory bug fixes.
-Sun Aug 24 21:35:19 1997 Ian Lance Taylor <ian@cygnus.com>
-
- * win/Makefile.in ($(TCLDLL)): Set base address to 0x66000000.
- ($(TCLREGDLL)): Set base address to 0x66200000.
-
-Thu Aug 21 12:49:47 1997 Ian Lance Taylor <ian@cygnus.com>
-
- * win/tclWinPipe.c (Tcl_WaitPid): If __CYGWIN32__, handle a
- cygwin32 signal exit status correctly.
-
- * win/tclWinPipe.c (PipeThread): Only set PIPE_READAHEAD if we
- really did read a byte. Set PIPE_READABLE if ReadFile completes.
- (PipeProc): Don't bother to set PIPE_READABLE either.
- (PipeSetupProc): Handle a read from a pipe without a thread.
- (PipeCheckProc): Likewise.
+ * doc/SetVar.3:
+ * doc/TraceVar.3:
+ * 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):
+ * generic/tclCmdMZ.c (TraceVarProc):
+ * generic/tclEnv.c (EnvTraceProc):
+ * generic/tclEvent.c (VwaitVarProc):
+ * generic/tclInt.decls (TclLookupVar,TclPrecTraceProc):
+ * 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:
+ * generic/tclIntDecls.h: make genstubs
-Wed Aug 20 23:17:23 1997 Ian Lance Taylor <ian@cygnus.com>
+2002-03-15 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * win/tclWinPipe.c (PIPE_READABLE, PIPE_CLOSED): Define.
- (PIPE_HAS_THREAD, PIPE_READAHEAD): Define.
- (PipeInfo): Add fields: flagsMutex, mutex, tryReadEvent,
- readAhead.
- (pipeHwnd): New static variable.
- (PipeGetFlags, PipeSetFlag, PipeResetFlag): New static functions.
- Use them for all access to the flags field of a pipe.
- (PipeThread): New static function.
- (PipeProc): New static function.
- (PipeInit): Set up pipe window class and window.
- (PipeExitHandler): Unregister the class and destroy the window.
- (PipeSetupProc): Only set the block time to 0 for a readable pipe
- if we know that it is readable. If we want read events, tell the
- thread to try a read.
- (PipeCheckProc): Only post an event for a readable pipe if we know
- that it is readable.
- (TclpCreateCommandChannel): Create the flags mutex.
- (PipeCloseProc): If the pipe has a thread, tell the thread the
- pipe is closed, and let it free everything. Otherwise, close the
- flags mutex.
- (PipeInputProc): Lock the pipe during the function. Use the
- readahead byte if it is available. Reset PIPE_READABLE.
- (PipeEventProc): Check PIPE_READABLE if we have a thread.
- (PipeWatchProc): Create a thread if we want read events.
+ * tests/compile.test (compile-12.3): Test to detect bug 530320.
+ * generic/tclCompile.c (TclCompileTokens): Fixed buffer overrun
+ reported in bug 530320.
-Tue Aug 19 16:34:54 MET DST 1997 Zsolt Koppany <zkoppany@multix.de>
- * generic/tclEnv.c
- Removed patch from EnvExitProc()
+2002-03-14 Mo DeJong <mdejong@users.sourceforge.net>
-Mon Aug 18 20:15:23 1997 Ian Lance Taylor <ian@cygnus.com>
+ * win/configure: Regen.
+ * win/configure.in: Add configure time test for SEH
+ support in the compiler.
+ * win/tclWin32Dll.c (ESP, EBP, TclpCheckStackSpace,
+ _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]
- * win/tclWinPipe.c (TclpCreateProcess): Make sure the pipe stuff
- is initialized.
+2002-03-14 Mo DeJong <mdejong@users.sourceforge.net>
- * win/tclWin32Dll.c (TclSetSystemEnv): If we set Path, clear
- PATH. If we set PATH, clear Path.
+ * 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]
-Fri Aug 15 19:20:44 1997 Ian Lance Taylor <ian@cygnus.com>
+2002-03-11 Mo DeJong <mdejong@users.sourceforge.net>
- * win/tclWinInit.c (initScript): Look up one more level, to allow
- for exec-prefix being a subdirectory of prefix.
+ * 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.
-Wed Aug 13 13:22:15 1997 Ian Lance Taylor <ian@cygnus.com>
+2002-03-11 Don Porter <dgp@users.sourceforge.net>
- * generic/tclPipe.c (TclCreatePipeline): Check explicitly for
- redirecting stderr to stdout, and handle it by making the stderr
- file a copy of the stdout file.
+ * library/tcltest/tcltest.tcl:
+ * library/tcltest/pkgIndex.tcl: Bumped tcltest package to 2.0.2.
- * generic/tclEnv.c (TclSetEnv): Call TclSetSystemEnv before
- calling Tcl_SetVar2.
+2002-03-11 Mo DeJong <mdejong@users.sourceforge.net>
-Mon Aug 11 19:39:45 1997 Ian Lance Taylor <ian@cygnus.com>
+ * 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.
- * configure.in: Call AC_CANONICAL_HOST. Check host, not target,
- for cygwin32.
- * configure: Rebuild.
+2002-03-11 Mo DeJong <mdejong@users.sourceforge.net>
-Sat Aug 9 20:27:48 1997 Ian Lance Taylor <ian@cygnus.com>
+ * 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.
- * win/tclWinSock.c (SocketEventProc): Handle an FD_CONNECT event
- for a client channel. On FD_CLOSE for a client channel, set
- TCL_WRITABLE.
- (Tcl_MakeTcpClientChannel): Select for FD_CONNECT.
- (TcpWatchProc): Watch for FD_CLOSE on a client channel when
- looking for writable. Watch for FD_CONNECT on a client channel in
- all cases.
+2002-03-08 Mo DeJong <mdejong@users.sourceforge.net>
-Thu Aug 7 12:44:49 1997 Ian Lance Taylor <ian@cygnus.com>
+ * 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/tclWinSock.c: Add clientChannel field.
- (SocketEventProc): Handle FD_ACCEPT on a client channel by setting
- TCL_READABLE.
- (NewSocketInfo): Initialize clientChannel field to 0.
- (Tcl_MakeTcpClientChannel): Set clientChannel field to 1. Select
- for FD_ACCEPT.
+2002-03-08 Jeff Hobbs <jeffh@ActiveState.com>
- * win/tclWinInit.c (initScript): Use share rather than lib.
-
-Wed Aug 6 20:49:13 1997 Ian Lance Taylor <ian@cygnus.com>
+ * win/tclWinFCmd.c (DoCopyFile): correctly set retval to TCL_OK.
- * win/Makefile.in: Update for Tcl 8.0.
- * win/configure.in: Likewise.
- * win/configure: Rebuild.
- * win/tclWin32Dll.c (TclSetSystemEnv): Handle a NULL value.
- * win/tclWinChan.c (Tcl_OpenFileChannel): Move conv_to_win32_path
- call after Tcl_TranslateFileName call.
- * win/tclWinFile.c: Don't include <shlobj.h> if __CYGWIN32__.
- (TclWinStat): Don't adjust stat times if __CYGWIN32__.
+2002-03-07 Mo DeJong <mdejong@users.sourceforge.net>
-Tue Aug 5 13:25:43 1997 Tom Tromey <tromey@cygnus.com>
+ * 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/tclWinPipe.c: Preserved local changes.
- * win/tclWinSock.c: Preserved local changes.
- * win/tclWinChan.c: Preserved local changes.
+2002-03-07 Don Porter <dgp@users.sourceforge.net>
-Mon Aug 4 16:23:53 1997 Tom Tromey <tromey@cygnus.com>
+ * doc/interp.n:
+ * 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
+ implementation from Stephen Trier. [TIP 87, Patch 522849]
- * tests/fCmd.test: fCmd-8.1 test marked nonportable; removed local
- changes.
+2002-03-06 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * tests/defs: Preserved local changes.
+ * 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.
-Fri Aug 1 16:51:03 1997 Ian Lance Taylor <ian@cygnus.com>
+2002-03-06 Miguel Sofer <msofer@users.sourceforge.net>
- * win/tclWinChan.c (Tcl_OpenFileChannel): If __CYGWIN32__, convert
- the path name to a win32 path name.
+ * 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].
-Wed Jul 23 20:03:07 1997 Ian Lance Taylor <ian@cygnus.com>
+2002-03-06 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * win/tclWinSock.c (TclWinWatchSocket): Only set the maximum block
- time to zero if we have an event that matches something in the
- desired mask.
+ * 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
+ http://purl.org/tcl/tip/80 for details.
-Mon Jun 30 13:38:43 1997 Ian Lance Taylor <ian@cygnus.com>
+2002-03-05 Jeff Hobbs <jeffh@ActiveState.com>
- * win/tclWinPipe.c (TclpCreateProcess): Our DLL is named
- cygtclpip, not tclpip.
+ *** 8.4a4 TAGGED FOR RELEASE ***
- * generic/tclEnv.c: If __CYGWIN32__, define environ as a static
- variable.
- (EnvInit): If __CYGWIN32__, initialize environ from
- __imp___cygwin_environ.
- * win/tclWinPort.h (__imp___cygwin_environ): Don't declare.
- (environ): Don't define.
- (TclSetSystemEnv): If __CYGWIN32__, declare as function, don't
- define as macro.
- * win/tclWin32Dll.c (TclSetSystemEnv): New function.
+ * 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.
-Thu Jun 26 13:56:01 1997 Ian Lance Taylor <ian@cygnus.com>
+ * unix/README: added --enable-langinfo doc.
- * win/Makefile.in (WINDRES): New variable.
- (install-binaries): Don't install DLLs here...
- (install-libraries): ...install them here instead.
- ($(TCLDLL)): Depend upon and link with tclres.o.
- ($(TCLSH)): Depend upon and link with tclshres.o.
- ($(TCLTEST)): Likewise.
- (tclres.o, tclshres.o): New targets.
- * win/configure.in: Define and substitute WINDRES.
- * win/configure: Rebuild.
+ * unix/tcl.spec:
+ * tools/tcl.wse.in: fixed URL refs to use www.tcl.tk or SF.
-Mon Jun 23 10:15:10 1997 Ian Lance Taylor <ian@cygnus.com>
+2002-03-04 Jeff Hobbs <jeffh@ActiveState.com>
- * Makefile.in (install-binaries, install-libraries): New targets.
+ * README:
+ * mac/README:
+ * unix/Makefile.in:
+ * unix/README:
+ * win/README:
+ * win/README.binary: updated to use www.tcl.tk URL.
-Wed Jun 18 12:12:36 1997 Ian Lance Taylor <ian@cygnus.com>
+ * unix/Makefile.in: added older ChangeLogs to dist target.
- * win/Makefile.in: Copy install, install-binaries, and
- install-libraries rules, and associated variables from
- unix/Makefile.in, with appropriate adjustments.
+ * tests/io.test:
+ * 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)
+ (TclFinalizeEncodingSubsystem): corrected potential double-free
+ when encodings were finalized on exit. [Bug #219314, #524674]
-Thu Jun 12 19:12:20 1997 Ian Lance Taylor <ian@cygnus.com>
+2002-03-01 Jeff Hobbs <jeffh@ActiveState.com>
- * win/Makefile.in ($(TMPDIR)/tclcyg.def): Don't export
- impure_ptr.
+ * 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)
-Fri Jun 6 15:52:50 1997 Ian Lance Taylor <ian@cygnus.com>
+ * 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]
+ Also reduced the value of ENCODING_LINESIZE from 30 to 20 as this
+ seems to improve the performance of 'gets' according to tclbench.
- Add support for building with cygwin32:
- * win/Makefile.in: Rewrite completely based on makefile.vc.
- * win/configure.in: Rewrite completely.
- * win/configure: Rebuild.
- * win/tclWinPort.h (__imp___cygwin_environ): Declare if
- __CYGWIN32__.
- (environ): Define if __CYGWIN32__.
- * win/tclWin32Dll.c (_impure_ptr): Define if __CYGWIN32__.
- (__imp_reent_data): Declare if __CYGWIN32__.
- (DllMain): Initialize _impure_ptr if __CYGWIN32__.
- * win/tclWinFCmd.c (TclpRenameFile): Don't use try and except if
- __GNUC__.
- (TclpCopyFile): Likewise.
- * win/tclWinPipe.c: Don't include dos.h if __CYGWIN32__.
- * win/tclWinSock.c (InitSockets): Don't cast to PASCAL FAR if
- __GNUC__.
+2002-02-28 Jeff Hobbs <jeffh@ActiveState.com>
-Thu Jun 5 18:17:53 1997 Ian Lance Taylor <ian@cygnus.com>
+ * generic/tclCmdMZ.c (TraceCommandProc): ensure that TraceCommandInfo
+ structure was also deleted when a command was deleted to prevent a
+ mem leak.
- * generic/tcl.h (USE_TCLALLOC): Don't define USE_TCLALLOC if it is
- already defined (this modifies a CYGNUS LOCAL patch).
+ * generic/tclBasic.c (Tcl_CreateObjTrace): set tracePtr->flags
+ correctly.
-Fri May 9 09:36:00 1997 Tom Tromey <tromey@cygnus.com>
+ * generic/tclTimer.c (TimerExitProc): remove remaining events in
+ tls on thread exit.
- * patchlevel.h: Removed.
+2002-02-28 Miguel Sofer <msofer@users.sourceforge.net>
-Wed Apr 9 17:31:41 1997 Bob Manson <manson@charmed.cygnus.com>
+ * 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/regexp.c (regmatch): Speed up .* matching
- significantly. Treat a single bracketed character the same as a
- string.
+2002-02-28 Miguel Sofer <msofer@users.sourceforge.net>
-Thu Mar 20 14:27:45 1997 Geoffrey Noer <noer@cygnus.com>
+ * generic/tclExecute.c: Replaced a few direct stack accesses
+ with the POP_OBJECT() macro [Bug 507181] (Don Porter).
- * compat/strncasecmp.c: fix args in prototype for strcasecmp
+2002-02-27 Don Porter <dgp@users.sourceforge.net>
-Fri Mar 14 10:36:30 1997 Tom Tromey <tromey@cygnus.com>
+ * 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]
- * tests/fCmd.test: Commented out fcmd-8.1 test.
+ * generic/tclDecls.h: make genstubs
-Fri Mar 7 10:46:04 1997 Tom Tromey <tromey@cygnus.com>
+ * 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.
- * Updated to Tcl 7.6p2 and preserved Cygnus changes.
+2002-02-27 Jeff Hobbs <jeffh@ActiveState.com>
-Wed Mar 5 12:00:44 1997 Martin <hunt@cyber>
+ * generic/tclBasic.c (Tcl_EvalTokensStandard): corrected mem leak
+ in error case.
- * Makefile.in, configure.in: Added support for building
- the windows directory.
- * configure: Rebuilt.
+ * generic/tclTest.c (TestStatProc[123]): correct harmless UMRs.
-Fri Dec 13 15:47:07 1996 Tom Tromey <tromey@cygnus.com>
+ * generic/tclLink.c (Tcl_LinkVar): correct mem leak in error case.
- * compat/strtod.c: Include ../compat/stdlib.h, not
- compat/stdlib.h. From Donald Koch <koch@cognex.com>.
+2002-02-27 Andreas Kupries <andreas_kupries@users.sourceforge.net>
-Wed Nov 20 14:07:06 1996 Tom Tromey <tromey@cygnus.com>
+ * 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.
- * generic/tclAlloc.c: Removed; functionality has been integrated
- into Tcl core.
+ * 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.
-Tue Nov 19 09:30:41 1996 Tom Tromey <tromey@cygnus.com>
+2002-02-26 Jeff Hobbs <jeffh@ActiveState.com>
- * generic/tcl.h: Remove redundant decls of Tcl_Alloc and friends.
+ * generic/tclCmdAH.c (StoreStatData): corrected mem leak.
-Mon Nov 18 14:59:47 1996 Tom Tromey <tromey@cygnus.com>
+ * generic/tclCmdMZ.c (Tcl_RegsubObjCmd): prevent obj leak in
+ remedial regsub case.
- * generic/tclAlloc.c (Tcl_Alloc): Renamed.
- * generic/tcl.h: Always define USE_TCLALLOC.
+ * generic/tclFileName.c (Tcl_TranslateFileName): decr refcount for
+ error case to prevent mem leak.
- * Imported Tcl 7.6 and preserved local changes.
+ * generic/tclVar.c (Tcl_ArrayObjCmd): removed extra obj allocation.
-Mon Aug 5 10:41:11 1996 Tom Tromey <tromey@creche.cygnus.com>
+ * unix/tclUnixSock.c (Tcl_GetHostName): added an extra
+ gethostbyname check to guard against failure with truncated
+ names returned by uname.
- * Makefile.in (configure): Don't depend on configure.in.
- (config.status): Depend on configure.
+ * 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.
-Wed Jul 31 14:41:34 1996 Tom Tromey <tromey@creche.cygnus.com>
+ * unix/tclUnixChan.c: added Unix implementation of TIP #35, serial
+ port support. [Patch #438509] (schroedter)
- * tests/socket.test: Commented out test socket-8.1; it can fail on
- Solaris 2.4.
+2002-02-26 Miguel Sofer <msofer@users.sourceforge.net>
-Tue Jul 30 14:53:59 1996 Tom Tromey <tromey@creche.cygnus.com>
+ * 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.
- * tests/socket.test: Find remote.tcl in srcdir.
- * tests/io.test: Find io.test in srcdir.
- * tests/defs: Find "defs" in directory $srcdir.
+2002-02-25 Andreas Kupries <andreas_kupries@users.sourceforge.net>
-Wed Jun 26 12:36:57 1996 Jason Molenda (crash@godzilla.cygnus.co.jp)
+ * mac/tclMacSock.c (TcpGetOptionProc): Changed to recognize the
+ option "-error". Essentially ignores the option, always
+ returning an empty string.
- * configure.in (AC_PREREQ): autoconf 2.5 or higher.
- * configure: Rebuilt.
+2002-02-25 Jeff Hobbs <jeffh@ActiveState.com>
-Thu Jun 6 15:04:44 1996 Gordon Irlam <gordoni@snuffle.cygnus.com>
+ * doc/Alloc.3:
+ * doc/LinkVar.3:
+ * doc/ObjectType.3:
+ * doc/PkgRequire.3:
+ * 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)
- * doc/usenix.ps, doc/usenix.text: Removed because copyright status
- unclear.
+ * 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)
-Mon May 20 16:11:55 1996 Tom Tromey <tromey@creche.cygnus.com>
+2002-02-25 Miguel Sofer <msofer@users.sourceforge.net>
- * tcltk-man-html.tcl: Moved to devo/inet.
+ * 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]
-Mon May 6 15:21:14 1996 Tom Tromey <tromey@lisa.cygnus.com>
+2002-02-25 Don Porter <dgp@users.sourceforge.net>
- * tcltk-man-html.tcl: Search Tk section 3 man pages if possible.
+ * unix/tclUnixPort.h: corrected strtoll prototype mismatch on Tru64.
+ * compat/strtod.c (strtod): simplified #includes
+ * compat/strtol.c (strtol): gather result in a long before returning
+ as a long: necessary on platforms where sizeof(int) != sizeof(long).
-Wed May 1 15:17:14 1996 Tom Tromey <tromey@lisa.cygnus.com>
+2002-02-25 Daniel Steffen <das@users.sourceforge.net>
- * tcltk-man-html.tcl: New file.
+ * unix/tclLoadDyld.c: updated to use Mac OS X 10.1 dyld APIs that
+ have more libdl-like semantics. (bug #514392)
-Thu Mar 7 10:01:05 1996 Tom Tromey <tromey@creche.cygnus.com>
+2002-02-25 Miguel Sofer <msofer@users.sourceforge.net>
- * Makefile.in (config.status): Don't depend on configure.
+ * 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>
-Wed Mar 6 10:48:56 1996 Tom Tromey <tromey@creche.cygnus.com>
+ * compat/strtoul.c, compat/strtol.c, compat/strtod.c: Added UCHAR,
+ CONST and #includes to clean up GCC output.
- * Makefile.in (Makefile): Removed redundant rule.
+2002-02-23 Don Porter <dgp@users.sourceforge.net>
-Thu Feb 29 21:27:38 1996 Fred Fish <fnf@ninemoons.com>
+ * compat/strtoull.c (strtoull):
+ * compat/strtoll.c (strtoll):
+ * compat/strtoul.c (strtoul): Fixed failure to handle leading
+ sign symbols '+' and '-' and '0X' and raise overflow errors.
+ [Bug 440916] Also corrects prototype and errno problems.
- * Makefile.in (configure): Run autoconf in source dir,
- not build dir.
+2002-02-23 Mo DeJong <mdejong@users.sourceforge.net>
-Thu Feb 29 09:08:52 1996 Tom Tromey <tromey@creche.cygnus.com>
+ * configure: Regen.
+ * unix/tcl.m4 (SC_CONFIG_CFLAGS): Link with -n32
+ instead of -32 when building on IRIX64-6.* system.
+ [Tcl bug 521707]
- * Makefile.in (Makefile): New rule.
- (config.status): New rule.
+2002-02-22 Don Porter <dgp@users.sourceforge.net>
- * tests/all: Use $srcdir to find tests.
- Source `defs' here.
- Only print filename, not entire path.
+ * generic/tclInt.h:
+ * generic/tclObj.c: renamed global variable emptyString ->
+ tclEmptyString because it is no longer static.
+ * generic/tclPkg.c: Fix for panic when library is loaded on a
+ platform without backlinking without proper use of stubs. [Bug 476537]
-Tue Feb 27 20:40:56 1996 Rob Savoye <rob@chinadoll.cygnus.com>
+2002-02-22 Jeff Hobbs <jeffh@ActiveState.com>
- * unix/configure.in: Use -fpic for dltests, as gcc now support
- shared libraries on HPUX.
- * configure: Rebuild.
+ * tests/regexpComp.test: updated regexp-11.[1-4] to match changes
+ in regexp.test for new regsub syntax
-Mon Feb 12 14:55:34 1996 Rob Savoye <rob@chinadoll.cygnus.com>
+ * unix/configure:
+ * unix/tcl.m4: added --enable-64bit support for AIX-4 (using -q64
+ flag) when using IBM's xlc compiler.
+
+ * 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].
+
+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).
+
+2002-02-22 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ --- TIP#76 CHANGES ---
+ * generic/tclCmdMZ.c (Tcl_RegsubObjCmd): Final-argument-less
+ [regsub] returns the modified string.
+ * doc/regsub.n: Updated docs.
+ * tests/regexp.test: Updated and added tests.
+
+ * 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.
+
+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.
+
+ 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.
+
+ Stuff left to do:
+ 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.
+
+2002-02-21 David Gravereaux <davygrvy@pobox.com>
- * unix/configure.in: Set the shared lib flags so the dynamic
- loading tests work for SunOS and Solaris when using GCC.
+ * 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.
-Wed Jan 24 09:41:00 1996 Tom Tromey <tromey@creche.cygnus.com>
+ * 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).
- * Makefile.in: Replaced realclean with maintainer-clean.
+2002-02-21 Donal K. Fellows <fellowsd@cs.man.ac.uk>
-Mon Jan 22 14:42:47 1996 Tom Tromey <tromey@creche.cygnus.com>
+ * generic/tcl.h: Better guessing of LP64/ILP32 architecture, but
+ now sensitive to presence of (suitable) <limits.h>
- * tests/all: Print message when tests finished.
+2002-02-20 Don Porter <dgp@users.sourceforge.net>
- * Makefile.in (check): Use absolute directory when finding
- TCL_LIBRARY.
+ * generic/tcl.decls (Tcl_RegExpRange,Tcl_GetIndexFromObjStruct):
+ Overlooked a few source incompatibilities. Now using CONST84.
+ * generic/tclDecls.h: make genstubs
+ * generic/tcl.h (Tcl_CmdObjTraceProc): silence warning from Sun
+ Workshop compiler.
-Fri Jan 19 10:35:16 1996 Tom Tromey <tromey@creche.cygnus.com>
+2002-02-20 David Gravereaux <davygrvy@pobox.com>
- * Makefile.in (check installcheck): Moved from unix/Makefile.in.
+ * 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.
-Thu Jan 11 14:41:35 1996 Tom Tromey <tromey@creche.cygnus.com>
+ Added IA64 B-stepping errata switch when the compiler supports it.
- * Makefile.in (test): New target.
+ Added profiling to $(lflags) when requested and also removed the
+ explict -entry option as the default works fine as is.
-Wed Jan 10 11:21:38 1996 Tom Tromey <tromey@creche.cygnus.com>
+ 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.
- * Makefile.in (mostlyclean-recursive clean-recursive
- distclean-recursive realclean-recursive): Separated out recursive
- rules.
+2002-02-20 Donal K. Fellows <fellowsd@cs.man.ac.uk>
-Tue Jan 9 17:34:56 1996 Tom Tromey <tromey@creche.cygnus.com>
+ * 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.
- * Makefile.in: New file.
- * configure.in: New file.
+2002-02-19 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * Updated to the tcl7.5a2 release, plus preserved our patches.
- Entries past this point mostly likely refer to files in various
- subdirectories.
+ * doc/format.n: Updated docs to list the specification.
+ * generic/tclCmdAH.c (Tcl_FormatObjCmd): Made behaviour on 64-bit
+ platforms correctly meet the specification, that %d works with the
+ native word-sized integer, instead of trying to guess (wrongly)
+ from the value being passed.
-Fri Dec 1 10:18:01 1995 Rob Savoye <rob@chinadoll.cygnus.com>
+2002-02-19 Don Porter <dgp@users.sourceforge.net>
- * Makefile.in, changes, configure, patchlevel.h, tcl.h,
- tclBasic.c, tclCkalloc.c, tclCmdAH.c, tclCmdMZ.c, tclInt.h,
- tclMain.c, tclPort.h, tclRegexp.h, tclUnixAZ.c, tclUnixStr.c,
- tclUnixUtil.c, tclVar.c, README, compat/fixstrtod.c,
- tests/lsort.test, testsuite/config/default.exp,
- testsuite/tcl.tests/tcl-test.exp: Upgrade to Tcl7.4p3 to fix a few
- bugs.
+ * changes: First draft of updated changes for 8.4a4 release.
-Thu Nov 16 10:01:20 1995 Rob Savoye <rob@chinadoll.cygnus.com>
+2002-02-15 Jeff Hobbs <jeffh@ActiveState.com>
- * configure.in: Use AC_PROG_CC again since Cygnus configure now
- does the sames thing.
+ * unix/tclUnixPort.h: add strtoll/strtoull declarations for
+ platforms that do not define them.
-Sat Oct 7 20:51:29 1995 Michael Meissner <meissner@cygnus.com>
+ * generic/tclIndexObj.c (STRING_AT): removed ptrdiff_t cast and
+ use of VOID* in default case (GNU-ism).
- * tcl.h (ckrealloc): Cast pointer argument to char * to silence
- warnings.
+2002-02-15 Kevin Kenny <kennykb@acm.org>
-Sun Aug 20 00:43:51 1995 Jason Molenda (crash@phydeaux.cygnus.com)
+ * compat/strtoll.c:
+ * compat/strtoul.c:
+ * compat/strtoull.c:
+ * generic/tclIOUtil.c:
+ * generic/tclPosixStr.c:
+ * generic/tclTest.c:
+ * generic/tclTestObj.c:
+ * 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
+
+2002-02-15 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ +----------------------+
+ | TIP #72 IMPLEMENTED. |
+ +----------------------+
+
+ 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:
+
+ * generic/tcl.h: New types.
+ * generic/tcl.decls: New public functions.
+ * generic/tclExecute.c: 64-bit aware bytecode engine.
+ * generic/tclBinary.c: 64-bit handling in [binary] command.
+ * generic/tclScan.c: 64-bit handling in [scan] command.
+ * generic/tclCmdAH.c: 64-bit handling in [file] and [format]
+ commands.
+ * generic/tclBasic.c: New "wordSize" entry in ::tcl_platform.
+ * generic/tclFCmd.c: Large-file support (with many consequences.)
+ * generic/tclIO.c: Large-file support (with many consequences.)
+ * compat/strtoll.c, compat/strtoull.c: New support functions.
+ * 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.
+
+ 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.
+
+ ***POTENTIAL INCOMPATIBILITY***: Extracted from the TIP
+
+ 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).
+
+ 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.
+
+ 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.
+
+ 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.)
+
+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.
+
+2002-02-12 David Gravereaux <davygrvy@pobox.com>
+
+ * djgpp/ (new directory)
+ * djgpp/Makefile (new):
+ * unix/tclAppInit.c:
+ * unix/tclMtherr.c:
+ * 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.
- * configure.in: If the system has a functional strtod(), *don't*
- provide one.
+2002-02-10 Kevin Kenny <kennykb@acm.org>
-Thu Aug 17 16:04:39 1995 Rob Savoye <rob@darkstar.cygnus.com>
+ * doc/CrtObjCmd.3:
+ * doc/CrtTrace.3:
+ * generic/tcl.decls:
+ * generic/tcl.h:
+ * generic/tclBasic.c:
+ * generic/tclInt.h:
+ * generic/tclTest.c:
+ * tests/basic.test: Added Tcl_CreateObjTrace,
+ Tcl_GetCommandInfoFromToken and Tcl_SetCommandInfoFromToken.
+ (TIPs #32 and #79.)
- * tcl: Updated to the official tcl7.4 release, plus preserved
- our patches.
+ * generic/tclDecls.h:
+ * generic/tclStubInit.c: Regenerated Stubs tables.
+
+2002-02-08 Jeff Hobbs <jeffh@ActiveState.com>
-Sun Aug 6 11:45:19 1995 Fred Fish <fnf@cygnus.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.
- * Makefile.in (distclean): Remove config.cache & config.log
+ * unix/tclUnixPort.h:
+ * unix/tclUnixThrd.c: added thread-safe versions of readdir,
+ localtime, gmtime and inet_ntoa for threaded build. (jgdavidson)
-Mon Jun 12 15:46:48 1995 J.T. Conklin <jtc@rtl.cygnus.com>
+ * generic/tclScan.c (Tcl_ScanObjCmd): prevented ckfree being
+ called on a pointer to NULL.
- * tclAlloc.c: New file.
- * tcl.h (Tcl_Malloc, Tcl_Realloc, Tcl_Free): New functions.
- (ckalloc, ckrealloc, ckfree): Defined to Tcl_Malloc, Tcl_Free
- respectively when compiling without TCL_MEM_DEBUG.
- * Makefile.in (GENERIC_OBJS): Added tclAlloc.o
- (SRCS): Added tclAlloc.c.
+2002-02-07 Don Porter <dgp@users.sourceforge.net>
-Thu Apr 6 19:32:43 1995 Doug Evans <dje@chestnut.cygnus.com>
+ * doc/DString.3:
+ * doc/Encoding.3:
+ * doc/GetCwd.3:
+ * doc/SplitPath.3:
+ * doc/Translate.3:
+ * doc/Utf.3:
+ * generic/tcl.decls:
+ * generic/tcl.h:
+ * generic/tclEncoding.c:
+ * generic/tclEnv.c:
+ * generic/tclFileName.c:
+ * generic/tclIOUtil.c:
+ * generic/tclUtf.c:
+ * generic/tclUtil.c:
+ * mac/tclMacInit.c:
+ * unix/tclUnixFile.c:
+ * unix/tclUnixInit.c:
+ * unix/tclUnixPipe.c:
+ * win/tclWin32Dll.c:
+ * win/tclWinFCmd.c:
+ * win/tclWinFile.c:
+ * 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.
- * tclPort.h (gettimeofday): Comment out prototype.
+ * generic/tclDecls.h:
+ * generic/tclPlatDecls.h: make genstubs
-Thu Mar 23 17:58:38 1995 Rob Savoye <rob@thepub.cygnus.com>
+ * generic/tclCmdMZ.c: corrected use of C++-style comment.
- * tcl: Upgrade to 7.4.b2. Update configure.in to autoconf 2.2,
- merge in our LynxOS patches.
+2002-02-06 Jeff Hobbs <jeffh@ActiveState.com>
-Wed Dec 21 15:12:14 1994 J.T. Conklin (jtc@phishhead.cygnus.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]
- * tclUnixUtil.c: Use __Lynx__ in the conditional which selects
- LynxOS-specific waitpid() prototype.
+ * generic/tclCompCmds.c (TclCompileRegexpCmd): made early check
+ for bad RE to stop checking further.
-Mon Dec 19 04:38:49 1994 Angela Marie Thomas <angela@cygnus.com>
+ * 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.
- * Makefile.in (all): use ${AR_FLAGS}, not ${ARFLAGS} because the
- "make" default for ${ARFLAGS} includes an option, f, which I can't
- find in any man page and breaks builds.
+ * tests/regexp.test:
+ * tests/regexpComp.test: extra code coverage tests.
-Tue Jun 7 07:44:31 1994 D. V. Henkel-Wallace (gumby@cygnus.com)
+ * tests/string.test: added 10.18 and 10.19 extra tests.
- * compat/tmpnam.c: handle losing LynxOS mktemp.
+ * generic/regc_locale.c (casecmp): slight performance improvement.
-Thu May 26 20:15:55 1994 David J. Mackenzie (djm@poseidon.cygnus.com)
+2002-02-05 Don Porter <dgp@users.sourceforge.net>
- * aclocal.m4 (TCL_LYNX_POSIX): Renamed from AC_LYNX_POSIX.
- Check __GNUC__ value to get POSIX flag right.
- * configure.in: Use new name.
- * configure: Regenerate.
+ * library/http/http.tcl:
+ * library/http/pkgIndex.tcl: Corrected use of http::error when
+ ::error was intended. Bump to http 2.4.2.
-Wed May 4 20:17:46 1994 D. V. Henkel-Wallace (gumby@cygnus.com)
+2002-02-04 Andreas Kupries <andreas_kupries@users.sourceforge.net>
- * compat/tmpnam.c: if you're going to redefine P_tmpdir,
- undefine it first.
+ * 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.
- * compat/strerror.c: undefine various error codes which are
- defined in terms of others, where that causes duplicated case
- labels on r/s6000 lynxos 2.2.2.
+ * 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'.
-Sat Apr 23 17:10:13 1994 Bill Cox (bill@rtl.cygnus.com)
+2002-02-01 Jeff Hobbs <jeffh@ActiveState.com>
- * compat/getcwd.c: The contents of this file was the UCB
- float.h file. Restored the correct contents from devo.
+ * generic/tclCmdMZ.c (Tcl_RegexpObjCmd): handle quirky about case
+ earlier to avoid shimmering problem.
-Fri Apr 22 11:28:35 1994 Bill Cox (bill@cygnus.com)
+2002-02-01 Andreas Kupries <andreas_kupries@users.sourceforge.net>
- * tclUnixUtil.c: Make a new prototype for waitpid if
- we're compiling under the Lynx version of gcc.
+ * tests/io.test: io-39.22 split into two tests, one platform
+ dependent, the other not. -eofchar is not empty on the windows
+ platform.
-Thu Mar 31 19:36:44 1994 Ken Raeburn (raeburn@cujo.cygnus.com)
+2002-02-01 Vince Darley <vincentdarley@users.sourceforge.net>
- * install.sh: Since "set -e" is in effect, don't use a test that
- can fail in a while condition; it confuses some shells. Use break
- instead. Use "case" rather than "if [" for efficiency with some
- shells.
+ * generic/tclTest.c: fix to picky windows compiler problem
+ with the 'MainLoop' function declaration.
-Tue Jan 4 17:03:31 1994 Rob Savoye (rob@rtl.cygnus.com)
+2002-01-31 Andreas Kupries <andreas_kupries@users.sourceforge.net>
- * All files: Upgraded to Tcl7.3. This version has incompatablities
- with the old versions before 7.0.
+ * win/tclWinFCmd.c: TIP 27: Applied patch fixing CONST warnings on
+ behalf of Don Porter <dgp@users.sourceforge.net>.
-Tue Nov 23 13:01:22 1993 Rob Savoye (rob@darkstar.cygnus.com)
+2002-01-30 Don Porter <dgp@users.sourceforge.net>
- * configure.in: Use AC_HEADER_CHECK for unistd.h.
+ * 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.
+ * 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].
+ * unix/mkLinks: make mklinks
+
+2002-01-29 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * tests/regexpComp.test:
+ * generic/tclCompCmds.c (TclCompileRegexpCmd): enhanced to support
+ -nocase and -- options.
+
+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.
+
+2002-01-28 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * win/tclWinReg.c (regConnectRegistryProc,RecursiveDeleteKey)
+ (DeleteKey,GetKeyNames,GetType,GetValue,OpenSubKey,SetValue):
+ redid the CONSTification as previous changes caused failing tests.
+
+ * tests/regexpComp.test (new):
+ * generic/tclInt.h:
+ * generic/tclBasic.c: added TclCompileRegexpCmd entry
+ * generic/tclCompCmds.c (TclCompileStringCmd): corrected to return
+ 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.
+ (TclCompileAppendCmd): made TclPushVarName call always use
+ TCL_CREATE_VAR as numWords is always > 2 at that point.
-Tue Nov 9 19:07:39 1993 Rob Savoye (rob@cygnus.com)
+ * generic/tclExecute.c (TclExecuteByteCode:INST_LIST): correct
+ possibly dangerous decr in macro call.
- * tclUnixStr.c (Tcl_ErrnoId): Added cpp tests for duplicate
- defines that choked LynxOS.
+ * win/tclWinInit.c (TclpFindVariable): CONSTification touch-up
-Fri Oct 1 17:30:06 1993 Doug Evans (dje@canuck.cygnus.com)
+ * win/tclWinReg.c (OpenSubKey): corrected bug introduced in
+ CONSTification that dropped pointer reference.
- * Makefile.in (tclTest.o): Sun VPATH lossage.
+ * ChangeLog.2000 (new file):
+ * ChangeLog: broke changes from 2000 into ChangeLog.2000 to reduce
+ size of the main ChangeLog.
-Tue Aug 17 11:23:27 1993 david d `zoo' zuhn (zoo@rtl.cygnus.com)
+2002-01-28 David Gravereaux <davygrvy@pobox.com>
- * Makefile.in (install): don't install *.tcl all at once
+ * generic/tclPlatDecls.h: Added preprocessor logic to force a
+ typedef of TCHAR when __STDC__ is defined when using the uncommon
+ -Za compiler switch with the microsoft compiler.
-Thu Jul 8 09:24:47 1993 Doug Evans (dje@canuck.cygnus.com)
+2002-01-27 Don Porter <dgp@users.sourceforge.net>
- * Makefile.in: Add stuff needed to make Sun VPATH work.
+ * doc/package.n: Documented global namespace context for script
+ evaluation by [package require].
-Thu May 6 12:04:52 1993 Rob Savoye (rob at darkstar.cygnus.com)
+2002-01-27 Daniel Steffen <das@users.sourceforge.net>
- * Makefile.in: Install the manpages too.
+ * generic/tclInt.decls:
+ * generic/tclIntPlatDecls.h:
+ * mac/tclMacChan.c:
+ * mac/tclMacFCmd.c:
+ * mac/tclMacFile.c:
+ * mac/tclMacInit.c:
+ * mac/tclMacLoad.c:
+ * mac/tclMacResource.c:
+ * mac/tclMacSock.c: TIP 27 CONSTification induced changes
-Tue May 4 22:01:24 1993 Rob Savoye (rob at darkstar.cygnus.com)
+ * tests/event.test:
+ * tests/main.test: added catches/constraints to test that
+ use features that don't exist on the mac.
+
+2002-01-25 Mo DeJong <mdejong@users.sourceforge.net>
+
+ 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.
+
+2002-01-25 Don Porter <dgp@users.sourceforge.net>
+
+ * compat/strstr.c (strstr):
+ * generic/tclCmdAH.c (Tcl_FormatObjCmd):
+ * generic/tclCmdIL.c (InfoNameOfExecutableCmd):
+ * generic/tclEnv.c (ReplaceString):
+ * generic/tclFileName.c (ExtractWinRoot):
+ * generic/tclIO.c (FlushChannel,Tcl_BadChannelOption):
+ * generic/tclStringObj.c (AppendUnicodeToUtfRep):
+ * generic/tclThreadTest.c (TclCreateThread):
+ * generic/tclUtf.c (Tcl_UtfPrev):
+ * mac/tclMacFCmd.c (TclpObjListVolumes):
+ * mac/tclMacResource.c (TclMacRegisterResourceFork,
+ 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):
+ * generic/tclNamesp.c (Tcl_Export, Tcl_Import, Tcl_ForgetImport,
+ 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.
+ * generic/tclIntDecls.h: make genstubs
+
+ * Following is [Patch 505630]
+ * doc/AddErrorInfo.3:
+ * generic/tcl.decls (Tcl_LogCommandInfo):
+ * generic/tclBasic.c (Tcl_LogCommandInfo): Updated interfaces
+ of generic/tclBasic.cc according to TIP 27.
+ * generic/tclDecls.h: make genstubs
+
+ * Following is [Patch 506818]
+ * doc/Hash.3:
+ * generic/tcl.decls (Tcl_HashStats):
+ * generic/tclHash.c (Tcl_HashStats): Updated APIs of generic/tclHash.c
+ according to guidelines of TIP 27.
+ * generic/tclDecls.h: make genstubs
+ * generic/tclVar.c (Tcl_ArrayObjCmd): Updated callers.
+
+ * Following is [Patch 506807]
+ * doc/ObjectType.3:
+ * generic/tcl.decls (Tcl_GetObjType):
+ * generic/tclObj.c (Tcl_GetObjType): Updated APIs of generic/tclObj.c
+ according to guidelines of TIP 27.
+ * generic/tclDecls.h: make genstubs
+
+ * Following is [Patch 507304]
+ * doc/Encoding.3:
+ * generic/tcl.decls (Tcl_WinUtfToTChar,Tcl_WinTCharToUtf):
+ * win/tclWin32Dll.c (Tcl_WinUtfToTChar,Tcl_WinTCharToUtf):
+ Updated interfaces in win/tclWin32Dll.c according to TIP 27.
+ * generic/tclPlatDecls.h: make genstubs
+ * generic/tclIOUtil.c (TclpNativeToNormalized):
+ * win/tclWinFCmd.c (TclpObjNormalizePath):
+ * win/tclWinFile.c (TclpFindExecutable,TclpMatchInDirectory,
+ NativeIsExec,NativeStat):
+ * win/tclWinLoad.c (TclpLoadFile):
+ * win/tclWinPipe.c (TclpOpenFile,ApplicationType):
+ * win/tclWinReg.c (regConnectRegistryProc,RecursiveDeleteKey,DeleteKey,
+ GetKeyNames,GetType,GetValue,OpenSubKey,SetValue):
+ * win/tclWinSerial.c (SerialSetOptionProc): Update callers.
+
+ * Following is [Patch 505072]
+ * doc/Concat.3:
+ * doc/Encoding.3:
+ * doc/Filesystem.3:
+ * doc/Macintosh.3:
+ * doc/OpenFileChnl.3
+ * doc/SetResult.3:
+ * doc/SetVar.3:
+ * doc/SplitList.3:
+ * doc/SplitPath.3:
+ * doc/Translate.3:
+ * 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):
+ * generic/tclInt.decls (TclCreatePipeline,TclGetEnv,TclpGetCwd,
+ TclpCreateProcess):
+ * mac/tclMacFile.c (TclpGetCwd):
+ * generic/tclEncoding.c (Tcl_GetDefaultEncodingDir,
+ Tcl_SetDefaultEncodingDir,Tcl_GetEncodingName,
+ Tcl_ExternalToUtfDString,Tcl_UtfToExternalDString, OpenEncodingFile,
+ LoadEscapeEncoding):
+ * generic/tclFileName.c (DoTildeSubst,Tcl_JoinPath,Tcl_SplitPath,
+ Tcl_TranslateFileName):
+ * generic/tclIOUtil.c (Tcl_FSMatchInDirectory):
+ * generic/tclPipe.c (FileForRedirect,TclCreatePipeline,
+ 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):
+ * mac/tclMacResource.c (Tcl_MacEvalResource,Tcl_MacFindResource):
+ 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***
+ 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/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):
+ * generic/tclCompCmds.c (TclCompileForeachCmd):
+ * generic/tclCompCmds.h (TclCompileForeachCmd):
+ * generic/tclCompile.c (TclFindCompiledLocal):
+ * generic/tclEnv.c (TclSetupEnv,TclSetEnv,Tcl_PutEnv,TclGetEnv,
+ EnvTraceProc):
+ * generic/tclEvent.c (Tcl_BackgroundError):
+ * generic/tclIO.c (Tcl_BadChannelOption,Tcl_SetChannelOption):
+ * generic/tclIOCmd.c (Tcl_ExecObjCmd,Tcl_OpenObjCmd):
+ * generic/tclIOSock.c (TclSockGetPort):
+ * generic/tclIOUtil.c (SetFsPathFromAny):
+ * generic/tclLink.c (LinkTraceProc):
+ * generic/tclMain.c (Tcl_Main):
+ * generic/tclNamesp.c (TclTeardownNamespace):
+ * generic/tclProc.c (TclCreateProc):
+ * generic/tclTest.c (TestregexpObjCmd,TesttranslatefilenameCmd,
+ TestchmodCmd,GetTimesCmd,TestsetCmd,TestOpenFileChannelProc1,
+ TestOpenFileChannelProc2,TestOpenFileChannelProc3,AsyncHandlerProc,
+ TestpanicCmd):
+ * generic/tclThreadTest.c (ThreadErrorProc,ThreadEventProc):
+ * generic/tclUtil.c (TclPrecTraceProc):
+ * mac/tclMacFCmd.c (GetFileSpecs):
+ * mac/tclMacFile.c (TclpMatchInDirectory):
+ * mac/tclMacInit.c (TclpInitLibraryPath,Tcl_SourceRCFile):
+ * mac/tclMacOSA.c (tclOSAStore,tclOSALoad):
+ * mac/tclMacResource.c (Tcl_MacEvalResource):
+ * unix/tclUnixFCmd.c (TclpObjNormalizePath):
+ * unix/tclUnixFile.c (TclpMatchInDirectory,TclpGetUserHome,TclpGetCwd,
+ TclpReadLink):
+ * unix/tclUnixInit.c (TclpInitLibraryPath,TclpSetVariables,
+ Tcl_SourceRCFile):
+ * unix/tclUnixPipe.c (TclpOpenFile,TclpCreateTempFile,
+ TclpCreateProcess):
+ * win/tclWinFile.c (TclpGetCwd,TclpMatchInDirectory):
+ * win/tclWinInit.c (TclpInitLibraryPath,Tcl_SourceRCFile,
+ 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]
+
+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]
+
+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>.
+
+2002-01-23 Don Porter <dgp@users.sourceforge.net>
+
+ * win/tclWinFile.c (NativeAccess,NativeStat,NativeIsExec,
+ 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.
+ * generic/tclPlatDecls.h: make genstubs
+
+ * doc/GetHostName.3:
+ * doc/GetOpnFl.3:
+ * doc/OpenTcp.3:
+ * tcl.decls (Tcl_GetHostName,Tcl_GetOpenFile,Tcl_OpenTcpClient,
+ Tcl_OpenTclServer):
+ * mac/tclMacSock.c (CreateSocket,Tcl_OpenTcpClient,Tcl_OpenTcpServer,
+ Tcl_GetHostName,GetHostFromString):
+ * unix/tclUnixChan.c (CreateSocket,CreateSocketAddress,
+ Tcl_OpenTcpClient,Tcl_OpenTcpServer,Tcl_GetOpenFile):
+ * unix/tclUnixSock.c (Tcl_GetHostName):
+ * win/tclWinSock.c (CreateSocket,CreateSocketAddress,
+ 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]
+
+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.
+
+2002-01-21 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclTest.c: Converted declarations of TestReport file system
+ to more portable form. [Bug 501417].
+
+ * generic/tcl.decls (Tcl_TraceCommand,Tcl_UntraceCommand,
+ Tcl_CommandTraceInfo):
+ * generic/tclCmdMZ.c (Tcl_TraceCommand,Tcl_UntraceCommand,
+ 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>
- * tclUnix.h: Don't set TCL_PID_T anymore. FInd the right dirent.h.
- * configure.in: Handle no pid_t in sys/types.h. Also also check
- for dirent.h.
- * Makefile.in: Let INSTALL_PROGRAM and INSTALL_DATA come from
- configure.
+ * win/tclWinChan.c:
+ * win/tclWinFCmd.c:
+ * win/tclWinFile.c: Overlooked callers of Tcl_FSGetNativePath
-Fri Apr 16 07:25:07 1993 Fred Fish (fnf@lisa.cygnus.com)
+ * win/tclWinDde.c:
+ * win/tclWinReg.c: Overlooked callers of Tcl_GetIndexFromObj
- * configure (DEFS): When defining "-Dconst=" define "-DCONST="
- as well, for the sake of things in compat/* that use it.
+2002-01-18 Daniel Steffen <das@users.sourceforge.net>
- * Makefile.in (opendir.c): Add missing ../compat/..
+ * generic/tclThreadTest.c:
+ * mac/tclMacChan.c:
+ * mac/tclMacFCmd.c:
+ * mac/tclMacFile.c:
+ * mac/tclMacLoad.c:
+ * 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.
+
+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]
+
+2002-01-16 Don Porter <dgp@users.sourceforge.net>
+
+ * doc/FileSystem.3:
+ * doc/GetCwd.3:
+ * doc/GetIndex.3:
+ * generic/tcl.decls (Tcl_GetIndexFromObj, Tcl_GetIndexFromObjStruct,
+ 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):
+ 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.
+ * generic/tclDecls.h: make genstubs
+
+ * generic/tclBinary.c (Tcl_BinaryObjCmd):
+ * generic/tclClock.c (Tcl_ClockObjCmd):
+ * 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):
+ * 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):
+ * 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):
+ * generic/tclTestObj.c (TestindexObjCmd,TeststringObjCmd):
+ * generic/tclTimer.c (Tcl_AfterObjCmd):
+ * generic/tclVar.c (Tcl_ArrayObjCmd):
+ * mac/tclMacFCmd.c (SetFileFinderAttributes):
+ * unix/tclUnixChan.c (TclpOpenFileChannel):
+ * unix/tclUnixFCmd.c (tclpFileAttrStrings):
+ * unix/tclUnixFile.c (TclpObjAccess,TclpObjChdir,TclpObjStat,
+ TclpObjLstat):
+ * win/tclWinFCmd.c (tclpFileAttrStrings): Updated callers.
-Mon Apr 5 10:56:28 1993 Rob Savoye (rob@cygnus.com)
+ * doc/RegExp.3:
+ * doc/Utf.3:
+ * generic/tcl.decls:
+ * generic/tclInt.decls:
+ * generic/tclRegexp.c:
+ * generic/tclUtf.c: Updated APIs in generic/tclUtf.c and
+ generic/tclRegexp.c according to the guidelines of TIP 27.
+ [Patch 471509]
- * testsuite/config/unix-tcl.exp: Use tcl/tclTest for test code
- driver.
- * Makefile.in, testsuite/*.in, testsuite/tcl.tests/*.in: Don't use
- Cygnus configure anymore.
+ * generic/regc_locale.c (element,cclass):
+ * generic/tclCmdMZ.c (Tcl_StringObjCmd):
+ * generic/tclFileName.c (TclpGetNativePathType,SplitMacPath):
+ * generic/tclIO.c (ReadChars):
+ * mac/tclMacLoad.c (TclpLoadFile):
+ * win/tclWinFile.c (TclpGetUserHome): Updated callers.
-Wed Mar 24 02:09:33 1993 david d `zoo' zuhn (zoo at poseidon.cygnus.com)
+ * 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/tclDecls.h: make genstubs
+
+ * generic/tcl.decls (Tcl_RecordAndEval):
+ * generic/tclDecls.h: make genstubs
+ * generic/tclHistory.c (Tcl_RecordAndEval): Updated APIs in
+ generic/tclHistory.c according to the guidelines of TIP 27.
+ [Patch 504091]
+
+ * doc/CrtSlave.3:
+ * generic/tcl.decls (Tcl_CreateAlias, Tcl_CreateAliasObj,
+ Tcl_CreateSlave, Tcl_GetAlias, Tcl_GetAliasObj, Tcl_GetSlave):
+ * generic/tclInterp.c (Tcl_CreateAlias, Tcl_CreateAliasObj,
+ 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.
+
+ * 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]
+
+ * doc/AddErrInfo.3 (Tcl_PosixError):
+ * doc/Eval.3 (Tcl_EvalFile):
+ * doc/FileSystem.c (Tcl_FSOpenFileChannel,Tcl_FSOpenFileChannelProc):
+ * doc/OpenFileChnl.3 (Tcl_OpenFileChannel):
+ * 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):
+ * generic/tcl.h (Tcl_FSOpenFileChannelProc):
+ * generic/tclIO.c (FlushChannel):
+ * generic/tclIOUtil.c (Tcl_OpenFileChannel,Tcl_EvalFile,TclGetOpenMode,
+ Tcl_PosixError,Tcl_FSOpenFileChannel):
+ * generic/tclInt.decls (TclGetOpenMode):
+ * generic/tclInt.h (TclOpenFileChannelProc_,TclGetOpenMode,
+ TclpOpenFileChannel):
+ * generic/tclPipe.c (TclCleanupChildren):
+ * generic/tclPosixStr.c (Tcl_ErrnoId,Tcl_ErrnoMsg,Tcl_SignalId,
+ Tcl_SignalMsg):
+ * generic.tclTest.c (PretendTclpOpenFileChannel,
+ 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]
- * Makefile.in: add installcheck & dvi targets
+ * generic/tclDecls.h:
+ * generic/tclIntDecls.h: make genstubs
-Fri Mar 19 21:07:25 1993 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+ * doc/CrtChannel.3:
+ * doc/OpenFileChnl.3:
+ * 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):
+ Updated APIs in the file generic/tclIO.c according to the guidelines
+ 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):
+ * generic/tclIOGT.c (TransformOutputProc, TransformGetOptionProc,
+ TransformSetOptionProc):
+ * mac/tclMacChan.c (FileOutput, StdIOOutput):
+ * man/tclMacSock.c (TcpGetOptionProc, TcpOutput):
+ * unix/tclUnixChan.c (FileOutputProc, TcpGetOptionProc, TcpOutputProc,
+ TtyGetOptionProc, TtySetOptionProc):
+ * unix/tclUnixPipe.c (PipeOuputProc):
+ * win/tclWinChan.c (FileOutputProc):
+ * win/tclWinConsole.c (ConsleOutputProc):
+ * win/tclWinPipe.c (PipeOuputProc):
+ * win/tclWinSerial.c (SerialOutputProc, SerialGetOptionProc,
+ SerialSetOptionProc):
+ * win/tclWinSock.c (TcpGetOptionProc, TcpOutput): Updated channel
+ driver interface according to the guidelines of TIP 27. See also
+ [Bug 500348].
- * tclEnv.c: disable putenv. no one uses it.
+ * doc/CrtChannel.3:
+ * generic/tcl.h:
+ * generic/tclIO.c:
+ * generic/tclIO.h:
+ * 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
+ anywhere in Tcl's public interface.
-Mon Feb 22 07:54:03 1993 Mike Werner (mtw@poseidon.cygnus.com)
+2002-01-14 Don Porter <dgp@users.sourceforge.net>
- * tcl/testsuite: made modifications to testcases, etc., to allow
- them to work properly given the reorganization of deja-gnu and the
- relocation of the testcases from deja-gnu to a "tool" subdirectory.
+ * 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]
+ * generic/tclDecls.h: make genstubs
-Sun Feb 21 10:55:55 1993 Mike Werner (mtw@poseidon.cygnus.com)
+2002-01-11 Mo DeJong <mdejong@users.sourceforge.net>
- * tcl/testsuite: Initial creation of tcl/testsuite.
- Migrated dejagnu testcases and support files for testing nm to
- tcl/testsuite from deja-gnu. These files were moved "as is"
- with no modifications. This migration is part of a major overhaul
- of dejagnu. The modifications to these testcases, etc., which
- will allow them to work with the new version of dejagnu will be
- made in a future update.
+ * unix/configure: Regen.
+ * unix/configure.in:
+ * win/configure: Regen.
+ * 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>
+
+ * 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.
+
+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]
+
+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
+ 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.
+
+2002-01-08 Don Porter <dgp@users.sourceforge.net>,
+ Kevin Kenny <kennykb@users.sourceforge.net>
+
+ * doc/StaticPkg.3 (Tcl_StaticPackage):
+ * generic/tcl.decls (Tcl_StaticPackage):
+ * generic/tclDecls.h (Tcl_StaticPackage):
+ * generic/tclInt.decls (TclGuessPackageName):
+ * generic/tclInt.h (TclGuessPackageName):
+ * generic/tclLoad.c (Tcl_StaticPackage):
+ * generic/tclLoadNone.c (TclGuessPackageName):
+ * mac/tclMacLoad.c (TclGuessPackageName):
+ * unix/tclLoadAout.c (TclGuessPackageName):
+ * unix/tclLoadDl.c (TclGuessPackageName):
+ * unix/tclLoadDld.c (TclGuessPackageName):
+ * unix/tclLoadDyld.c (TclGuessPackageName):
+ * 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]
+
+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.
+
+2002-01-07 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclEvent.c (TclInExit):
+ * generic/tclIOUtil.c (SetFsPathFromAbsoluteNormalized,
+ 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.
+
+2002-01-05 Don Porter <dgp@users.sourceforge.net>
+
+ * doc/Tcl_Main.3:
+ * 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.
+
+ * generic/tclInt.decls (TclGetStartupScriptPath,
+ TclSetStartupScriptPath): New internal VFS-aware routines for
+ managing the startup script of Tcl_Main.
+ * generic/tclIntDecls.h:
+ * generic/tclStubInit.c: make genstubs
-Thu Feb 18 11:31:05 1993 Fred Fish (fnf@cygnus.com)
+ * 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().
- * tclEnv.c (putenv): On at least the Sun and SVR4, and possibly
- most other systems, the argument is just "char *", not
- "const char *".
+2002-01-04 Don Porter <dgp@users.sourceforge.net>
-Sat Dec 26 11:13:40 1992 Fred Fish (fnf@cygnus.com)
+ * doc/Alloc.3:
+ * doc/Concat.3:
+ * doc/CrtMathFnc.3:
+ * doc/Hash.3:
+ * doc/Interp.3:
+ * doc/LinkVar.3:
+ * doc/ObjectType.3:
+ * doc/PkgRequire.3:
+ * doc/Preserve.3:
+ * doc/SetResult.3:
+ * doc/SplitList.3:
+ * 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]
- * tclUnix.h (fseek): Returns int, not long. True for both
- ANSI-C and traditional C unix environments.
+ * generic/tclThreadJoin.c (TclRememberJoinableThread,TclJoinThread):
+ Replaced Tcl_Alloc and Tcl_Free calls with ckalloc and ckfree so that
+ memory debugging is supported.
-Wed Dec 16 11:02:29 1992 Ian Lance Taylor (ian@cygnus.com)
+2002-01-04 Daniel Steffen <das@users.sourceforge.net>
- * configure.in: check for gettimeofday, and define TCL_GETTOD
- accordingly.
- * configure: regenerated.
+ * mac/tclMacTime.c (TclpGetTZName): fix for daylight savings TZName bug
-Fri Nov 27 19:09:03 1992 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+2002-01-03 Don Porter <dgp@users.sourceforge.net>
- * Makefile.in: don't make TCL_INCLUDE a subdir of $(includedir)
+ * doc/FileSystem.3:
+ * generic/tclIOUtil.c: Updated some old uses of "fileName" to
+ new VFS terminology, "pathPtr".
-Fri Nov 20 10:15:55 1992 Ian Lance Taylor (ian@cygnus.com)
+2002-01-03 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * Makefile.in (INSTALL): Default to @INSTALL@, not install -c.
- (test): get tests from $(srcdir).
+ * 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
+ 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
+ derefs/assigns per list per iteration, with no change in the
+ number of tests) and if something odd *is* going on, the code is
+ now far more robust.
-Sun Nov 8 21:56:26 1992 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+ * tests/basic.test (basic-39.4): Reproducable script from Bug #494348
- * Makefile.in: install .tcl files from $(srcdir)/library
+2002-01-02 Donal K. Fellows <fellowsd@cs.man.ac.uk>
- * New file for GNU/Cygnus distribution of TCL.
+ * 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]
+ ******************************************************************
+ *** 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/tcl/ChangeLog.1999 b/tcl/ChangeLog.1999
new file mode 100644
index 00000000000..a7483a0ef9b
--- /dev/null
+++ b/tcl/ChangeLog.1999
@@ -0,0 +1,2698 @@
+1999-12-22 Jeff Hobbs <hobbs@scriptics.com>
+
+ * changes: updated changes file
+ * tools/tclSplash.bmp: updated to show 8.3
+
+1999-12-21 Jeff Hobbs <hobbs@scriptics.com>
+
+ * README:
+ * generic/tcl.h:
+ * mac/README:
+ * unix/configure.in:
+ * tools/tcl.wse.in:
+ * win/README.binary:
+ * win/configure.in: updated to patch level 8.3b1
+
+ * unix/Makefile.in: added -srcdir=... for 'make html'
+
+ * 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
+
+ * doc/lsort.n: added -unique docs
+ * tests/cmdIL.test:
+ * generic/tclCmdIL.c: added -unique option to lsort
+
+ * generic/tclThreadTest.c: changed thread ids to longs [Bug: 3902]
+
+ * mac/tclMacOSA.c: fixed applescript for I18N [Bug: 3644]
+
+ * win/mkd.bat:
+ * win/rmd.bat: removed necessity of tag.txt [Bug: 3874]
+
+ * win/tclWinThrd.c: changed CreateThread to _beginthreadex and
+ ExitThread to _endthreadex
+
+1999-12-12 Jeff Hobbs <hobbs@scriptics.com>
+
+ * doc/glob.n:
+ * tests/fileName.test:
+ * generic/tclInt.decls:
+ * generic/tclInt.h:
+ * generic/tclIntDecls.h:
+ * generic/tclStubInit.c:
+ * generic/tclEncoding.c:
+ * generic/tclFileName.c:
+ * 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
+ TclpMatchFilesTypes, extended TclGlob and TclDoGlob and added
+ 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/tclCmdMZ.c:
+ * generic/tclExecute.c: optimized INST_TRY_CVT_TO_NUMERIC to
+ recognize boolean objects. (Spjuth) [Bug: 2815]
+
+ * 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]
+
+ * 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]
+
+1999-12-09 Jeff Hobbs <hobbs@scriptics.com>
+
+ * win/aclocal.m4: made it just include tcl.m4
+
+ * doc/exec.n:
+ * doc/open.n:
+ * win/tclWin32Dll.c:
+ * win/tclWinChan.c:
+ * 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/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)
+
+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)
+
+ * 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]
+
+ * 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]
+
+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]
+
+ * tests/env.test: removed knownBug limitation from working test
+ * tests/all.tcl: ensured that ::tcltest::testsDirectory would be
+ set to an absolute path
+
+ * tests/expr-old.test:
+ * tests/parseExpr.test:
+ * tests/string.test:
+ * generic/tclGet.c:
+ * generic/tclInt.h:
+ * generic/tclObj.c:
+ * 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]
+
+ * 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:
+ expr 1 + {[string length abc]}
+ 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
+ expr 1 + {[mindless error]}
+ from seg faulting, and only affects optimizations for
+ degenerate cases [Bug: 3737]
+
+1999-12-01 Scott Redman <redman@scriptics.com>
+
+ * generic/tcl.decls :
+ * 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.
+
+ * generic/tclEncoding.c:
+ * 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>
+
+ * 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.
+
+ * 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
+
+ * unix/tclUnixPipe.c: fixed PipeBlockModeProc to properly set
+ 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]
+
+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]
+
+ * 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.
+
+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.
+
+ * tools/tcl.wse.in: added tcltest1.0 library to distribution list
+
+ * doc/http.n:
+ * library/http2.1/http.tcl:
+ * library/http2.1/pkgIndex.tcl: updated http package to 2.2
+
+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
+
+ * 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/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]
+
+ * doc/scan.n:
+ * tests/scan.test:
+ * 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]
+
+ * 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]
+
+ * 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]
+
+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.
+
+1999-11-09 Jeff Hobbs <hobbs@scriptics.com>
+
+ * doc/open.n: corrected docs for 'a' open mode.
+
+ * generic/tclIOUtil.c: changed Tcl_Alloc to ckalloc
+
+ * generic/tclInt.h:
+ * generic/tclObj.c: rolled back changes from 1999-10-29
+ Purify noted new leaks with that code
+
+ * 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
+
+ * 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
+
+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
+
+ * generic/tclStringObj.c: fixed Tcl_AppendStringsToObjVA so it only
+ 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
+
+ * tests/incr.test:
+ * tests/set.test:
+ * 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
+ * win/tclWinPort.h: added sys/utime.h to includes
+ * 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)
+
+1999-10-20 Jeff Hobbs <hobbs@scriptics.com>
+
+ * 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/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
+
+ * tests/string.test:
+ * 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]
+
+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.
+
+ 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]
+
+ 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.
+
+ * tests/autoMkindex.test:
+ * 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/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.
+
+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]
+
+1999-10-12 Jeff Hobbs <hobbs@scriptics.com>
+
+ * generic/regc_color.c:
+ * generic/regc_cvec.c:
+ * generic/regc_lex.c:
+ * generic/regc_locale.c:
+ * generic/regcomp.c:
+ * generic/regcustom.h:
+ * generic/regerrs.h:
+ * generic/regex.h:
+ * generic/regexec.c:
+ * generic/regguts.h:
+ * 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.
+
+ * 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)
+ * 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/tclUnixTest.c: fixed mem leak in findexecutable test command
+
+1999-10-05 Jeff Hobbs <hobbs@scriptics.com>
+
+ * {win,mac,unix,tools,}/README:
+ * win/README.binary:
+ * win/makefile.vc:
+ * {win,unix}/configure.in:
+ * generic/tcl.h:
+ * library/init.tcl: updated to 8.3a1 from 8.2.0.
+
+ * 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.
+
+ * generic/tclNamesp.c:
+ * generic/tclVar.c:
+ * generic/tclCmdIL.c: fixed comment typos
+
+ * 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)
+
+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]
+
+1999-09-20 Jeff Hobbs <hobbs@scriptics.com>
+
+ * tests/env.test:
+ * 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]
+
+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/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]
+
+ * 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]
+
+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]
+
+ * tests/format.test:
+ * generic/tclCmdAH.c: fixed translation of %0#s in format [Bug: 2605]
+
+ * 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]
+
+ * 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]
+
+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]
+
+ * doc/regexp.n:
+ * doc/regsub.n:
+ * tests/regexp.test:
+ * 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: 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)
+
+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)
+
+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.
+ * 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]
+ * unix/aclocal.m4:
+ * 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>
+
+ * library/tcltest1.0/tcltest.tcl:
+ * doc/tcltest.n:
+ * tests/README: Modified testConstraints variable so that it isn't
+ unset every time ::tcltest::initConstraints is called and cleaned up
+ documentation in the README file and the man page.
+
+1999-08-27 Jennifer Hom <jenn@scriptics.com>
+
+ * tests/env.test:
+ * tests/exec.test:
+ * tests/io.test:
+ * tests/event.test:
+ * tests/tcltest.test: Added 'exit' calls to scripts that the tests
+ 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.
+
+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.
+
+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/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.
+
+1999-08-21 Jeff Hobbs <hobbs@scriptics.com>
+
+ * 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]
+
+ * 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]
+
+ * doc/interp.n: updated list of commands available in a safe
+ 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/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.
+
+ * 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]
+
+ * 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:
+ * library/ldAout.tcl:
+ * library/package.tcl:
+ * 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).
+
+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!
+
+1999-08-13 Scott Redman <redman@scriptics.com>
+
+ * /: 8.2.0 tagged for final release
+
+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.
+
+ * 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]
+
+1999-08-12 Scott Redman <redman@scriptics.com>
+
+ * win/tclWinSerial.c: Applied patch from Petteri Kettunen to
+ remove compiler warning.
+
+1999-08-10 Scott Redman <redman@scriptics.com>
+
+ * generic/tclAlloc.c:
+ * generic/tclCmdIL.c:
+ * generic/tclIO.c:
+ * generic/tclThread.c:
+ * win/tclWinThrd.c:
+ * unix/tclUnixThrd.c: Fixed Brent's changes so that they work on
+ Windows (and he fixed the bug in the Unix thread implementation).
+
+1999-08-09 Brent Welch <welch@scriptics.com>
+
+ * generic/tcl.decls:
+ * generic/tclAlloc.c:
+ * generic/tclCkalloc.c:
+ * generic/tclCmdIL.c:
+ * generic/tclDecls.h:
+ * generic/tclIO.c:
+ * generic/tclInt.decls:
+ * generic/tclIntDecls.h:
+ * generic/tclStubInit.c:
+ * 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.
+
+1999-08-09 Jeff Hobbs <hobbs@scriptics.com>
+
+ * tests/string.test: added largest_int proc to adapt for >32 bit
+ 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/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]
+
+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]
+
+1999-08-04 Scott Stanton <stanton@scriptics.com>
+
+ * tests/reg.test: Added test for REG_EXPECT bug fixed by Henry's
+ patch.
+
+ * generic/regc_nfa.c:
+ * generic/regcomp.c:
+ * generic/rege_dfa.c:
+ * 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]
+
+1999-08-03 Scott Redman <redman@scriptics.com>
+
+ * win/tclWinInt.h: Remove function declarations in header that was
+ moved to tclInt.decls file in previous changes.
+
+1999-08-02 Scott Redman <redman@scriptics.com>
+
+ * unix/configure.in:
+ * win/configure.in: Change beta level to b2.
+
+ * generic/tcl.h:
+ * generic/tcl.decls:
+ * generic/tclDecls.h:
+ * generic/tclInt.h:
+ * generic/tclInt.decls:
+ * 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.
+
+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.
+
+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).
+
+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]
+
+1999-07-30 <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/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]
+
+ * tests/info.test: Enable test for tclParse.c change (info
+ complete).
+
+1999-07-30 <hobbs@scriptics.com>
+
+ * tclIO.c: added fix for Kupries' trf patch [Bug: 2386]
+
+ * tclParse.c: fixed bug in info complete regarding nested square
+ brackets [Bug: 2382, 2466]
+
+1999-07-29 <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]
+
+ * unix/mkLinks.tcl: Applied patch to avoid linking pack.n to
+ 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]
+
+ * win/tclWinSock.c: Free Win32 Event handles when destroying
+ the socket helper thread.
+
+1999-07-28 <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.
+
+1999-07-27 <redman@scriptics.com>
+
+ * tools/tclSplash.bmp: Updated Windows installer bitmap
+ to ready Tcl/Tk Version 8.2.
+
+1999-07-26 <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/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.
+
+ * 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).
+
+1999-07-26 Jennifer Hom <jenn@scriptics.com>
+
+ * tests/tcltest.test:
+ * library/tcltest1.0/tcltest.tcl:
+ * doc/tcltest.n: Cleaned up code in ::tcltest::PrintError, revised
+ documentation, and added tests for the tcltest package.
+
+1999-07-23 <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]
+
+1999-07-22 <redman@scriptics.com>
+
+ * Changed version to 8.2b2.
+
+ * 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/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]
+
+ * 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]
+
+1999-07-21 <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]
+
+ * 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).
+
+ * unix/Makefile.in: Added the Windows configure script to the
+ distribution file list, already shipping configure.in and the .m4
+ files, but needed the configure script itself.
+
+ * win/makefile.vc: Changed version number of DDE package in VC++
+ makefile to use 1.1 instead of 1.0.
+
+ * doc/open.n: Added documentation of \\.\comX notation for opening
+ serial ports on Windows (alternative to comX:).
+
+ * 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]
+
+1999-07-21 <jpeek@scriptics.com>
+
+ * README: Small tweaks to clean up typos and wording.
+
+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
+ 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.
+ * unix/tclWinInit.c: just updated some comments.
+
+1999-07-19 Melissa Hirschl <hershey@matisse.scriptics.com>
+
+ * library/http2.1/http.tcl: updated -useragent text to say version
+ 2.1.
+
+1999-07-16 <redman@scriptics.com>
+
+ * generic/tcl.decls:
+ * generic/tclDecls.h:
+ * 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.
+
+ * tools/tcl.hpj.in: Change version number of .cnt file referenced
+ in .HPJ file.
+
+1999-07-15 <redman@scriptics.com>
+
+ * tools/tcl.wse.in: Fixed naming of target files for Windows.
+
+1999-07-14 <jpeek@scriptics.com>
+
+ * doc/re_syntax.n: Deleted sentence as suggested by Scott S.
+
+1999-07-12 <jpeek@scriptics.com>
+
+ * doc/re_syntax.n: Removed two notes to myself (oops), cleaned
+ up wording, fixed changebars, made two examples easier to read.
+
+1999-07-11 <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
+ autoconf/configure/gmake build mechanism for Windows, the version
+ 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 <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.
+
+1999-07-08 <stanton@scriptics.com>
+
+ * tests/string.test:
+ * 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.
+
+1999-07-08 <stanton@scriptics.com>
+
+ * 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]
+
+1999-07-07 <stanton@scriptics.com>
+
+ * doc/fconfigure.n: Clarified default buffering behavior for the
+ standard channels. [Bug: 2335]
+
+1999-07-06 <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]
+
+1999-07-06 <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!)
+
+1999-07-03 <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.
+
+1999-07-03 <welch@scriptics.com>
+
+ * generic/tclNotify.c:
+ * unix/tclUnixNotfy.c:
+ * 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.
+
+1999-07-03 <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.
+
+1999-07-01 <redman@scriptics.com>
+
+ * generic/tclCmdAH.c:
+ * generic/tclFCmd.c: Call TclStat instead of TclpStat in order to
+ allow Tcl_Stat hooks to work properly.
+
+1999-06-29 Jennifer Hom <jenn@scriptics.com>
+
+ * 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.
+
+1999-06-28 <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.
+
+1999-06-26 <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]
+
+1999-06-25 Jennifer Hom <jenn@scriptics.com>
+
+ * unix/Makefile.in:
+ * win/Makefile.in:
+ * 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
+ 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.
+
+1999-06-25 <stanton@scriptics.com>
+
+ * tests/reg.test:
+ * generic/regexec.c: Fixed bugs in non-greedy quantifiers.
+
+1999-06-23 <jpeek@scriptics.com>
+
+ * doc/re_syntax.n:
+ * doc/switch.n:
+ * doc/lsearch.n:
+ * 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.
+
+1999-06-23 <stanton@scriptics.com>
+
+ * unix/Makefile.in: Changed install-doc to install-man.
+
+ * tools/uniParse.tcl:
+ * tools/uniClass.tcl:
+ * tools/README:
+ * tests/string.test:
+ * generic/regc_locale.c:
+ * 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"
+ definitions of character classes.
+
+1999-06-21 <stanton@scriptics.com>
+
+ * unix/tclUnixThrd.c (TclpThreadCreate): Fixed memory leak where
+ thread attributes were not being released. [Bug: 2254]
+
+1999-06-17 <stanton@scriptics.com>
+
+ * tests/regexp.test:
+ * generic/tclCmdMZ.c:
+ * 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.
+
+ * 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/regcomp.c: lint
+
+ * tests/reg.test:
+ * generic/regex.h:
+ * generic/regc_lex.c: Added REG_BOSONLY flag to allow Expect to
+ iterate through a string an only find matches that start at the
+ current position within the string.
+
+1999-06-16 <wart@scriptics.com>
+
+ * unix/configure.in:
+ * unix/Makefile.in:
+ * unix/tcl.m4:
+ * unix/aclocal.m4: Numerous build changes to make Tcl conform to the
+ proposed TEA spec
+
+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".
+
+1999-06-16 <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]
+
+1999-06-14 Melissa Hirschl <hershey@matisse.scriptics.com>
+
+ * doc/StringObj.3
+ * test/stringObj.test
+ * unix/Makefile.in
+ * 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,
+ Tcl_AppendUnicodeToObj.
+
+1999-06-09 <stanton@scriptics.com>
+
+ * 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/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/tclCmdMZ.c:
+ * tests/string.test: Fixed bug where string map failed on null
+ strings.
+
+ * generic/regexec.c:
+ * unix/tclUnixNotfy.c: lint
+
+ * tools/genStubs.tcl: Changed to always write output in LF mode.
+
+1999-06-08 <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.
+
+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.
+
+ * unix/Makefile.in:
+ * win/Makefile.in:
+ * win/Makefile.vc:
+ * tests/unicode.test:
+ * generic/tclInt.h:
+ * generic/tclObj.c:
+ * generic/tclUnicodeObj.c: added a new object type to store the
+ 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.
+
+1999-06-04 <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.
+
+1999-06-03 <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]
+
+1999-06-02 <stanton@scriptics.com>
+
+ * generic/tclUtf.c (Tcl_UtfNcasecmp): Fixed incorrect computation
+ of relative ordering. [Bug: 2135]
+
+1999-06-01 <stanton@scriptics.com>
+
+ * unix/configure.in: Fixed various small configure.in patches
+ submitted by Jan Nijtmans. [Bug: 2121]
+
+ * tests/reg.test:
+ * generic/regc_color.c:
+ * generic/regc_cvec.c:
+ * generic/regc_lex.c:
+ * generic/regc_locale.c:
+ * generic/regc_nfa.c:
+ * generic/regcomp.c:
+ * generic/regcustom.h:
+ * generic/rege_dfa.c:
+ * generic/regerror.c:
+ * generic/regerrs.h:
+ * generic/regex.h:
+ * generic/regexec.c:
+ * generic/regfree.c:
+ * generic/regfronts.c:
+ * generic/regguts.h:
+ * generic/tclCmdMZ.c:
+ * 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]
+
+1999-05-28 <stanton@scriptics.com>
+
+ * generic/tclObj.c: Changed to eliminate use of isupper/tolower in
+ favor of the Unicode versions.
+
+ * win/Makefile.in:
+ * 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]
+
+1999-05-26 <redman@scriptic.com>
+
+ * 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).
+
+1999-05-24 <stanton@scriptics.com>
+
+ * tools/genStubs.tcl: Changed to allow a list of platforms instead
+ of just one at a time.
+
+ * generic/tcl.decls:
+ * generic/tclCmdMZ.c:
+ * generic/tclDecls.h:
+ * generic/tclInt.decls:
+ * generic/tclIntDecls.h:
+ * generic/tclPort.h:
+ * generic/tclStubInit.c:
+ * generic/tclStubLib.c: Various header file related changes and other
+ lint to try to get the Mac builds working.
+
+1999-05-21 <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]
+
+1999-05-20 <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.
+
+1999-05-19 <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/tclUtil.c:
+ * doc/StrMatch.3: Added Tcl_StringCaseMatch() implementation to
+ support case-insensitive globbing.
+
+ * 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.
+
+1999-05-19 <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.
+
+ * 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 <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.
+
+1999-05-14 <stanton@scriptics.com>
+
+ * generic/tclCmdAH.c (Tcl_ForObjCmd): Fixed crash caused by
+ failure to reset the result before evaluating the test
+ expression.
+
+1999-05-14 <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.
+
+1999-05-14 <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]
+
+1999-05-13 <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]
+
+ * 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 <stanton@scriptics.com>
+
+ * doc/tclsh.1: Updated references to rc script names to accurately
+ reflect the platform differences on Windows.
+
+ * tests/regexp.test:
+ * 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]
+
+ * 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 <stanton@scriptics.com>
+
+ * win/winDumpExts.c:
+ * 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]
+
+ * generic/tclLoadNone.c: Updated to use current interfaces, added
+ TclpUnloadFile. [Bug: 2003]
+
+ * win/winDumpExts.c:
+ * win/makefile.vc: Changed to emit library name in defs
+ file. [Bug: 1998]
+
+ * unix/configure.in: Added fix for OS/390. [Bug: 1976]
+
+1999-05-06 <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.
+
+ * tests/http.test: Unset "data" array before running tests to
+ avoid failures due to previous tests.
+
+ * doc/string.n:
+ * tests/cmdIL.test:
+ * tests/cmdMZ.test:
+ * tests/error.test:
+ * tests/ioCmd.test:
+ * tests/lindex.test:
+ * tests/linsert.test:
+ * tests/lrange.test:
+ * tests/lreplace.test:
+ * 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.
+
+ * doc/Utf.3:
+ * generic/tclStubInit.c:
+ * generic/tclDecls.h:
+ * generic/tclUtf.c:
+ * generic/tcl.decls: Added Tcl_UtfNcmp and Tcl_UtfNcasecmp.
+
+1999-05-05 <stanton@scriptics.com>
+
+ * win/makefile.vc: Added encoding directory to install-libraries
+ target.
+
+1999-05-03 <stanton@scriptics.com>
+
+ * 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.
+
+ * tests/cmdIL.test:
+ * tests/cmdMZ.test:
+ * tests/error.test:
+ * tests/lindex.test:
+ * tests/linsert.test:
+ * tests/lrange.test:
+ * 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]
+
+ * tests/binary.test:
+ * generic/tclBinary.c (DupByteArrayInternalRep): Fixed bug where
+ type was not being set in duplicated object. [Bug: 1975, 2047]
+
+1999-04-30 <stanton@scriptics.com>
+
+ * Changed version to 8.1.1.
+
+1999-04-30 <stanton@scriptics.com>
+
+ * Merged changes from 8.1.0 branch:
+
+ * generic/tclParse.c: Fixed memory leak in CommandComplete.
+
+ * generic/tclPlatDecls.h:
+ * generic/tclIntPlatDecls.h:
+ * 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]
+
+ * Lots of documentation and other release engineering fixes.
+
+1999-04-28 <stanton@scriptics.com>
+
+ * mac/tclMacResource.c:
+ * 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.
+
+1999-04-27 <stanton@scriptics.com>
+
+ * generic/tclLiteral.c (TclHideLiteral): Fixed so hidden literals
+ get duplicated to avoid accidental sharing in the global object
+ table.
+
+1999-04-23 <stanton@scriptics.com>
+
+ * generic/tclStubInit.c:
+ * tools/genStubs.tcl: Changed to avoid the need for forward
+ declarations in stub initializers.
+
+1999-04-23 <stanton@scriptics.com>
+
+ * library/encoding/koi8-r.enc:
+ * tools/encoding/koi8-r.txt: Added support for the koi8-r Cyrillic
+ encoding. [Bug: 1771]
+
+1999-04-22 <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.
+
+ * 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.
+
+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/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
+ found used by tcl_findLibrary.
+
+1999-04-22 <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.
+
+1999-04-15 <stanton@scriptics.com>
+
+ * Merged 8.1 back into the main trunk
+
+1999-04-13 <stanton@scriptics.com>
+
+ * library/encoding/gb2312.enc:
+ * library/encoding/euc-cn.enc:
+ * 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]
+
+1999-04-13 <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]
+
+1999-04-09 <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]
+
+1999-04-06 <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/unixInit.test: Fixed race condition in test.
+
+ * tests/unixInit.test:
+ * tests/fileName.test: Minor test nits.
+
+ * unix/tclUnixInit.c (TclpSetInitialEncodings): Fixed bad initial
+ encoding string.
+
+1999-04-06 <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:
+ * generic/tclWinInit.h:
+ * generic/tclUnixInit.h:
+ * 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]
+
+1999-04-05 <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]
+
+ * unix/configure.in:
+ * unix/tclUnixPort.h: Applied patch for OS/390 to handle lack of
+ sys/param.h. [Bug: 1725]
+
+ * unix/configure.in: Fixed BSD/OS 4.* configuration to support
+ shared libraries properly. [Bug: 1730]
+
+1999-04-05 <redman@scriptics.com>
+
+ * win/tclWinDde.c: decrease timeout value for DDE calls to 30k
+ [Bug: 1639]
+
+ * generic/tcl.decls:
+ * generic/tcl.h:
+ * generic/tclDecls.h:
+ * generic/tclInt.decls:
+ * generic/tclInt.h:
+ * 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).
+
+ * 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.
+
+1999-04-05 <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]
+
+ * tests/platform.test:
+ * tests/fileName.test: Fixed broken tests.
+
+ * 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.
+
+ * 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.
+
+1999-04-02 <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.
+
+1999-04-02 <redman@scriptics.com>
+
+ * doc/dde.n:
+ * 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.
+
+1999-04-02 <stanton@scriptics.com>
+
+ * tests/expr.test:
+ * tests/for-old.test:
+ * tests/for.test:
+ * tests/foreach.test:
+ * tests/format.test:
+ * tests/httpold.test:
+ * tests/if.test:
+ * tests/init.test:
+ * tests/interp.test:
+ * tests/while.test: Added some tests for known bugs (marked with
+ knownBug constraint), and cleaned up a few bad tests.
+
+ * generic/regc_locale.c:
+ * generic/regcustom.h:
+ * generic/tcl.decls:
+ * generic/tclCmdIL.c:
+ * generic/tclCmdMZ.c:
+ * generic/tclInt.h:
+ * generic/tclRegexp.c:
+ * generic/tclScan.c:
+ * 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:
+ Tcl_UtfToUniCharDString, Tcl_UniCharToUtfDString,
+ Tcl_UniCharLen, Tcl_UniCharNcmp, Tcl_UniCharIsAlnum,
+ Tcl_UniCharIsAlpha, Tcl_UniCharIsDigit, Tcl_UniCharIsLower,
+ Tcl_UniCharIsSpace, Tcl_UniCharIsUpper, Tcl_UniCharIsWordChar
+
+1999-04-01 <stanton@scriptics.com>
+
+ * tests/registry.test:
+ * 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]
+
+ * generic/tclInt.h: Removed duplicate declarations.
+
+ * generic/tclInt.decls:
+ * generic/tcl.decls: Added Tcl_WinUtfToTChar and Tcl_WinTCharToUtf
+ to the tclPlat table.
+
+1999-04-01 <redman@scriptics.com>
+
+ * generic/tcl.decls:
+ * generic/tcl.h:
+ * generic/tclBasic.c:
+ * generic/tclDecls.h:
+ * generic/StubInit.c:
+ * 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).
+
+1999-03-31 <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.
+
+1999-03-30 <stanton@scriptics.com>
+
+ * 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]
+
+ * 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.
+
+ * 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]
+
+1999-03-29 <stanton@scriptics.com>
+
+ * generic/tclFileName.c:
+ * generic/tclDecls.h:
+ * generic/tcl.decls: Added CONST to Tcl_JoinPath and
+ Tcl_TranslateFileName.
+
+1999-03-29 <redman@scriptics.com>
+
+ * tools/genStubs.tcl:
+ * unix/configure.in:
+ * unix/Makefile.in:
+ * win/makefile.vc:
+ * generic/tcl.h:
+ * generic/tclBasic.c:
+ * 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).
+
+1999-03-27 <redman@scriptics.com>
+
+ * win/makefile.bc: Removed makefile for Borland compiler, no
+ longer supported.
+
+1999-03-26 <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.
+
+1999-03-26 <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.
+
+1999-03-25 <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]
+
+ * 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]
+
+ * 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]
+
+ * 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]
+
+1999-03-24 <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]
+
+1999-03-24 <redman@scriptics.com>
+
+ * generic/tclAlloc.c:
+ * 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/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 <stanton@scriptics.com>
+
+ * tools/tcl.wse: Fixed file association to look in the right place
+ for the wish icon. [Bug: 1544]
+
+ * tests/winNotify.test:
+ * tests/ioCmd.test:
+ * tests/event.test: Changed to use new style conditionals.
+
+ * tests/encoding.test: Fixed nonportable test.
+
+ * unix/dltest/configure.in:
+ * 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/tclInt.h:
+ * generic/tcl.decls: Renamed TclpAlertNotifier back to
+ Tcl_AlertNotifier since it is part of the public notifier driver
+ API.
+
+1999-03-23 <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.
+
+ * 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.
+
+1999-03-22 <stanton@scriptics.com>
+
+ * tests/reg.test:
+ * generic/regc_color.c: Applied regexp bug fix from Henry Spencer.
+
+1999-03-19 <redman@scriptics.com>
+
+ * 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
+ compiler (not gcc).
+
+1999-03-18 <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/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]
+
+ * generic/tclInt.decls:
+ * generic/tcl.decls: Eliminated use of "string" and "list" from
+ 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.
+
+1999-03-17 <stanton@GASPODE>
+
+ * win/README.binary:
+ * win/README:
+ * unix/configure.in:
+ * generic/tcl.h:
+ * README: Updated version to 8.1b3.
+
+1999-03-14 <stanton@GASPODE>
+
+ * win/tclWinConsole.c:
+ * 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.
+
+ * generic/tclIntDecls.h:
+ * generic/tclIntPlatDecls.h:
+ * generic/tclIntPlatStubs.c:
+ * generic/tclIntStubs.c:
+ * generic/tclPlatDecls.h:
+ * generic/tclPlatStubs.c:
+ * generic/tclStubInit.c:
+ * generic/tclStubs.c: Fixed bad eol characters.
+
+ * 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.
+
+1999-03-11 <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.
+
+ * generic/tcl.h: Changed magic number so it doesn't match the plus
+ patch, at Jan's request.
+
+ * unix/tclConfig.sh.in:
+ * unix/dltest/Makefile.in:
+ * unix/dltest/configure.in:
+ * unix/dltest/pkga.c:
+ * unix/dltest/pkgb.c:
+ * 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.
+
+1999-03-10 <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.
+
+ * mac/tclMacNotify.c:
+ * generic/tclNotify.c:
+ * generic/tclInt.h:
+ * 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.
+
+ * 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/tcl.decls: Fixed declarations of reserved slots.
+
+1999-03-10 <redman@scriptic.com>
+
+ * generic/tclCompile.h: Ensure that the ByteCode struct is binary
+ 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).
+
+1999-03-09 <stanton@GASPODE>
+
+ * Integrated changes from Tcl 8.0 including:
+ stubs mechanism
+ configure patches from Jan Nijtmans
+ rename of panic to Tcl_Panic
+
+1999-03-08 <lfb@scriptics.com>
+
+ * win/tclWin32Dll.c: Removed Dll instance from thread-local
+ storage.
+
+1999-03-08 <stanton@GASPODE>
+
+ * 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:
+ * generic/regcomp.c:
+ * generic/tclCmdIL.c:
+ * generic/tclCmdAH.c:
+ * generic/tclIOCmd.c:
+ * generic/tclParse.c:
+ * generic/tclStringObj.c:
+ * unix/tclUnixNotfy.c: Cleaned up various compiler warnings,
+ eliminated UCHAR bugs.
+
+ * unix/tclUnixNotfy.c:
+ * unix/tclUnixThrd.c:
+ * generic/tclThreadTest.c:
+ * mac/tclMacThrd.c: Changed TclpCondition*() to Tcl_Condition*().
+
+ * INTEGRATED PATCHES FROM 8.0.6:
+
+ * generic/tcl.decls:
+ * generic/tcl.h:
+ * generic/tclBasic.c:
+ * generic/tclDecls.h:
+ * generic/tclInt.decls:
+ * generic/tclInt.h:
+ * generic/tclIntDecls.h:
+ * generic/tclIntPlatDecls.h:
+ * generic/tclIntPlatStubs.c:
+ * generic/tclIntStubs.c:
+ * generic/tclPlatDecls.h:
+ * generic/tclPlatStubs.c:
+ * generic/tclStubInit.c:
+ * generic/tclStubLib.c:
+ * generic/tclStubs.c:
+ * tools/genStubs.tcl:
+ * unix/configure.in:
+ * 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.
+
+ * unix/Makefile.in:
+ * unix/configure.in:
+ * unix/ldAix: Enhanced AIX shared library support.
+
+ * 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.
+
+ * doc/AddErrInfo.3:
+ * doc/Eval.3:
+ * doc/PkgRequire.3:
+ * doc/SetResult.3:
+ * doc/StringObj.3:
+ * generic/tcl.h:
+ * generic/tclBasic.c:
+ * 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.
+
+ * doc/package.n:
+ * doc/PkgRequire.3:
+ * generic/tclPkg.c: Added Tcl_PkgProvideEx, Tcl_RequireEx,
+ 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.
+
+ * generic/tclPanic.c:
+ * generic/panic.c: Renamed panic to Tcl_Panic.
+
+1999-02-25 <redman@scriptics.com>
+
+ * 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/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).
+
+1999-02-11 <stanton@GASPODE>
+
+ * README:
+ * generic/tcl.h:
+ * win/README.binary:
+ * win/README:
+ * unix/configure.in:
+ * mac/README: Updated version numbers to 8.1b2.
+
+1999-02-10 <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".
+
+ * 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.
+
+1999-02-10 <stanton@GASPODE>
+
+ INTEGRATED PATCHES FROM 8.0.5b2:
+
+ * test/winPipe.test: Changed to remove echoArgs.tcl temporary file
+ when done.
+
+ * 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]
+
+ * 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/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]
+
+ * 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]
+
+ * 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: 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]
+
+ * 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]
+
+ * 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]
+
+ * generic/tclIOCmd.c:
+ * 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]
+
+ * 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]
+
+ * win/tclWinReg.c:
+ * doc/registry.n: Added support for HKEY_PERFORMANCE_DATA and
+ 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]
+
+1999-02-01 <stanton@GASPODE>
+
+ * generic/tclBasic.c:
+ * generic/tclCmdAH.c:
+ * generic/tclCmdIL.c:
+ * generic/tclCmdMZ.c:
+ * generic/tclExecute.c:
+ * generic/tclHistory.c:
+ * generic/tclIO.c:
+ * generic/tclIOUtil.c:
+ * generic/tclInterp.c:
+ * generic/tclMain.c:
+ * generic/tclNamesp.c:
+ * generic/tclParse.c:
+ * 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.
+
+1999-01-28 <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.
+
+1998-12-11 === Tcl 8.1b1 Release ===
+
+1998-12-10 <stanton@GASPODE>
+
+ * Fixed lots of files that used TCL_THREAD instead of TCL_THREADS.
+
+ * 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.
+
+1998-12-09 <stanton@GASPODE>
+
+ * 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]
+
+1998-12-08 <stanton@GASPODE>
+
+ * library/msgcat1.0/msgcat.tcl: changed mc to invoke mcunknown in
+ the calling context, changed locale lookups to be case insensitive
+
+1998-12-07 <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]
+
+ * tests/msgcat.test: Added message catalog test suite.
+
+ * library/msgcat1.0/msgcat.tcl: minor bug fixes, integrated latest
+ changes from Mark Harrison.
+
+1998-12-04 <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: Added initial implementaion of Tcl message
+ catalog package contributed by Mark Harrison.
+
+1998-12-03 <stanton@GASPODE>
+
+ * 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.
+
+ * generic/tclUtil.c (Tcl_StringMatch): Changed to match 8.0
+ behavior in corner case where there is no closing bracket.
+
+1998-12-02 <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.
+
+ * 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]
+
+1998-12-02 <welch@SAGE>
+
+ * Updated patchlevel to 8.1b1
+
+1998-12-02 <stanton@GASPODE>
+
+ * 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.
+
+1998-12-02 <welch@SAGE>
+
+ * Merged changes from 8.0.4, especially the new pkg_mkIndex
+
+1998-12-01 <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/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/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.
+
+ * generic/tclCompCmds.c (TclCompileForeachCmd): Fixed code that
+ corrupted the exceptDepth value in the compile environment when
+ foreach failed to compile inline. [Bug: 884]
+
+ * library/encoding/euc-kr.enc:
+ * library/encoding/ksc5601.enc:
+ * tools/encoding/ksc5601.txt:
+ * unix/tclUnixInit.c: Added support for Korean EUC.
+
+ * win/tclWinChan.c (TclpGetDefaultStdChannel): added check for a
+ failure during Tcl_MakeFileChannel.
+
+1998-11-30 <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/tclUnixFCmd.c (GetPermissionsAttribute): Increase size of
+ 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/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]
+
+ * 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]
+
+1998-11-23 <stanton@GASPODE>
+
+ * regexec.c: more performance tuning from Henry Spencer.
+
+1998-11-17 <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]
+
+ * 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 <stanton@GASPODE>
+
+ * tclVar.c (TclGetIndexedScalar): Fixed bug 796, var name was
+ getting lost before being passed to CallTraces.
+
+1998-10-21 <stanton@GASPODE>
+
+ * added "encoding" command
+
+ * Moved internal regexp declarations from tclInt.h to tclRegexp.h
+
+ * integrated regexp updates from Henry Spencer
+
+1998-10-15 <stanton@GASPODE>
+
+ * tclUtf.c: added Unicode character table support
+
+ * tclInt.h: added TclUniCharIsWordChar
+
+ * tclCmdMZ.c (Tcl_StringObjCmd): added "totitle" subcommand,
+ changed "wordend" and "wordstart" to properly handle Unicode word
+ characters and connector punctuation
+
+1998-10-05 <stanton@GASPODE>
+
+ * auto.tcl, package.tcl: fixed SCCS strings
+
+ * tclIndex: updated index to reflect 8.1 files
+
+ * tclCompile.c (TclCompileScript): changed to avoid modifying the
+ input string in place because name lookup operations could have
+ arbitrary side effects
+
+ * tclInterp.c: added guard against deleting current interpreter
+
+ * tclMacFile.c, tclUnixFile.c, tclWinFile.c, tclFileName.c: added
+ warnings around code that modifies strings in place
+
+ * tclExecute.c: fixed off-by-one copying error, fixed merge bugs
+
+ * 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
+
+ * interp.test: added test for interp deleting itself
+
+1998-09-30 <stanton@GASPODE>
+
+ * makefile.vc: fixed so TCL_LIBRARY is set before running tcltest
+
+ * tclWin32Dll.c: removed TclpFinalize, cleanup of merges
+
diff --git a/tcl/ChangeLog.2000 b/tcl/ChangeLog.2000
new file mode 100644
index 00000000000..70d491f6271
--- /dev/null
+++ b/tcl/ChangeLog.2000
@@ -0,0 +1,2583 @@
+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]
+
+2000-12-10 Don Porter <dgp@users.sourceforge.net>
+
+ * library/init.tcl:
+ * 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]
+
+2000-12-09 jeff hobbs <jhobbs@interwoven.com>
+
+ * win/tclWinTime.c (CalibrationThread): added lint return value to
+ 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/tclExecute.c (TclExecuteByteCode): Commited patch fixing
+ handling of {!<boolean>} in expressions. [Patch #102702]
+
+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]
+
+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.
+
+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
+
+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]
+
+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]
+
+ * 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.
+
+ * 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):
+ * library/safe.tcl (AddSubDirs): [glob] uses -directory instead of
+ unsafe [file join] to fix 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...
+
+ * 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
+
+ * 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...
+
+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.
+
+ * 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.
+
+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
+
+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.
+
+ * 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.
+
+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.
+
+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.
+
+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.
+
+2000-11-03 David Gravereaux <davygrvy@ajubasolutions.com>
+
+ * 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):
+ * win/makefile.vc (install-libraries):
+ * win/Makefile.in (install-libraries): updated to install
+ unversioned library directories into versioned directories.
+
+ * tools/tcl.wse.in: updated for unversioning of library dirs
+
+ * unix/mkLinks: updated mkLinks with latest doc updates
+
+ * doc/Tcl_Main.3: added docs for Tcl_SetMainLoop
+
+ * 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.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.
+
+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]
+
+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.
+
+ * win/makefile.vc:
+ * win/tcl.m4: makefile fixes for Win64 support
+
+ * generic/tclIndexObj.c (Tcl_GetIndexFromObjStruct): minor cast
+ changes.
+
+2000-11-01 Jeff Hobbs <hobbs@ajubasolutions.com>
+
+ * 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.
+ * generic/tclParse.c (Tcl_EvalEx): corrected handling of non-zero,
+ 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]
+
+2000-10-30 David Gravereaux <davygrvy@ajubasolutions.com>
+
+ * win/configure.in:
+ * win/Makefile.in:
+ * win/makefile.vc:
+ * win/tcl.rc:
+ * win/tclsh.rc: Added logic to derive filenames better in the resource
+ scripts based on compile options.
+
+2000-10-30 Jeff Hobbs <hobbs@ajubasolutions.com>
+
+ * unix/tclUnixInit.c: added default encoding map from
+ "ja_JP.eucJP" to "euc-jp". (takahashi)
+
+ * tests/clock.test: corrected clock-2.* test numbering
+
+ * unix/configure.in (SC_TCL_LINK_LIBS): removed code that was
+ commented out (it had been moved to tcl.m4's SC_TCL_LINK_LIBS
+ already).
+
+ * unix/tcl.m4: consolidated gettimeofday check for AIX.
+
+2000-10-27 Jeff Hobbs <hobbs@ajubasolutions.com>
+
+ * 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.
+
+ * unix/tclUnixChan.c: updated channel types to strict
+ 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.
+
+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.
+
+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).
+
+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]
+
+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.
+
+ * 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.
+
+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]
+
+2000-10-06 Jeff Hobbs <hobbs@ajubasolutions.com>
+
+ * tests/cmdAH.test: extra tests for 'file channels' that include
+ multiple interpreter tests and channel sharing
+ * generic/tclIO.c (Tcl_GetChannelNamesEx): corrected function (and
+ consequently 'file channels') to return channels that are actually
+ registered for this specific interp, rather than this thread.
+
+ * doc/CrtChannel.3: fixed spelling mistakes
+
+2000-09-29 Jennifer Hom <jenn@ajubasolutions.com>
+
+ * 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.
+
+2000-09-29 Jeff Hobbs <hobbs@scriptics.com>
+
+ * win/tclWinSerial.c (SerialGetOptionProc): corrected reporting of
+ 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.
+
+ * 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.
+
+ * 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/fileName.test: cleaned up the testing of glob patterns for
+ c:/globTest (Windows) to directly create/remove directory.
+
+2000-09-27 Jeff Hobbs <hobbs@ajubasolutions.com>
+
+ * 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.
+ (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]
+
+ * doc/ChnlStack.3:
+ * doc/CrtChannel.3:
+ * generic/tcl.decls:
+ * generic/tcl.h:
+ * generic/tclDecls.h:
+ * generic/tclIO.c:
+ * generic/tclIO.h:
+ * generic/tclIOGT.c:
+ * generic/tclInt.decls:
+ * generic/tclIntDecls.h:
+ * generic/tclStubInit.c:
+ * generic/tclTest.c:
+ * tests/iogt.test:
+ * unix/Makefile.in:
+ * win/Makefile.in:
+ * win/makefile.vc:
+ * win/tclConfig.sh.in:
+ * win/tclWinChan.c:
+ * win/tclWinConsole.c:
+ * 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
+ channel implementation, with a few config related fixes.
+
+ Following is an asynchronous include of the applicable ChangeLog
+ entries from 8.3.2.
+
+ ********************************************************
+ ** START OF ASYNCHRONOUS UP-PORT LOG (8.3.2 -> 8.4a2) **
+ ********************************************************
+
+2000-08-07 Jeff Hobbs <hobbs@scriptics.com>
+
+ * doc/ChnlStack.3:
+ * 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.
+
+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/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.
+
+ * 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,
+ Tcl_ChannelGetOptionProc, Tcl_ChannelWatchProc,
+ 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.
+
+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.
+
+ * 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.
+
+ * generic/tcl.decls: New public API 'Tcl_ChannelBuffered'. S.a.
+
+2000-07-17 Jeff Hobbs <hobbs@scriptics.com>
+
+ * unix/Makefile.in:
+ * win/Makefile.in:
+ * win/makefile.vc: added tclIOGT.c to objects list to compile.
+
+ * generic/tclStubInit.c:
+ * 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
+ 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.
+
+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).
+
+ * win/tclWinChan.c: updated fileChannelType to v2 channel struct
+ * win/tclWinConsole.c: updated consoleChannelType to v2 channel struct
+ * win/tclWinPipe.c: updated pipeChannelType to v2 channel struct
+ * win/tclWinSerial.c: updated serialChannelType to v2 channel struct
+ * win/tclWinSock.c: updated tcpChannelType to v2 channel struct
+
+2000-07-11 Brent Welch <welch@ajubasolutions.com>
+
+ * 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.
+
+ * 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/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).
+
+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 :(.
+
+ * 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).
+
+ 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).
+ * 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.
+
+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.
+
+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.
+
+ ******************************************************
+ ** END OF ASYNCHRONOUS UP-PORT LOG (8.3.2 -> 8.4a2) **
+ ******************************************************
+
+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.
+
+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
+ 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.
+ * 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.
+
+ * 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.
+
+ * unix/mkLinks: Added code to link to tcltest2.n.
+
+ * generic/tcl.h: Added comment to modify tcltest2.tcl as well as
+ tcltest.tcl for version changes.
+
+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].
+
+2000-09-19 David Gravereaux <davygrvy@ajubasolutions.com>
+
+ * 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.
+
+2000-09-17 Eric Melski <ericm@ajubasolutions.com>
+
+ * tests/cmdIL.test: Added a test for fix for [Bug: 6212].
+
+ * generic/tclCmdIL.c (Tcl_LsortObjCmd): Applied patch from [Bug:
+ 6212], which corrected an error in the handling of the -index option.
+
+2000-09-14 Eric Melski <ericm@ajubasolutions.com>
+
+ * 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/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.
+
+ * 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
+ AppendUnicodeToUnicodeRep, AppendUtfToUtfRep, and
+ Tcl_AppendStringsToObjVA to support this.
+
+2000-09-07 David Gravereaux <davygrvy@ajubasolutions.com>
+
+ * win/.cvsignore: changed the glob patterns a bit to exclude VC++
+ 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]
+
+2000-09-07 Jeff Hobbs <hobbs@scriptics.com>
+
+ * doc/trace.n: minor doc cleanup
+
+2000-09-06 André Pönitz <poenitz@htwm.de>
+
+ * doc/*.n: added or changed "SEE ALSO:" section
+
+2000-09-06 Jeff Hobbs <hobbs@scriptics.com>
+
+ * 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".
+
+ * README:
+ * generic/tcl.h:
+ * library/tcltest1.0/tcltest.tcl:
+ * tools/tcl.wse.in:
+ * tools/tcltk-man2html.tcl:
+ * unix/configure.in:
+ * unix/tcl.spec:
+ * win/README.binary:
+ * win/configure.in: updated patchlevel to 8.4a2
+
+ * unix/tclUnixPipe.c (TclpCreateProcess): Removed WNOHANG from
+ Tcl_WaitPid call in error case of process creation on Unix, as it
+ would lead to defunct processes. [Bug: 6148]
+
+ * tests/string.test: extended string repeat tests
+ * generic/tclCmdMZ.c (Tcl_StringObjCmd): changed STR_REPEAT to
+ preallocate the full space of the final string, avoided repeated
+ 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.
+
+2000-09-05 Jeff Hobbs <hobbs@scriptics.com>
+
+ * generic/tclHash.c: fixed pedantic warning of incorrectly placed
+ #endif
+
+ * generic/tclExecute.c (TclExecuteByteCode): INST_STR_INDEX fixed
+ pedantic cast warning.
+ Corrected support for building with -DTCL_COMPILE_STATS.
+ Added efficiency check of object equality.
+
+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.
+
+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.
+
+ * 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.
+
+2000-08-24 Eric Melski <ericm@ajubasolutions.com>
+
+ * 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>
+
+ * unix/README: Update to account for removal of --enable-gcc.
+ * 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.
+
+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].
+
+ * doc/trace.n: Updated documentation for new syntax; flagged old
+ 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.
+
+ * generic/tclVar.c: Support for new trace syntax; support for
+ TCL_TRACE_ARRAY.
+
+ * generic/tclStubInit.c:
+ * generic/tclDecls.h:
+ * generic/tcl.decls: Stub functions for command rename/delete traces.
+
+ * generic/tcl.h:
+ * generic/tclInt.h:
+ * generic/tclBasic.c: Support for command traces.
+
+ * 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).
+
+2000-08-20 Eric Melski <ericm@ajubasolutions.com>
+
+ * generic/tclVar.c: Added check for non-arrays for [array statistics]
+ command (patch from Mark Patton).
+
+2000-08-19 David Gravereaux <davygrvy@ajubasolutions.com>
+
+ * generic/tclPlatDecls.h: without a previous '#include <windows.h>',
+ 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.
+
+2000-08-18 David Gravereaux <davygrvy@ajubasolutions.com>
+
+ * win/.cvsignore (added): provides a cleaner build environment with
+ graphical CVS clients.
+
+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].
+
+2000-08-14 Eric Melski <ericm@ajubasolutions.com>
+
+ * 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].
+
+ * generic/tcl.h: Added #include "tclPlatDecls.h" to get
+ 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/...).
+
+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].
+
+2000-08-10 Eric Melski <ericm@ajubasolutions.com>
+
+ * 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].
+
+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.
+
+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/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.
+
+2000-07-25 David Gravereaux <davygrvy@ajubasolutions.com>
+
+ * doc/Async.3:
+ * generic/tclAsync.c:
+ * generic/tclInt.decls:
+ * generic/tclIntPlatDecls.h:
+ * generic/tclStubInit.c:
+ * 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]
+
+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].
+
+ * 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.
+
+2000-07-23 Joe English <jenglish@flightlab.com>
+ * doc/AddErrInfo.3:
+ * doc/ChnlStack.3:
+ * doc/Exit.3:
+ * doc/GetIndex.3:
+ * doc/Notifier.3:
+ * doc/Object.3:
+ * doc/RegExp.3:
+ * doc/SetResult.3:
+ * doc/SplitList.3:
+ * doc/Thread.3: Added missing entries to NAME section.
+
+ * doc/AddErrInfo.3:
+ * doc/CrtObjCmd.3:
+ * doc/RecEvalObj.3: Changed Tcl_EvalObj to Tcl_EvalObjEx
+
+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:
+ * doc/Hash.3: Reapplied patch from Paul Duffin to extend hash tables
+ to allow custom key types, such as Tcl_Obj *'s, and others.
+
+ * doc/binary.n: Noted that the example in the introduction assumes a
+ 32-bit system [Bug: 6035].
+
+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,
+ 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.
+
+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.
+
+ * 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).
+
+ * win/makefile.vc: Applied patch from Don Porter to provide better
+ nmake support for NT/Alpha [RFE: 5938].
+
+2000-07-18 Mo DeJong <mdejong@redhat.com>
+
+ * 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.
+
+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]
+
+
+2000-07-18 Eric Melski <ericm@scriptics.com>
+
+ * 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]
+
+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.
+
+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.
+
+2000-07-13 André Pönitz <poenitz@mathematik.tu-chemnitz.de>
+
+ * doc/lappend.n:
+ * doc/lindex.n:
+ * doc/linsert.n:
+ * doc/list.n:
+ * doc/llength.n:
+ * doc/lrange.n:
+ * doc/lreplace.n:
+ * doc/lsearch.n:
+ * doc/lsort.n: Added SEE ALSO sections.
+
+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/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].
+
+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.
+
+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].
+
+2000-06-26 Eric Melski <ericm@scriptics.com>
+
+ * doc/package.n: Corrected information about [package forget]
+ arguments [Bug: 5418].
+
+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].
+
+ * 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
+ corrected an incorrect use of [string match].
+
+ * unix/tclConfig.sh.in:
+ * win/tclConfig.sh.in: Applied patch from [Bug: 5921], which corrects a
+ typo in the comments in these files.
+
+2000-06-19 Eric Melski <ericm@scriptics.com>
+
+ * doc/RegExp.3: Replaced instances of "Tcl_GetRegExpInfo" with
+ "Tcl_RegExpGetInfo", the correct name of the function [Bug: 5901].
+
+2000-06-13 Eric Melski <ericm@scriptics.com>
+
+ * win/tcl.m4:
+ * win/configure.in:
+ * 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.
+
+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.
+
+2000-05-31 Eric Melski <ericm@scriptics.com>
+
+ * generic/tclVar.c (Tcl_ArrayObjCmd): Added support for regexp and
+ exact matching for [array names] command. [RFE: 3684].
+
+ * doc/array.n: Added documentation for [array names
+ -exact/-regexp/-glob] [RFE: 3684].
+
+ * tests/set-old.test: Added tests for [array names
+ -exact/-regexp/-glob] [RFE: 3684].
+
+2000-06-06 Jeff Hobbs <hobbs@scriptics.com>
+
+ 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.
+
+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]
+
+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.
+
+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]
+
+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.
+
+ * 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/tclInt.h:
+ * 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
+ sizeof(Tcl_UniChar) multiplier.
+
+ * tests/string.test: added string map tests for the one-pair case,
+ corrected tests to reflect improved error messages in first/last.
+ Added tests against mem overrun in string index bytearray case.
+
+2000-05-23 Eric Melski <ericm@scriptics.com>
+
+ * 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/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.
+
+ (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.
+
+2000-05-22 Jeff Hobbs <hobbs@scriptics.com>
+
+ * doc/scan.n:
+ * doc/array.n: minor doc fixes [Bug: 5396]
+
+ * generic/tclEnv.c: cast cleanup [Bug: 5624]
+ * win/tclWinConsole.c: cast and header cleanup [Bug: 5625]
+ * win/tclWinSerial.c: cast cleanup [Bug: 5626]
+ * win/tclWinFCmd.c: cast cleanup [Bug: 5627]
+
+2000-05-19 Jeff Hobbs <hobbs@scriptics.com>
+
+ * generic/tclTest.c:
+ * generic/tclIO.c: moved channel test commands from tclIO.c to
+ tclTest.c.
+ * generic/tclIO.h: new file, split out from tclIO.c to allow test
+ commands to be moved to tclTest.c.
+
+ * 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.
+
+2000-05-18 Eric Melski <ericm@scriptics.com>
+
+ * tests/clock.test: Added test for "2 days 2 hours ago" style
+ specifications.
+
+ * 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].
+
+2000-05-18 Jeff Hobbs <hobbs@scriptics.com>
+
+ * win/{tcl.m4,Makefile.in,configure.in}: added support for mingw
+ compile env and cross-compiling. [Bug: 5499]
+
+ * 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]
+
+2000-05-17 Jeff Hobbs <hobbs@scriptics.com>
+
+ * library/init.tcl (auto_import): added check to see if a valid
+ pattern was coming in, to avoid simple error cases [Bug: 3326]
+
+ * doc/regsub.n: correct regsub docs [Bug: 5346]
+
+2000-05-15 Eric Melski <ericm@scriptics.com>
+
+ * library/history.tcl: Corrected an off-by-one error in HistIndex,
+ which was causing [history redo] to start its search at the wrong
+ event index. [Bug: 1269].
+
+2000-05-10 Jeff Hobbs <hobbs@scriptics.com>
+
+ * 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]
+
+ * 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.
+
+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.
+
+2000-05-09 Eric Melski <ericm@scriptics.com>
+
+ * tests/lsearch.test:
+ * doc/lsearch.n:
+ * generic/tclCmdIL.c (Tcl_LsearchObjCmd): Extended [lsearch] to
+ support sorted list searching and typed list searching. [RFE: 4098].
+
+2000-05-08 Jeff Hobbs <hobbs@scriptics.com>
+
+ * doc/expr.n:
+ * 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/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/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.
+
+ * generic/tclObj.c (Tcl_DuplicateObj): simplified code to call
+ TclInitStringRep, which the code was just duplicating in part.
+
+ * doc/Utf.3:
+ * generic/tclStubInit.c:
+ * generic/tcl.decls:
+ * generic/tclDecls.h:
+ * generic/tclUtf.c: Added new functions Tcl_UniCharNcasecmp and
+ Tcl_UniCharCaseMatch (unicode parallel to Tcl_StringCaseMatch)
+ * generic/tclUtil.c: rewrote Tcl_StringCaseMatch algorithm for
+ optimization and made Tcl_StringMatch just call Tcl_StringCaseMatch
+ * tests/string.test: extended string match tests
+
+2000-05-08 Eric Melski <ericm@scriptics.com>
+
+ * 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.
+
+2000-05-02 Jeff Hobbs <hobbs@scriptics.com>
+
+ * README:
+ * generic/tcl.h:
+ * library/init.tcl:
+ * library/reg1.0/pkgIndex.tcl:
+ * library/tcltest1.0/tcltest.tcl:
+ * mac/README:
+ * tools/tcl.hpj.in:
+ * tools/tcl.wse.in:
+ * unix/README:
+ * unix/configure.in:
+ * unix/tcl.spec:
+ * win/README:
+ * win/README.binary:
+ * win/configure.in:
+ * win/makefile.vc:
+ * win/tcl.m4: updated patchlevel to 8.4a1
+
+ * tests/compile.test:
+ * tests/init.test:
+ * tests/proc.test:
+ * tests/proc-old.test:
+ * tests/rename.test:
+ * generic/tclProc.c: reworked error return for procedures with
+ incorrect args to be like the C Tcl_WrongNumArgs, where a "wrong #
+ args: ..." message is printed out with the args list.
+
+ * unix/Makefile.in: add tclsh.ico and tcl.spec to dist target
+
+2000-05-02 Andreas Kupries <a.kupries@westend.com>
+
+ * 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.
+
+ * 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).
+
+ * 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).
+
+ * unix/tclUnixThread.c: Implemented Tcl_JoinThread using the
+ 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.
+
+ * 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.
+
+ * 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).
+
+ * 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.
+
+ * 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'.
+
+ * doc/CrtChannel.3: Added documentation for Tcl_IsChannelRegistered,
+ Tcl_IsChannelShared, Tcl_CutChannel, Tcl_SpliceChannel,
+ Tcl_IsChannelExisting and Tcl_ClearChannelHandlers.
+
+ * doc/Thread.3: Added documentation for Tcl_JoinThread.
+
+ * tests/thread.test: Added tests for joining of threads.
+
+2000-04-27 Eric Melski <ericm@scriptics.com>
+
+ * doc/library.n: Added entries for auto_qualify and auto_import
+ [Bug: 1271].
+
+ * doc/Init.3: Manual entry for Tcl_Init [Bug: 1820].
+
+ * doc/expr.n: Added documentation for each of the math library
+ functions that expr supports [Bug: 1054].
+
+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/TCL_MEM_DEBUG.3: Man page with overall information about
+ TCL_MEM_DEBUG usage.
+
+ * doc/DumpActiveMemory.3: Man page for Tcl_DumpActiveMemory,
+ Tcl_InitMemory, and Tcl_ValidateAllMemory [Bug: 1816, 1835].
+
+ * generic/tclCkalloc.c: Fixed some function headers.
+
+ * 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).
+
+ * 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].
+
+2000-04-26 Jeff Hobbs <hobbs@scriptics.com>
+
+ 8.3.1 RELEASE
+
+ * README:
+ * mac/README:
+ * tools/tcl.wse.in:
+ * unix/README:
+ * unix/tcl.spec:
+ * win/README:
+ * win/README.binary: Updating URLs to reference dev.scriptics.com
+
+2000-04-25 Jeff Hobbs <hobbs@scriptics.com>
+
+ * unix/Makefile.in:
+ * win/Makefile.in:
+ * win/makefile.vc: updated for http change and some cleanup
+ * library/http2.[13]: moved dir http2.1 to http2.3 to match version
+
+ * doc/Utf.3: clarified docs for Tcl_(UniChar|Utf)AtIndex
+
+ * unix/tclUnixThrd.c: removed {}s around PTHREAD_MUTEX_INITIALIZER
+ [Bug: 5254]
+
+ * unix/tclLoadDyld.c (TclpLoadFile): removed use of interp->result
+
+2000-04-25 Eric Melski <ericm@scriptics.com>
+
+ * unix/mkLinks:
+ * doc/AddErrInfo.3: Added information about Tcl_LogCommandInfo
+ [Bug: 1818].
+
+2000-04-24 Eric Melski <ericm@scriptics.com>
+
+ * unix/mkLinks:
+ * doc/OpenFileChnl.3: Added man entry for Tcl_Ungets [Bug: 1834].
+
+ * unix/mkLinks:
+ * doc/SourceRCFile.3: Man page for Tcl_SourceRCFile [Bug: 1833].
+
+ * 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]
+
+ * 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...
+ * 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
+ experimenting with MacTCP.
+
+2000-04-22 Jim Ingham <jingham@cygnus.com>
+
+ * library/package.tcl (tclPkgUnknown): Fixed a typo in the Mac package
+ search part of tclPkgUnknown.
+
+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).
+
+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.
+
+2000-04-20 Jeff Hobbs <hobbs@scriptics.com>
+
+ * generic/tclAlloc.c: wrapped caddr_t define to not be done on Unix
+ * unix/tclUnixPort.h: added Tclp*Alloc defines to allow the use of
+ USE_TCLALLOC on Unix. [Bug: 4731]
+
+2000-04-19 Jeff Hobbs <hobbs@scriptics.com>
+
+ * 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/Makefile.in: expanded cleanup target for help files
+
+ * doc/Thread.3: minor macro cleanup
+
+ * generic/tclFileName.c (SplitUnixPath): added support for QNX
+ node ids.
+
+2000-04-18 Jeff Hobbs <hobbs@scriptics.com>
+
+ * README:
+ * generic/tcl.h:
+ * tools/tcl.wse.in:
+ * unix/configure.in:
+ * unix/tcl.spec:
+ * win/configure.in:
+ * win/README.binary: bumped version to 8.3.1
+
+ * win/tcl.hpj.in: updated copyright date
+
+ * generic/tclEnv.c: environment support for Mac OS/X
+ * unix/tclUnixPort.h: environment support for Mac OS/X
+ * unix/tclLoadDyld.c: new file for Mac OS/X dl functions
+ * 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]
+
+ * generic/tclEvent.c (TclInitSubsystems): Moved tclLibraryPath to
+ thread-local storage to prevent thread-related race condition.
+ [Bug: 5033]
+ * unix/tclAppInit.c (main): removed #ifdef TCL_TEST that sets the
+ library path as it was unnecessary and conflicts with move of
+ tclLibraryPath to thread-local storage.
+
+2000-04-18 Scott Redman <redman@scriptics.com>
+
+ * 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.
+
+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.
+
+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]
+
+ * doc/AppInit.3:
+ * doc/Async.3:
+ * doc/BackgdErr.3:
+ * doc/CrtChannel.3:
+ * doc/CrtInterp.3:
+ * doc/CrtMathFnc.3:
+ * doc/DString.3:
+ * doc/Eval.3:
+ * doc/ExprLong.3:
+ * doc/GetInt.3:
+ * doc/GetOpnFl.3:
+ * doc/Interp.3:
+ * doc/LinkVar.3:
+ * doc/OpenFileChnl.3:
+ * doc/OpenTcp.3:
+ * doc/PkgRequire.3:
+ * doc/RecordEval.3:
+ * doc/SetResult.3:
+ * doc/SplitList.3:
+ * doc/StaticPkg.3:
+ * doc/TraceVar.3:
+ * doc/Translate.3:
+ * doc/UpVar.3:
+ * doc/load.n: removed or updated references to interp->result use.
+
+2000-04-13 Jeff Hobbs <hobbs@scriptics.com>
+
+ * doc/regexp.n: doc clarification [Bug: 5037]
+ * doc/update.n: typo fix [Bug: 4996]
+
+ * unix/tcl.m4 (SC_ENABLE_THREADS): enhanced the detection of
+ pthread_mutex_init [Bug: 4359] and (SC_CONFIG_CFLAGS) added
+ --enable-64bit-vis switch for Sparc VIS compilation [Bug: 4995]
+
+2000-04-12 Jeff Hobbs <hobbs@scriptics.com>
+
+ * doc/dde.n: corrected dde poke docs. [Bug: 4991]
+
+2000-04-11 Eric Melski <ericm@scriptics.com>
+
+ * win/tclWinPipe.c: Added "CONST" keyword to declaration of char
+ *native in TclpCreateTempFile, to supress compiler warnings.
+
+2000-04-10 Brent Welch <welch@scriptics.com>
+
+ * 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
+
+2000-04-10 Eric Melski <ericm@scriptics.com>
+
+ * 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].
+
+ * tests/*.test: Changed all occurances of "namespace import
+ ::tcltest" to "namespace import -force ::tcltest" [Bug: 3948].
+
+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.
+
+2000-04-09 Jeff Hobbs <hobbs@scriptics.com>
+
+ * tests/reg.test (matchexpected): corrected tests to use tcltest
+ constraint types to skip certain tests.
+
+ * 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).
+
+2000-04-08 Andreas Kupries <a.kupries@westend.com>
+
+ * Overall change: Definition of a public API for the creation of
+ 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.
+
+ * 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.
+
+ * win/tclWinThrd.c:
+ * mac/tclMacThrd.c: Renamed TclpThreadCreate to Tcl_CreateThread,
+ 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.
+
+ * generic/tclThreadTest.c (line 363): See below.
+
+ * 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).
+
+ * 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]
+
+ * 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.
+
+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: ??].
+
+2000-03-04 Brent Welch <welch@scriptics.com>
+
+ * {win,unix}/Makefile.in: added dependency of tclStubInit.c on
+ tcl.decls and tclInt.decls
+ * generic/tclThread.c: Tweak so this compiles w/out TCL_THREADS
+ * generic/{tcl.decls,tclStubInit.c}: Just touched the tcl.decls and
+ regenerated the tclStubInit.c file
+
+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.
+
+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].
+
+ * generic/tclInt.h: Removed definitions of TclFinalizeMutex and
+ TclFinalizeCondition.
+
+ * 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/tclNotify.c: Changed usage of TclFinalizeMutex to
+ Tcl_MutexFinalize.
+
+ * 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.
+
+ * 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]
+
+ * tests/foreach.test:
+ * tests/namespace.test:
+ * tests/var.test: Added lsorts to avoid random sorted return
+ problems. [Bug: 2682]
+
+ * tests/fileName.test: fixed 14.1 test fragility [Bug: 1482]
+
+ * tools/man2help2.tcl: fixed winhelp cross-linking error [Bug: 4156]
+ improved translation to winhelp [Bug: 3679]
+
+ * unix/Makefile.in (MAN_INSTALL_DIR): patch to accept --mandir
+ correctly [Bug: 4085]
+
+ * unix/dltest/pkg[a-e].c: Cleaned up test packages [Bug: 2293]
+
+2000-04-03 Eric Melski <ericm@scriptics.com>
+
+ * 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].
+
+ * 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].
+ (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.)
+
+2000-03-30 Jeff Hobbs <hobbs@scriptics.com>
+
+ * generic/tclBasic.c (Tcl_DeleteCommandFromToken): Added comments
+ noting the need to pair ckalloc with ckfree. [Bug: 4262]
+
+ * generic/tclInt.decls:
+ * generic/tclIntPlatDecls.h:
+ * generic/tclStubInit.c:
+ * win/tclWin32Dll.c: removed TclWinSynchSpawn (vestige of Win32s
+ support).
+
+ * win/tclWinReg.c: made use of TclWinGetPlatformId instead of
+ getting info again
+
+ * win/tclWinPort.h:
+ * win/Makefile.in:
+ * win/configure.in:
+ * win/tcl.m4: Added support for gcc/mingw on Windows [Bug: 4234]
+
+2000-03-29 Jeff Hobbs <hobbs@scriptics.com>
+
+ * generic/tclCompile.c (TclCleanupByteCode): made ByteCode cleanup
+ more aware of TCL_BYTECODE_PRECOMPILED flagged structs (gen'd by
+ tbcload), to correctly clean them up.
+
+ * generic/tclClock.c (FormatClock): moved check for empty format
+ earlier, commented 0 result return value
+
+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.
+
+2000-03-27 Jeff Hobbs <hobbs@scriptics.com>
+
+ * tests/httpd: removed unnecessary 'puts stderr "Post Dispatch"'
+
+ * 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.
+
+ * 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/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.
+
+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.
+
+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.
+
+ * 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).
+
+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.
+
+ * 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".
+
+ * 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).
+
+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.
+
+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.
+
+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
+
+ * 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]
+
+ * 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.
+ Previously it would fail to recognize 000000 as an ISO base.
+
+2000-02-14 Eric Melski <ericm@scriptics.com>
+
+ * unix/Makefile.in: Added rpm target to generate Tcl binary RPM.
+
+ * unix/tcl.spec: RPM specification file for a Tcl binary RPM for
+ Linux.
+
+2000-02-10 Jeff Hobbs <hobbs@scriptics.com>
+
+ 8.3.0 RELEASE
+
+ * changes: updated for 8.3.0 release
+
+ * 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
+
+ * 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]
+
+ * 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
+ 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...
+
+ 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/tclGetDate.y (Message): Added a grammar rule for "next
+ monthname" so that we can handle "next january" and similar
+ constructs (bug #4146).
+
+2000-02-08 Jeff Hobbs <hobbs@scriptics.com>
+
+ * README:
+ * tools/tcl.wse.in:
+ * unix/configure.in:
+ * win/configure.in:
+ * win/README:
+ * win/README.binary:
+ * generic/tcl.h (TCL_RELEASE_SERIAL): Moved to 8.3.0 patchlevel
+
+ * doc/library.n:
+ * library/auto.tcl: fixed crufty puts code and docs [Bug: 4122]
+
+ * library/tcltest1.0/tcltest.tcl: correctly protected searchDirectory
+ list to allow dirnames with spaces
+
+ * unix/tcl.m4: changed all -fpic to -fPIC
+
+ * generic/tclDecls.h:
+ * generic/tcl.decls: change Tcl_GetOpenFile to use decl of 'int
+ forWriting' instead of 'int write' to avoid shadowing [Bug: 4121]
+
+ * 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]
+
+ * 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:
+ * 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
+ 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
+
+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.
+
+2000-02-01 Jeff Hobbs <hobbs@scriptics.com>
+
+ * win/Makefile.in (install-*): reduced verbosity of install
+
+ * generic/tclFileName.c (Tcl_JoinPath): improved support for special
+ QNX node id prefixes in pathnames [Bug: 4053]
+
+ * library/http1.0/http.tcl:
+ * library/http2.1/http.tcl: The query data POSTed was newline
+ terminated when it shouldn't be altered [Bug: 4089]
+
+2000-01-31 Eric Melski <ericm@scriptics.com>
+
+ * 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/auto.tcl: "Fixed" issues with $ in files to be auto indexed.
+
+ * doc/Package.n: New man page for package::create function.
+
+ * doc/pkgMkIndex.n: Added additional information.
+
+ * doc/library.n: Added additional qualification regarding auto_mkindex.
+
+2000-01-28 Eric Melski <ericm@scriptics.com>
+
+ * 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).
+
+ * 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).
+
+ * 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).
+
+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.
+
+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.
+ * 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:
+ * 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.
+ 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).
+
+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/info.n: Added further information about differences between
+ "namespace which" and "info exists".
+
+ * doc/SetErrno.3: Added descriptions of ErrnoId() and ErrnoMsg()
+ functions.
+
+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]
+
+ * 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/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]
+
+ * doc/glob.n: clarified Mac path separator determination docs.
+
+ * win/makefile.vc: added some support for building helpfile on Windows
+
+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]
+
+ * 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]
+
+ * 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]
+ and removed 'register' from stub definition of
+ Tcl_AppendUnicodeToObj [Bug: 4038]
+
+2000-01-21 Eric Melski <ericm@scriptics.com>
+
+ * unix/mkLinks:
+ * doc/GetHostName.3: Man page for Tcl_GetHostName (bug #1817).
+
+ * doc/lreplace.n: Corrected man page with respect to treatment of
+ empty lists, and "prettied up" the page. (bug #1705).
+
+2000-01-20 Eric Melski <ericm@scriptics.com>
+
+ * tests/namespace.test: Added test for undefined variables with
+ namespace which (bug #956).
+
+ * generic/tclNamesp.c: Added check for undefined variables in
+ NamespaceWhichCmd (bug #956).
+
+ * 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).
+
+ * 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).
+
+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/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
+
+ * unix/tclUnixNotfy.c (Tcl_InitNotifier): added cast for tsdPtr
+
+ * tests/set.test: added test for complex array elem name compiling
+ * generic/tclCompCmds.c (TclCompileSetCmd): Fixed parsing of array
+ elements during compiling, and slightly optimised same [Bug: 3889]
+
+ * doc/tclvars.n: added definitions for tcl_(non)wordchars
+
+ * 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
+
+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.
+
+ * unix/tclUnixTime.c: New clock format format.
+
+ * compat/strftime.c: New clock format format.
+
+ * generic/tclGetDate.y: New clock scan format.
+
+2000-01-13 Jeff Hobbs <hobbs@scriptics.com>
+
+ * changes: updated changes file to reflect 8.3b2 mods
+
+ * README:
+ * generic/tcl.h:
+ * tools/tcl.wse.in:
+ * unix/configure.in:
+ * unix/tcl.m4:
+ * win/README.binary:
+ * win/configure.in: updated to patchlevel 8.3b2
+
+ * generic/regexec.c: added var initialization to prevent compiler
+ warning
+
+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.
+
+ * 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.
+
+2000-01-12 Eric Melski <ericm@scriptics.com>
+
+ * tests/clock.test: Added tests for "next <day-of-week>" and
+ "<day-of-week>"
+ Added tests for "monday 1 week ago", etc, from RFE #3671.
+
+ * doc/tests/clock.test: Added numerous tests for clock scan.
+
+ * 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.
+
+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]
+
+ * generic/tclClock.c: fixed support for 64bit handling of clock
+ values [Bug: 1806]
+
+ * generic/tclThreadTest.c: upped a buffer size to hold double
+
+ * tests/info.test:
+ * generic/tclCmdIL.c: fixed 'info procs ::namesp::*' behavior (Dejong)
+
+ * generic/tclNamesp.c: made imported commands also import their
+ compile proc [Bug: 2100]
+
+ * 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
+ 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]
+
+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/tclDate.c: Fixed compiler warning issues.
+
+2000-01-10 Jeff Hobbs <hobbs@scriptics.com>
+
+ * 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/tcl.h: noted need to change win/tcl.m4 and
+ tools/tclSplash.bmp for minor version changes
+
+ * library/http2.1/http.tcl: trim value for $state(meta) key
+
+ * unix/tclUnixFile.c: fixed signature style on functions
+
+ * unix/Makefile.in: made sure tcl.m4 would be installed with dist
+
+ * unix/tcl.m4: added ELF support for NetBSD [Bug: 3959]
+
+2000-01-10 Eric Melski <ericm@scriptics.com>
+
+ * generic/tclGetDate.y: Added rules for ISO 8601 formats (BUG #847):
+ CCYY-MM-DD
+ CCYYMMDD
+ YY-MM-DD
+ YYMMDD
+ CCYYMMDDTHHMMSS
+ CCYYMMDD HHMMSS
+ CCYYMMDDTHH:MM:SS
+ Fixed "clock scan <number>" to scan the number as an hour for the
+ current day, rather than a minute after 00:00 for the current day
+ (bug #2732).
+
+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).
diff --git a/tcl/ChangeLog.2001 b/tcl/ChangeLog.2001
new file mode 100644
index 00000000000..2c8b4d7f2e1
--- /dev/null
+++ b/tcl/ChangeLog.2001
@@ -0,0 +1,3738 @@
+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.
+
+2001-12-28 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCkalloc.c (MemoryCmd, TclFinalizeMemorySubsystem):
+ Added the [memory onexit] command, intended to replace [checkmem].
+
+ * doc/DumpActiveMemory.3:
+ * doc/memory.n: Updated documentation for [memory] and related
+ 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.
+
+ * generic/tclBinary.c:
+ * generic/tclListObj.c:
+ * generic/tclObj.c:
+ * generic/tclStringObj.c: Removed references to [checkmem] in
+ comments, referencing [memory active] instead, since it is
+ documented.
+
+2001-12-28 Daniel Steffen <das@users.sourceforge.net>
+
+ * 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.
+ * mac/tclMacApplication.r:
+ * mac/tclMacLibrary.r:
+ * mac/tclMacOSA.r:
+ * mac/tclMacResource.r: minor version resources cleanup
+
+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]
+
+2001-12-21 Daniel Steffen <das@users.sourceforge.net>
+
+ * 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: 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]
+
+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).
+
+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]
+
+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.
+
+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.
+
+2001-12-19 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * 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/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/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/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.
+
+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.
+
+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.
+
+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...
+
+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.
+
+2001-12-12 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * doc/Preserve.3: doc'd TCL_DYNAMIC use. [Patch #483989] (porter)
+
+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.
+
+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: 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].
+
+2001-12-10 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ * 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].
+
+2001-12-10 Don Porter <dgp@users.sourceforge.net>
+
+ * doc/Access.3:
+ * doc/CrtChannel.3:
+ * doc/DString.3:
+ * doc/ExprLong.3:
+ * doc/FileSystem.3:
+ * doc/GetStdChan.3:
+ * doc/OpenFileChnl.3:
+ * doc/StdChannels.3:
+ * doc/TCL_MEM_DEBUG.3:
+ * doc/Tcl_Main.3:
+ * 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]
+ * unix/mkLinks: 'make mklinks'
+
+2001-12-10 Miguel Sofer <msofer@users.sourceforge.net>
+
+ * generic/tclCompCmds.c:
+ * generic/tclCompExpr.c:
+ * 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].
+
+2001-12-07 Miguel Sofer <msofer@users.sourceforge.net>
+
+ * generic/tclVar.c:
+ * tests/trace.test: restored consistency in refCount accounting by
+ array traces [Bug #4484339], submitted by Don Porter.
+
+2001-12-06 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * tests/parseExpr.test, tests/for.test, tests/expr.test:
+ * tests/expr-old.test, tests/compile.test, tests/compExpr.test
+ * tests/compExpr-old.test: Kept up to date with syntax errors.
+ * 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.
+
+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].
+
+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/while.test, tests/if.test: Rewrite to handle more specific
+ syntax errors.
+ * tests/parseExpr.test: Rewrite to get rid of dup test numbers and
+ handle more specific syntax errors.
+ * generic/tclParseExpr.c (LogSyntaxError): Added a detail message
+ 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.
+
+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.
+
+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.
+
+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
+
+2001-11-29 Miguel Sofer <msofer@users.sourceforge.net>
+
+ * tests/namespace.test: modified namespace-41.2, added 41.3
+ {knownbug} after discussion with Don Porter and Kevin Kenny.
+
+2001-11-29 Miguel Sofer <msofer@users.sourceforge.net>
+
+ * tests/namespace.test: added namespace-41.2, a simpler test for
+ [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.
+
+2001-11-28 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * doc/regsub.n, doc/regexp.n: Converted dangling references to
+ METASYNTAX section into references to the re_syntax manual page.
+
+2001-11-27 D. Richard Hipp <drh@hwaci.com>
+
+ * win/tclWinFCmd.c: Fix a coredump in the filename normalizer
+ code for Win95/98.
+
+2001-11-27 David Gravereaux <davygrvy@pobox.com>
+
+ * win/makefile.vc: Removed the Tk reference for the 'winhelp' target.
+ Converge at install will need to be the solution for Tk and all other
+ extensions.
+
+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.]
+
+ * 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.
+
+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.
+
+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.
+
+2001-11-23 Daniel Steffen <das@users.sourceforge.net>
+
+ * unix/Makefile.in:
+ * unix/configure.in:
+ * unix/install-sh:
+ * unix/mkLinks:
+ * 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)
+
+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)
+
+ * 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
+ 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
+ resource compiler (note that *.r files include tcl.h)
+
+ * 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/tclMacInt.h:
+ * generic/tclInt.h:
+ * mac/tclMacTime.c:
+ * generic/tclIOUtil.c: moved declaration of TclpGetGMTOffset()
+
+ * mac/tclMacShLib.exp:
+ * mac/tclMacOSA.exp:
+ * mac/tclMacMSLPrefix.h: removed files
+
+ * unix/Makefile.in: removed reference to .exp files
+
+ * mac/MW_TclBuildLibHeader.h:
+ * mac/MW_TclBuildLibHeader.pch:
+ * mac/MW_TclHeaderCommon.h:
+ * mac/MW_TclStaticHeader.h:
+ * mac/MW_TclStaticHeader.pch: new precompiled header files
+
+ * mac/MW_TclAppleScriptHeader.pch:
+ * mac/MW_TclHeader.pch:
+ * mac/MW_TclTestHeader.pch:
+ * mac/tclMacCommonPch.h: revised precompiled header handling: now
+ include a common header file 'MW_TclHeaderCommon.h' from all .pch
+ files, the .pch files themselves now only setup #defines (e.g.
+ BUILD_tcl, STATIC_BUILD, TCL_DEBUG, TCL_THREADS) like in makefiles on
+ other platforms.
+
+ * mac/tclMac.h:
+ * mac/tclMacPort.h:
+ * mac/tclMacInt.h: use of BUILD_tcl and TCL_STORAGE_CLASS like on other
+ platforms, standardize #include'd files to what's done on other
+ platforms, removed use of #pragma export.
+
+ * mac/tcltkMacBuildSupport.sea.hqx: new archive of mac build support
+ 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.
+ included XML versions of the projects for CW Pro5 or Pro7 users.
+
+ * mac/tclMacProjects.sea.hqx: updated mac build project files:
+ build support for CodeWarrior Pro6, UnivIntf 3.4 & shared runtime
+ libraries: the MSL libraries and MoreFiles are no longer compiled into
+ Tcl.shlb, all non-static binaries now use the Pro6 shared runtime
+ libraries and MoreFiles.shlb. These shlbs are merged into the standard
+ Wish and TclShell, but 3rd party applications linking with Tcl.shlb or
+ Tk.shlb need to setup access to them. (see the "(sh-ppc)" targets
+ for how to do this.)
+ included XML versions of the projects for CW Pro5 or Pro7 users.
+ use compat/strtod.c instead of MSL's strtod()
+ use WASTE versions of MSL for tcl test target to avoid text buffer
+ cutoff at 32k.
+ Merging the full MSL.shlb and the other shlbs into Wish & TclShell
+ makes them a bit larger than before, use unmerged binaries to avoid
+ copying the shared code with every application, e.g. when deploying
+ numerous Wish based droplets.
+ Note that using CW Pro5 to compile extensions is in principle still
+ possible, but need to link with Pro6 runtime libraries.
+ Tclapplescript now loads and runs on CFM68k.
+ 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.
+ 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
+ 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
+ uncarbonized code in Tcl.shlb and TclShell.
+
+ * generic/tclMain.c: MAC_TCL: workaround for broken/non-standard isatty
+ on MW Pro6, #include <unistd.h> instead of defining isatty
+
+ * mac/tclMacPort.h: MW Pro6 changes for MSL fcntl.h, stat.h & isatty
+
+ * mac/tclMacAppInit.c: add EXTERN to InstallConsole to enable DLL
+ export via the TCL_STORAGE_CLASS mechanism.
+
+ * mac/tclMacFCmd.c: fix for FSpDirectoryCopy API change
+
+ * mac/tclMacLibrary.c: emit compile time error when
+ TCL_REGISTER_LIBRARY and USE_TCL_STUBS are both defined at the same
+ time in an extension, this use is not currently supported and will
+ result in a crash when dynamically loading the extension.
+
+ * mac/tclMacApplication.r:
+ * mac/tclMacLibrary.r:
+ * mac/tclMacOSA.r:
+ * mac/tclMacResource.r: fixed obsolete copyrights/dates in version
+ 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.
+
+ * mac/tclMacChan.c:
+ * mac/tclMacSock.c: cast for *BlockMode
+
+ * mac/tclMacUtil.c:
+ * mac/tclMacMath.h: removed obsolete hypot() definition
+
+ * generic/tclIntPlatDecls.h:
+ * generic/tclInt.decls:
+ * generic/tclStubInit.c:
+ * mac/tclMacNotify.c:
+ * mac/tclMacOSA.c:
+ * mac/tclMacUtil.c:
+ * generic/tclThreadTest.c: renamed routines conflicting with standard
+ Apple or MoreFiles headers (at compile or link time):
+ GetGlobalMouse -> GetGlobalMouseTcl
+ FSpGetDirectoryID -> FSpGetDirectoryIDTcl
+ FSpOpenResFileCompat -> FSpOpenResFileCompatTcl
+ FSpCreateResFileCompat -> FSpCreateResFileCompatTcl
+ NewThread -> NewTestThread
+ the renamed MoreFiles *Tcl routines are just wrappers calling into the
+ MoreFiles DLL.
+
+ * mac/tclMacCommonPch.h:
+ * mac/tclMacThrd.c:
+ * mac/tclMacPanic.c: removed OLDROUTINENAMES define, renamed obsolete
+ apple API names to modern equivalents; UH3.4 support: added #include
+ <ControlDefinitions.h>, updated New*Proc() calls to New*UPP().
+
+ * 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/tclMacTime.c:
+ * mac/tclMacPort.h:
+ * 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.
+
+ * 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
+ atime touch test
+
+ * tests/appendComp.test:
+ * tests/cmdMZ.test:
+ * tests/compile.test:
+ * tests/exec.test:
+ * 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.
+
+ * 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]
+
+2001-11-20 Kevin B. Kenny <kennykb@users.sourceforge.net>
+
+ * doc/GetTime.3 (Tcl_GetTime):
+ * generic/tcl.decls (Tcl_GetTime):
+ * generic/tclClock.c (Tcl_ClockObjCmd):
+ * generic/tclCompile.c (TclCleanupByteCode, TclInitByteCodeObj):
+ * generic/tclCmdMZ.c (Tcl_TimeObjCmd):
+ * generic/tclUtil.c (TclpGetTime):
+ * generic/tclTest.c (GetTimesCmd):
+ * generic/tclTimer.c (Tcl_CreateTimerHandler, TimerSetupProc,
+ TimerCheckProc, TimerHandlerEventProc):
+ * mac/tclMacNotify.c (Tcl_SetTimer):
+ * mac/tclMacShLib.exp (Tcl_GetTime):
+ * mac/tclMacTime.c (Tcl_GetTime):
+ * unix/tclUnixChan.c (TclUnixWaitForFile):
+ * unix/tclUnixEvent.c (Tcl_Sleep):
+ * unix/tclUnixThrd.c (Tcl_ConditionWait):
+ * unix/tclUnixTime.c (Tcl_GetTime):
+ * 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]
+
+ * 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]
+
+ * 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/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.
+
+2001-11-20 Miguel Sofer <msofer@users.sourceforge.net>
+
+ * generic/tclBasic.c
+ * 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.
+
+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
+
+2001-11-20 Miguel Sofer <msofer@users.sourceforge.net>
+
+ * generic/tclExecute.c: missing variable declaration under
+ 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).
+
+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)
+
+ * 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>
+
+ * win/buildall.vc.bat: Added useful comments.
+
+2001-11-19 Miguel Sofer <msofer@users.sourceforge.net>
+
+ * tests/compile.test: added a test for bug [Bug 483309]
+
+2001-11-19 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * win/tclWinFile.c:
+ * 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.
+
+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,
+ Tcl_EvalObjv, Tcl_LogCommandInfo, Tcl_EvalTokensStandard,
+ Tcl_EvalTokens, Tcl_EvalEx, Tcl_Eval, Tcl_EvalObj and
+ 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...
+
+ * 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.
+
+ * doc/TraceVar.3: Added documentation for change due to TIP#68.
+
+ * 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
+ management subsystem.
+ (TclTraceCommandObjCmd, TraceCommandProc): Removed references to
+ errMsg field which was never used in command traces in any case.
+ (Tcl_TraceObjCmd, TclTraceVariableObjCmd): Removed references to
+ 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/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.
+
+2001-11-19 Miguel Sofer <msofer@users.sourceforge.net>
+
+ * generic/tclCompCmds.c: patch for [Bug 483309] (petasis).
+
+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.
+
+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)
+
+ * unix/tclUnixInit.c: added HAVE_LANGINFO code block.
+ * unix/configure: regened
+ * unix/configure.in: added SC_ENABLE_LANGINFO call
+ * 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)
+
+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.
+
+2001-11-16 Miguel Sofer <msofer@users.sourceforge.net>
+
+ * generic/tclBasic.c:
+ * generic/tclCompile.h:
+ * generic/tclExecute.c:
+ * 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]
+
+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.
+
+2001-10-17 Kevin B. Kenny <kennykb@users.sourceforge.net>
+
+ * doc/lappend.n:
+ * doc/lindex.n:
+ * doc/linsert.n:
+ * doc/list.n:
+ * doc/llength.n:
+ * doc/lrange.n:
+ * doc/lsearch.n:
+ * doc/lset.n (new-file):
+ * doc/lsort.n:
+ * generic/tclBasic.c (builtInCmds, Tcl_EvalObjEx):
+ * generic/tclCmdIL.c (Tcl_LindexObjCmd, Tcl_LindexList):
+ (Tcl_LindexFlat, Tcl_LsetObjCmd):
+ * generic/tclCompCmds.c (Tcl_CompileLindexCmd, Tcl_CompileLsetCmd):
+ * generic/tclCompile.c:
+ * generic/tclCompile.h:
+ * generic/tclExecute.c (TclExecuteByteCode):
+ * generic/tclInt.decls:
+ * generic/tclInt.h:
+ * generic/tclIntDecls.h:
+ * generic/tclListObj.c (TclLsetList, TclLsetFlat, TclSetListElement):
+ * generic/tclObj.c (TclInitObjSubsystem):
+ * generic/tclStubInit.c:
+ * generic/tclTestObj.c (TestobjCmd):
+ * generic/tclUtil.c (TclGetIntForIndex, SetEndOffsetFromAny):
+ * generic/tclVar.c (Tcl_LappendObjCmd):
+ * tests/lindex.test:
+ * tests/lset.test (new-file):
+ * tests/lsetComp.test (new-file):
+ * 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)
+
+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.
+
+2001-11-12 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * doc/FileSystem.3:
+ * doc/file.n:
+ * doc/tcltest.n: converted use of \' to more reasonable format.
+
+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.
+
+2001-11-10 David Gravereaux <davygrvy@pobox.com>
+
+ * win/makefile.vc: Added a check to make sure one runs the makefile
+ from the /win directory only.
+
+ * win/mkd.bat:
+ * win/rmd.bat: Changes from Llyod Lim for better stability.
+ [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.
+
+ Sticky-points left: 'profile' option.
+
+2001-11-09 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * doc/FileSystem.3:
+ * doc/StdChannels.3:
+ * doc/file.n:
+ * doc/tcltest.n:
+ * tools/man2help.tcl:
+ * tools/man2help2.tcl: fixed winhelp generation problems
+ [Patch #480268]
+
+ * unix/configure:
+ * unix/tcl.m4: added -lc to AIX libs, fixed path to ldAix
+
+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]
+
+2001-11-08 Mo DeJong <mdejong@users.sourceforge.net>
+
+ Fixup stack size under OSF1. [Tcl patch 474790]
+
+ * unix/configure: Regen.
+ * 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]
+
+ * 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.
+
+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.
+
+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/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
+ 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]
+
+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]
+
+ * unix/configure: Regen.
+ * unix/configure.in: Define TCL_INCLUDE_SPEC.
+ * unix/tclConfig.sh.in: Define TCL_INCLUDE_SPEC.
+ * win/configure: Regen.
+ * win/configure.in: Define TCL_INCLUDE_SPEC.
+ * win/tclConfig.sh.in: Define TCL_INCLUDE_SPEC.
+
+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.
+
+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/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.
+
+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.
+
+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:
+
+ 1) winhelp target shows errors in the converting script.
+ 2) .rc scripts aren't getting the right #defines to build the correct
+ "OriginalFilename" strings. (have patch, won't commit yet)
+ 3) Naming convention with suffixes describing the buildtype are 'tsdx'
+ which will need public acceptance. ie. tclsh84tsx.exe is a (t)
+ threaded shell (s) statically linked to the core and (x) uses
+ msvcrt instead of libcmt.
+
+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.
+
+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.
+
+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/tclWin32Dll.c
+ * 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]
+
+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]
+
+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.
+
+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)
+
+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)
+
+2001-10-18 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * 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)
+
+2001-10-16 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * 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>
+
+ * 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".
+
+ * 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
+
+ * generic/tclFileName.c: minor code cleanup
+
+ * 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)
+
+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)
+
+ * library/encoding/tis-620.enc:
+ * tools/encoding/tis-620.txt: TIS-620 charset mapping.
+ [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/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...
+
+2001-10-10 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/unixInit.test: Corrected restore of ::env(LANG).
+
+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.
+
+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.
+
+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)
+
+2001-10-04 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * tools/configure:
+ * tools/configure.in: noted 8.4 as default Tcl version
+
+ * library/encoding/cp936.enc:
+ * library/encoding/cp949.enc:
+ * library/encoding/cp950.enc:
+ * library/encoding/iso8859-16.enc:
+ * library/encoding/macCroatian.enc:
+ * library/encoding/macCyrillic.enc:
+ * library/encoding/macGreek.enc:
+ * library/encoding/macIceland.enc:
+ * library/encoding/macRoman.enc:
+ * library/encoding/macTurkish.enc:
+ * tools/encoding/cp1250.txt:
+ * tools/encoding/cp1251.txt:
+ * tools/encoding/cp1252.txt:
+ * tools/encoding/cp1253.txt:
+ * tools/encoding/cp1254.txt:
+ * tools/encoding/cp1255.txt:
+ * tools/encoding/cp1256.txt:
+ * tools/encoding/cp1257.txt:
+ * tools/encoding/cp1258.txt:
+ * tools/encoding/cp874.txt:
+ * tools/encoding/cp932.txt:
+ * tools/encoding/cp936.txt:
+ * tools/encoding/cp949.txt:
+ * tools/encoding/cp950.txt:
+ * tools/encoding/iso8859-1.txt:
+ * tools/encoding/iso8859-10.txt:
+ * tools/encoding/iso8859-13.txt:
+ * tools/encoding/iso8859-14.txt:
+ * tools/encoding/iso8859-15.txt:
+ * tools/encoding/iso8859-16.txt:
+ * tools/encoding/iso8859-2.txt:
+ * tools/encoding/iso8859-3.txt:
+ * tools/encoding/iso8859-4.txt:
+ * tools/encoding/iso8859-5.txt:
+ * tools/encoding/iso8859-6.txt:
+ * tools/encoding/iso8859-7.txt:
+ * tools/encoding/iso8859-8.txt:
+ * tools/encoding/iso8859-9.txt:
+ * tools/encoding/koi8-r.txt:
+ * tools/encoding/macCentEuro.txt:
+ * tools/encoding/macCroatian.txt:
+ * tools/encoding/macCyrillic.txt:
+ * tools/encoding/macGreek.txt:
+ * 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.
+
+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.
+
+2001-10-01 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * win/configure: regen'ed
+ * win/tcl.m4:
+ * win/makefile.vc: added Win64 SDK RC1 compilation support
+ * win/Makefile.in: added $(LDFLAGS_CONSOLE) to TCLSH, TCLTEST and
+ PIPE_DLL_FILE targets to get the link flags
+
+ * win/tclWinInit.c: minor 64bit casts
+
+2001-10-01 Miguel Sofer <msofer@users.sourceforge.net>
+
+ * 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.
+
+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.
+
+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]
+
+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.
+
+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]
+ * 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.
+ * generic/tclIO.c: added '(ClientData)' cast to calls to
+ Tcl_(Preserve|Release) newly introduced, fixing compile
+ error on Windows.
+
+2001-09-27 Don Porter <dgp@users.sourceforge.net>
+
+ * doc/FileSystem.3 (Tcl_FSLoadFile):
+ * generic/tcl.decls (Tcl_FSLoadFile):
+ * generic/tcl.h (Tcl_FSLoadFileProc):
+ * generic/tclInt.h (TclpLoadFile):
+ * generic/tclIOUtil.c (Tcl_FSLoadFile):
+ * generic/tclLoadNone.c (TclpLoadFile):
+ * generic/tclTest.c (TestReportLoadFile):
+ * library/ldAout.tcl:
+ * mac/tclMacLoad.c (TclpLoadFile):
+ * unix/tclLoadAix.c (TclpLoadFile):
+ * unix/tclLoadAout.c (TclpLoadFile):
+ * unix/tclLoadDl.c (TclpLoadFile):
+ * unix/tclLoadDld.c (TclpLoadFile):
+ * unix/tclLoadDyld.c (TclpLoadFile):
+ * unix/tclLoadNext.c (TclpLoadFile):
+ * unix/tclLoadOSF.c (TclpLoadFile):
+ * 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]
+
+ * 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/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}):
+ * 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/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 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.
+
+ * generic/tclDecls.h: make genstubs
+
+2001-09-25 Don Porter <dgp@users.sourceforge.net>
+
+ * doc/GetInt.3:
+ * 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/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.
+
+2001-09-24 Don Porter <dgp@users.sourceforge.net>
+
+ * doc/Concat.3:
+ * doc/DString.3:
+ * doc/SplitList.3:
+ * generic/tclInt.h (TclCheckBadOctal):
+ * generic/tcl.decls:
+ * generic/tclInt.decls:
+ * 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]
+
+ * 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'.
+
+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].
+
+ * 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.
+
+2001-09-20 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * win/tclWinInit.c: added extra processor definitions. (mstacy)
+
+ * win/tclWinSock.c (SocketThread): corrected pointer cast for _WIN64.
+
+ * win/tclWinNotify.c: removed unnecessary winsock include (it is
+ 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.
+
+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]
+
+2001-09-19 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tclTest.c (TestcmdtokenCmd): corrected pointer
+ 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)
+
+ * unix/configure: regen'ed
+ * 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
+
+ * tests/winFCmd.test: simplified error check for winFCmd-7.9
+
+ * 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):
+ * generic/tclCompile.c (instructionTable):
+ * generic/tclCompCmds.c (TclCompileStringCmd): INST_STR_MATCH -
+ Updated to Int1 instruction type and added special case to use
+ INST_STR_EQ instead when no glob chars are specified in a static
+ string.
+
+ * 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)
+
+2001-09-19 Miguel Sofer <msofer@users.sourceforge.net>
+
+ * 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.
+
+ * 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. ]
+
+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.
+
+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]
+
+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.
+
+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.
+
+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]
+
+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.
+
+2001-09-13 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ * win/Makefile.in:
+ * win/configure.in:
+ * 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.
+
+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]
+
+ * 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]
+
+ * ChangeLog.1999:
+ * ChangeLog: broke changes from 199x into ChangeLog.1999 to reduce
+ 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.
+
+2001-09-13 Miguel Sofer <msofer@users.sourceforge.net>
+
+ * 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
+ evaluations; the deprecated function could only return TCL_OK or
+ 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]
+
+2001-09-12 Don Porter <msofer@users.sourceforge.net>
+
+ * tests/appendComp.test:
+ * 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]
+
+2001-09-12 Miguel Sofer <msofer@users.sourceforge.net>
+
+ * generic/tcl.decls: reserved stub #481 for the implementation of
+ [TIP 56]
+
+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].
+
+ * The changes below are a fix for [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.
+
+ * 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)
+
+ * tests/stack.test:
+ * generic/tclInterp.c (AliasObjCmd): Check the numLevels to ensure
+ 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]
+
+2001-09-10 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ * doc/tclsh.1:
+ * 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.
+
+ * doc/StdChannels.3: New manpage describing handling of the
+ standard channels by the Tcl library [402725].
+
+2001-09-10 Don Porter <dgp@users.sourceforge.net>
+
+ * 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]
+
+ * generic/tclInitScript.h (initScript):
+ * win/tclWinInit.c (TCL_REGISTRY_KEY, TclpSetVariables): Removed
+ 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.
+
+ * 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.
+
+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]
+
+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.
+
+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]
+
+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.
+
+2001-09-08 David Gravereaux <davygrvy@pobox.com>
+
+ * win/mkd.bat:
+ * 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]
+
+2001-09-08 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * 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.
+
+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]
+
+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.
+
+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>.
+
+ 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.
+
+ * 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.
+
+ (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.
+
+ (TclWinOpenFileChannel): Added initialization of 'dirty' flag.
+
+2001-09-06 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * doc/http.n: noted -binary, charset and coding state keys.
+ * 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]
+
+ * 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]
+
+ * 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.
+
+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/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]
+
+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]
+
+2001-09-05 David Gravereaux <davygrvy@pobox.com>
+
+ * generic/tclPlatDecls.h: Another small trim finalizing Borland
+ 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/.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]
+
+2001-09-05 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * 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
+ 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/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);
+
+ will have to be this with Borland:
+
+ int __cdecl __export func (int a, int b);
+
+ The order of the attribute needs to be after the return type.
+
+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]
+
+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]
+
+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.
+ * 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/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/tcl.stubs:
+ * generic/tcl.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.
+ 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.
+
+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)
+
+2001-09-03 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * 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]
+
+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]
+
+ * 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]
+
+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.
+
+ * 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]
+
+2001-08-30 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tclIndexObj.c: fixed some casting problems that upset
+ Crays. [Bug #419528] (andreasen)
+
+2001-08-30 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tcl.h: Silence warning from Sun compiler. [Bug 454374]
+
+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].
+
+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...)
+
+ * 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.
+ * mac/tclMacFCmd.c: wrapped long lines and cleaned up
+ 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.
+ * 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 '~'.
+ * 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
+ TclFinalizeAsync() to tclAsync.c and called from Tcl_FinalizeThread().
+ 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]
+
+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]
+
+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
+ 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]
+ * doc/filename.n: documented windows path/file length limitation.
+ [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.
+
+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>.
+
+2001-08-23 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * unix/configure:
+ * unix/tcl.m4: added QNX-6 build support. [Bug #219410] (loverso)
+
+ * unix/tclUnixFCmd.c:
+ * generic/tclIOUtil.c:
+ * generic/tclFileName.c: corrected minor compiler warnings.
+
+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]
+ * 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.
+ 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.
+ 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.
+ * 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'
+ 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.
+
+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]
+
+ * tests/format.test: Converted conditional execution of tests into
+ a test constraint.
+
+2001-08-22 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * win/Makefile.in:
+ * 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]
+ Updated dde to 1.2
+
+ * 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.
+
+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]
+
+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]
+
+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)
+
+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]
+
+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.
+
+ * 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]
+
+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]
+
+2001-08-13 Miguel Sofer <msofer@users.sourceforge.net>
+
+ * 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.
+
+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.
+
+2001-08-10 Miguel Sofer <msofer@users.sourceforge.net>
+
+ * generic/tclVar.c:
+ * tests/trace.test: Insure that [array] traces work correctly for
+ 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.
+
+2001-08-08 Don Porter <dgp@users.sourceforge.net>
+
+ * library/dde/pkgIndex.tcl:
+ * library/http/http.tcl:
+ * library/http/pkgIndex.tcl:
+ * library/msgcat/msgcat.tcl:
+ * library/msgcat/pkgIndex.tcl:
+ * library/opt/optparse.tcl:
+ * library/opt/pkgIndex.tcl:
+ * 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]
+
+ * README:
+ * generic/tcl.h:
+ * tools/tcl.wse.in:
+ * unix/configure:
+ * unix/configure.in:
+ * 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].
+
+2001-08-06 Jeff Hobbs <jeffh@ActiveState.com>
+
+ 8.4a3 RELEASE
+
+ * changes:
+ * README:
+ * mac/README:
+ * unix/README:
+ * win/README.binary: updated for 8.4a3 release
+
+ * 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/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]
+
+ * win/README: made note of URL for Windows compilation notes
+
+ * 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)
+ The use of tmpnam in TclpTempFileName must still be changed.
+
+ * tests/http.test (http-4.14): fixed variable error return.
+ [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.
+ * 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.
+
+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]
+
+ * 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]
+
+2001-08-02 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tclIOUtil.c (Tcl_FSMatchInDirectory): corrected
+ uninitialized value.
+
+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.
+
+2001-08-01 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * unix/tclUnixFCmd.c: minor casts to eliminate warnings. (lim)
+ [Patch: #440218]
+
+ * 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.
+
+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
+
+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.
+
+2001-07-21 Don Porter <dgp@users.sourceforge.net>
+
+ * doc/pkgMkindex.n:
+ * 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.
+ * 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.
+
+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.
+
+2001-07-17 Mo DeJong <mdejong@redhat.com>
+
+ * 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.
+
+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.
+
+2001-07-16 Mo DeJong <mdejong@redhat.com>
+
+ * win/tclWinConsole.c:
+ * win/tclWinPipe.c:
+ * 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.
+
+2001-07-16 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * win/tclWinPipe.c (PipeClose2Proc): constrained the mutex lock to
+ 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]
+
+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!
+
+ * 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.
+ * 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]
+
+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.
+ * 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.
+
+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.
+
+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]
+
+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/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.
+
+2001-07-04 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * README:
+ * mac/README:
+ * unix/README:
+ * win/README:
+ * win/README.binary: updated READMEs with purls
+
+2001-07-03 Mo DeJong <mdejong@redhat.com>
+
+ * 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.
+
+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]
+
+ * 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_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.
+
+ * 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.
+
+ * tests/append.test:
+ * tests/appendComp.test: added tests for read trace triggering for
+ append and lappend.
+
+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.
+
+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.
+
+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.
+
+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
+ 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]
+
+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.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]
+
+2001-06-28 Miguel Sofer <msofer@users.sourceforge.net>
+
+ * 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...
+
+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.
+
+ * 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/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]
+
+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]
+
+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.
+
+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/configure: Regen.
+ * win/configure.in: Don't subst VPSEP.
+ * win/tcl.m4 (SC_CONFIG_CFLAGS): Remove VPSEP variable.
+
+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.
+ * 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.
+ * win/configure: Regen.
+ * win/configure.in: Ditto.
+
+2001-06-25 Mo DeJong <mdejong@redhat.com>
+
+ * 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.
+
+2001-06-25 Mo DeJong <mdejong@redhat.com>
+
+ * 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.
+
+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.
+
+2001-06-22 Mo DeJong <mdejong@redhat.com>
+
+ * win/configure: Regen.
+ * win/tcl.m4: Fix silly typo in last checkin.
+
+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/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.
+ * 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.
+
+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.
+
+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!
+
+ * 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]
+
+2001-06-16 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclInt.decls:
+ * 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]
+
+ * generic/tclIntPlatDecls.h:
+ * generic/tclStubInit.c: `make gentubs` after above changes.
+
+2001-06-13 Don Porter <dgp@users.sourceforge.net>
+
+ * mac/tclMacAppInit.c (main, Macintosh_Init):
+ * mac/tclMacBOAAppInit.c (main):
+ * mac/tclMacPanic.c: Applied patches from Dan Steffen correcting
+ problems on the Macintosh in the 2001-06-08 changes.
+
+2001-06-12 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * 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]
+
+2001-06-08 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tcl.h:
+ * generic/tcl.decls:
+ * generic/tclPanic.c: Added CONST to Tcl_*Panic* public interfaces.
+ [Patch 415648, TIP 27]
+
+ * generic/tclInt.decls:
+ * 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]
+
+ * generic/tclDecls.h:
+ * generic/tclIntPlatDecls.h:
+ * generic/tclStubInit.c: `make gentubs` after above changes.
+
+ * doc/Panic.3:
+ * unix/mkLinks: New file documenting Tcl_*Panic* public interfaces,
+ 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]
+
+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:
+ * doc/info.n: Changes due to TIP #15 "Functions to List and Detail
+ Math Functions"
+
+2001-05-28 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * library/init.tcl (unknown): removed errant " in error message
+
+2001-05-27 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * 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.
+
+ * 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/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
+ the amount of parsing needed for searchIds.
+
+ * 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>
+
+2001-05-23 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * tests/io.test: changed io-52.[9-11] to not be platform sensitive
+ with EOL translation.
+
+ * library/encoding/cp1250.enc:
+ * library/encoding/cp1251.enc:
+ * library/encoding/cp1252.enc:
+ * library/encoding/cp1253.enc:
+ * library/encoding/cp1254.enc:
+ * library/encoding/cp1255.enc:
+ * library/encoding/cp1256.enc:
+ * library/encoding/cp1257.enc:
+ * library/encoding/cp1258.enc:
+ * library/encoding/cp874.enc:
+ * library/encoding/iso8859-6.enc:
+ * library/encoding/iso8859-7.enc:
+ * 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)
+
+2001-05-23 Mo DeJong <mdejong@redhat.com>
+
+ * 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.
+ * 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.
+
+2001-05-22 Miguel Sofer <msofer@users.sourceforge.net>
+
+ * generic/tclExecute.c: removed Tcl_DuplicateObj in INST_DUP
+
+2001-05-21 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * tests/tcltest.test (tcltest-19.1): fixed failing test that was
+ 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]
+
+ * 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/http.test: removed unused notLinux constraint setting
+
+ * generic/tclRegexp.c (Tcl_RegExpExecObj): added use of
+ Tcl_GetUnicodeFromObj.
+
+2001-05-19 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+
+ * Note that "tclbench" (see project "tcllib") was extended with
+ 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].
+
+ * 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)
+
+ * 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).
+ * 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,
+ 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).
+ 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.
+ * 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
+ TCL_APPEND_ELEMENT and TCL_LIST_ELEMENT as well.
+ * generic/tclInt.decls:
+ * generic/tclIntDecls.h: minor signature changes for above.
+
+ * generic/tclCmdMZ.c: made use of new Tcl_GetUnicodeFromObj.
+
+2001-05-16 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * doc/console.n: Deleted. Put it in the wrong source tree! D'oh!
+
+2001-05-15 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * generic/tcl.decls:
+ * generic/tclDecls.h:
+ * generic/tclStubInit.c:
+ * 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.
+
+ * tests/fileName.test: corrected tests not to fail on win when a
+ C:/test dir exists.
+
+ * generic/tclFileName.c (ExtractWinRoot): corrected ABR error
+
+2001-05-15 Miguel Sofer <msofer@users.sourceforge.net>
+
+ * 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]
+
+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...
+
+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]
+
+2001-05-11 Mo DeJong <mdejong@redhat.com>
+
+ * 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.
+ * 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@.
+
+2001-05-07 Miguel Sofer <msofer@users.sourceforge.net>
+
+ * generic/tclExecute.c: insure different rand() seeds in different
+ 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.
+
+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].
+
+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]
+
+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.
+
+2001-04-27 Kevin Kenny <kennykb@crd.ge.com>
+
+ * generic/tclInt.decls:
+ * generic/tclInt.h:
+ * generic/tclCmdIL.c:
+ * generic/tclProc.c:
+ * 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.
+ * unix/tcl.m4: Subst TCL_THREADS into tclConfig.sh.
+ * unix/tclConfig.sh.in: Add TCL_THREADS variable.
+ * win/configure: Regen.
+ * win/tcl.m4: Subst TCL_THREADS into tclConfig.sh.
+ * win/tclConfig.sh.in: Add TCL_THREADS variable.
+
+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.
+
+2001-04-25 Mo DeJong <mdejong@redhat.com>
+
+ * unix/Makefile.in: Use TCL_STUB_LIB_FILE instead of STUB_LIB_FILE.
+ * unix/configure: Regen.
+ * unix/configure.in: Don't subst STUB_LIB_FILE, use TCL_STUB_LIB_FILE
+ instead.
+
+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...
+
+ * 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.
+
+ * generic/tclNamesp.c:
+ * 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:
+ * doc/CrtObjCmd.3:
+ * doc/ExprLong.3:
+ * generic/tclBasic.c:
+ * generic/tclCmdMZ.c:
+ * doc/CrtSlave.3:
+ * generic/tclNamesp.c:
+ * generic/tcl.decls:
+ * 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.
+
+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
+ 'localtime' that broke the Linux build.
+
+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]
+
+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/configure: Re-ran 'autoconf' with changed tcl.m4
+ * tclUnixTime.c: Modified for thread safety of 'gmtime' and
+ '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!]
+
+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]
+ * 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)
+ * 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/mkLinks: Updated to include the new manpage.
+
+ * doc/UniCharIsAlpha.3: New manpage documenting the Unicode
+ 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].
+
+ * 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].
+
+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]
+
+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]
+
+ * 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]
+ * 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].
+
+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]
+
+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]
+
+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/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]
+
+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.
+
+2001-04-04 Kevin Kenny <kennykb@acm.org>
+
+ * doc/ByteArrObj.3:
+ * doc/DumpActiveMemory.3:
+ * doc/InitStubs.3:
+ * doc/PkgRequire.3:
+ * doc/StringObj.3:
+ * generic/tcl.decls:
+ * generic/tcl.h:
+ * generic/tclBinary.c:
+ * generic/tclCkalloc.c:
+ * generic/tclDecls.h:
+ * generic/tclListObj.c:
+ * 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]
+
+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]
+
+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/Signal.3: New man page describing the public API procedures
+ 'Tcl_SignalId' and 'Tcl_SignalMsg' [Bug #219172].
+
+2001-04-02 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * README:
+ * win/README:
+ * win/README.binary: further notes corrections.
+
+ * win/configure:
+ * win/tcl.m4 (SHLIB_LD): added -incremental:no. [Bug #219381]
+
+2001-04-01 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * README:
+ * mac/README:
+ * win/README:
+ * win/README.binary:
+ * unix/README: updated patchlevel information to 8.4a3 and
+ updated links and notes.
+
+ * generic/tcl.h:
+ * tools/tcl.wse.in:
+ * win/configure.in (VER):
+ * win/configure:
+ * unix/configure:
+ * unix/configure.in (VER):
+ * unix/tcl.spec: updated patchlevel information to 8.4a3
+
+2001-03-30 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * 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/tclThreadTest.c (Tcl_ThreadObjCmd): cast fixes
+ * 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]
+
+ * win/tcl.m4: added imm32.lib to LIBS_GUI for Tk IME support.
+
+ * win/Makefile.in (install-libraries): removed extra \s that broke
+ the target.
+ (install-doc): improved install-* targets to use their base build
+ dependency.
+
+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.
+
+ * 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.
+
+ 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_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/tclTest.c (TestChannelCmd, lines 4520-4532): Added
+ 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.
+
+2001-03-29 Jeff Hobbs <jeffh@gimlet.activestate.com>
+
+ * doc/tcltest.n: corrected incorrect macro usage.
+
+ * doc/lsort.n: corrected unbalanced nroff macros.
+
+ * unix/tclUnixPipe.c (TclpCreateTempFile): prevent potential race
+ condition and security leak in tmp filename creation.
+ (max) [Patch #402924]
+
+ * unix/configure:
+ * unix/tcl.m4: corrected IRIX-5.x config to not use -n32.
+ (english) [Patch #403626]
+
+ * 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]
+
+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]
+
+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]
+
+ * tests/regexp.test (regexp-19.1):
+ * 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'.
+
+2001-03-26 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * win/tclWinInt.h (tclWinTCharEncoding): Removed as now a static
+ variable in win/tclWin32Dll.c instead.
+
+2001-03-23 Jeff Hobbs <jeffh@activestate.com>
+
+ * 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]
+
+2001-03-15 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * tests/set-old.test (set-old-7.2): Changed error behaviour of
+ [unset] to agree with documentation, so must change test as well.
+
+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]
+
+2001-03-13 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * 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]
+
+ * 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
+ 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]
+
+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]
+
+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]
+
+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
+
+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).
+
+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]
+
+2001-01-31 Don Porter <dgp@users.sourceforge.net>
+
+ * 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]
+
+2001-01-18 Andreas Kupries <a.kupries@westend.com>
+
+ * 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 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.
+
+ * doc/Hash.3:
+ * unix/mkLinks: Changed 'Tcl_InitHashTableEx' to
+ '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
+
+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]
+
+ ******************************************************************
+ *** CHANGELOG ENTRIES FOR 2000 IN "ChangeLog.2000" ***
+ *** CHANGELOG ENTRIES FOR 1999 AND EARLIER IN "ChangeLog.1999" ***
+ ******************************************************************
diff --git a/tcl/README b/tcl/README
index 55ae9576f02..e48983c5566 100644
--- a/tcl/README
+++ b/tcl/README
@@ -1,9 +1,9 @@
README: Tcl
- This is the Tcl 8.3.2 source distribution.
- You can get any release of Tcl from:
- http://dev.scriptics.com/registration/<version>.tml
+ This is the Tcl 8.4.0 source distribution.
Tcl/Tk is also available through NetCVS:
- http://dev.scriptics.com/software/tcltk/netcvs.html
+ http://tcl.sourceforge.net/
+ You can get any source release of Tcl from the file distributions
+ link at the above URL.
RCS: @(#) $Id$
@@ -22,19 +22,21 @@ Contents
1. Introduction
---------------
-Tcl provides a powerful platform for creating integration
-applications that tie together diverse applications, protocols,
-devices, and frameworks. When paired with the Tk toolkit, Tcl
-provides the fastest and most powerful way to create GUI applications
-that run on PCs, Unix, and the Macintosh. Tcl can also be used for a
-variety of web-related tasks and for creating powerful command
-languages for applications.
+Tcl provides a powerful platform for creating integration applications that
+tie together diverse applications, protocols, devices, and frameworks.
+When paired with the Tk toolkit, Tcl provides the fastest and most powerful
+way to create GUI applications that run on PCs, Unix, and the Macintosh.
+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 as a
-service to the Tcl community by Scriptics Corporation.
-The official home for Tcl/Tk is on the Scriptics Web site:
+Tcl is maintained, enhanced, and distributed freely by the Tcl community.
+The home for Tcl/Tk sources and bug/patch database is on SourceForge:
- http://dev.scriptics.com
+ http://tcl.sourceforge.net/
+
+with the Tcl Developer Xchange hosted at:
+
+ http://www.tcl.tk/
Tcl is a freely available open source package. You can do virtually
anything you like with it, such as modifying it, redistributing it,
@@ -42,20 +44,21 @@ and selling it either in whole or in part. See the file
"license.terms" for complete information.
2. Documentation
----------------
+----------------
Extensive documentation is available at our website.
The home page for this release, including new features, is
- http://dev.scriptics.com/software/tcltk/8.3.html
+ http://www.tcl.tk/software/tcltk/8.4.html
-Detailed release notes can be found at
- http://dev.scriptics.com/software/tcltk/relnotes/tcl8.3.2.txt
+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
Information about Tcl itself can be found at
- http://dev.scriptics.com/scripting/
+ http://www.tcl.tk/scripting/
There are many Tcl books on the market. Most are listed at
- http://dev.scriptics.com/resource/doc/books/
+ http://www.tcl.tk/resource/doc/books/
2a. Unix Documentation
----------------------
@@ -71,50 +74,48 @@ normal -man macros, for example
ditroff -man Tcl.n
-to print Tcl.n. If Tcl has been installed correctly and your "man"
-program supports it, you should be able to access the Tcl manual entries
-using the normal "man" mechanisms, such as
+to print Tcl.n. If Tcl has been installed correctly and your "man" program
+supports it, you should be able to access the Tcl manual entries using the
+normal "man" mechanisms, such as
man Tcl
2b. Windows Documentation
-------------------------
-The "doc" subdirectory in this release contains a complete set of
-Windows help files for Tcl. Once you install this Tcl release, a
-shortcut to the Windows help Tcl documentation will appear in the
-"Start" menu:
+The "doc" subdirectory in this release contains a complete set of Windows
+help files for Tcl. Once you install this Tcl release, a shortcut to the
+Windows help Tcl documentation will appear in the "Start" menu:
Start | Programs | Tcl | Tcl Help
3. Compiling and installing Tcl
-------------------------------
-There are brief notes in the unix/README, win/README, and mac/README
-about compiling on these different platforms. There is additional
-information about building Tcl from sources at
- http://dev.scriptics.com/support/howto/compile.html
+There are brief notes in the unix/README, win/README, and mac/README about
+compiling on these different platforms. There is additional information
+about building Tcl from sources at
+ http://www.tcl.tk/doc/howto/compile.html
4. TclPro Development tools
---------------------
-
-A high quality set of commercial development tools is now available to
-accelerate your Tcl application development. Scriptics' TclPro
-product provides a debugger, static code checker, packaging utility,
-and bytecode compiler. Visit the Scriptics Web site at:
+---------------------------
- http://dev.scriptics.com/tclpro
+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:
-for more information on TclPro and for a free evaluation download.
+ http://tclpro.sourceforge.net/
5. Tcl newsgroup
----------------
-There is a network 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. For
-bug reports, please see the "Support and bug fixes" section below.
+There is a network 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. For bug reports, please
+see the "Support and bug fixes" section below.
6. Tcl contributed archive
--------------------------
@@ -130,7 +131,7 @@ that are commonly encountered by TCL newcomers.
7. Tcl Resource Center
----------------------
-Visit http://dev.scriptics.com/resource/ to see an annotated index of
+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
@@ -140,62 +141,42 @@ Resource".
8. Mailing lists
----------------
-A couple of Mailing List have been set up to discuss Macintosh or
-Windows related Tcl issues. To subscribe send a message to:
-
- wintcl-request@tclconsortium.org
- mactcl-request@tclconsortium.org
-
-In the body of the message (the subject will be ignored) put:
-
- subscribe mactcl Joe Smith
-
-Replace Joe Smith with your real name, of course. (Use wintcl
-instead of mactcl if you're interested in the Windows list.) If you
-would just like to receive more information about the list without
-subscribing put the line:
-
- information mactcl
-
-(or wintcl) in the body instead.
+Several mailing lists are hosted at SourceForge to discuss development or
+use issues (like Macintosh and Windows topics). For more information and
+to subscribe, visit:
+
+ http://sourceforge.net/projects/tcl/
+
+and go to the Mailing Lists page.
9. Support and Training
------------------------
-Scriptics is very interested in receiving bug reports, patches, and
-suggestions for improvements. We prefer that you send this
-information to us via the bug form on the Scriptics Web site, rather
-than emailing us directly. The bug form is at:
+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:
- http://dev.scriptics.com/ticket/
+ 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.
-The bug form also includes an option to automatically post your report
-on comp.lang.tcl. We strongly recommend that you select this option
-because someone else who reads comp.lang.tcl may be able to offer a
-solution.
We will log and follow-up on each bug, although we cannot promise a
-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 the size of the installed base.
-
-The Tcl community is too large for us to provide much individual
-support for users. If you need help we suggest that you post
-questions to comp.lang.tcl. We read the newsgroup and will attempt to
-answer esoteric questions for which no-one else is likely to know the
-answer. In addition, Tcl/Tk support and training are available
-commercially from Scriptics at:
+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 the size of
+the installed base.
- http://dev.scriptics.com/training
+The Tcl community is too large for us to provide much individual support
+for users. If you need help we suggest that you post questions to
+comp.lang.tcl. We read the newsgroup and will attempt to answer esoteric
+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:
-Also see the following Web site for links to other organizations that
-offer Tcl/Tk training:
-
- http://www.scriptics.com/resource/community/commercial/training
+ http://www.tcl.tk/resource/community/commercial/training
10. Thank You
-------------
@@ -203,5 +184,3 @@ offer Tcl/Tk training:
We'd like to express our thanks to the Tcl community for all the
helpful suggestions, bug reports, and patches we have received.
Tcl/Tk has improved vastly and will continue to do so with your help.
-
-
diff --git a/tcl/changes b/tcl/changes
index 29e46fd66c6..d24add87332 100644
--- a/tcl/changes
+++ b/tcl/changes
@@ -4835,7 +4835,7 @@ loads on Windows (dejong, hobbs)
proper handling of async callbacks (new options), version is now at 2.3
(tamhankar, welch)
-2000-03 (speed improvements) speedup in Windows filename handling (newman)
+2000-03 (performance enhancement) speedup in Windows filename handling (newman)
and ==/!= empty string in exprs. (hobbs)
2000-03-27 (bug fix) added uniq'ing test to namespace export list to
@@ -4874,6 +4874,56 @@ exec process was running (dejong)
--- Released 8.3.1, April 26, 2000 --- See ChangeLog for details ---
+2000-04-26 (doc fix) updated/added documentation for many API's and
+commands (melski)
+
+2000-05-02 (feature enhancement) added support for joinable threads;
+extended API's for channels to allow channels to move between threads
+(kupries)
+
+2000-05-02 (feature enhancement) changed error return for procedures
+with incorrect args to be like the Tcl_WrongNumArgs API, with a "wrong
+# args: ..." message printed, with an args list (hobbs)
+
+2000-05-08 (feature enhancement) added [array statistics] command
+
+2000-05-08 (performance enhancement) rewrote Tcl_StringCaseMatch
+algorithm for better performance; this affects the [string match]
+command; added "eq" and "ne" operands to expr, for testing
+string equality and inequality (hobbs)
+
+2000-05-09 (feature enhancement) extended [lsearch] to support sorted
+list searches and typed list searches (melski)
+
+2000-05-10 (feature enhancement) added [namespace exists] command
+(darley)
+
+2000-05-18 (build enhancement) added support for mingw compile env and
+cross-compiling (dejong)
+
+2000-05-18 (bug fix) corrected clock grammar to properly handle the
+"ago" keyword when it follows multiple relative unit specifiers
+(melski)
+
+2000-05-22 (compile fix) type cast cleanups (dejong)
+
+2000-05-23 (performance enhancement) added byte-compiled
+implementation of [return] command and [string] command (melski)
+
+2000-05-26 (performance enhancement) extended byte-compiled [string]
+command with support for [string compare/index/match] (hobbs)
+
+2000-05-27 (feature enhancement) added ability to set [info script]
+return value ([info script ?newFileName?]) (welch)
+
+2000-05-31 (feature enhancement) added support for regexp and exact
+pattern matching for [array names] (gazetta)
+
+2000-05-31 (feature enhancement) added -nocomplain and -- flags to
+[unset] to allow for silent unset operation (hobbs)
+
+--- Released 8.4a1, June 6, 2000 --- See ChangeLog for details ---
+
2000-05-29 (bug fix) corrected resource cleanup in http error cases.
Improved handling of error cases in http. (tamhankar)
@@ -4912,3 +4962,642 @@ sections. (english)
DumpActiveMemory.3. (melski)
--- Released 8.3.2, August 9, 2000 --- See ChangeLog for details ---
+
+2000-06 thru 2000-11 (build improvements) Added support for mingw (gcc on
+Windows), AIX-5 and Win64 builds (dejong, hobbs)
+
+2000-06-23 (feature enhancement) ability to use Tcl_Obj *s as hash keys (duffin)
+
+2000-06-29 (new features) added [mcmax] and [mcmset] and extended [unknown] in
+msgcat package (duperval, krone, nelson)
+=> msgcat 1.1
+
+2000-08 thru 2000-09 added tclPlatDecls.h to default install (melski, hobbs)
+
+2000-08-24 (new feature) Enhanced trace syntax to add:
+ trace {add|remove|list} {variable|command} name ops command
+(darley, melski)
+
+2000-09-06 (cross-platform feature) Set ^Z (\32) as default EOF char. (hobbs)
+
+2000-09-07 partial fix for bug 2460 to prevent exec mem leak on Windows for the
+common case (gravereaux)
+
+2000-09-14 Improved string allocation growth for large strings (hintermayer,
+melski)
+
+2000-09-14 New non-panic'ing mem allocation functions Tcl_AttemptAlloc,
+Tcl_AttemptRealloc, Tcl_AttemptSetObjLength (melski)
+
+2000-09-20 (new features) completely new, enhanced syntax in tcltest package.
+Backwards compatable with tcltest v1. (hom)
+=> tcltest 2.0
+
+2000-09-27 (bug fix) 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 (mem leak) Correct mem leak in channels when statePtr was released
+(hobbs)
+
+2000-09-29 (bug fix) corrected reporting of space parity on Windows (Eason)
+
+2000-10-06 (bug fix) corrected [file channels] to only return channels in
+the current interpreter (hobbs)
+
+2000-10-20 (performance enhancement) call stat only when necessary in 'glob' to
+speed up command significantly in base cases (hobbs)
+
+2000-10-27 Fixed mem leak in Tcl_CreateChannel. Re-purified core via test
+suites. (hobbs)
+
+2000-10-30 (new feature) add "ja_JP.eucJP" map to "euc-jp" encoding (takahashi)
+
+2000-11-01 (mem leak) Corrected excessive mem use of info exists on a
+non-existent array element (hobbs)
+
+2000-11-02 (bug fix) Corrected sharing of tclLibraryPath in threaded
+environment (gravereaux)
+
+2000-11-03 (new feature) Tcl_SetMainLoop enables defining an event loop for
+tclsh. This enables Tk as a truly loadable package. (hobbs)
+
+--- Released 8.4a2, November 3, 2000 --- See ChangeLog for details ---
+
+2000-09-27 (bug fix) 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 (mem leak) Correct mem leak in channels when statePtr was released
+(hobbs)
+
+2000-09-29 (bug fix) corrected reporting of space parity on Windows (Eason)
+
+2000-10-06 (bug fix) corrected [file channels] to only return channels in
+the current interpreter (hobbs)
+
+2000-10-20 (performance enhancement) call stat only when necessary in 'glob' to
+speed up command significantly in base cases (hobbs)
+
+2000-11-01 (mem leak) Corrected excessive mem use of info exists on a
+non-existent array element (hobbs)
+
+2000-11-02 (bug fix) Corrected sharing of tclLibraryPath in threaded
+environment (gravereaux)
+
+2000-11-23 (mem leak) fixed potential memory leak in error case of lsort
+(fellows)
+
+2000-12-09 (feature enhancement) changed %o and %x to use strtoul instead
+of strtol to correctly preserve scan<>format conversion of large integers
+(hobbs)
+Fixed handling of {!<boolean>} in expressions (hobbs, fellows)
+
+2000-12-14 (feature enhancement) improved (s)rand for 64-bit platforms
+(porter)
+
+2001-01-04 (bug fix) corrected parsing of $tcl_libPath at startup on
+Windows (porter)
+
+2001-01-30 (bug fix) Fixed possible hangs in fcopy. (porter)
+
+2001-02-15 (performance enhancement) improved efficiency of [string split]
+(fellows)
+
+2001-03-13 (bug fix) Correctly possible memory corruption in string map {}
+$str (fellows)
+
+2001-03-29 (bug fix) prevent potential race condition and security leak in
+tmp filename creation on Unix. (max)
+Fixed handling of timeout for threads (corrects excessive CPU usage issue
+for Tk on Unix in threaded Tcl environment). (ruppert)
+
+2001-03-30 (bug fix) corrected Windows memory error on exit (wu)
+Fixed race condition in readability of socket on Windows.
+
+2001-04-03 (doc fixes) numerous doc corrections and clarifications.
+Update of READMEs.
+
+2001-04-04 (build improvements) redid Mac build structure (steffen)
+Corrected IRIX-5* configure (english). Added support for AIX-5 (hobbs).
+Added support for Win64 (hobbs).
+
+--- Released 8.3.3, April 6, 2001 --- See ChangeLog for details ---
+
+2000-11-23 (new feature)[TIP 7] higher resolution timer on Windows (kenny)
+
+2001-01-18 (new feature) Tcl_InitHashTableEx renamed to Tcl_InitCustomHashTable
+(kupries)
+
+2001-03-30 (new feature)[TIP 10] support for thread-aware/hot channels (kupries)
+
+2001-04-06 (new feature)[219280] auto-loading hidden in ::errorInfo (porter)
+
+2001-04-07 (bug fix)[406709] corrected panic when extra items left on the
+byte compiler execution stack (sofer)
+
+2001-04-09 (bug fix)[219136,232558] improved use of thread-safe functions in
+unix time commands (kenny)
+
+2001-04-24 (new feature)[TIP 27] started CONST-ification of the Tcl APIs (kenny)
+
+2001-05-03 (new feature) [auto_import] now matches patterns like
+[namespace import], not like [string match] (porter)
+ **** POTENTIAL INCOMPATABILITY ****
+
+2001-05-07 (new feature)[416643] distinct srand() seed per interp (sofer)
+
+2001-05-15 (new feature) new Tcl_GetUnicodeFromObj API (hobbs)
+
+2001-05-16 (performance enhancement) byte-compiled versions of [lappend],
+[append] simple cases (hobbs)
+
+2001-05-23 (new feature) added ISO-8859-15 and koi8-u encodings, updated other
+encoding tables based on http://www.unicode.org/Public/MAPPINGS/ (kuhn)
+
+2001-05-27 (new feature) updated to Unicode 3.1.0 data set (still using 16
+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
+definitions brought into agreement (porter)
+
+2001-06-12 (bug fix)[219232] regexp returned non-matching sub-pairs to have
+index pair {-1 -1} (fellows)
+
+2001-06-27 (bug fix)[217987] corrected backslash substitution of non-ASCII
+characters. (hobbs, riefenstahl)
+
+2001-06-28 (bug fix)[231259] failure to re-compile after cmd shadowing (sofer)
+
+2001-07-02 (bug fix)[227512] corrected [concat] treatment of UTF-8 strings
+(hobbs, barras)
+
+2001-07-12 (new feature)[TIP 36] Tcl_SubstObj API (fellows)
+
+2001-07-16 (bug fix) corrected thread-enabled pipe closing on Windows
+(hobbs, jsmith)
+
+2001-07-18 (bug fix)[427196] corrected memory overwrite error when buffer size
+of a channel is changed after channel use has already begun (kupries, porter)
+
+2001-07-31 (new feature)[TIP 17] TclFS* APIs provide new virtual file
+system. This includes the addition of 'file normalize', 'file system',
+'file separator' and 'glob -tails' (darley)
+
+2001-08-06 (bug fix) removed use of tmpnam in TclpCreateTempFile on Unix (lim)
+
+ * improved build support for IRIX, GNU HURD, Mac OS 9 and OS X
+
+ * configure scripts revamped for better support of cygwin and gcc on
+ Windows (mdejong)
+
+ * corrected several minor errors noted by Purify (hobbs)
+
+--- Released 8.4a3, August 6, 2001 --- See ChangeLog for details ---
+
+2001-06-27 (bug fix)[217987] corrected backslash substitution of non-ASCII
+characters. (hobbs, riefenstahl)
+
+2001-06-28 (bug fix)[231259] failure to re-compile after cmd shadowing (sofer)
+
+2001-07-02 (bug fix)[227512] corrected [concat] treatment of UTF-8 strings
+(hobbs, barras)
+
+2001-07-16 (bug fix) corrected thread-enabled pipe closing on Windows
+(hobbs, jsmith)
+
+2001-07-18 (bug fix)[427196] corrected memory overwrite error when buffer size
+of a channel is changed after channel use has already begun (kupries, porter)
+
+2001-08-06 (bug fix)[442665] corrected object reference counting in [gets]
+(jikamens)
+
+2001-08-06 (new feature) added GNU (HURD) configuration target. (brinkmann)
+
+2001-08-07 (bug fix)[406709] corrected panic when extra items left on the
+byte compiler execution stack (see test foreach-5.5) (sofer, tallneil, jstrot)
+
+2001-08-08 (new features) updated packages msgcat 1.1.1, opt 0.4.3,
+tcltest 1.0.1, dependencies checked (porter)
+
+2001-08-20 (new feature)[452217] http 2.3.2: include port number in Host: header
+to comply with HTTP/1.1 spec (RFC 2068) (hobbs, tils)
+
+2001-08-23 (new feature) added QNX-6 build support (loverso)
+
+2001-08-23 (bug fix) corrected handling of spaces in path name passed to
+[exec] on Windows (kenpoole)
+
+2001-08-24 (bug fix) corrected [package forget] stopping on non-existent
+package (porter)
+
+2001-08-24 (bug fix) corrected construction of script library search path
+relative to executable (porter)
+
+2001-08-24 (bug fix) [auto_import] now matches patterns like
+[namespace import], not like [string match] (porter)
+ **** POTENTIAL INCOMPATABILITY ****
+
+2001-08-27 (new feature) added Tcl_SetMainLoop() to enable loading Tk as a
+true package (hobbs)
+
+2001-08-30 (bug fix) build support for Crays (andreasen)
+
+2001-09-01 (bug fix) rewrite of Tcl_Async* APIs to better manage thread
+cleanup (gravereaux)
+
+2001-09-06 (new feature) http 2.4: honor the Content-encoding and charset
+parameters; add -binary switch for forcing the issue (hobbs, saoukhi, orwell)
+=> http 2.4
+
+2001-09-06 (performance enhancement) rewrite of file I/O flush management on
+Windows. Approximately 100x speedup for some operations. (kupries, traum)
+
+2001-09-10 (bug fix) corrected finalization error in TclInExit (darley)
+
+2001-09-10 (bug fix) protect against alias loops (hobbs)
+
+2001-09-12 (bug fix) added missing #include in tclLoadShl.c (techentin)
+
+2001-09-12 (bug fix) script library path construction on Windows no longer
+uses registry, nor adds the current working directory to the path (porter)
+
+2001-09-12 (bug fix) correct bugs in compatibility strtod() (porter)
+
+2001-09-13 (bug fix) Tcl_UtfPrev now returns the proper location when the
+middle of a UTF-8 byte is passed in (hobbs)
+
+2001-09-19 (bug fix) [format] and [scan] corrected for 64-bit machines (rmax)
+
+2001-09-19 (new feature) --enable-64-bit support for HP-11. (hobbs)
+
+2001-09-19 (new feature) native memory allocator now default on Windows
+(hobbs)
+
+2001-09-20 (new feature) WIN64 support and extra processor definitions
+(hobbs, mstacy)
+
+2001-09-26 (bug fix) corrected potential deadlock in channels that do not
+provide a BlockModeProc (kupries, kogorman)
+
+2001-10-03 (new feature) WIN64 build support (hobbs)
+
+2001-10-03 (bug fix) correction in thread finalization (rbrunner)
+
+2001-10-04 (new feature) updated encodings with latest mappings from
+www.unicode.org (hobbs)
+
+2001-10-11 (bug fix) corrected cleanup of self-referential bytecodes at
+interpreter deletion (sofer, rbrunner)
+
+2001-10-16 (new feature) config support for MacOSX / Darwin (steffen)
+
+2001-10-16 (new feature, Mac) change in binary extension format from MachO
+bundles to standard .dylib dynamic libraries like on other unices.
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2001-10-18 (bug fix) corrected off-by-one-day error in clock scan with
+relative months and years during swing hours. (lavana)
+
+--- Released 8.3.4, October 19, 2001 --- See ChangeLog for details ---
+
+2001-08-21 (bug fix)[219184] overagressive compilation of [catch] (sofer)
+
+2001-08-22 (new feature)[227482] [dde request -binary] (hobbs)
+=> dde 1.2
+
+2001-08-30 (performance enhancement)[456668] fully qualified command names use
+cached Command for all namespaces, avoiding repeated lookups (sofer)
+
+2001-08-31 (performance enhancement) bytecompiled [list] (hobbs)
+
+2001-09-02 (bug fix)[403553] Add -Zl to VC++ compile line for tclStubLib to
+avoid any specific C-runtime library dependence. (gravereaux)
+
+2001-09-05 (new feature) restored support for Borland compiler (gravereaux)
+
+2001-09-05 (new feature)[TIP 49] Tcl_OutputBuffered API (schroedter, fellows)
+
+2001-09-07 (new feature) restored VC++ 5.0 compatibility (gravereaux)
+
+2001-09-10 (performance enhancement)[TIP 53,451441] [proc foo args {}] now
+compiles to 0 bytecodes (sofer)
+
+2001-09-13 (new feature)[TIP 56] Tcl_EvalTokensStandard API (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
+enable all compile and execution tracing (sofer)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2001-09-19 (bug fix)[411825] made TclNeedSpace UTF-8 aware (fellows)
+
+2001-09-19 (bug fix)[219166] overagressive compilation of "quoted" bodies of
+[for], [foreach], [if], and [while] (sofer)
+
+2001-09-19 (performance enhancement) bytecompiled [string match] (hobbs)
+
+2001-10-15 (new feature)[TIP 35] serial channel configuration: Win (schroedter)
+
+2001-11-06 (bug fix)[478856] loss of fileevents due to short reads (kupries)
+
+2001-11-06 (new feature) revitalized makefile.vc (gravereaux)
+
+2001-11-07 (new feature) Cygwin gcc support dropped. Use mingw (dejong)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2001-11-07 (new feature) Support --include-dir= and --libdir= options to
+configure. Store in tclConfig.sh as TCL_INCLUDE_SPEC and TCL_LIB_SPEC.
+(dejong)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2001-11-08 (new feature) Enable --enable-threads on FreeBSD (dejong)
+
+2001-11-08 (new feature) New make target 'make gdb' (dejong)
+
+2001-11-09 (bug fix)[480176] [global] mishandled varnames matching :* (porter)
+
+2001-11-12 (new feature)[TIP 22,33,45] new command [lset],
+[lindex] extended to accept multiple indices. (kenny, hobbs)
+
+2001-11-16 (new feature) new configure option --enable-langinfo=no.
+By default, nl_langinfo() is used on Unix to determine system encoding.
+Tcl's built-in system is used only if that fails, or configured with
+--enable-langinfo=no. (hobbs, wagner)
+
+2001-11-19 (new feature)[TIP 62] A Tcl_VarTraceProc can now return Tcl_Obj *
+or a dynamic string as well as a static string to indicate an error (fellows)
+
+2001-11-19 (new feature)[TIP 73] Tcl_GetTime API (kenny)
+
+2001-11-19 (bug fix)[478847] overflows in [time] of >2**31 microseconds (kenny)
+
+2001-11-29 (performance enhancement) caching scheme added to [binary scan]
+(fellows)
+
+2001-12-05 (new feature) new algorithm for [array get] adds safety when read
+traces modify the array. (sofer)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2001-12-10 (bug fix)[490514] doc fixes (porter,english)
+
+2001-12-18 (new feature) removed unix/dltest/configure; unix/configure does
+all (dejong)
+
+2001-12-19 (new feature) New make target 'make shell' (dejong)
+
+2001-12-21 (new feature) MaxOSX / Darwin support (steffen)
+
+2001-12-28 (new feature) new command [memory onexit] replaces [checkmem] when
+compiled with TCL_MEM_DEBUG. Added documentation. (porter)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2001-12-28 (bug fix) proper case in [auto_execok] use of $env(COMPSPEC) (hobbs)
+
+2002-01-05 (feature rewrite) Tcl_Main() rewritten and documentation improved.
+Interactive operation and event loop operation (via Tcl_SetMainLoop) now
+interleave cleanly. Also more robust against strange happenings. (porter)
+
+2002-01-17 (bug fix)[504642] Tcl_Obj refCounts in [gets] (griffen,kupries)
+
+2002-01-21 (bug fix)[506297] infinite loop writing in iso2022-jap encoding
+(forssen,kupries)
+
+2002-01-24 (HTTP server bug workaround)[504508] leave the default port out
+of the Host: header value
+=> http 2.4.1 (hobbs)
+
+2002-01-25 (new feature)[496733] socket options -eofchar and -translation
+return read-only values (dejong)
+
+2002-01-28 (new feature) Old ChangeLog entries => ChangeLog.20900 (hobbs)
+
+2002-01-28 (performance enhancement) bytecompiled [regexp] for trivial cases
+that amount to string matching. Also -nocase and --. (hobbs)
+
+2002-02-05 (bug fix) [http::error] called when [::error] intended
+=> http 2.4.2 (porter)
+
+2002-02-05 (bug fix)[465765] avoid zero-byte writes to STREAMs
+(talcott,kupries)
+
+2002-02-06 (performance enhancement) [regsub] special cases that map to
+[string map] detected. (hobbs)
+
+2002-02-06 (bug fix)[495213] [scan] accept 0x as prefix of base 16 value
+(hobbs)
+
+2002-02-10 (new feature)[TIP 32,79] Tcl_CreateObjTrace API (kenny)
+
+2002-02-12 (new feature) partial support for DJGPP Tcl on DOS (gravereaux)
+
+2002-02-14 (mem leak) Fixed leaking an empty Tcl_Obj when [gets $chan]
+errored out. (kupries, sofer)
+
+2002-02-15 (new feature)[TIP 72] support for 64-bit integer values on
+32-bit platforms and ability to work with >2GiB files. Extends many
+commands. See ChangeLog and TIP for details.
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2002-02-22 (bug fix)[476537] Fix panic when loading shared library without
+proper use of stubs on platform without backlinking (porter)
+
+2002-02-22 (new feature) 64-bit support for xlc compiler on AIX-4 (hobbs)
+
+2002-02-22 (new feature)[521560] Removed limits on filename length and
+format [source]able through the Safe Base (hobbs)
+
+2002-02-22 (performance enhancement) optimized bytecodes for [if], [for],
+[while] and constant conditions (sofer)
+
+2002-02-22 (new feature)[TIP 76] [regsub] can now return result (fellows)
+
+2002-02-25 (bug fix)[495207] buffer overrun when closing ] left out of
+argument to [subst] (sofer, english)
+
+2002-02-25 (bug fix)[514392] [load] updated for Mac OS X 10.1 (steffen)
+
+2002-02-26 (bug fix) [info hostname] choked on names >31 characters (hobbs)
+
+2002-02-26 (new feature)[TIP 35] serial channel configuration: Unix
+(schroedter, hobbs)
+
+2002-02-25 (bug fix)[483575] [fconfigure ... -error] now no-op on Mac (kupries)
+
+2002-02-28 (performance enhancement)[458872] fully qualified command names use
+cached Command for all namespaces, avoiding repeated lookups (sofer)
+
+ * (new feature)[TIP 27] completed CONST-ification of TCL APIs.
+Added compiler macro USE_NON_CONST to keep using those old API prototypes
+that present irreconcilable source incompatibilities with header files
+of prior Tcl releases. Others will need to be reconciled.
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2002-03-04 (bug fix)[474358, 218099, 219314, 524674] fixed several problems
+related to the handling of iso2022 text and finalization of escape-based
+encodings. (taguchi, takahashi, hobbs)
+
+--- Released 8.4a4, March 5, 2002 --- See ChangeLog for details ---
+
+2002-03-06 (new feature)[TIP 80] expanded [lsearch] options (wilkason, fellows)
+
+2002-03-07 (new feature)[TIP 87] [interp recursionlimit] (trier)
+
+2002-03-08 (platform feature) mingw 1.1 build favored (dejong)
+
+2002-03-20 (new feature)[TIP 27] CONST-ified variable access functions (porter)
+
+2002-03-24 (bug fix)[511666,511658,523217,530960] expanded
+Tcl_FSMatchInDirectory to handle assorted [glob] bugs in VFS. (darley)
+ *** POTENTIAL INCOMPATIBILITY with prior 8.4a releases ***
+
+2002-03-25 (bug fix)[495726] stopped tcltest disabling of auto-loading (porter)
+
+2002-03-25 (bug fix)[495977] allow \n in test constraints (porter)
+
+2002-03-27 (platform support)[527941,533862] VC/winhelp/W9X (spjuth,
+gravereaux)
+
+2002-03-28 (bug fix)[219181] exception at level 0 issues (sofer)
+
+2002-03-28 (bug fix)[219362] command termination; Tcl_CreateTrace (knoll,sofer)
+
+2002-04-05 (bug fix)[536879] exceptions during variable subst (porter)
+
+2002-04-15 (bug fix)[497446,513983] tcltest syntax errors now raised (porter)
+ ***POTENTIAL INCOMPATIBILITY with prior tcltest 2.0.* (8.4aX)***
+
+2002-04-17 (bug fix)[495660] [(save|restore)state] deprecated (porter)
+
+2002-04-17 (bug fix)[526524] escape-based encodings corrected (yamamoto, hobbs)
+
+2002-04-18 (bug fix)[542588] [expr] error msgs improved (ehrens, sofer)
+
+2002-04-18 (bug fix)[545325] [info level $level] now returns [namespace eval]
+as documented (suchenwirth,sofer)
+
+2002-04-19 (bug fix)[544727] export [mcload]; ns context of [mcmax] (porter)
+=> msgcat 1.2.3
+
+2002-04-22 (performance enhancement) threaded memory allocator (AOL, hobbs)
+
+2002-04-24 (new feature) TCLTK_NO_LIBRARY_TEXT_RESOURCES #define disables
+inclusion of tcl library code in resource fork on Mac. (steffen)
+
+2002-05-21 (platform support) static libs on OSF (dejong)
+
+2002-05-24 (bug fix)[557878] set encoding on listening socket (staplin,
+kupries)
+
+2002-05-24 (new feature)[TIP 91] Tcl_Seek compatibility (fellows)
+
+2002-05-28 (bug fix)[545579] VFS [load] left temp file (darley)
+
+2002-05-28 (bug fix)[559376] plug timezone env leak on Windows (hobbs)
+
+2002-05-29 (performance enhancement) [string compare] optimized (hobbs,fellows)
+
+2002-05-31 (bug fix)[550534] plug interp leak in [pkg_mkIndex] (helmut)
+
+2002-05-31 (dead code)[474335,555635] removed all use of matherr() (english)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2002-06-04 (new feature)[TIP 85,521362] custom result match in tcltest
+(markus, porter)
+=> tcltest 2.1
+
+2002-06-06 (bug fix)[524352] encoding, threading, and environment issues on
+MacOSX (steffen)
+
+2002-06-06 (bug fix)[512214,558742,512214,461000] lazy initialization of
+tcltest constraints (porter)
+
+2002-06-07 (bug fix)[563122,564595] EOVERFLOW definitions (fellows)
+
+2002-06-11 (bug fix)[567386] [info locals] corrections (sofer)
+
+2002-06-14 (new feature)[TIP 102] [trace list] renamed [trace info] (fellows)
+
+2002-06-17 (new feature)[525522,525525] msgcat support for XPG4 locales;
+examination of LC_ALL, LC_MESSAGES environment variables (haible, porter)
+=> msgcat 1.3
+
+2002-06-17 (new feature)[565088] header files assume modern C compiler by
+default; older compilers may need configuration (english)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2002-06-17 (bug fix)[554068] [exec] argument quoting on Windows (darley)
+
+2002-06-17 (new feature)[TIP 62,462580] command execution traces (lavana)
+
+2002-06-19 (bug fix)[558324] regexp sets a linked variable (watson)
+
+ * (performance enhancment) optimizations of bytecode execution (sofer)
+
+2002-06-21 (new feature)[TIP 99,562970] new [file link] command (darley)
+
+2002-06-24 (new feature)[TIP 101] new [tcltest::configure] command (porter)
+=> tcltest 2.2
+
+2002-06-25 (new feature) --enable-man-symlinks and --enable-man-compression
+options to configure (max)
+
+2002-06-26 (bug fix)[565880] [clock format] now respects locale (max)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2002-07-03 (bug fix)[577015] [catch] catches even compile errors (sofer)
+
+--- Released 8.4b1, July 5, 2002 --- See ChangeLog for details ---
+
+2002-07-08 (bug fix) restored compatibility of [viewFile] in tcltest (porter)
+
+2002-07-11 (bug fix) [file normalize] returns long form on Win 95/98/ME (darley)
+
+2002-07-15 (performance enhancment) variable operations rewritten to store
+ and use cached Var pointers (sofer)
+
+2002-07-22 (bug fix)[218000] Inf and Nan are floating-point values (fellows)
+
+2002-07-23 (platform support)[219220] 64-bit compile on IRIX (dejong)
+
+2002-07-25 (bug fix)[219218] return codes in background errors (english)
+
+2002-07-28 (bug fix)[582522] alias fires exec traces (sofer)
+
+2002-07-29 (bug fix)[578363] regexp (fellows,pvgoran)
+
+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
+ are now fully CONST-ified. Use the symbols USE_NON_CONST or
+ USE_COMPAT_CONST to select interfaces with fewer changes.
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2002-08-05 (bug fix)[589859] tcltest setup and cleanup scripts skipped when
+ test body is skipped (porter)
+ => 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)
+
+Many internal bugs fixed.
+Considerable cleanup of the test suite.
+
+--- Released 8.4b2, August 9, 2002 --- See ChangeLog for details ---
+
+2002-08-20 (new feature) --enable-memdebug configure option (kupries)
+
+2002-08-23 (bug fix)[597936] mem leak with USE_THREAD_ALLOC (sofer,zoran)
+
+2002-08-26 (bug fix)[599788] segfault in compiler (sofer,wilkason)
+
+2002-08-28 (bug fix)[414910] avoid mem leaks accessing environment variables
+ on Windows (welton,gravereaux)
+
+2002-08-31 (platform support)[TIP 108] Mac OS X port (steffen,ingham)
+
+2002-09-02 (platfrom support) 64-bit compile on HP-11 (martin)
+
+--- Released 8.4.0, September 10, 2002 --- See ChangeLog for details ---
diff --git a/tcl/compat/README b/tcl/compat/README
index 28d50a36541..5bbf04179aa 100644
--- a/tcl/compat/README
+++ b/tcl/compat/README
@@ -6,4 +6,3 @@ they are known to be incorrect. When the whole world becomes POSIX-
compliant this directory should be unnecessary.
RCS: @(#) $Id$
-
diff --git a/tcl/compat/license.terms b/tcl/compat/license.terms
index 9df3e600352..f1dcaa5245c 100644
--- a/tcl/compat/license.terms
+++ b/tcl/compat/license.terms
@@ -1,7 +1,8 @@
This software is copyrighted by the Regents of the University of
-California, Sun Microsystems, Inc., Scriptics Corporation,
-and other parties. The following terms apply to all files associated
-with the software unless explicitly disclaimed in individual files.
+California, Sun Microsystems, Inc., Scriptics Corporation, ActiveState
+Corporation and other parties. The following terms apply to all files
+associated with the software unless explicitly disclaimed in
+individual files.
The authors hereby grant permission to use, copy, modify, distribute,
and license this software and its documentation for any purpose, provided
diff --git a/tcl/compat/strftime.c b/tcl/compat/strftime.c
index 38ba41457cd..5c2765fdd25 100644
--- a/tcl/compat/strftime.c
+++ b/tcl/compat/strftime.c
@@ -8,6 +8,8 @@
* source. See the copyright notice below for details on redistribution
* restrictions. The "license.terms" file does not apply to this file.
*
+ * Changes 2002 Copyright (c) 2002 ActiveState Corporation.
+ *
* RCS: @(#) $Id$
*/
@@ -68,7 +70,13 @@ typedef struct {
const char *t_fmt;
const char *t_fmt_ampm;
} _TimeLocale;
-
+
+/*
+ * This is the C locale default. On Windows, if we wanted to make this
+ * localized, we would use GetLocaleInfo to get the correct values.
+ * It may be acceptable to do localization of month/day names, as the
+ * numerical values would be considered the locale-independent versions.
+ */
static const _TimeLocale _DefaultTimeLocale =
{
{
@@ -97,6 +105,7 @@ static const _TimeLocale _DefaultTimeLocale =
static const _TimeLocale *_CurrentTimeLocale = &_DefaultTimeLocale;
+static int isGMT;
static size_t gsize;
static char *pt;
static int _add _ANSI_ARGS_((const char* str));
@@ -106,11 +115,12 @@ static size_t _fmt _ANSI_ARGS_((const char *format,
const struct tm *t));
size_t
-TclpStrftime(s, maxsize, format, t)
+TclpStrftime(s, maxsize, format, t, useGMT)
char *s;
size_t maxsize;
const char *format;
const struct tm *t;
+ int useGMT;
{
if (format[0] == '%' && format[1] == 'Q') {
/* Format as a stardate */
@@ -122,6 +132,11 @@ TclpStrftime(s, maxsize, format, t)
return(strlen(s));
}
+ isGMT = useGMT;
+ /*
+ * We may be able to skip this for useGMT, but it should be harmless.
+ * -- hobbs
+ */
tzset();
pt = s;
@@ -144,6 +159,20 @@ _fmt(format, t)
const char *format;
const struct tm *t;
{
+#ifdef WIN32
+#define BUF_SIZ 256
+ TCHAR buf[BUF_SIZ];
+ SYSTEMTIME syst = {
+ t->tm_year + 1900,
+ t->tm_mon + 1,
+ t->tm_wday,
+ t->tm_mday,
+ t->tm_hour,
+ t->tm_min,
+ t->tm_sec,
+ 0,
+ };
+#endif
for (; *format; ++format) {
if (*format == '%') {
++format;
@@ -188,10 +217,6 @@ _fmt(format, t)
2, '0'))
return(0);
continue;
- case 'c':
- if (!_fmt(_CurrentTimeLocale->d_t_fmt, t))
- return(0);
- continue;
case 'D':
if (!_fmt("%m/%d/%y", t))
return(0);
@@ -307,6 +332,38 @@ _fmt(format, t)
if (!_conv(t->tm_wday, 1, '0'))
return(0);
continue;
+#ifdef WIN32
+ /*
+ * To properly handle the localized time routines on Windows,
+ * we must make use of the special localized calls.
+ */
+ case 'c':
+ if (!GetDateFormat(LOCALE_USER_DEFAULT, DATE_LONGDATE,
+ &syst, NULL, buf, BUF_SIZ) || !_add(buf)
+ || !_add(" ")) {
+ return(0);
+ }
+ /*
+ * %c is created with LONGDATE + " " + TIME on Windows,
+ * so continue to %X case here.
+ */
+ case 'X':
+ if (!GetTimeFormat(LOCALE_USER_DEFAULT, 0,
+ &syst, NULL, buf, BUF_SIZ) || !_add(buf)) {
+ return(0);
+ }
+ continue;
+ case 'x':
+ if (!GetDateFormat(LOCALE_USER_DEFAULT, DATE_SHORTDATE,
+ &syst, NULL, buf, BUF_SIZ) || !_add(buf)) {
+ return(0);
+ }
+ continue;
+#else
+ case 'c':
+ if (!_fmt(_CurrentTimeLocale->d_t_fmt, t))
+ return(0);
+ continue;
case 'x':
if (!_fmt(_CurrentTimeLocale->d_fmt, t))
return(0);
@@ -315,6 +372,7 @@ _fmt(format, t)
if (!_fmt(_CurrentTimeLocale->t_fmt, t))
return(0);
continue;
+#endif
case 'y':
if (!_conv((t->tm_year + TM_YEAR_BASE) % 100,
2, '0'))
@@ -324,15 +382,13 @@ _fmt(format, t)
if (!_conv((t->tm_year + TM_YEAR_BASE), 4, '0'))
return(0);
continue;
-#ifndef MAC_TCL
case 'Z': {
- char *name = TclpGetTZName(t->tm_isdst);
+ char *name = (isGMT ? "GMT" : TclpGetTZName(t->tm_isdst));
if (name && !_add(name)) {
return 0;
}
continue;
}
-#endif
case '%':
/*
* X311J/88-090 (4.12.3.5): if conversion char is
diff --git a/tcl/compat/string.h b/tcl/compat/string.h
index 8b998f552b0..4976367a073 100644
--- a/tcl/compat/string.h
+++ b/tcl/compat/string.h
@@ -59,12 +59,13 @@ 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, char *chars));
+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_((CONST char *s, CONST char *delim));
+extern char * strtok _ANSI_ARGS_((char *s, CONST char *delim));
#endif /* _STRING */
diff --git a/tcl/compat/strstr.c b/tcl/compat/strstr.c
index c648b9f67f3..68b6bfbadd5 100644
--- a/tcl/compat/strstr.c
+++ b/tcl/compat/strstr.c
@@ -64,5 +64,5 @@ strstr(string, substring)
}
b = substring;
}
- return (char *) 0;
+ return NULL;
}
diff --git a/tcl/compat/strtod.c b/tcl/compat/strtod.c
index 19d24a1f7f7..14f97d40a66 100644
--- a/tcl/compat/strtod.c
+++ b/tcl/compat/strtod.c
@@ -12,12 +12,8 @@
* RCS: @(#) $Id$
*/
-#include "tcl.h"
-#ifdef NO_STDLIB_H
-# include "../compat/stdlib.h"
-#else
-# include <stdlib.h>
-#endif
+#include "tclInt.h"
+#include "tclPort.h"
#include <ctype.h>
#ifndef TRUE
@@ -108,7 +104,7 @@ strtod(string, endPtr)
*/
p = string;
- while (isspace(*p)) {
+ while (isspace(UCHAR(*p))) {
p += 1;
}
if (*p == '-') {
@@ -206,7 +202,11 @@ strtod(string, endPtr)
}
expSign = FALSE;
}
- while (isdigit(*p)) {
+ if (!isdigit(UCHAR(*p))) {
+ p = pExp;
+ goto done;
+ }
+ while (isdigit(UCHAR(*p))) {
exp = exp * 10 + (*p - '0');
p += 1;
}
@@ -232,6 +232,7 @@ strtod(string, endPtr)
}
if (exp > maxExponent) {
exp = maxExponent;
+ errno = ERANGE;
}
dblExp = 1.0;
for (d = powersOf10; exp != 0; exp >>= 1, d += 1) {
diff --git a/tcl/compat/strtol.c b/tcl/compat/strtol.c
index e1d7de599fb..d0267c9847f 100644
--- a/tcl/compat/strtol.c
+++ b/tcl/compat/strtol.c
@@ -13,6 +13,8 @@
*/
#include <ctype.h>
+#include "tclInt.h"
+#include "tclPort.h"
/*
@@ -37,7 +39,7 @@
long int
strtol(string, endPtr, base)
- char *string; /* String of ASCII digits, possibly
+ 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.
@@ -51,15 +53,15 @@ strtol(string, endPtr, base)
* else means decimal.
*/
{
- register char *p;
- int result;
+ register CONST char *p;
+ long result;
/*
* Skip any leading blanks.
*/
p = string;
- while (isspace(*p)) {
+ while (isspace(UCHAR(*p))) {
p += 1;
}
@@ -77,7 +79,7 @@ strtol(string, endPtr, base)
result = strtoul(p, endPtr, base);
}
if ((result == 0) && (endPtr != 0) && (*endPtr == p)) {
- *endPtr = string;
+ *endPtr = (char *) string;
}
return result;
}
diff --git a/tcl/compat/strtoll.c b/tcl/compat/strtoll.c
new file mode 100644
index 00000000000..267b6baa3c2
--- /dev/null
+++ b/tcl/compat/strtoll.c
@@ -0,0 +1,111 @@
+/*
+ * 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$
+ */
+
+#include "tcl.h"
+#include "tclPort.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/tcl/compat/strtoul.c b/tcl/compat/strtoul.c
index 9f5d66882fd..e75547b1bb0 100644
--- a/tcl/compat/strtoul.c
+++ b/tcl/compat/strtoul.c
@@ -12,7 +12,8 @@
* RCS: @(#) $Id$
*/
-#include <ctype.h>
+#include "tclInt.h"
+#include "tclPort.h"
/*
* The table below is used to convert from ASCII digits to a
@@ -53,7 +54,7 @@ static char cvtIn[] = {
unsigned long int
strtoul(string, endPtr, base)
- char *string; /* String of ASCII digits, possibly
+ 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.
@@ -67,19 +68,29 @@ strtoul(string, endPtr, base)
* else means decimal.
*/
{
- register char *p;
+ register CONST char *p;
register unsigned long int result = 0;
register unsigned digit;
int anyDigits = 0;
+ int negative=0;
+ int overflow=0;
/*
* Skip any leading blanks.
*/
p = string;
- while (isspace(*p)) {
+ while (isspace(UCHAR(*p))) {
p += 1;
}
+ if (*p == '-') {
+ negative = 1;
+ p += 1;
+ } else {
+ if (*p == '+') {
+ p += 1;
+ }
+ }
/*
* If no base was provided, pick one from the leading characters
@@ -90,7 +101,7 @@ strtoul(string, endPtr, base)
{
if (*p == '0') {
p += 1;
- if (*p == 'x') {
+ if ((*p == 'x') || (*p == 'X')) {
p += 1;
base = 16;
} else {
@@ -111,7 +122,7 @@ strtoul(string, endPtr, base)
* Skip a leading "0x" from hex numbers.
*/
- if ((p[0] == '0') && (p[1] == 'x')) {
+ if ((p[0] == '0') && ((p[1] == 'x') || (p[1] == 'X'))) {
p += 2;
}
}
@@ -122,24 +133,33 @@ strtoul(string, endPtr, base)
*/
if (base == 8) {
+ unsigned long maxres = ULONG_MAX >> 3;
for ( ; ; p += 1) {
digit = *p - '0';
if (digit > 7) {
break;
}
- result = (result << 3) + digit;
+ if (result > maxres) { overflow = 1; }
+ result = (result << 3);
+ if (digit > (ULONG_MAX - result)) { overflow = 1; }
+ result += digit;
anyDigits = 1;
}
} else if (base == 10) {
+ unsigned long maxres = ULONG_MAX / 10;
for ( ; ; p += 1) {
digit = *p - '0';
if (digit > 9) {
break;
}
- result = (10*result) + digit;
+ if (result > maxres) { overflow = 1; }
+ result *= 10;
+ if (digit > (ULONG_MAX - result)) { overflow = 1; }
+ result += digit;
anyDigits = 1;
}
} else if (base == 16) {
+ unsigned long maxres = ULONG_MAX >> 4;
for ( ; ; p += 1) {
digit = *p - '0';
if (digit > ('z' - '0')) {
@@ -149,20 +169,27 @@ strtoul(string, endPtr, base)
if (digit > 15) {
break;
}
- result = (result << 4) + digit;
+ if (result > maxres) { overflow = 1; }
+ result = (result << 4);
+ if (digit > (ULONG_MAX - result)) { overflow = 1; }
+ result += digit;
anyDigits = 1;
}
- } else {
+ } else if ( base >= 2 && base <= 36 ) {
+ unsigned long maxres = ULONG_MAX / base;
for ( ; ; p += 1) {
digit = *p - '0';
if (digit > ('z' - '0')) {
break;
}
digit = cvtIn[digit];
- if (digit >= base) {
+ if (digit >= ( (unsigned) base )) {
break;
}
- result = result*base + digit;
+ if (result > maxres) { overflow = 1; }
+ result *= base;
+ if (digit > (ULONG_MAX - result)) { overflow = 1; }
+ result += digit;
anyDigits = 1;
}
}
@@ -176,8 +203,16 @@ strtoul(string, endPtr, base)
}
if (endPtr != 0) {
- *endPtr = p;
+ /* unsafe, but required by the strtoul prototype */
+ *endPtr = (char *) p;
}
+ if (overflow) {
+ errno = ERANGE;
+ return ULONG_MAX;
+ }
+ if (negative) {
+ return -result;
+ }
return result;
}
diff --git a/tcl/compat/strtoull.c b/tcl/compat/strtoull.c
new file mode 100644
index 00000000000..f1545f03bed
--- /dev/null
+++ b/tcl/compat/strtoull.c
@@ -0,0 +1,261 @@
+/*
+ * 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$
+ */
+
+#include "tcl.h"
+#include "tclPort.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/tcl/compat/tclErrno.h b/tcl/compat/tclErrno.h
index 068ef356744..a0905d7930e 100644
--- a/tcl/compat/tclErrno.h
+++ b/tcl/compat/tclErrno.h
@@ -14,87 +14,86 @@
* RCS: @(#) $Id$
*/
-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 EFTYPE 79 /* Inappropriate file type or format */
+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/tcl/doc/Access.3 b/tcl/doc/Access.3
index ae68cb9e6a7..6f0bd659c6a 100644
--- a/tcl/doc/Access.3
+++ b/tcl/doc/Access.3
@@ -1,5 +1,5 @@
'\"
-'\" Copyright (c) 1998-1999 Scriptics Corportation
+'\" Copyright (c) 1998-1999 Scriptics Corporation
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -21,7 +21,7 @@ int
int
\fBTcl_Stat\fR(\fIpath\fR, \fIstatPtr\fR)
.SH ARGUMENTS
-.AS stat *statPtr in
+.AS "struct stat" *statPtr in
.AP char *path in
Native name of the file to check the attributes of.
.AP int mode in
@@ -29,18 +29,22 @@ 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.
-.AP stat *statPtr out
+.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.
+.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 possibity to reroute
+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,
@@ -58,7 +62,7 @@ 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),
-priviledge mode, nlink (always 1 on Windows), user id (always 0 on
+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.
@@ -68,4 +72,5 @@ is filled with data. Otherwise, -1 is returned, and no stat info is
given.
.SH KEYWORDS
-stat access
+stat, access
+
diff --git a/tcl/doc/AddErrInfo.3 b/tcl/doc/AddErrInfo.3
index 58635d8b25c..97e704166c7 100644
--- a/tcl/doc/AddErrInfo.3
+++ b/tcl/doc/AddErrInfo.3
@@ -26,7 +26,7 @@ Tcl_AddObjErrorInfo, Tcl_AddErrorInfo, Tcl_SetObjErrorCode, Tcl_SetErrorCode, Tc
.sp
\fBTcl_SetErrorCodeVA\fR(\fIinterp, argList\fR)
.sp
-char *
+CONST char *
\fBTcl_PosixError\fR(\fIinterp\fR)
.sp
void
@@ -53,11 +53,11 @@ This variable \fBerrorCode\fR will be set to this value.
String to record as one element of \fBerrorCode\fR variable.
Last \fIelement\fR argument must be NULL.
.AP va_list argList in
-An argument list which must have been initialised using
+An argument list which must have been initialized using
\fBTCL_VARARGS_START\fR, and cleared using \fBva_end\fR.
-.AP char *script in
+.AP "CONST char" *script in
Pointer to first character in script containing command (must be <= command)
-.AP char *command in
+.AP "CONST char" *command in
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
@@ -155,7 +155,7 @@ 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 occured to the \fBerrorInfo\fR variable, and
+executed when the error occurred to the \fBerrorInfo\fR variable, and
the line number stored internally in the interpreter is set. On the
first call to \fBTcl_LogCommandInfo\fR or \fBTcl_AddObjErrorInfo\fR
since an error occurred, the old information in \fBerrorInfo\fR is
diff --git a/tcl/doc/Alloc.3 b/tcl/doc/Alloc.3
index ce114516091..f4541599d17 100644
--- a/tcl/doc/Alloc.3
+++ b/tcl/doc/Alloc.3
@@ -10,7 +10,7 @@
.TH Tcl_Alloc 3 7.5 Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_Alloc, Tcl_Free, Tcl_Realloc \- allocate or free heap memory
+Tcl_Alloc, Tcl_Free, Tcl_Realloc, Tcl_AttemptAlloc, Tcl_AttemptRealloc, ckalloc, ckfree, ckrealloc, attemptckalloc, attemptckrealloc \- allocate or free heap memory
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -18,10 +18,32 @@ Tcl_Alloc, Tcl_Free, Tcl_Realloc \- allocate or free heap memory
char *
\fBTcl_Alloc\fR(\fIsize\fR)
.sp
+void
\fBTcl_Free\fR(\fIptr\fR)
.sp
char *
\fBTcl_Realloc\fR(\fIptr, size\fR)
+.sp
+char *
+\fBTcl_AttemptAlloc\fR(\fIsize\fR)
+.sp
+char *
+\fBTcl_AttemptRealloc\fR(\fIptr, size\fR)
+.sp
+char *
+\fBckalloc\fR(\fIsize\fR)
+.sp
+void
+\fBckfree\fR(\fIptr\fR)
+.sp
+char *
+\fBckrealloc\fR(\fIptr, size\fR)
+.sp
+char *
+\fBattemptckalloc\fR(\fIsize\fR)
+.sp
+char *
+\fBattemptckrealloc\fR(\fIptr, size\fR)
.SH ARGUMENTS
.AS char *size
.AP int size in
@@ -48,5 +70,21 @@ further allocation.
\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.
+.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.
+.PP
+The procedures \fBckalloc\fR, \fBckfree\fR, \fBckrealloc\fR,
+\fBattemptckalloc\fR, and \fBattemptckrealloc\fR are implemented
+as macros. Normally, they are synonyms for the corresponding
+procedures documented on this page. When Tcl and all modules
+calling Tcl are compiled with \fBTCL_MEM_DEBUG\fR defined, however,
+these macros are redefined to be special debugging versions of
+of these procedures. To support Tcl's memory debugging within a
+module, use the macros rather than direct calls to \fBTcl_Alloc\fR, etc.
+
.SH KEYWORDS
-alloc, allocation, free, malloc, memory, realloc
+alloc, allocation, free, malloc, memory, realloc, TCL_MEM_DEBUG
diff --git a/tcl/doc/AllowExc.3 b/tcl/doc/AllowExc.3
index d035d0e50d8..9ca0bd79751 100644
--- a/tcl/doc/AllowExc.3
+++ b/tcl/doc/AllowExc.3
@@ -27,12 +27,16 @@ Interpreter in which script will be evaluated.
.PP
If a script is evaluated at top-level (i.e. no other scripts are
pending evaluation when the script is invoked), and if the script
-terminates with a completion code other than TCL_OK, TCL_CONTINUE
+terminates with a completion code other than TCL_OK, TCL_ERROR
or TCL_RETURN, then Tcl normally converts this into a TCL_ERROR
-return with an appropriate message.
+return with an appropriate message. The particular script
+evaluation procedures of Tcl that act in the manner are
+\fBTcl_EvalObjEx\fR, \fBTcl_EvalObjv\fR, \fBTcl_Eval\fR, \fBTcl_EvalEx\fR,
+\fBTcl_GlobalEval\fR, \fBTcl_GlobalEvalObj\fR, \fBTcl_VarEval\fR and
+\fBTcl_VarEvalVA\fR.
.PP
However, if \fBTcl_AllowExceptions\fR is invoked immediately before
-calling a procedure such as \fBTcl_Eval\fR, then arbitrary completion
+calling one of those a procedures, then arbitrary completion
codes are permitted from the script, and they are returned without
modification.
This is useful in cases where the caller can deal with exceptions
diff --git a/tcl/doc/AssocData.3 b/tcl/doc/AssocData.3
index 9acc9eb0f86..a6de4c431fe 100644
--- a/tcl/doc/AssocData.3
+++ b/tcl/doc/AssocData.3
@@ -27,7 +27,9 @@ ClientData
.AS Tcl_InterpDeleteProc *delProcPtr
.AP Tcl_Interp *interp in
Interpreter in which to execute the specified command.
-.AP char *key in
+.VS 8.4
+.AP "CONST char" *key in
+.VE
Key for association with which to store data or from which to delete or
retrieve data. Typically the module prefix for a package.
.AP Tcl_InterpDeleteProc *delProc in
diff --git a/tcl/doc/Async.3 b/tcl/doc/Async.3
index 702e474293e..9e914d03ded 100644
--- a/tcl/doc/Async.3
+++ b/tcl/doc/Async.3
@@ -60,6 +60,13 @@ The only safe approach is to set a flag indicating that the event
occurred, then handle the event later when the world has returned
to a clean state, such as after the current Tcl command completes.
.PP
+\fBTcl_AsyncCreate\fR, \fBTcl_AsyncDelete\fR, and \fBTcl_AsyncReady\fR
+are thread sensitive. They access and/or set a thread-specific data
+structure in the event of an --enable-thread built core. The token
+created by Tcl_AsyncCreate contains the needed thread information it
+was called from so that calling Tcl_AsyncMark(token) will only yield
+the origin thread into the AsyncProc.
+.PP
\fBTcl_AsyncCreate\fR creates an asynchronous handler and returns
a token for it.
The asynchronous handler must be created before
diff --git a/tcl/doc/Backslash.3 b/tcl/doc/Backslash.3
index 071bf97702d..3f53c5336c1 100644
--- a/tcl/doc/Backslash.3
+++ b/tcl/doc/Backslash.3
@@ -34,7 +34,7 @@ the backslash character.
The use of \fBTcl_Backslash\fR is deprecated in favor of
\fBTcl_UtfBackslash\fR.
.PP
-This is a utility procedure provided for backwards compatibilty with
+This is a utility procedure provided for backwards compatibility with
non-internationalized Tcl extensions. It parses a backslash sequence and
returns the low byte of the Unicode character corresponding to the sequence.
.VE
diff --git a/tcl/doc/BoolObj.3 b/tcl/doc/BoolObj.3
index 43a308a39ba..86173385174 100644
--- a/tcl/doc/BoolObj.3
+++ b/tcl/doc/BoolObj.3
@@ -75,6 +75,12 @@ Otherwise, \fBTcl_GetBooleanFromObj\fR returns \fBTCL_OK\fR
and stores the boolean value in the address given by \fIboolPtr\fR.
If the object is not already a boolean object,
the conversion will free any old internal representation.
+Objects having a string representation equal to any of \fB0\fR,
+\fBfalse\fR, \fBno\fR, or \fBoff\fR have a boolean value 0; if the
+string representation is any of \fB1\fR, \fBtrue\fR, \fByes\fR, or
+\fBon\fR the boolean value is 1.
+Any of these string values may be abbreviated, and upper-case spellings
+are also acceptable.
.SH "SEE ALSO"
Tcl_NewObj, Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_GetObjResult
diff --git a/tcl/doc/ByteArrObj.3 b/tcl/doc/ByteArrObj.3
index ae3261b993d..85aa82aaa41 100644
--- a/tcl/doc/ByteArrObj.3
+++ b/tcl/doc/ByteArrObj.3
@@ -28,7 +28,7 @@ unsigned char *
\fBTcl_SetByteArrayLength\fR(\fIobjPtr, length\fR)
.SH ARGUMENTS
.AS "unsigned char" *lengthPtr in/out
-.AP "unsigned char" *bytes in
+.AP "CONST unsigned char" *bytes in
The array of bytes used to initialize or set a byte-array object.
.AP int length in
The length of the array of bytes. It must be >= 0.
diff --git a/tcl/doc/ChnlStack.3 b/tcl/doc/ChnlStack.3
index a99e2848e69..c1c3c87ebf4 100644
--- a/tcl/doc/ChnlStack.3
+++ b/tcl/doc/ChnlStack.3
@@ -10,7 +10,7 @@
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
-Tcl_StackChannel, Tcl_UnstackChannel, Tcl_GetStackedChannel \- stack an I/O channel on top of another, and undo it
+Tcl_StackChannel, Tcl_UnstackChannel, Tcl_GetStackedChannel, Tcl_GetTopChannel \- stack an I/O channel on top of another, and undo it
.SH SYNOPSIS
.nf
.nf
@@ -25,6 +25,9 @@ int
Tcl_Channel
\fBTcl_GetStackedChannel\fR(\fIchannel\fR)
.sp
+Tcl_Channel
+\fBTcl_GetTopChannel\fR(\fIchannel\fR)
+.sp
.SH ARGUMENTS
.AS Tcl_ChannelType
.AP Tcl_Interp *interp in
@@ -82,6 +85,12 @@ associated with the channel name, and the processing module added by
\fBTcl_UnstackChannel\fP is equivalent to \fBTcl_Close\fP. If an error
occurs unstacking the channel, \fBTCL_ERROR\fR is returned, otherwise
\fBTCL_OK\fR is returned.
+.PP
+\fBTcl_GetTopChannel\fR returns the top channel in the stack of
+channels the supplied channel is part of.
+.PP
+\fBTcl_GetStackedChannel\fR returns the channel in the stack of
+channels which is just below the supplied channel.
.SH "SEE ALSO"
Notifier(3), Tcl_CreateChannel(3), Tcl_OpenFileChannel(3), vwait(n).
diff --git a/tcl/doc/CmdCmplt.3 b/tcl/doc/CmdCmplt.3
index 3147926a10d..9fa44929503 100644
--- a/tcl/doc/CmdCmplt.3
+++ b/tcl/doc/CmdCmplt.3
@@ -19,8 +19,8 @@ Tcl_CommandComplete \- Check for unmatched braces in a Tcl command
int
\fBTcl_CommandComplete\fR(\fIcmd\fR)
.SH ARGUMENTS
-.AS char *cmd
-.AP char *cmd in
+.AS "CONST char" *cmd
+.AP "CONST char" *cmd in
Command string to test for completeness.
.BE
diff --git a/tcl/doc/Concat.3 b/tcl/doc/Concat.3
index 8c81cf02bf7..d6b03acad9d 100644
--- a/tcl/doc/Concat.3
+++ b/tcl/doc/Concat.3
@@ -16,12 +16,12 @@ Tcl_Concat \- concatenate a collection of strings
.nf
\fB#include <tcl.h>\fR
.sp
-char *
+CONST char *
\fBTcl_Concat\fR(\fIargc, argv\fR)
.SH ARGUMENTS
.AP int argc in
Number of strings.
-.AP char *argv[] in
+.AP "CONST char * CONST" argv[] in
Array of strings to concatenate. Must have \fIargc\fR entries.
.BE
diff --git a/tcl/doc/CrtChannel.3 b/tcl/doc/CrtChannel.3
index 0030b7f61d4..45d043b816a 100644
--- a/tcl/doc/CrtChannel.3
+++ b/tcl/doc/CrtChannel.3
@@ -11,7 +11,7 @@
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
-Tcl_CreateChannel, Tcl_GetChannelInstanceData, Tcl_GetChannelType, Tcl_GetChannelName, Tcl_GetChannelHandle, Tcl_GetChannelMode, Tcl_GetChannelBufferSize, Tcl_SetChannelBufferSize, Tcl_NotifyChannel, Tcl_BadChannelOption, 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, Tcl_ChannelHandlerProc, \- procedures for creating and manipulating channels
+Tcl_CreateChannel, Tcl_GetChannelInstanceData, Tcl_GetChannelType, Tcl_GetChannelName, Tcl_GetChannelHandle, Tcl_GetChannelMode, Tcl_GetChannelBufferSize, Tcl_SetChannelBufferSize, Tcl_NotifyChannel, Tcl_BadChannelOption, Tcl_ChannelName, Tcl_ChannelVersion, Tcl_ChannelBlockModeProc, Tcl_ChannelCloseProc, Tcl_ChannelClose2Proc, Tcl_ChannelInputProc, Tcl_ChannelOutputProc, Tcl_ChannelSeekProc, Tcl_ChannelWideSeekProc, Tcl_ChannelSetOptionProc, Tcl_ChannelGetOptionProc, Tcl_ChannelWatchProc, Tcl_ChannelGetHandleProc, Tcl_ChannelFlushProc, Tcl_ChannelHandlerProc, Tcl_IsChannelShared, Tcl_IsChannelRegistered, Tcl_CutChannel, Tcl_SpliceChannel, Tcl_IsChannelExisting, Tcl_ClearChannelHandlers, Tcl_GetChannelThread, Tcl_ChannelBuffered \- procedures for creating and manipulating channels
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -25,12 +25,17 @@ ClientData
Tcl_ChannelType *
\fBTcl_GetChannelType\fR(\fIchannel\fR)
.sp
-char *
+CONST char *
\fBTcl_GetChannelName\fR(\fIchannel\fR)
.sp
int
\fBTcl_GetChannelHandle\fR(\fIchannel, direction, handlePtr\fR)
.sp
+.VS 8.4
+Tcl_ThreadId
+\fBTcl_GetChannelThread\fR(\fIchannel\fR)
+.VE 8.4
+.sp
int
\fBTcl_GetChannelBufferSize\fR(\fIchannel\fR)
.sp
@@ -40,9 +45,31 @@ int
.sp
int
\fBTcl_BadChannelOption\fR(\fIinterp, optionName, optionList\fR)
-.VS 8.3.2
+.VS 8.4
+.sp
+int
+\fBTcl_IsChannelShared\fR(\fIchannel\fR)
+.sp
+int
+\fBTcl_IsChannelRegistered\fR(\fIinterp, channel\fR)
+.sp
+int
+\fBTcl_IsChannelExisting\fR(\fIchannelName\fR)
.sp
-char *
+void
+\fBTcl_CutChannel\fR(\fIchannel\fR)
+.sp
+void
+\fBTcl_SpliceChannel\fR(\fIchannel\fR)
+.sp
+void
+\fBTcl_ClearChannelHandlers\fR(\fIchannel\fR)
+.VE 8.4
+.sp
+int
+\fBTcl_ChannelBuffered\fR(\fIchannel\fR)
+.sp
+CONST char *
\fBTcl_ChannelName\fR(\fItypePtr\fR)
.sp
Tcl_ChannelTypeVersion
@@ -66,6 +93,11 @@ Tcl_DriverOutputProc *
Tcl_DriverSeekProc *
\fBTcl_ChannelSeekProc\fR(\fItypePtr\fR)
.sp
+.VS 8.4
+Tcl_DriverWideSeekProc *
+\fBTcl_ChannelWideSeekProc\fR(\fItypePtr\fR)
+.VE 8.4
+.sp
Tcl_DriverSetOptionProc *
\fBTcl_ChannelSetOptionProc\fR(\fItypePtr\fR)
.sp
@@ -83,14 +115,13 @@ Tcl_DriverFlushProc *
.sp
Tcl_DriverHandlerProc *
\fBTcl_ChannelHandlerProc\fR(\fItypePtr\fR)
-.VE
.sp
.SH ARGUMENTS
-.AS Tcl_EolTranslation *channelName in
+.AS Tcl_ChannelType *channelName in
.AP 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 char *channelName in
+.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.
@@ -108,9 +139,6 @@ means the output handle is wanted.
.AP ClientData *handlePtr out
Points to the location where the desired OS-specific handle should be
stored.
-.AP Tcl_EolTranslation transMode in
-The translation mode; one of the constants \fBTCL_TRANSLATE_AUTO\fR,
-\fBTCL_TRANSLATE_CR\fR, \fBTCL_TRANSLATE_LF\fR and \fBTCL_TRANSLATE_CRLF\fR.
.AP int size in
The size, in bytes, of buffers to allocate in this channel.
.AP int mask in
@@ -119,9 +147,9 @@ and \fBTCL_EXCEPTION\fR that indicates events that have occurred on
this channel.
.AP Tcl_Interp *interp in
Current interpreter. (can be NULL)
-.AP char *optionName in
+.AP "CONST char" *optionName in
Name of the invalid option.
-.AP char *optionList in
+.AP "CONST char" *optionList in
Specific options list (space separated words, without "-")
to append to the standard generic options list.
Can be NULL for generic options error message only.
@@ -175,6 +203,15 @@ mode indicated by \fImask\fR.
For a discussion of channel drivers, their operations and the
\fBTcl_ChannelType\fR structure, see the section TCL_CHANNELTYPE, below.
.PP
+\fBTcl_CreateChannel\fR interacts with the code managing the standard
+channels. Once a standard channel was initialized either through a
+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
+regard to them.
+.PP
\fBTcl_GetChannelInstanceData\fR returns the instance data associated with
the channel in \fIchannel\fR. This is the same as the \fIinstanceData\fR
argument in the call to \fBTcl_CreateChannel\fR that created this channel.
@@ -195,13 +232,19 @@ the channel does not have a device handle for the specified direction,
then \fBTCL_ERROR\fR is returned instead. Different channel drivers
will return different types of handle. Refer to the manual entries
for each driver to determine what type of handle is returned.
+.VS 8.4
+.PP
+\fBTcl_GetChannelThread\fR returns the id of the thread currently managing
+the specified \fIchannel\fR. This allows channel drivers to send their file
+events to the correct event queue even for a multi-threaded core.
+.VE 8.4
.PP
\fBTcl_GetChannelMode\fR returns an OR-ed combination of \fBTCL_READABLE\fR
and \fBTCL_WRITABLE\fR, indicating whether the channel is open for input
and output.
.PP
- \fBTcl_GetChannelBufferSize\fR returns the size, in bytes, of buffers
-allocated to store input or output in \fIchan\fR. If the value was not set
+\fBTcl_GetChannelBufferSize\fR returns the size, in bytes, of buffers
+allocated to store input or output in \fIchannel\fR. If the value was not set
by a previous call to \fBTcl_SetChannelBufferSize\fR, described below, then
the default value of 4096 is returned.
.PP
@@ -220,6 +263,38 @@ channel. See \fBWATCHPROC\fR below for more details.
.PP
\fBTcl_BadChannelOption\fR is called from driver specific set or get option
procs to generate a complete error message.
+.PP
+\fBTcl_ChannelBuffered\fR returns the number of bytes of input
+currently buffered in the internal buffer (push back area) of the
+channel itself. It does not report about the data in the overall
+buffers for the stack of channels the supplied channel is part of.
+.PP
+.VS 8.4
+\fBTcl_IsChannelShared\fR checks the refcount of the specified
+\fIchannel\fR and returns whether the \fIchannel\fR was shared among
+multiple interpreters (result == 1) or not (result == 0).
+.PP
+\fBTcl_IsChannelRegistered\fR checks whether the specified \fIchannel\fR is
+registered in the given \fIinterp\fRreter (result == 1) or not
+(result == 0).
+.PP
+\fBTcl_IsChannelExisting\fR checks whether a channel with the specified
+name is registered in the (thread)-global list of all channels (result
+== 1) or not (result == 0).
+.PP
+\fBTcl_CutChannel\fR removes the specified \fIchannel\fR from the
+(thread)global list of all channels (of the current thread).
+Application to a channel still registered in some interpreter
+is not allowed.
+.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.
+.PP
+\fBTcl_ClearChannelHandlers\fR removes all channelhandlers and event
+scripts associated with the specified \fIchannel\fR, thus shutting
+down all event processing for this channel.
+.VE 8.4
.SH TCL_CHANNELTYPE
.PP
@@ -227,8 +302,8 @@ A channel driver provides a \fBTcl_ChannelType\fR structure that contains
pointers to functions that implement the various operations on a channel;
these operations are invoked as needed by the generic layer. The structure
was versioned starting in Tcl 8.3.2/8.4 to correct a problem with stacked
-channel drivers. See the \fBOLD_CHANNEL\fR section below for details about
-the old structure.
+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:
.CS
@@ -247,6 +322,7 @@ typedef struct Tcl_ChannelType {
Tcl_DriverBlockModeProc *\fIblockModeProc\fR;
Tcl_DriverFlushProc *\fIflushProc\fR;
Tcl_DriverHandlerProc *\fIhandlerProc\fR;
+ Tcl_DriverWideSeekProc *\fIwideSeekProc\fR;
} Tcl_ChannelType;
.CE
.PP
@@ -258,7 +334,6 @@ 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.
.PP
-.VS 8.3.2
The user should only use the above structure for \fBTcl_ChannelType\fR
instantiation. When referencing fields in a \fBTcl_ChannelType\fR
structure, the following functions should be used to obtain the values:
@@ -266,6 +341,9 @@ structure, the following functions should be used to obtain the values:
\fBTcl_ChannelBlockModeProc\fR, \fBTcl_ChannelCloseProc\fR,
\fBTcl_ChannelClose2Proc\fR, \fBTcl_ChannelInputProc\fR,
\fBTcl_ChannelOutputProc\fR, \fBTcl_ChannelSeekProc\fR,
+.VS 8.4
+\fBTcl_ChannelWideSeekProc\fR,
+.VE 8.4
\fBTcl_ChannelSetOptionProc\fR, \fBTcl_ChannelGetOptionProc\fR,
\fBTcl_ChannelWatchProc\fR, \fBTcl_ChannelGetHandleProc\fR,
\fBTcl_ChannelFlushProc\fR, or \fBTcl_ChannelHandlerProc\fR.
@@ -274,7 +352,6 @@ The change to the structures was made in such a way that standard channel
types are binary compatible. However, channel types that use stacked
channels (ie: TLS, Trf) have new versions to correspond to the above change
since the previous code for stacked channels had problems.
-.VE
.SH TYPENAME
.PP
@@ -282,24 +359,23 @@ The \fItypeName\fR field contains a null-terminated string that
identifies the type of the device implemented by this driver, e.g.
\fBfile\fR or \fBsocket\fR.
.PP
-.VS 8.3.2
-This value can be retried with \fBTcl_ChannelName\fR, which returns
+This value can be retrieved with \fBTcl_ChannelName\fR, which returns
a pointer to the string.
-.VE
-.VS 8.3.2
.SH VERSION
.PP
The \fIversion\fR field should be set to \fBTCL_CHANNEL_VERSION_2\fR.
-If it is not set to this value \fBTCL_CHANNEL_VERSION_2\fR, then this
+If it is not set to this value \fBTCL_CHANNEL_VERSION_3\fR, then this
\fBTcl_ChannelType\fR is assumed to have the older structure. See
-\fBOLD_CHANNEL\fR for more details. While Tcl will recognize and
-function with either structure, stacked channels must be of the newer
-style to function correctly.
-.PP
-This value can be retried with \fBTcl_ChannelVersion\fR, which returns
-either \fBTCL_CHANNEL_VERSION_2\fR or \fBTCL_CHANNEL_VERSION_1\fR.
-.VE
+\fBOLD CHANNEL TYPES\fR for more details. While Tcl will recognize
+and function with either structure, stacked channels must be of at
+least \fBTCL_CHANNEL_VERSION_2\fR to function correctly.
+.PP
+This value can be retrieved with \fBTcl_ChannelVersion\fR, which returns
+.VS 8.4
+one of \fBTCL_CHANNEL_VERSION_3\fR,
+.VE 8.4
+\fBTCL_CHANNEL_VERSION_2\fR or \fBTCL_CHANNEL_VERSION_1\fR.
.SH BLOCKMODEPROC
.PP
@@ -327,10 +403,8 @@ For some device types, the blocking and nonblocking behavior can be
implemented by the underlying operating system; for other device types, the
behavior must be emulated in the channel driver.
.PP
-.VS 8.3.2
-This value can be retried with \fBTcl_ChannelBlockModeProc\fR, which returns
+This value can be retrieved with \fBTcl_ChannelBlockModeProc\fR, which returns
a pointer to the function.
-.VE
.SH "CLOSEPROC AND CLOSE2PROC"
.PP
@@ -382,11 +456,9 @@ return a nonzero POSIX error code. In addition, if an error occurs and
\fIinterp\fR is not NULL, the procedure should store an error message
in the interpreter's result.
.PP
-.VS 8.3.2
-These value can be retried with \fBTcl_ChannelCloseProc\fR or
+These value can be retrieved with \fBTcl_ChannelCloseProc\fR or
\fBTcl_ChannelClose2Proc\fR, which returns a pointer to the respective
function.
-.VE
.SH INPUTPROC
.PP
@@ -430,10 +502,8 @@ for the shortest possible time until at least one byte of data can be read
from the device; then, it should return as much data as it can read without
blocking.
.PP
-.VS 8.3.2
-This value can be retried with \fBTcl_ChannelInputProc\fR, which returns
+This value can be retrieved with \fBTcl_ChannelInputProc\fR, which returns
a pointer to the function.
-.VE
.SH OUTPUTPROC
.PP
@@ -444,7 +514,7 @@ generic layer to transfer data from an internal buffer to the output device.
.CS
typedef int Tcl_DriverOutputProc(
ClientData \fIinstanceData\fR,
- char *\fIbuf\fR,
+ CONST char *\fIbuf\fR,
int \fItoWrite\fR,
int *\fIerrorCodePtr\fR);
.CE
@@ -471,12 +541,10 @@ If the channel is nonblocking and the output device is unable to absorb any
data whatsoever, the function should return -1 with an \fBEAGAIN\fR error
without writing any data.
.PP
-.VS 8.3.2
-This value can be retried with \fBTcl_ChannelOutputProc\fR, which returns
+This value can be retrieved with \fBTcl_ChannelOutputProc\fR, which returns
a pointer to the function.
-.VE
-.SH SEEKPROC
+.SH "SEEKPROC AND WIDESEEKPROC"
.PP
The \fIseekProc\fR field contains the address of a function called by the
generic layer to move the access point at which subsequent input or output
@@ -505,10 +573,32 @@ does not implement seeking.
The return value is the new access point or -1 in case of error. If an
error occurred, the function should not move the access point.
.PP
-.VS 8.3.2
-This value can be retried with \fBTcl_ChannelSeekProc\fR, which returns
-a pointer to the function.
-.VE
+.VS 8.4
+If there is a non-NULL \fIseekProc\fR field, the \fIwideSeekProc\fR
+field may contain the address of an alternative function to use which
+handles wide (i.e. larger than 32-bit) offsets, so allowing seeks
+within files larger than 2GB. The \fIwideSeekProc\fR will be called
+in preference to the \fIseekProc\fR, but both must be defined if the
+\fIwideSeekProc\fR is defined. \fIWideSeekProc\fR must match the
+following prototype:
+.PP
+.CS
+typedef Tcl_WideInt Tcl_DriverWideSeekProc(
+ ClientData \fIinstanceData\fR,
+ Tcl_WideInt \fIoffset\fR,
+ int \fIseekMode\fR,
+ int *\fIerrorCodePtr\fR);
+.CE
+.PP
+The arguments and return values mean the same thing as with
+\fIseekProc\fR above, except that the type of offsets and the return
+type are different.
+.PP
+The \fIseekProc\fR value can be retrieved with
+\fBTcl_ChannelSeekProc\fR, which returns a pointer to the function,
+and similarly the \fIwideSeekProc\fR can be retrieved with
+\fBTcl_ChannelWideSeekProc\fR.
+.VE 8.4
.SH SETOPTIONPROC
.PP
@@ -520,11 +610,11 @@ the generic layer to set a channel type specific option on a channel.
typedef int Tcl_DriverSetOptionProc(
ClientData \fIinstanceData\fR,
Tcl_Interp *\fIinterp\fR,
- char *\fIoptionName\fR,
- char *\fIoptionValue\fR);
+ CONST char *\fIoptionName\fR,
+ CONST char *\fInewValue\fR);
.CE
.PP
-\fIoptionName\fR is the name of an option to set, and \fIoptionValue\fR is
+\fIoptionName\fR is the name of an option to set, and \fInewValue\fR is
the new value for that option, as a string. The \fIinstanceData\fR is the
same as the value given to \fBTcl_CreateChannel\fR when this channel was
created. The function should do whatever channel type specific action is
@@ -542,17 +632,15 @@ returns \fBTCL_OK\fR.
It should call \fBTcl_BadChannelOption\fR which itself returns
\fBTCL_ERROR\fR if the \fIoptionName\fR is
unrecognized.
-If \fIoptionValue\fR specifies a value for the option that
+If \fInewValue\fR specifies a value for the option that
is not supported or if a system call error occurs,
the function should leave an error message in the
\fIresult\fR field of \fIinterp\fR if \fIinterp\fR is not NULL. The
function should also call \fBTcl_SetErrno\fR to store an appropriate POSIX
error code.
.PP
-.VS 8.3.2
-This value can be retried with \fBTcl_ChannelSetOptionProc\fR, which returns
+This value can be retrieved with \fBTcl_ChannelSetOptionProc\fR, which returns
a pointer to the function.
-.VE
.SH GETOPTIONPROC
.PP
@@ -564,21 +652,21 @@ channel. \fIgetOptionProc\fR must match the following prototype:
typedef int Tcl_DriverGetOptionProc(
ClientData \fIinstanceData\fR,
Tcl_Interp *\fIinterp\fR,
- char *\fIoptionName\fR,
- Tcl_DString *\fIdsPtr\fR);
+ CONST char *\fIoptionName\fR,
+ Tcl_DString *\fIoptionValue\fR);
.CE
.PP
\fIOptionName\fR is the name of an option supported by this type of
channel. If the option name is not NULL, the function stores its current
-value, as a string, in the Tcl dynamic string \fIdsPtr\fR.
-If \fIoptionName\fR is NULL, the function stores in \fIdsPtr\fR an
+value, as a string, in the Tcl dynamic string \fIoptionValue\fR.
+If \fIoptionName\fR is NULL, the function stores in \fIoptionValue\fR an
alternating list of all supported options and their current values.
On success, the function returns \fBTCL_OK\fR.
It should call \fBTcl_BadChannelOption\fR which itself returns
\fBTCL_ERROR\fR if the \fIoptionName\fR is
unrecognized. If a system call error occurs,
the function should leave an error message in the
-\fIresult\fR field of \fIinterp\fR if \fIinterp\fR is not NULL. The
+result of \fIinterp\fR if \fIinterp\fR is not NULL. The
function should also call \fBTcl_SetErrno\fR to store an appropriate POSIX
error code.
.PP
@@ -589,10 +677,8 @@ channel driver will get called to implement them. The \fIgetOptionProc\fR
field can be NULL, which indicates that this channel type supports no type
specific options.
.PP
-.VS 8.3.2
-This value can be retried with \fBTcl_ChannelGetOptionProc\fR, which returns
+This value can be retrieved with \fBTcl_ChannelGetOptionProc\fR, which returns
a pointer to the function.
-.VE
.SH WATCHPROC
.PP
@@ -624,10 +710,8 @@ the Tcl event queue to allow the channel event to be scheduled in sequence
with other events. See the description of \fBTcl_QueueEvent\fR for
details on how to queue an event.
.PP
-.VS 8.3.2
-This value can be retried with \fBTcl_ChannelWatchProc\fR, which returns
+This value can be retrieved with \fBTcl_ChannelWatchProc\fR, which returns
a pointer to the function.
-.VE
.SH GETHANDLEPROC
.PP
@@ -656,12 +740,9 @@ stored in the location referred to by \fIhandlePtr\fR, and
specified direction, or if the channel implementation does not use
device handles, the function should return \fBTCL_ERROR\fR.
.PP
-.VS 8.3.2
-This value can be retried with \fBTcl_ChannelGetHandleProc\fR, which returns
+This value can be retrieved with \fBTcl_ChannelGetHandleProc\fR, which returns
a pointer to the function.
-.VE
-.VS 8.3.2
.SH FLUSHPROC
.PP
The \fIflushProc\fR field is currently reserved for future use.
@@ -673,13 +754,13 @@ typedef int Tcl_DriverFlushProc(
ClientData \fIinstanceData\fR);
.CE
.PP
-This value can be retried with \fBTcl_ChannelFlushProc\fR, which returns
+This value can be retrieved with \fBTcl_ChannelFlushProc\fR, which returns
a pointer to the function.
.SH HANDLERPROC
.PP
The \fIhandlerProc\fR field contains the address of a function called by
-the generic layer to notify the channel that an event occured. It should
+the generic layer to notify the channel that an event occurred. It should
be defined for stacked channel drivers that wish to be notified of events
that occur on the underlying (stacked) channel.
\fIHandlerProc\fR should match the following prototype:
@@ -693,11 +774,10 @@ typedef int Tcl_DriverHandlerProc(
\fIInstanceData\fR is the same as the value passed to \fBTcl_CreateChannel\fR
when this channel was created. The \fIinterestMask\fR is an OR-ed
combination of \fBTCL_READABLE\fR or \fBTCL_WRITABLE\fR; it indicates what
-type of event occured on this channel.
+type of event occurred on this channel.
.PP
-This value can be retried with \fBTcl_ChannelHandlerProc\fR, which returns
+This value can be retrieved with \fBTcl_ChannelHandlerProc\fR, which returns
a pointer to the function.
-.VE
.SH TCL_BADCHANNELOPTION
.PP
@@ -709,7 +789,7 @@ the generic options error message string.
.PP
It always return \fBTCL_ERROR\fR
.PP
-An error message is generated in interp's result object to
+An error message is generated in \fIinterp\fR's result object to
indicate that a command was invoked with the a bad option
The message has the form
.CS
@@ -719,14 +799,14 @@ so you get for instance:
bad option "-blah": should be one of -blocking,
-buffering, -buffersize, -eofchar, -translation,
-peername, or -sockname
-when called with optionList="peername sockname"
+when called with \fIoptionList\fR="peername sockname"
.CE
-``blah'' is the optionName argument and ``<specific options>''
+``blah'' is the \fIoptionName\fR argument and ``<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.
-.SH OLD_CHANNEL
+.SH "OLD CHANNEL TYPES"
The original (8.3.1 and below) \fBTcl_ChannelType\fR structure contains
the following fields:
@@ -752,9 +832,37 @@ internal channel code will determine the version. It is imperative to use
the new \fBTcl_ChannelType\fR structure if you are creating a stacked
channel driver, due to problems with the earlier stacked channel
implementation (in 8.2.0 to 8.3.1).
+.PP
+.VS 8.4
+Prior to 8.4.0 (i.e. during the later releases of 8.3 and early part
+of the 8.4 development cycle) the \fBTcl_ChannelType\fR structure
+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_ChannelType;
+.CE
+.PP
+When the above structure is registered as a channel type, the
+\fIversion\fR field should always be \fBTCL_CHANNEL_VERSION_2\fR.
+.VE 8.4
.SH "SEE ALSO"
-Tcl_Close(3), Tcl_OpenFileChannel(3), Tcl_SetErrno(3), Tcl_QueueEvent(3), Tcl_StackChannel(3)
+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/tcl/doc/CrtCommand.3 b/tcl/doc/CrtCommand.3
index a2946854ac3..2b429a00862 100644
--- a/tcl/doc/CrtCommand.3
+++ b/tcl/doc/CrtCommand.3
@@ -22,7 +22,9 @@ Tcl_Command
.AS Tcl_CmdDeleteProc **deleteProcPtr
.AP Tcl_Interp *interp in
Interpreter in which to create new command.
-.AP char *cmdName in
+.VS 8.4
+.AP "CONST char" *cmdName in
+.VE
Name of command.
.AP Tcl_CmdProc *proc in
Implementation of new command: \fIproc\fR will be called whenever
@@ -82,7 +84,7 @@ typedef int Tcl_CmdProc(
ClientData \fIclientData\fR,
Tcl_Interp *\fIinterp\fR,
int \fIargc\fR,
- char *\fIargv\fR[]);
+ CONST char *\fIargv\fR[]);
.CE
When \fIproc\fR is invoked the \fIclientData\fR and \fIinterp\fR
parameters will be copies of the \fIclientData\fR and \fIinterp\fR
diff --git a/tcl/doc/CrtInterp.3 b/tcl/doc/CrtInterp.3
index 4347736413d..c6f8f6ce57f 100644
--- a/tcl/doc/CrtInterp.3
+++ b/tcl/doc/CrtInterp.3
@@ -38,9 +38,9 @@ procedures, such as \fBTcl_CreateCommand\fR, \fBTcl_Eval\fR, and
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.
-The new interpreter is initialized with no defined variables and only
-the built-in Tcl commands. To bind in additional commands, call
-\fBTcl_CreateCommand\fR.
+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.
.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
@@ -103,8 +103,6 @@ has been called. To ensure that the interpreter is properly deleted when
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.
-Do not call \fBTcl_DeleteInterp\fR on an interpreter for which
-\fBTcl_InterpDeleted\fR returns nonzero.
.TP
Retrieving An Interpreter From A Data Structure
When an interpreter is retrieved from a data structure (e.g. the client
diff --git a/tcl/doc/CrtMathFnc.3 b/tcl/doc/CrtMathFnc.3
index 253c10cafc8..90f2a6a89be 100644
--- a/tcl/doc/CrtMathFnc.3
+++ b/tcl/doc/CrtMathFnc.3
@@ -8,20 +8,31 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH Tcl_CreateMathFunc 3 7.0 Tcl "Tcl Library Procedures"
+.TH Tcl_CreateMathFunc 3 8.4 Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_CreateMathFunc \- Define a new math function for expressions
+Tcl_CreateMathFunc, Tcl_GetMathFuncInfo, Tcl_ListMathFuncs \- Define, query and enumerate math functions for expressions
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
+void
\fBTcl_CreateMathFunc\fR(\fIinterp, name, numArgs, argTypes, proc, clientData\fR)
+.sp
+.VS 8.4
+int
+\fBTcl_GetMathFuncInfo\fR(\fIinterp, name, numArgsPtr, argTypesPtr, procPtr, clientDataPtr\fR)
+.sp
+Tcl_Obj *
+\fBTcl_ListMathFuncs\fR(\fIinterp, pattern\fR)
+.VE
.SH ARGUMENTS
-.AS Tcl_ValueType clientData
+.AS Tcl_ValueType *clientDataPtr
.AP Tcl_Interp *interp in
Interpreter in which new function will be defined.
-.AP char *name in
+.VS 8.4
+.AP "CONST char" *name in
+.VE
Name for new function.
.AP int numArgs in
Number of arguments to new function; also gives size of \fIargTypes\fR array.
@@ -32,6 +43,24 @@ function.
Procedure that implements the function.
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIproc\fR when it is invoked.
+.AP int *numArgsPtr out
+Points to a variable that will be set to contain the number of
+arguments to the function.
+.AP Tcl_ValueType *argTypesPtr out
+Points to a variable that will be set to contain a pointer to an array
+giving the permissible types for each argument to the function which
+will need to be freed up using \fITcl_Free\fR.
+.AP Tcl_MathProc *procPtr out
+Points to a variable that will be set to contain a pointer to the
+implementation code for the function (or NULL if the function is
+implemented directly in bytecode.)
+.AP ClientData *clientDataPtr out
+Points to a variable that will be set to contain the clientData
+argument passed to \fITcl_CreateMathFunc\fR when the function was
+created if the function is not implemented directly in bytecode.
+.AP "CONST char" *pattern in
+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
@@ -88,6 +117,32 @@ to indicate which value was set.
Under normal circumstances \fIproc\fR should return TCL_OK.
If an error occurs while executing the function, \fIproc\fR should
return TCL_ERROR and leave an error message in the interpreter's result.
+.PP
+.VS 8.4
+\fBTcl_GetMathFuncInfo\fR retrieves the values associated with
+function \fIname\fR that were passed to a preceding
+\fBTcl_CreateMathFunc\fR call. Normally, the return code is
+\fBTCL_OK\fR but if the named function does not exist, \fBTCL_ERROR\fR
+is returned and an error message is placed in the interpreter's
+result.
+.PP
+If an error did not occur, the array reference placed in the variable
+pointed to by \fIargTypesPtr\fR is newly allocated, and should be
+released by passing it to \fBTcl_Free\fR. Some functions (the
+standard set implemented in the core) are implemented directly at the
+bytecode level; attempting to retrieve values for them causes a NULL
+to be stored in the variable pointed to by \fIprocPtr\fR and the
+variable pointed to by \fIclientDataPtr\fR will not be modified.
+.PP
+\fBTcl_ListMathFuncs\fR returns a Tcl object 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.
+.VE
.SH KEYWORDS
expression, mathematical function
+
+.SH "SEE ALSO"
+expr(n), info(n), Tcl_Free(3), Tcl_NewListObj(3)
diff --git a/tcl/doc/CrtObjCmd.3 b/tcl/doc/CrtObjCmd.3
index 2b97779c7f7..5752c50b884 100644
--- a/tcl/doc/CrtObjCmd.3
+++ b/tcl/doc/CrtObjCmd.3
@@ -10,7 +10,7 @@
.TH Tcl_CreateObjCommand 3 8.0 Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_CreateObjCommand, Tcl_DeleteCommand, Tcl_DeleteCommandFromToken, Tcl_GetCommandInfo, Tcl_SetCommandInfo, Tcl_GetCommandName \- implement new commands in C
+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
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -30,13 +30,31 @@ int
int
\fBTcl_SetCommandInfo\fR(\fIinterp, cmdName, infoPtr\fR)
.sp
-char *
+.VS 8.4
+int
+\fBTcl_GetCommandInfoFromToken\fR(\fItoken, infoPtr\fR)
+.sp
+int
+\fBTcl_SetCommandInfoFromToken\fR(\fItoken, infoPtr\fR)
+.VE
+.sp
+.VS 8.4
+CONST char *
+.VE
\fBTcl_GetCommandName\fR(\fIinterp, token\fR)
+.sp
+void
+\fBTcl_GetCommandFullName\fR(\fIinterp, token, objPtr\fR)
+.sp
+Tcl_Command
+\fBTcl_GetCommandFromObj\fR(\fIinterp, objPtr\fR)
.SH ARGUMENTS
.AS Tcl_ObjCmdProc *deleteProc in/out
.AP Tcl_Interp *interp in
Interpreter in which to create a new command or that contains a command.
+.VS 8.4
.AP char *cmdName in
+.VE
Name of command.
.AP Tcl_ObjCmdProc *proc in
Implementation of the new command: \fIproc\fR will be called whenever
@@ -53,6 +71,8 @@ The command must not have been deleted.
.AP Tcl_CmdInfo *infoPtr in/out
Pointer to structure containing various information about a
Tcl command.
+.AP Tcl_Obj *objPtr in
+Object containing the name of a Tcl command.
.BE
.SH DESCRIPTION
.PP
@@ -226,6 +246,12 @@ to pass to \fIdeleteProc\fR; it is normally the same as
The field \fInamespacePtr\fR holds a pointer to the
Tcl_Namespace that contains the command.
.PP
+\fBTcl_GetCommandInfoFromToken\fR is identical to
+\fBTcl_GetCommandInfo\fR except that it uses a command token returned
+from \fBTcl_CreateObjCommand\fR in place of the command name. If the
+\fItoken\fR parameter is NULL, it returns 0; otherwise, it returns 1
+and fills in the structure designated by \fIinfoPtr\fR.
+.PP
\fBTcl_SetCommandInfo\fR is used to modify the procedures and
ClientData values associated with a command.
Its \fIcmdName\fR argument is the name of a command in \fIinterp\fR.
@@ -234,11 +260,22 @@ to identify a command in a particular namespace.
If this command does not exist then \fBTcl_SetCommandInfo\fR returns 0.
Otherwise, it copies the information from \fI*infoPtr\fR to
Tcl's internal structure for the command and returns 1.
-Note that this procedure allows the ClientData for a command's
-deletion procedure to be given a different value than the ClientData
-for its command procedure.
-Note that \fBTcl_SetCmdInfo\fR will not change a command's namespace;
-you must use \fBTcl_RenameCommand\fR to do that.
+.PP
+\fBTcl_SetCommandInfoFromToken\fR is identical to
+\fBTcl_SetCommandInfo\fR except that it takes a command token as
+returned by \fBTcl_CreateObjCommand\fR instead of the command name.
+If the \fItoken\fR parameter is NULL, it returns 0. Otherwise, it
+copies the information from \fI*infoPtr\fR to Tcl's internal structure
+for the command and returns 1.
+.PP
+Note that \fBTcl_SetCommandInfo\fR and
+\fBTcl_SetCommandInfoFromToken\fR both allow the ClientData for a
+command's deletion procedure to be given a different value than the
+ClientData for its command procedure.
+.PP
+Note that neither \fBTcl_SetCommandInfo\fR nor
+\fBTcl_SetCommandInfoFromToken\fR will change a command's namespace.
+You must use \fBTcl_RenameCommand\fR to do that.
.PP
\fBTcl_GetCommandName\fR provides a mechanism for tracking commands
that have been renamed.
@@ -252,7 +289,16 @@ 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
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.
+.PP
+\fBTcl_GetCommandFromObj\fR returns a token for the command
+specified by the name in a \fBTcl_Obj\fP.
+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
diff --git a/tcl/doc/CrtSlave.3 b/tcl/doc/CrtSlave.3
index 88767a12a87..ee63e7e0074 100644
--- a/tcl/doc/CrtSlave.3
+++ b/tcl/doc/CrtSlave.3
@@ -35,18 +35,18 @@ int
.sp
.VS
int
-\fBTcl_CreateAlias\fR(\fIslaveInterp, srcCmd, targetInterp, targetCmd, argc, argv\fR)
+\fBTcl_CreateAlias\fR(\fIslaveInterp, slaveCmd, targetInterp, targetCmd, argc, argv\fR)
.sp
int
-\fBTcl_CreateAliasObj\fR(\fIslaveInterp, srcCmd, targetInterp, targetCmd, objc, objv\fR)
+\fBTcl_CreateAliasObj\fR(\fIslaveInterp, slaveCmd, targetInterp, targetCmd, objc, objv\fR)
.VE
.sp
int
-\fBTcl_GetAlias\fR(\fIinterp, srcCmd, targetInterpPtr, targetCmdPtr, argcPtr, argvPtr\fR)
+\fBTcl_GetAlias\fR(\fIinterp, slaveCmd, targetInterpPtr, targetCmdPtr, argcPtr, argvPtr\fR)
.sp
.VS
int
-\fBTcl_GetAliasObj\fR(\fIinterp, srcCmd, targetInterpPtr, targetCmdPtr, objcPtr, objvPtr\fR)
+\fBTcl_GetAliasObj\fR(\fIinterp, slaveCmd, targetInterpPtr, targetCmdPtr, objcPtr, objvPtr\fR)
.sp
int
\fBTcl_ExposeCommand\fR(\fIinterp, hiddenCmdName, cmdName\fR)
@@ -57,7 +57,7 @@ int
.AS Tcl_InterpDeleteProc **hiddenCmdName
.AP Tcl_Interp *interp in
Interpreter in which to execute the specified command.
-.AP char *slaveName in
+.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
@@ -65,33 +65,33 @@ 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
below).
-.AP char *srcCmd in
+.AP "CONST char" *slaveCmd in
Name of source command for alias.
.AP Tcl_Interp *targetInterp in
Interpreter that contains the target command for an alias.
-.AP char *targetCmd in
+.AP "CONST char" *targetCmd in
Name of target command for alias in \fItargetInterp\fR.
.AP int argc in
Count of additional arguments to pass to the alias command.
-.AP char **argv in
+.AP "CONST char * CONST" *argv in
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.
.AP Tcl_Object **objv in
-Vector of Tcl_Obj structures, the additional object argumenst to pass to
+Vector of Tcl_Obj structures, the additional object arguments to pass to
the alias object 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
command is defined for an alias.
-.AP char **targetCmdPtr out
+.AP "CONST char" **targetCmdPtr out
Pointer to location to store the address of the name of the target command
for an alias.
.AP int *argcPtr out
Pointer to location to store count of additional arguments to be passed to
the alias. The location is in storage owned by the caller.
-.AP char ***argvPtr out
+.AP "CONST char" ***argvPtr out
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.
@@ -104,9 +104,13 @@ arguments to pass to an object alias command. The location is in storage
owned by the caller, the vector of Tcl_Obj structures is owned by the
called function.
.VS
-.AP char *cmdName in
+.VS 8.4
+.AP "CONST char" *cmdName in
+.VE
Name of an exposed command to hide or create.
-.AP char *hiddenCmdName in
+.VS 8.4
+.AP "CONST char" *hiddenCmdName in
+.VE
Name under which a hidden command is stored and with which it can be
exposed or invoked.
.VE
@@ -157,11 +161,11 @@ of the relative path succeeds, \fBTCL_OK\fR is returned, else
\fIaskingInterp\fR contains the error message.
.PP
.VS
-\fBTcl_CreateAlias\fR creates an object command named \fIsrcCmd\fR in
+\fBTcl_CreateAlias\fR creates an object 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 \fIsrcCmd\fR and passed to \fItargetCmd\fR.
+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
of \fIslaveInterp\fR.
@@ -220,11 +224,11 @@ 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 fail.
.PP
-.SH "SEE ALSO"
For a description of the Tcl interface to multiple interpreters, see
\fIinterp(n)\fR.
+.SH "SEE ALSO"
+interp
.SH KEYWORDS
alias, command, exposed commands, hidden commands, interpreter, invoke,
-master, slave,
-
+master, slave
diff --git a/tcl/doc/CrtTrace.3 b/tcl/doc/CrtTrace.3
index 8c95ed22895..0106a0e14fc 100644
--- a/tcl/doc/CrtTrace.3
+++ b/tcl/doc/CrtTrace.3
@@ -1,6 +1,7 @@
'\"
'\" 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.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -11,7 +12,7 @@
.TH Tcl_CreateTrace 3 "" Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_CreateTrace, Tcl_DeleteTrace \- arrange for command execution to be traced
+Tcl_CreateTrace, Tcl_CreateObjTrace, Tcl_DeleteTrace \- arrange for command execution to be traced
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -19,73 +20,109 @@ Tcl_CreateTrace, Tcl_DeleteTrace \- arrange for command execution to be traced
Tcl_Trace
\fBTcl_CreateTrace\fR(\fIinterp, level, proc, clientData\fR)
.sp
+Tcl_Trace
+\fBTcl_CreateObjTrace\fR(\fIinterp, level, flags, objProc, clientData, deleteProc\fR)
+.sp
\fBTcl_DeleteTrace\fR(\fIinterp, trace\fR)
.SH ARGUMENTS
-.AS Tcl_CmdTraceProc (clientData)()
+.AS Tcl_CmdObjTraceDeleteProc (clientData)()
.AP Tcl_Interp *interp in
Interpreter containing command to be traced or untraced.
.AP int level in
-Only commands at or below this nesting level will be traced. 1 means
+Only commands at or below this nesting level will be traced unless
+0 is specified. 1 means
top-level commands only, 2 means top-level commands or those that are
invoked as immediate consequences of executing top-level commands
(procedure bodies, bracketed commands, etc.) and so on.
+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
+details of the calling sequence.
.AP Tcl_CmdTraceProc *proc in
Procedure to call for each command that's executed. See below for
details on the calling sequence.
.AP ClientData clientData in
-Arbitrary one-word value to pass to \fIproc\fR.
+Arbitrary one-word value to pass to \fIobjProc\fR or \fIproc\fR.
+.AP Tcl_CmdObjTraceDeleteProc *deleteProc
+Procedure to call when the trace is deleted. See below for details of
+the calling sequence. A null pointer is permissible and results in no
+callback when the trace is deleted.
.AP Tcl_Trace trace in
Token for trace to be removed (return value from previous call
to \fBTcl_CreateTrace\fR).
.BE
-
.SH DESCRIPTION
.PP
-\fBTcl_CreateTrace\fR arranges for command tracing. From now on, \fIproc\fR
-will be invoked before Tcl calls command procedures to process
-commands in \fIinterp\fR. The return value from
-\fBTcl_CreateTrace\fR is a token for the trace,
-which may be passed to \fBTcl_DeleteTrace\fR to remove the trace. There may
-be many traces in effect simultaneously for the same command interpreter.
+\fBTcl_CreateObjTrace\fR arranges for command tracing. After it is
+called, \fIobjProc\fR will be invoked before the Tcl interpreter calls
+any command procedure when evaluating commands in \fIinterp\fR.
+The return value from \fBTcl_CreateObjTrace\fR is a token for the trace,
+which may be passed to \fBTcl_DeleteTrace\fR to remove the trace.
+There may be many traces in effect simultaneously for the same
+interpreter.
.PP
-\fIProc\fR should have arguments and result that match the
-type \fBTcl_CmdTraceProc\fR:
+\fIobjProc\fR should have arguments and result that match the type,
+\fBTcl_CmdObjTraceProc\fR:
.CS
-typedef void Tcl_CmdTraceProc(
- ClientData \fIclientData\fR,
- Tcl_Interp *\fIinterp\fR,
- int \fIlevel\fR,
- char *\fIcommand\fR,
- Tcl_CmdProc *\fIcmdProc\fR,
- ClientData \fIcmdClientData\fR,
- int \fIargc\fR,
- char *\fIargv\fR[]);
+typedef int \fBTcl_CmdObjTraceProc\fR(
+ \fBClientData\fR \fIclientData\fR,
+ \fBTcl_Interp\fR* \fIinterp\fR,
+ int \fIlevel\fR,
+ CONST char* \fIcommand\fR,
+ \fBTcl_Command\fR \fIcommandToken\fR,
+ int \fIobjc\fR,
+ \fBTcl_Obj\fR *CONST \fIobjv\fR[] );
.CE
-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 structure that describes what to do when \fIproc\fR
-is invoked. \fILevel\fR gives the nesting level of the command
-(1 for top-level commands passed to \fBTcl_Eval\fR by the application,
-2 for the next-level commands passed to \fBTcl_Eval\fR as part of parsing
-or interpreting level-1 commands, and so on). \fICommand\fR
-points to a string containing the text of the
-command, before any argument substitution.
-\fICmdProc\fR contains the address of the command procedure that
-will be called to process the command (i.e. the \fIproc\fR argument
-of some previous call to \fBTcl_CreateCommand\fR) and \fIcmdClientData\fR
-contains the associated client data for \fIcmdProc\fR (the \fIclientData\fR
-value passed to \fBTcl_CreateCommand\fR). \fIArgc\fR and \fIargv\fR give
-the final argument information that will be passed to \fIcmdProc\fR, after
-command, variable, and backslash substitution.
-\fIProc\fR must not modify the \fIcommand\fR or \fIargv\fR strings.
+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
+structure that describes what to do when \fIobjProc\fR is invoked. The
+\fIlevel\fR parameter gives the nesting level of the command (1 for
+top-level commands passed to \fBTcl_Eval\fR by the application, 2 for
+the next-level commands passed to \fBTcl_Eval\fR as part of parsing or
+interpreting level-1 commands, and so on). The \fIcommand\fR parameter
+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
+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
+performed.
+.PP
+The \fIobjProc\fR callback is expected to return a standard Tcl status
+return code. If this code is \fBTCL_OK\fR (the normal case), then
+the Tcl interpreter will invoke the command. Any other return code
+is treated as if the command returned that status, and the command is
+\fInot\fR invoked.
+.PP
+The \fIobjProc\fR callback must not modify \fIobjv\fR in any way. It
+is, however, permissible to change the command by calling
+\fBTcl_SetCommandTokenInfo\fR prior to returning. Any such change
+takes effect immediately, and the command is invoked with the new
+information.
.PP
Tracing will only occur for commands at nesting level less than
or equal to the \fIlevel\fR parameter (i.e. the \fIlevel\fR
-parameter to \fIproc\fR will always be less than or equal to the
+parameter to \fIobjProc\fR will always be less than or equal to the
\fIlevel\fR parameter to \fBTcl_CreateTrace\fR).
.PP
-Calls to \fIproc\fR will be made by the Tcl parser immediately before
+Tracing has a significant effect on runtime performance because it
+causes the bytecode compiler to refrain from generating in-line code
+for Tcl commands such as \fBif\fR and \fBwhile\fR in order that they
+may be traced. If traces for the built-in commands are not required,
+the \fIflags\fR parameter may be set to the constant value
+\fBTCL_ALLOW_INLINE_COMPILATION\fR. In this case, traces on built-in
+commands may or may not result in trace callbacks, depending on the
+state of the interpreter, but run-time performance will be improved
+significantly. (This functionality is desirable, for example, when
+using \fBTcl_CreateObjTrace\fR to implement an execution time
+profiler.)
+.PP
+Calls to \fIobjProc\fR will be made by the Tcl parser immediately before
it calls the command procedure for the command (\fIcmdProc\fR). This
occurs after argument parsing and substitution, so tracing for
substituted commands occurs before tracing of the commands
@@ -93,14 +130,59 @@ containing the substitutions. If there is a syntax error in a
command, or if there is no command procedure associated with a
command name, then no tracing will occur for that command. If a
string passed to Tcl_Eval contains multiple commands (bracketed, or
-on different lines) then multiple calls to \fIproc\fR will occur,
-one for each command. The \fIcommand\fR string for each of these
-trace calls will reflect only a single command, not the entire string
-passed to Tcl_Eval.
+on different lines) then multiple calls to \fIobjProc\fR will occur,
+one for each command.
.PP
\fBTcl_DeleteTrace\fR removes a trace, so that no future calls will be
made to the procedure associated with the trace. After \fBTcl_DeleteTrace\fR
returns, the caller should never again use the \fItrace\fR token.
-
+.PP
+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:
+.CS
+typedef void \fBTcl_CmdObjTraceDeleteProc\fR(
+ \fBClientData\fR \fIclientData\fR
+);
+.CE
+The \fIclientData\fR parameter will be the same as the
+\fIclientData\fR parameter that was originally passed to
+\fBTcl_CreateObjTrace\fR.
+.PP
+\fBTcl_CreateTrace\fR is an alternative interface for command tracing,
+\fInot recommended for new applications\fR. It is provided for backward
+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:
+.CS
+typedef void Tcl_CmdTraceProc(
+ ClientData \fIclientData\fR,
+ Tcl_Interp *\fIinterp\fR,
+ int \fIlevel\fR,
+ char *\fIcommand\fR,
+ Tcl_CmdProc *\fIcmdProc\fR,
+ ClientData \fIcmdClientData\fR,
+ int \fIargc\fR,
+ CONST char *\fIargv\fR[]);
+.CE
+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
+procedure that will be invoked; and \fIcmdClientData\fR, the client
+data that will be passed to the procedure. The \fIobjc\fR parameter
+is replaced with an \fIargv\fR parameter, that gives the arguments to
+the command as character strings.
+\fIProc\fR must not modify the \fIcommand\fR or \fIargv\fR strings.
+.PP
+If a trace created with \fBTcl_CreateTrace\fR is in effect, inline
+compilation of Tcl commands such as \fBif\fR and \fBwhile\fR is always
+disabled. There is no notification when a trace created with
+\fBTcl_CreateTrace\fR is deleted.
+There is no way to be notified when the trace created by
+\fBTcl_CreateTrace\fR is deleted. There is no way for the \fIproc\fR
+associated with a call to \fBTcl_CreateTrace\fR to abort execution of
+\fIcommand\fR.
.SH KEYWORDS
command, create, delete, interpreter, trace
diff --git a/tcl/doc/DString.3 b/tcl/doc/DString.3
index ae73fe83ef7..0ee81628d11 100644
--- a/tcl/doc/DString.3
+++ b/tcl/doc/DString.3
@@ -11,7 +11,7 @@
.TH Tcl_DString 3 7.4 Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_DStringInit, Tcl_DStringAppend, Tcl_DStringAppendElement, Tcl_DStringStartSublist, Tcl_DStringEndSublist, Tcl_DStringLength, Tcl_DStringValue, Tcl_DStringSetLength, Tcl_DStringFree, Tcl_DStringResult, Tcl_DStringGetResult \- manipulate dynamic strings
+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
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -47,7 +47,7 @@ char *
.AS Tcl_DString newLength
.AP Tcl_DString *dsPtr in/out
Pointer to structure that is used to manage a dynamic string.
-.AP char *string in
+.AP "CONST char" *string in
Pointer to characters to add to dynamic string.
.AP int length in
Number of characters from string to add to dynamic string. If -1,
diff --git a/tcl/doc/DetachPids.3 b/tcl/doc/DetachPids.3
index 2aa97a616e5..8855182214c 100644
--- a/tcl/doc/DetachPids.3
+++ b/tcl/doc/DetachPids.3
@@ -11,7 +11,7 @@
.TH Tcl_DetachPids 3 "" Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_DetachPids, Tcl_ReapDetachedProcs \- manage child processes in background
+Tcl_DetachPids, Tcl_ReapDetachedProcs, Tcl_WaitPid \- manage child processes in background
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -19,14 +19,23 @@ Tcl_DetachPids, Tcl_ReapDetachedProcs \- manage child processes in background
\fBTcl_DetachPids\fR(\fInumPids, pidPtr\fR)
.sp
\fBTcl_ReapDetachedProcs\fR()
+.sp
+Tcl_Pid
+\fBTcl_WaitPid\fR(\fIpid, statPtr, options\fR)
.SH ARGUMENTS
.AS int *statusPtr
.AP int numPids in
Number of process ids contained in the array pointed to by \fIpidPtr\fR.
.AP int *pidPtr in
Address of array containing \fInumPids\fR process ids.
+.AP Tcl_Pid pid in
+The id of the process (pipe) to wait for.
+.AP int* statPtr out
+The result of waiting on a process (pipe). Either 0 or ECHILD.
+.AP int options
+The options controlling the wait. WNOHANG specifies not to wait when
+checking the process.
.BE
-
.SH DESCRIPTION
.PP
\fBTcl_DetachPids\fR and \fBTcl_ReapDetachedProcs\fR provide a
@@ -57,6 +66,12 @@ However, if you call \fBTcl_DetachPids\fR in situations where the
\fBexec\fR command may never get executed, you may wish to call
\fBTcl_ReapDetachedProcs\fR from time to time so that background
processes can be cleaned up.
+.PP
+\fBTcl_WaitPid\fR is a thin wrapper around the facilities provided by
+the operating system to wait on the end of a spawned process and to
+check a whether spawned process is still running. It is used by
+\fBTcl_ReapDetachedProcs\fR and the channel system to portably access
+the operating system.
.SH KEYWORDS
background, child, detach, process, wait
diff --git a/tcl/doc/DumpActiveMemory.3 b/tcl/doc/DumpActiveMemory.3
index 285c0f3fffb..6dd8197445f 100644
--- a/tcl/doc/DumpActiveMemory.3
+++ b/tcl/doc/DumpActiveMemory.3
@@ -26,7 +26,7 @@ void
.SH ARGUMENTS
.AP Tcl_Interp *interp in
Tcl interpreter in which to add commands.
-.AP char *fileName in
+.AP "CONST char" *fileName in
For \fBTcl_DumpActiveMemory\fR, name of the file to which memory
information will be written. For \fBTcl_ValidateAllMemory\fR, name of
the file from which the call is being made (normally \fB__FILE__\fR).
@@ -37,8 +37,9 @@ Line number at which the call to \fBTcl_ValidateAllMemory\fR is made
.SH DESCRIPTION
These functions provide access to Tcl memory debugging information.
-They are only available when Tcl has been compiled with
-\fBTCL_MEM_DEBUG\fR defined at compile-time.
+They are only functional when Tcl has been compiled with
+\fBTCL_MEM_DEBUG\fR defined at compile-time. When \fBTCL_MEM_DEBUG\fR
+is not defined, these functions are all no-ops.
.PP
\fBTcl_DumpActiveMemory\fR will output a list of all currently
allocated memory to the specified file. The information output for
@@ -49,8 +50,8 @@ especially useful to call \fBTcl_DumpActiveMemory\fR after the Tcl
interpreter has been deleted.
.PP
\fBTcl_InitMemory\fR adds the Tcl \fBmemory\fR command to the
-interpreter given by \fIinterp\fR. It is called by \fBTcl_Main\fR
-when Tcl has been compiled with \fBTCL_MEM_DEBUG\fR defined.
+interpreter given by \fIinterp\fR. \fBTcl_InitMemory\fR is called
+by \fBTcl_Main\fR.
.PP
\fBTcl_ValidateAllMemory\fR forces a validation of the guard zones of
all currently allocated blocks of memory. Normally validation of a
diff --git a/tcl/doc/Encoding.3 b/tcl/doc/Encoding.3
index 146007f5782..6805a0aa86e 100644
--- a/tcl/doc/Encoding.3
+++ b/tcl/doc/Encoding.3
@@ -41,7 +41,7 @@ char *
TCHAR *
\fBTcl_WinUtfToTChar\fR(\fIsrc, srcLen, dstPtr\fR)
.sp
-char *
+CONST char *
\fBTcl_GetEncodingName\fR(\fIencoding\fR)
.sp
int
@@ -53,7 +53,7 @@ void
Tcl_Encoding
\fBTcl_CreateEncoding\fR(\fItypePtr\fR)
.sp
-char *
+CONST char *
\fBTcl_GetDefaultEncodingDir\fR(\fIvoid\fR)
.sp
void
@@ -124,7 +124,7 @@ 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
Structure that defines a new type of encoding.
-.AP char *path in
+.AP "CONST char" *path in
A path to the location of the encoding file.
.BE
.SH INTRODUCTION
@@ -244,7 +244,7 @@ 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
to perform the following type of test over and over in your program
-(as represented in psuedo-code):
+(as represented in pseudo-code):
.CS
if (running NT) {
encoding <- Tcl_GetEncoding("unicode");
diff --git a/tcl/doc/Environment.3 b/tcl/doc/Environment.3
new file mode 100644
index 00000000000..ba2da5892a6
--- /dev/null
+++ b/tcl/doc/Environment.3
@@ -0,0 +1,36 @@
+'\"
+'\" Copyright (c) 1997-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$
+'\"
+.so man.macros
+.TH Tcl_PutEnv 3 "7.5" Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_PutEnv \- procedures to manipulate the environment
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+int
+\fBTcl_PutEnv\fR(\fIstring\fR)
+.SH ARGUMENTS
+.AP "CONST char" *string in
+Info about environment variable in the form NAME=value. The string is
+in native format.
+.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
+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 KEYWORDS
+environment, variable
diff --git a/tcl/doc/Eval.3 b/tcl/doc/Eval.3
index 080d0ae7be6..70595e9b6f1 100644
--- a/tcl/doc/Eval.3
+++ b/tcl/doc/Eval.3
@@ -1,6 +1,7 @@
'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
+'\" Copyright (c) 2000 Scriptics Corporation.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -53,7 +54,7 @@ A Tcl object 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 char *fileName in
+.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;
@@ -65,10 +66,8 @@ value of a single word in the command to execute.
The number of bytes in \fIscript\fR, not including any
null terminating character. If \-1, then all characters up to the
first null byte are used.
-.AP char *script in
-Points to first byte of script to execute. This script must be in
-writable memory: temporary modifications are made to it during
-parsing.
+.AP "CONST char" *script in
+Points to first byte of script to execute (NULL terminated and UTF-8).
.AP char *string in
String forming part of a Tcl script.
.AP va_list argList in
@@ -101,6 +100,12 @@ 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.
+.VS 8.4
+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''.
+.VE 8.4
.PP
\fBTcl_EvalObjv\fR executes a single pre-parsed command instead of a
script. The \fIobjc\fR and \fIobjv\fR arguments contain the values
@@ -110,15 +115,18 @@ a completion code and result just like \fBTcl_EvalObjEx\fR.
.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
-occurs. The string is parsed and executed directly (using
-\fBTcl_EvalObjv\fR) instead of compiling it and executing the 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
+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 who's possible combinations
+might be a UTF-8 special code. The string is parsed and executed directly
+(using \fBTcl_EvalObjv\fR) instead of compiling it and executing the
+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
\fIinterp->result\fR (use is deprecated) where it can be accessed directly.
-This makes \fBTcl_Eval\fR somewhat slower than \fBTcl_EvalEx\fR, which
+ This makes \fBTcl_Eval\fR somewhat slower than \fBTcl_EvalEx\fR, which
doesn't do the copy.
.PP
\fBTcl_EvalEx\fR is an extended version of \fBTcl_Eval\fR that takes
@@ -194,4 +202,3 @@ from \fBTcl_EvalObjEx\fR other then \fBTCL_OK\fR or \fBTCL_ERROR\fR.
.SH KEYWORDS
execute, file, global, object, result, script
-
diff --git a/tcl/doc/Exit.3 b/tcl/doc/Exit.3
index 3cb74c9f6a8..d5e3ed45a4d 100644
--- a/tcl/doc/Exit.3
+++ b/tcl/doc/Exit.3
@@ -129,4 +129,3 @@ handlers will vanish into the bitbucket.
.SH KEYWORDS
callback, cleanup, dynamic loading, end application, exit, unloading, thread
-
diff --git a/tcl/doc/ExprLong.3 b/tcl/doc/ExprLong.3
index 8b4603736aa..dbbb9257023 100644
--- a/tcl/doc/ExprLong.3
+++ b/tcl/doc/ExprLong.3
@@ -31,10 +31,10 @@ int
.AS Tcl_Interp *booleanPtr
.AP Tcl_Interp *interp in
Interpreter in whose context to evaluate \fIstring\fR or \fIobjPtr\fR.
-.AP char *string in
-Expression to be evaluated. Must be in writable memory (the expression
-parser makes temporary modifications to the string during parsing, which
-it undoes before returning).
+.VS 8.4
+.AP "CONST char" *string in
+.VE
+Expression to be evaluated.
.AP long *longPtr out
Pointer to location in which to store the integer value of the
expression.
@@ -54,7 +54,7 @@ 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,
-\fBTcl_ExprBooleanObj\fR, and \fBTcl_ExprStringObj\fR.
+\fBTcl_ExprBooleanObj\fR, and \fBTcl_ExprObj\fR.
Those object-based procedures evaluate an expression held in a Tcl object
instead of a string.
The object argument can retain an internal representation
@@ -110,4 +110,3 @@ Tcl_ExprLongObj, Tcl_ExprDoubleObj, Tcl_ExprBooleanObj, Tcl_ExprObj
.SH KEYWORDS
boolean, double, evaluate, expression, integer, object, string
-
diff --git a/tcl/doc/ExprLongObj.3 b/tcl/doc/ExprLongObj.3
index 0769f223749..06da6e742cd 100644
--- a/tcl/doc/ExprLongObj.3
+++ b/tcl/doc/ExprLongObj.3
@@ -27,7 +27,7 @@ int
int
\fBTcl_ExprObj\fR(\fIinterp, objPtr, resultPtrPtr\fR)
.SH ARGUMENTS
-.AS Tcl_Interp *resultPtrPtr out
+.AS Tcl_Interp **resultPtrPtr out
.AP Tcl_Interp *interp in
Interpreter in whose context to evaluate \fIstring\fR or \fIobjPtr\fR.
.AP Tcl_Obj *objPtr in
@@ -41,7 +41,7 @@ expression.
.AP int *booleanPtr out
Pointer to location in which to store the 0/1 boolean value of the
expression.
-.AP Tcl_Obj *resultPtrPtr out
+.AP Tcl_Obj **resultPtrPtr out
Pointer to location in which to store a pointer to the object
that is the result of the expression.
.BE
diff --git a/tcl/doc/FileSystem.3 b/tcl/doc/FileSystem.3
new file mode 100644
index 00000000000..1fbf6e35b1c
--- /dev/null
+++ b/tcl/doc/FileSystem.3
@@ -0,0 +1,1341 @@
+'\"
+'\" Copyright (c) 2001 Vincent Darley
+'\"
+'\" 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 Filesystem 3 8.4 Tcl "Tcl Library Procedures"
+.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
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+int
+\fBTcl_FSRegister\fR(\fIclientData, fsPtr\fR)
+.sp
+int
+\fBTcl_FSUnregister\fR(\fIfsPtr\fR)
+.sp
+ClientData
+\fBTcl_FSData\fR(\fIfsPtr\fR)
+.sp
+void
+\fBTcl_FSMountsChanged\fR(\fIfsPtr\fR)
+.sp
+Tcl_Filesystem*
+\fBTcl_FSGetFileSystemForPath\fR(\fIpathObjPtr\fR)
+.sp
+Tcl_PathType
+\fBTcl_FSGetPathType\fR(\fIpathObjPtr\fR)
+.sp
+int
+\fBTcl_FSCopyFile\fR(\fIsrcPathPtr, destPathPtr\fR)
+.sp
+int
+\fBTcl_FSCopyDirectory\fR(\fIsrcPathPtr, destPathPtr, errorPtr\fR)
+.sp
+int
+\fBTcl_FSCreateDirectory\fR(\fIpathPtr\fR)
+.sp
+int
+\fBTcl_FSDeleteFile\fR(\fIpathPtr\fR)
+.sp
+int
+\fBTcl_FSRemoveDirectory\fR(\fIpathPtr, int recursive, errorPtr\fR)
+.sp
+int
+\fBTcl_FSRenameFile\fR(\fIsrcPathPtr, destPathPtr\fR)
+.sp
+Tcl_Obj*
+\fBTcl_FSListVolumes\fR(\fIvoid\fR)
+.sp
+int
+\fBTcl_FSEvalFile\fR(\fIinterp, pathPtr\fR)
+.sp
+int
+\fBTcl_FSLoadFile\fR(\fIinterp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, handlePtr, unloadProcPtr\fR)
+.sp
+int
+\fBTcl_FSMatchInDirectory\fR(\fIinterp, result, pathPtr, pattern, types\fR)
+.sp
+Tcl_Obj*
+\fBTcl_FSLink\fR(\fIlinkNamePtr, toPtr, linkAction\fR)
+.sp
+int
+\fBTcl_FSLstat\fR(\fIpathPtr, statPtr\fR)
+.sp
+int
+\fBTcl_FSUtime\fR(\fIpathPtr, tval\fR)
+.sp
+int
+\fBTcl_FSFileAttrsGet\fR(\fIinterp, int index, pathPtr, objPtrRef\fR)
+.sp
+int
+\fBTcl_FSFileAttrsSet\fR(\fIinterp, int index, pathPtr, Tcl_Obj *objPtr\fR)
+.sp
+CONST char**
+\fBTcl_FSFileAttrStrings\fR(\fIpathPtr, objPtrRef\fR)
+.sp
+int
+\fBTcl_FSStat\fR(\fIpathPtr, statPtr\fR)
+.sp
+int
+\fBTcl_FSAccess\fR(\fIpathPtr, mode\fR)
+.sp
+Tcl_Channel
+\fBTcl_FSOpenFileChannel\fR(\fIinterp, pathPtr, modeString, permissions\fR)
+.sp
+Tcl_Obj*
+\fBTcl_FSGetCwd\fR(\fIinterp\fR)
+.sp
+int
+\fBTcl_FSChdir\fR(\fIpathPtr\fR)
+.sp
+Tcl_Obj*
+\fBTcl_FSPathSeparator\fR(\fIpathPtr\fR)
+.sp
+Tcl_Obj*
+\fBTcl_FSJoinPath\fR(\fIlistObj, elements\fR)
+.sp
+Tcl_Obj*
+\fBTcl_FSSplitPath\fR(\fIpathPtr, lenPtr\fR)
+.sp
+int
+\fBTcl_FSEqualPaths\fR(\fIfirstPtr, secondPtr\fR)
+.sp
+Tcl_Obj*
+\fBTcl_FSGetNormalizedPath\fR(\fIinterp, pathPtr\fR)
+.sp
+Tcl_Obj*
+\fBTcl_FSJoinToPath\fR(\fIbasePtr, objc, objv\fR)
+.sp
+int
+\fBTcl_FSConvertToPathType\fR(\fIinterp, pathPtr\fR)
+.sp
+ClientData
+\fBTcl_FSGetInternalRep\fR(\fIpathPtr, fsPtr\fR)
+.sp
+Tcl_Obj*
+\fBTcl_FSGetTranslatedPath\fR(\fIinterp, pathPtr\fR)
+.sp
+CONST char*
+\fBTcl_FSGetTranslatedStringPath\fR(\fIinterp, pathPtr\fR)
+.sp
+Tcl_Obj*
+\fBTcl_FSNewNativePath\fR(\fIfsPtr, clientData\fR)
+.sp
+CONST char*
+\fBTcl_FSGetNativePath\fR(\fIpathPtr\fR)
+.sp
+Tcl_Obj*
+\fBTcl_FSFileSystemInfo\fR(\fIpathPtr\fR)
+.sp
+Tcl_StatBuf*
+\fBTcl_AllocStatBuf\fR()
+.SH ARGUMENTS
+.AS Tcl_Filesystem *fsPtr in
+.AP 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
+representation, it will be converted to have one.
+.AP Tcl_Obj *srcPathPtr in
+As for \fBpathPtr\fR, but used for the source file for a copy or
+rename operation.
+.AP Tcl_Obj *destPathPtr in
+As for \fBpathPtr\fR, but used for the destination filename for a copy or
+rename operation.
+.AP "CONST char" *pattern in
+Only files or directories matching this pattern will be returned by
+\fBTcl_FSMatchInDirectory\fR.
+.AP GlobTypeData *types in
+Only files or directories matching the type descriptions contained in
+this structure will be returned by \fBTcl_FSMatchInDirectory\fR. It
+is very important that the 'directory' flag is properly handled.
+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.
+.AP Tcl_Obj *firstPtr in
+The first of two path objects to compare. The object 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
+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 listObj which should
+be joined together. If negative, then all elements are joined.
+.AP Tcl_Obj **errorPtr out
+In the case of an error, filled with an object containing the name of
+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.
+.AP Tcl_Obj *result out
+Pre-allocated object in which to store (by lappending) the list of
+files or directories which are successfully matched in
+\fBTcl_FSMatchInDirectory\fR.
+.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.
+.AP Tcl_StatBuf *statPtr out
+The structure that contains the result of a stat or lstat operation.
+.AP "CONST char" *sym1 in
+Name of a procedure to look up in the file's symbol table
+.AP "CONST char" *sym2 in
+Name of a procedure to look up in the file's symbol table
+.AP Tcl_PackageInitProc **proc1Ptr out
+Filled with the init function for this code.
+.AP Tcl_PackageInitProc **proc2Ptr out
+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 TclfsUnloadFileProc_ **unloadProcPtr out
+Filled with the function to use to unload this piece of code.
+.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
+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
+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.
+.AP int objc in
+The number of elements in \fIobjv\fR.
+.AP "Tcl_Obj *CONST" objv[] in
+The elements to join to the given base path.
+.BE
+
+.SH DESCRIPTION
+.PP
+There are several reasons for calling the \fBTcl_FS...\fR functions
+rather than calling system level functions like \fBaccess\fR and
+\fBstat\fR directly. First, they will work cross-platform, so an
+extension which calls them should work unmodified on Unix, MacOS 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
+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 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
+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
+extension which accesses the filesystem through this API is
+automatically '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 vfs's 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
+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 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 are 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 refCount 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 refCount of
+zero - it may have been incremented), or in a direct segfault
+due to the object being freed part way through the complex object
+manipulation required to ensure that the path is fully normalized and
+absolute for filesystem determination. The practical lesson to learn
+from this is that \fBTcl_Obj *path = Tcl_NewStringObj(...) ;
+Tcl_FS...(path) ; Tcl_DecrRefCount(path)\fR is wrong, and may segfault.
+The 'path' must have its refCount incremented before passing it in, or
+decrementing it. For this reason, objects with a refCount of zero are
+considered not to be valid filesystem paths and calling any Tcl_FS API
+with such an object will result in no action being taken.
+.PP
+\fBTcl_FSCopyFile\fR attempts to copy the file given by srcPathPtr to the
+path name given by destPathPtr. 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).
+Otherwise the function returns -1 and sets Tcl's errno to the 'EXDEV'
+posix error code (which signifies a 'cross-domain link').
+.PP
+\fBTcl_FSCopyDirectory\fR attempts to copy the directory given by srcPathPtr to the
+path name given by destPathPtr. 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).
+Otherwise the function returns -1 and sets Tcl's errno to the 'EXDEV'
+posix error code (which signifies a 'cross-domain link').
+.PP
+\fBTcl_FSCreateDirectory\fR attempts to create the directory given by
+pathPtr by calling the owning filesystem's 'create directory'
+function.
+.PP
+\fBTcl_FSDeleteFile\fR attempts to delete the file given by
+pathPtr by calling the owning filesystem's 'delete file'
+function.
+.PP
+\fBTcl_FSRemoveDirectory\fR attempts to remove the directory given by
+pathPtr by calling the owning filesystem's 'remove directory'
+function.
+.PP
+\fBTcl_FSRenameFile\fR attempts to rename the file or directory given by
+srcPathPtr to the path name given by destPathPtr. 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 Tcl's errno 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
+accumulates the return values in a list which is returned to the
+caller (with a refCount of 0).
+.PP
+\fBTcl_FSEvalFile\fR reads the file given by \fIpathPtr\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''.
+.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 pathPtr
+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.
+.PP
+Returns a standard Tcl completion code. If an error occurs, an error
+message is left in the interp's result.
+.PP
+\fBTcl_FSMatchInDirectory\fR 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.
+.PP
+The return value is a standard Tcl result indicating whether an error
+occurred in globbing. Error messages are placed in interp, but good
+results are placed in the resultPtr given.
+
+Note that the 'glob' code implements recursive patterns internally, so
+this function will only ever be passed simple patterns, which can be
+matched using the logic of 'string match'. To handle recursion, Tcl
+will call this function frequently asking only for directories to be
+returned.
+.PP
+\fBTcl_FSLink\fR replaces the library version of readlink(), and
+extends it to support the creation of links. The appropriate function
+for the filesystem to which linkNamePtr belongs will be called.
+.PP
+If the \fItoPtr\fR is NULL, a readlink 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
+an or'd combination of TCL_CREATE_SYMBOLIC_LINK and TCL_CREATE_HARD_LINK.
+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 should be
+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
+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_FSLstat\fR returns 0 and the stat structure
+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
+For results see 'utime' documentation. If successful, the function
+will update the 'atime' and 'mtime' values of the file given.
+.PP
+\fBTcl_FSFileAttrsGet\fR implements read access for the hookable 'file
+attributes' subcommand. The appropriate function for the filesystem to
+which pathPtr belongs will be called.
+.PP
+If the result is TCL_OK, then an object was placed in objPtrRef, which
+will only be temporarily valid (unless Tcl_IncrRefCount is called).
+.PP
+\fBTcl_FSFileAttrsSet\fR implements write access for the hookable 'file
+attributes' subcommand. The appropriate function for the filesystem to
+which pathPtr belongs will be called.
+.PP
+\fBTcl_FSFileAttrStrings\fR implements part of the hookable 'file attributes'
+subcommand. The appropriate function for the filesystem to which
+pathPtr 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 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 if
+the list should be disposed of by Tcl when done, it should have a
+refCount of zero, and if the list should not be disposed of, the
+filesystem should ensure it retains a refCount on the object.
+.PP
+\fBTcl_FSAccess\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.
+.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.
+.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
+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_FSStat\fR returns 0 and the stat structure
+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
+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 all arguments is similar to those
+given in the Tcl \fBopen\fR command when opening a file.
+If an error occurs while opening the channel, \fBTcl_FSOpenFileChannel\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, \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
+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 getcwd().
+.PP
+It returns the Tcl library's current working directory. This may be
+different to the native platform's working directory, in the case for
+which the cwd 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
+returned, an error message is left in the interp's result.
+
+The result already has its refCount incremented for the caller. When
+it is no longer needed, that refCount 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 chdir(). 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 stat and access to check whether the directory exists
+and has appropriate permissions.
+.PP
+For results, see chdir() documentation. If successful, we keep a
+record of the successful path in cwdPathPtr for subsequent calls to
+getcwd.
+.PP
+\fBTcl_FSPathSeparator\fR returns the separator character to be used for
+most specific element of the path specified by pathPtr (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.
+.PP
+\fBTcl_FSJoinPath\fR takes the given Tcl_Obj, which should be a valid list,
+and returns the path object given by considering the first 'elements'
+elements as valid path segments. If elements < 0, we use the entire
+list.
+.PP
+Returns object with refCount of zero, containing the joined path.
+.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
+an element.
+.PP
+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.
+.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
+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, with refCount of zero, 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.
+.PP
+\fBTcl_FSJoinToPath\fR takes the given object, which should usually be a
+valid path or NULL, and joins onto it the array of paths segments
+given.
+.PP
+Returns object with refCount of zero, containing the joined path.
+.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 TCL_OK is returned. Otherwise
+TCL_ERROR 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
+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
+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).
+.PP
+\fBTcl_FSGetTranslatedStringPath\fR does the same as
+\fBTcl_FSGetTranslatedPath\fR, but returns a character string or NULL.
+.PP
+\fBTcl_FSNewNativePath\fR performs something like that reverse of the
+usual obj->path->nativerep conversions. If some code retrieves a path
+in native form (from, e.g. readlink 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.
+.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.
+.PP
+\fBTcl_FSGetNativePath\fR is for use by the Win/Unix/MacOS 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
+MacOS, 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 containing the
+complete, absolute path in the native encoding.
+.PP
+The native representation is cached so that repeated calls to this
+function will not require additional conversions.
+.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
+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
+recognized, when NULL will be returned.
+.PP
+\fBTcl_FSGetFileSystemForPath\fR returns the a pointer to the
+\fBTcl_Filesystem\fR which accepts this path as valid.
+.PP
+If no filesystem will accept the path, NULL is returned.
+.PP
+\fBTcl_FSGetPathType\fR determines whether the given path is relative
+to the current directory, relative to the current volume, or
+absolute.
+.PP
+It returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or
+TCL_PATH_VOLUME_RELATIVE
+.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
+.SH TCL_FILESYSTEM
+.PP
+A filesystem provides a \fBTcl_Filesystem\fR structure that contains
+pointers to functions that implement the various operations on a
+filesystem; these operations are invoked as needed by the generic
+layer, which generally occurs through the functions listed above.
+.PP
+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
+this function, Tcl will attach the filesystem to the list of known
+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). TCL_OK will be returned.
+.PP
+\fBTcl_FSUnregister\fR removes the given filesystem structure from
+the list of known filesystems, if it is known, and returns TCL_OK. If
+the filesystem is not currently registered, TCL_ERROR is returned.
+.PP
+\fBTcl_FSData\fR will return the ClientData associated with the given
+filesystem, if that filesystem is registered. Otherwise it will
+return NULL.
+.PP
+\fBTcl_FSMountsChanged\fR is used to inform the Tcl's core that
+the set of mount points for the given (already registered) filesystem
+have changed, and that cached file representations may therefore no
+longer be correct.
+.PP
+The \fBTcl_Filesystem\fR structure contains the following fields:
+.CS
+typedef struct Tcl_Filesystem {
+ CONST char *\fItypeName\fR;
+ int \fIstructureLength\fR;
+ Tcl_FSVersion \fIversion\fR;
+ Tcl_FSPathInFilesystemProc *\fIpathInFilesystemProc\fR;
+ Tcl_FSDupInternalRepProc *\fIdupInternalRepProc\fR;
+ Tcl_FSFreeInternalRepProc *\fIfreeInternalRepProc\fR;
+ Tcl_FSInternalToNormalizedProc *\fIinternalToNormalizedProc\fR;
+ Tcl_FSCreateInternalRepProc *\fIcreateInternalRepProc\fR;
+ Tcl_FSNormalizePathProc *\fInormalizePathProc\fR;
+ Tcl_FSFilesystemPathTypeProc *\fIfilesystemPathTypeProc\fR;
+ Tcl_FSFilesystemSeparatorProc *\fIfilesystemSeparatorProc\fR;
+ Tcl_FSStatProc *\fIstatProc\fR;
+ Tcl_FSAccessProc *\fIaccessProc\fR;
+ Tcl_FSOpenFileChannelProc *\fIopenFileChannelProc\fR;
+ Tcl_FSMatchInDirectoryProc *\fImatchInDirectoryProc\fR;
+ Tcl_FSUtimeProc *\fIutimeProc\fR;
+ Tcl_FSLinkProc *\fIlinkProc\fR;
+ Tcl_FSListVolumesProc *\fIlistVolumesProc\fR;
+ Tcl_FSFileAttrStringsProc *\fIfileAttrStringsProc\fR;
+ Tcl_FSFileAttrsGetProc *\fIfileAttrsGetProc\fR;
+ Tcl_FSFileAttrsSetProc *\fIfileAttrsSetProc\fR;
+ Tcl_FSCreateDirectoryProc *\fIcreateDirectoryProc\fR;
+ Tcl_FSRemoveDirectoryProc *\fIremoveDirectoryProc\fR;
+ Tcl_FSDeleteFileProc *\fIdeleteFileProc\fR;
+ Tcl_FSCopyFileProc *\fIcopyFileProc\fR;
+ Tcl_FSRenameFileProc *\fIrenameFileProc\fR;
+ Tcl_FSCopyDirectoryProc *\fIcopyDirectoryProc\fR;
+ Tcl_FSLstatProc *\fIlstatProc\fR;
+ Tcl_FSLoadFileProc *\fIloadFileProc\fR;
+ Tcl_FSGetCwdProc *\fIgetCwdProc\fR;
+ Tcl_FSChdirProc *\fIchdirProc\fR;
+} Tcl_Filesystem;
+.CE
+.PP
+Except for the first three fields in this structure which contain
+simple data elements, all entries contain addresses of functions called
+by the generic filesystem layer to perform the complete range of
+filesystem related actions.
+.PP
+The many functions in this structure are broken down into three
+categories: infrastructure functions (almost all of which must be
+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
+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 'file rename' command is issued in Tcl, and the relevant
+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
+\fITcl_FSRenameFile\fR command is issued at the C level, no such
+fallbacks occur. This is true except for the last four entries in the
+filesystem table (lstat, load, getcwd and chdir)
+for which fallbacks do in fact occur at the C level.
+.PP
+As an example, here is the filesystem lookup table used by the
+"vfs" extension which allows filesystem actions to be implemented
+in Tcl.
+.CS
+static Tcl_Filesystem vfsFilesystem = {
+ "tclvfs",
+ sizeof(Tcl_Filesystem),
+ TCL_FILESYSTEM_VERSION_1,
+ &VfsPathInFilesystem,
+ &VfsDupInternalRep,
+ &VfsFreeInternalRep,
+ /* No internal to normalized, since we don't create any
+ * pure 'internal' Tcl_Obj path representations */
+ NULL,
+ /* No create native rep function, since we don't use it
+ * and don't choose to support uses of 'Tcl_FSNewNativePath' */
+ NULL,
+ /* Normalize path isn't needed - we assume paths only have
+ * one representation */
+ NULL,
+ &VfsFilesystemPathType,
+ &VfsFilesystemSeparator,
+ &VfsStat,
+ &VfsAccess,
+ &VfsOpenFileChannel,
+ &VfsMatchInDirectory,
+ &VfsUtime,
+ /* We choose not to support symbolic links inside our vfs's */
+ NULL,
+ &VfsListVolumes,
+ &VfsFileAttrStrings,
+ &VfsFileAttrsGet,
+ &VfsFileAttrsSet,
+ &VfsCreateDirectory,
+ &VfsRemoveDirectory,
+ &VfsDeleteFile,
+ /* 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,
+ /* Core will use stat for lstat */
+ NULL,
+ /* No load - fallback on core implementation */
+ NULL,
+ /* We don't need a getcwd or chdir - fallback on Tcl's versions */
+ NULL,
+ NULL
+};
+.CE
+.PP
+Any functions which take path names in Tcl_Obj form take
+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.
+.SH TYPENAME
+.PP
+The \fItypeName\fR field contains a null-terminated string that
+identifies the type of the filesystem implemented, e.g.
+\fBnative\fR or \fBzip\fR or \fBvfs\fR.
+.PP
+.SH "STRUCTURE LENGTH"
+.PP
+The \fIstructureLength\fR field is generally implemented as
+\fIsizeof(Tcl_Filesystem)\fR, and is there to allow easier
+binary backwards compatibility if the size of the structure
+changes in a future Tcl release.
+.SH VERSION
+.PP
+The \fIversion\fR field should be set to \fBTCL_FILESYSTEM_VERSION_1\fR.
+.SH "FILESYSTEM INFRASTRUCTURE"
+.PP
+These fields contain addresses of functions which are used to associate
+a particular filesystem with a file path, and deal with the internal
+handling of path representations, for example copying and freeing such
+representations.
+.SH 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
+functions with a path for which this function has returned
+\fBTCL_OK\fR. If the path does not belong, \fBTCL_ERROR\fR should be
+returned. If \fBTCL_OK\fR is returned, then the optional
+\fBclientDataPtr\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 are invalidated when
+filesystem structures are added or removed from Tcl's internal list of
+known filesystems.
+.PP
+.CS
+typedef int Tcl_FSPathInFilesystemProc(
+ Tcl_Obj *\fIpathPtr\fR,
+ ClientData *\fIclientDataPtr\fR);
+.CE
+.SH 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
+simply not copy the internal representation, which may then need to be
+regenerated later.
+.PP
+.CS
+typedef ClientData Tcl_FSDupInternalRepProc(
+ ClientData \fIclientData\fR);
+.CE
+.SH FREEINTERNALREPPROC
+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(
+ ClientData \fIclientData\fR);
+.CE
+.SH 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
+representation is the normalized path.
+.PP
+.CS
+typedef Tcl_Obj* Tcl_FSInternalToNormalizedProc(
+ ClientData \fIclientData\fR);
+.CE
+.SH CREATEINTERNALREPPROC
+.PP
+Function to take a path object, 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
+the \fITcl_FSPathInFilesystemProc\fR for this filesystem always
+immediately creates an internal representation for paths it accepts.
+.PP
+.CS
+typedef ClientData Tcl_FSCreateInternalRepProc(
+ Tcl_Obj *\fIpathPtr\fR);
+.CE
+.SH NORMALIZEPATHPROC
+.PP
+Function to normalize a path. Should be implemented for all
+filesystems which can have multiple string representations for the same
+path object. In Tcl, every 'path' must have a single unique '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
+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
+exception is required to agree with Tcl's semantics with 'file
+delete', 'file rename', 'file copy' operating on symbolic links.
+.PP
+.CS
+typedef int Tcl_FSNormalizePathProc(
+ Tcl_Interp *\fIinterp\fR,
+ Tcl_Obj *\fIpathPtr\fR,
+ int \fInextCheckpoint\fR);
+.CE
+.SH "FILESYSTEM OPERATIONS"
+.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
+them are not implemented, then certain Tcl commands may fail when
+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).
+.SH FILESYSTEMPATHTYPEPROC
+.PP
+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,
+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
+to it.
+.PP
+.CS
+typedef Tcl_Obj* Tcl_FSFilesystemPathTypeProc(
+ Tcl_Obj *\fIpathPtr\fR);
+.CE
+.SH FILESYSTEMSEPARATORPROC
+.PP
+Function to return the separator character(s) for this filesystem.
+Must be implemented, otherwise the \fBfile separator\fR command will not
+function correctly. The usual return value will be a Tcl_Obj
+containing the string "/".
+.PP
+.CS
+typedef Tcl_Obj* Tcl_FSFilesystemSeparatorProc(
+ Tcl_Obj *\fIpathPtr\fR);
+.CE
+.SH STATPROC
+.PP
+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,
+\fBglob\fR).
+.PP
+.CS
+typedef int Tcl_FSStatProc(
+ 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
+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 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.
+.SH ACCESSPROC
+.PP
+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).
+.PP
+.CS
+typedef int Tcl_FSAccessProc(
+ 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 file system
+object) whose name is pathname. If pathname is a symbolic link, then
+permissions of the file referred by this symbolic link should be 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.
+.PP
+.SH OPENFILECHANNELPROC
+.PP
+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).
+.PP
+.CS
+typedef Tcl_Channel Tcl_FSOpenFileChannelProc(
+ Tcl_Interp *\fIinterp\fR,
+ Tcl_Obj *\fIpathPtr\fR,
+ int \fImode\fR,
+ int \fIpermissions\fR);
+.CE
+.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
+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
+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
+previously closed, the act of creating the new channel also assigns it
+as a replacement for the standard channel.
+.SH MATCHINDIRECTORYPROC
+.PP
+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 'encoding names'
+which use glob functionality internally).
+.PP
+.CS
+typedef int Tcl_FSMatchInDirectoryProc(
+ Tcl_Interp* \fIinterp\fR,
+ Tcl_Obj *\fIresult\fR,
+ Tcl_Obj *\fIpathPtr\fR,
+ CONST char *\fIpattern\fR,
+ Tcl_GlobTypeData * \fItypes\fR);
+.CE
+.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 of a single file or directory which
+should be checked for 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.
+.PP
+The return value is a standard Tcl result indicating whether an error
+occurred in the matching process. Error messages are placed in interp,
+but on a TCL_OK result, the interpreter should not be modified, but
+rather results should be added to the \fIresult\fR object given
+(which can be assumed to be a valid Tcl list). The matches added
+to \fIresult\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
+result --- errors are only signaled for actual file or filesystem
+problems which may occur during the matching process.
+.SH UTIMEPROC
+.PP
+Function to process a \fBTcl_FSUtime()\fR call. Required to allow setting
+(not reading) of times with 'file mtime', 'file atime' and the
+open-r/open-w/fcopy implementation of 'file copy'.
+.PP
+.CS
+typedef int Tcl_FSUtimeProc(
+ Tcl_Obj *\fIpathPtr\fR,
+ struct utimbuf *\fItval\fR);
+.CE
+.PP
+The access and modification times of the file specified by \fIpathPtr\fR
+should be changed to the values given in the \fItval\fR structure.
+.PP
+The return value is a standard Tcl result indicating whether an error
+occurred in the process.
+.SH LINKPROC
+.PP
+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(
+ 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
+the 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 \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. See
+the documentation for \fBTcl_FSLink\fR for the correct interpretation
+of the \fIlinkAction\fR flags.
+.SH LISTVOLUMESPROC
+.PP
+Function to list any filesystem volumes added by this filesystem.
+Should be implemented only if the filesystem adds volumes at the head
+of the filesystem, so that they can be returned by 'file volumes'.
+.PP
+.CS
+typedef Tcl_Obj* Tcl_FSListVolumesProc(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
+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
+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
+to Tcl which will copy the contents and then decrement the count back
+to where it was).
+.PP
+Therefore, Tcl considers return values from this proc to be read-only.
+.PP
+.SH 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
+not implemented, there is no need to implement the \fBget\fR and \fBset\fR
+methods.
+.PP
+.CS
+typedef CONST char** Tcl_FSFileAttrStringsProc(
+ Tcl_Obj *\fIpathPtr\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 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 if
+the list should be disposed of by Tcl when done, it should have a
+refCount of zero, and if the list should not be disposed of, the
+filesystem should ensure it retains a refCount on the object.
+.SH FILEATTRSGETPROC
+.PP
+Function to process a \fBTcl_FSFileAttrsGet()\fR call, used by 'file
+attributes'.
+.PP
+.CS
+typedef int Tcl_FSFileAttrsGetProc(
+ 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,
+which corresponds to the \fIindex\fR'th element in the list returned by
+the Tcl_FSFileAttrStringsProc, is a Tcl_Obj placed in objPtrRef (if
+TCL_OK was returned) and 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.
+.SH FILEATTRSSETPROC
+.PP
+Function to process a \fBTcl_FSFileAttrsSet()\fR call, used by 'file
+attributes'. If the filesystem is read-only, there is no need
+to implement this.
+.PP
+.CS
+typedef int Tcl_FSFileAttrsSetProc(
+ Tcl_Interp *\fIinterp\fR,
+ int \fIindex\fR,
+ Tcl_Obj *\fIpathPtr\fR,
+ Tcl_Obj *\fIobjPtr\fR);
+.CE
+.PP
+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.
+.SH CREATEDIRECTORYPROC
+.PP
+Function to process a \fBTcl_FSCreateDirectory()\fR call. Should be
+implemented unless the FS is read-only.
+.PP
+.CS
+typedef int Tcl_FSCreateDirectoryProc(
+ 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
+been added to the filesystem in the location specified by
+\fIpathPtr\fR.
+.SH REMOVEDIRECTORYPROC
+.PP
+Function to process a 'Tcl_FSRemoveDirectory()' call. Should be
+implemented unless the FS is read-only.
+.PP
+.CS
+typedef int Tcl_FSRemoveDirectoryProc(
+ 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
+\fIrecursive\fR flag is given, then a non-empty directory should
+be deleted without error. If an error does occur, the name of
+the file or directory which caused the error should be placed in
+\fIerrorPtr\fR.
+.SH DELETEFILEPROC
+.PP
+Function to process a \fBTcl_FSDeleteFile()\fR call. Should be implemented
+unless the FS is read-only.
+.PP
+.CS
+typedef int Tcl_FSDeleteFileProc(
+ 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,
+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).
+.SH "FILESYSTEM EFFICIENCY"
+.PP
+.SH 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
+it need only be implemented if a filesystem can differentiate between
+\fBstat\fR and \fBlstat\fR calls.
+.PP
+.CS
+typedef int Tcl_FSLstatProc(
+ Tcl_Obj *\fIpathPtr\fR,
+ Tcl_StatBuf *\fIstatPtr\fR);
+.CE
+.PP
+The behavior of this function is very similar to that of the
+Tcl_FSStatProc defined above, except that if it is applied
+to a symbolic link, it returns information about the link, not
+about the target file.
+.PP
+.SH COPYFILEPROC
+.PP
+Function to process a \fBTcl_FSCopyFile()\fR call. If not implemented Tcl
+will fall back on open-r, open-w and fcopy 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(
+ 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
+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 'file
+copy' subcommand). Note that,
+if the filesystem supports symbolic links, Tcl will always call this
+function and not Tcl_FSCopyDirectoryProc when needed to copy them
+(even if they are symbolic links to directories).
+.SH 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
+only be implemented if the filesystem can perform that action more
+efficiently.
+.PP
+.CS
+typedef int Tcl_FSRenameFileProc(
+ 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.
+.SH COPYDIRECTORYPROC
+.PP
+Function to process a \fBTcl_FSCopyDirectory()\fR call. If not
+implemented, Tcl will fall back on a recursive create-dir, file copy
+mechanism. Therefore it need only be implemented if the filesystem can
+perform that action more efficiently.
+.PP
+.CS
+typedef int Tcl_FSCopyDirectoryProc(
+ 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
+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 'file copy' subcommand).
+.SH LOADFILEPROC
+.PP
+Function to process a \fBTcl_FSLoadFile()\fR call. If not implemented, Tcl
+will fall back on a copy to native-temp followed by a Tcl_FSLoadFile on
+that temporary copy. Therefore it need only be implemented if the
+filesystem can load code directly, or it can be implemented simply to
+return TCL_ERROR to disable load functionality in this filesystem
+entirely.
+.PP
+.CS
+typedef int Tcl_FSLoadFileProc(
+ 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 interp'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 procedure will be
+called with the given Tcl_LoadHandle as its only parameter when Tcl
+needs to unload the file.
+.SH UNLOADFILEPROC
+.PP
+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(
+ Tcl_LoadHandle \fIloadHandle\fR);
+.CE
+.SH GETCWDPROC
+.PP
+Function to process a \fBTcl_FSGetCwd()\fR call. Most filesystems need not
+implement this. It will usually only be called once, if 'getcwd' is
+called before 'chdir'. May be NULL.
+.PP
+.CS
+typedef Tcl_Obj* Tcl_FSGetCwdProc(
+ 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
+error message is left in the interp's result.
+.PP
+.SH CHDIRPROC
+.PP
+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
+respond with a positive return result if the dirName is a valid,
+accessible directory in their filesystem. They need not remember the
+result, since that will be automatically remembered for use by GetCwd.
+Real filesystems should carry out the correct action (i.e. call the
+correct system 'chdir' api).
+.PP
+.CS
+typedef int Tcl_FSChdirProc(
+ 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
diff --git a/tcl/doc/FindExec.3 b/tcl/doc/FindExec.3
index 33f123b2aa2..a9b89958109 100644
--- a/tcl/doc/FindExec.3
+++ b/tcl/doc/FindExec.3
@@ -39,7 +39,9 @@ It is also returned by the \fBinfo nameofexecutable\fR command.
.PP
On UNIX platforms this procedure is typically invoked as the very
first thing in the application's main program; it must be passed
-\fIargv[0]\fR as its argument. \fBTcl_FindExecutable\fR uses \fIargv0\fR
+\fIargv[0]\fR as its argument. It is important not to change the
+working directory before the invocation.
+\fBTcl_FindExecutable\fR uses \fIargv0\fR
along with the \fBPATH\fR environment variable to find the
application's executable, if possible. If it fails to find
the binary, then future calls to \fBinfo nameofexecutable\fR
@@ -54,4 +56,3 @@ computed or unknown.
.SH KEYWORDS
binary, executable file
-
diff --git a/tcl/doc/GetCwd.3 b/tcl/doc/GetCwd.3
index eb8278f5269..6d173574d9b 100644
--- a/tcl/doc/GetCwd.3
+++ b/tcl/doc/GetCwd.3
@@ -1,5 +1,5 @@
'\"
-'\" Copyright (c) 1998-1999 Scriptics Corportation
+'\" Copyright (c) 1998-1999 Scriptics Corporation
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
diff --git a/tcl/doc/GetHostName.3 b/tcl/doc/GetHostName.3
index 576c867196c..0adfdaf2723 100644
--- a/tcl/doc/GetHostName.3
+++ b/tcl/doc/GetHostName.3
@@ -13,7 +13,7 @@ Tcl_GetHostName \- get the name of the local host
.nf
\fB#include <tcl.h>\fR
.sp
-char *
+CONST char *
\fBTcl_GetHostName\fR()
.SH DESCRIPTION
@@ -26,4 +26,3 @@ not modify of free it.
.PP
.SH KEYWORDS
hostname
-
diff --git a/tcl/doc/GetIndex.3 b/tcl/doc/GetIndex.3
index b138cda6dc3..93fe14d002f 100644
--- a/tcl/doc/GetIndex.3
+++ b/tcl/doc/GetIndex.3
@@ -21,11 +21,11 @@ indexPtr\fR)
.VS
.sp
int
-\fBTcl_GetIndexFromObjStruct\fR(\fIinterp, objPtr, tablePtr, offset,
+\fBTcl_GetIndexFromObjStruct\fR(\fIinterp, objPtr, structTablePtr, offset,
msg, flags, indexPtr\fR)
.VE
.SH ARGUMENTS
-.AS Tcl_Interp **tablePtr
+.AS "CONST char" **tablePtr
.AP Tcl_Interp *interp in
Interpreter to use for error reporting; if NULL, then no message is
provided on errors.
@@ -33,15 +33,19 @@ provided on errors.
The string value of this object is used to search through \fItablePtr\fR.
The internal representation is modified to hold the index of the matching
table entry.
-.AP char **tablePtr in
-An array of null-terminated strings. The end of the array is marked
+.AP "CONST char" **tablePtr in
+An array of null-terminated ASCII strings. The end of the array is marked
by a NULL string pointer.
+.AP "CONST VOID" *structTablePtr in
+An array of arbitrary type, typically some \fBstruct\fP type.
+The first member of the structure must be a null-terminated ASCII string.
+The size of the structure is given by \fIoffset\fP.
.VS
.AP int offset in
-The offset to add to tablePtr to get to the next string in the
-list. The end of the array is marked by a NULL string pointer.
+The offset to add to structTablePtr to get to the next entry.
+The end of the array is marked by a NULL string pointer.
.VE
-.AP char *msg in
+.AP "CONST char" *msg in
Null-terminated string describing what is being looked up, such as
\fBoption\fR. This string is included in error messages.
.AP int flags in
@@ -100,4 +104,3 @@ Tcl_WrongNumArgs
.SH KEYWORDS
index, object, table lookup
-
diff --git a/tcl/doc/GetInt.3 b/tcl/doc/GetInt.3
index 221ba070657..61ecc49521e 100644
--- a/tcl/doc/GetInt.3
+++ b/tcl/doc/GetInt.3
@@ -28,7 +28,7 @@ int
.AS Tcl_Interp *doublePtr
.AP Tcl_Interp *interp in
Interpreter to use for error reporting.
-.AP char *string in
+.AP "CONST char" *string in
Textual value to be converted.
.AP int *intPtr out
Points to place to store integer value converted from \fIstring\fR.
@@ -79,4 +79,3 @@ are also acceptable.
.SH KEYWORDS
boolean, conversion, double, floating-point, integer
-
diff --git a/tcl/doc/GetOpnFl.3 b/tcl/doc/GetOpnFl.3
index 8d9e0d7b17f..80c47cbc273 100644
--- a/tcl/doc/GetOpnFl.3
+++ b/tcl/doc/GetOpnFl.3
@@ -21,7 +21,7 @@ int
.AS Tcl_Interp checkUsage
.AP Tcl_Interp *interp in
Tcl interpreter from which file handle is to be obtained.
-.AP char *string in
+.AP "CONST char" *string in
String identifying channel, such as \fBstdin\fR or \fBfile4\fR.
.AP int write in
Non-zero means the file will be used for writing, zero means it will
@@ -59,4 +59,3 @@ Note that this interface is only supported on the Unix platform.
.SH KEYWORDS
channel, file handle, permissions, pipeline, read, write
-
diff --git a/tcl/doc/GetStdChan.3 b/tcl/doc/GetStdChan.3
index 7192e4243ed..a35927d5b77 100644
--- a/tcl/doc/GetStdChan.3
+++ b/tcl/doc/GetStdChan.3
@@ -59,15 +59,19 @@ file handle. If \fBTcl_SetStdChannel\fR is called before
\fBTcl_GetStdChannel\fR, then the default channel will not be created.
.PP
If one of the standard channels is set to NULL, either by calling
-\fBTcl_SetStdChannel\fR with a null \fIchannel\fR argument, or by calling
+\fBTcl_SetStdChannel\fR with a NULL \fIchannel\fR argument, or by calling
\fBTcl_Close\fR on the channel, then the next call to \fBTcl_CreateChannel\fR
will automatically set the standard channel with the newly created channel. If
more than one standard channel is NULL, then the standard channels will be
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
.SH "SEE ALSO"
-Tcl_Close(3), Tcl_CreateChannel(3)
+Tcl_Close(3), Tcl_CreateChannel(3), Tcl_Main(3), tclsh(1)
.SH KEYWORDS
standard channel, standard input, standard output, standard error
diff --git a/tcl/doc/GetTime.3 b/tcl/doc/GetTime.3
new file mode 100644
index 00000000000..f72175f541d
--- /dev/null
+++ b/tcl/doc/GetTime.3
@@ -0,0 +1,53 @@
+'\"
+'\" Copyright (c) 2001 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$
+'\"
+.so man.macros
+.TH Tcl_GetTime 3 8.4 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_GetTime \- get date and time
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+\fBTcl_GetTime\fR(\fI timePtr \fR)
+.SH ARGUMENTS
+.AS "Tcl_Time *" timePtr
+.AP "Tcl_Time *" timePtr out
+Points to memory in which to store the date and time information.
+.BE
+.SH DESCRIPTION
+.PP
+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:
+.CS
+typedef struct Tcl_Time {
+ long sec;
+ long usec;
+} Tcl_Time;
+.CE
+.PP
+On return, the \fIsec\fR member of the structure is filled in with the
+number of seconds that have elapsed since the \fIepoch:\fR the epoch
+is the point in time of 00:00 UTC, 1 January 1970. This number does
+\fInot\fR count leap seconds \- an interval of one day advances it by
+86400 seconds regardless of whether a leap second has been inserted.
+.PP
+The \fIusec\fR member of the structure is filled in with the number of
+microseconds that have elapsed since the start of the second
+designated by \fIsec\fR. The Tcl library makes every effort to keep
+this number as precise as possible, subject to the limitations of the
+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.)
+.SH "SEE ALSO"
+clock
+.SH KEYWORDS
+date, time
diff --git a/tcl/doc/GetVersion.3 b/tcl/doc/GetVersion.3
index 5abec5b6aae..5a4f09ecae2 100644
--- a/tcl/doc/GetVersion.3
+++ b/tcl/doc/GetVersion.3
@@ -40,7 +40,7 @@ a program linked to an older version of Tcl than you expected.
Use \fBTcl_GetVersion\fR to verify that fact, and possibly to
change the behavior of your extension.
.PP
-If may pass a NULL for any of the arguments. For instance if
+\fBTcl_GetVersion\fR accepts NULL for any of the arguments. For instance if
you do not care about the \fIpatchLevel\fR of the library, pass
a NULL for the \fIpatchLevel\fR argument.
diff --git a/tcl/doc/Hash.3 b/tcl/doc/Hash.3
index e3fb971989d..be25ee7b185 100644
--- a/tcl/doc/Hash.3
+++ b/tcl/doc/Hash.3
@@ -11,13 +11,17 @@
.TH Tcl_Hash 3 "" Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_InitHashTable, 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
+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
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
\fBTcl_InitHashTable\fR(\fItablePtr, keyType\fR)
.sp
+\fBTcl_InitCustomHashTable\fR(\fItablePtr, keyType, typePtr\fR)
+.sp
+\fBTcl_InitObjHashTable\fR(\fItablePtr\fR)
+.sp
\fBTcl_DeleteHashTable\fR(\fItablePtr\fR)
.sp
Tcl_HashEntry *
@@ -42,7 +46,7 @@ Tcl_HashEntry *
Tcl_HashEntry *
\fBTcl_NextHashEntry\fR(\fIsearchPtr\fR)
.sp
-char *
+CONST char *
\fBTcl_HashStats\fR(\fItablePtr\fR)
.SH ARGUMENTS
.AS Tcl_HashSearch *searchPtr
@@ -52,9 +56,11 @@ Address of hash table structure (for all procedures but
previous call to \fBTcl_InitHashTable\fR).
.AP int keyType in
Kind of keys to use for new hash table. Must be either
-TCL_STRING_KEYS, TCL_ONE_WORD_KEYS, or an integer value
-greater than 1.
-.AP char *key in
+TCL_STRING_KEYS, TCL_ONE_WORD_KEYS, TCL_CUSTOM_TYPE_KEYS,
+TCL_CUSTOM_PTR_KEYS, 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
Key to use for probe into table. Exact form depends on
\fIkeyType\fR used to create table.
.AP int *newPtr out
@@ -69,40 +75,49 @@ ClientData, but must fit in same space as ClientData.
Pointer to record to use to keep track of progress in enumerating
all the entries in a hash table.
.BE
-
.SH DESCRIPTION
.PP
-A hash table consists of zero or more entries, each consisting of
-a key and a value.
-Given the key for an entry, the hashing routines can 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 three forms: strings,
-one-word values, or integer arrays.
-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 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.
-.PP
-Hash tables grow gracefully as the number of entries increases,
-so that there are always less than three entries per hash bucket,
-on average.
-This allows for fast lookups regardless of the number of entries
-in a table.
-.PP
-\fBTcl_InitHashTable\fR initializes a structure that describes
-a new hash table.
-The space for the structure is provided by the caller, not by
-the hash module.
-The value of \fIkeyType\fR indicates what kinds of keys will
-be used for all entries in the table. \fIKeyType\fR must have
-one of the following values:
+A hash table consists of zero or more entries, each consisting of a
+key and a value. Given the key for an entry, the hashing routines can
+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
+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
+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.
+.PP
+Hash tables grow gracefully as the number of entries increases, so
+that there are always less than three entries per hash bucket, on
+average. This allows for fast lookups regardless of the number of
+entries in a table.
+.PP
+The core provides three functions for the initialization of hash
+tables, Tcl_InitHashTable, Tcl_InitObjHashTable and
+Tcl_InitCustomHashTable.
+.PP
+\fBTcl_InitHashTable\fR initializes a structure that describes a new
+hash table. The space for the structure is provided by the caller,
+not by the hash module. The value of \fIkeyType\fR indicates what
+kinds of keys will be used for all entries in the table. All of the
+key types described later are allowed, with the exception of
+\fBTCL_CUSTOM_TYPE_KEYS\fR and \fBTCL_CUSTOM_PTR_KEYS\fR.
+.PP
+\fBTcl_InitObjHashTable\fR is a wrapper around
+\fBTcl_InitCustomHashTable\fR and initializes a hash table whose keys
+are Tcl_Obj *.
+.PP
+\fBTcl_InitCustomHashTable\fR initializes a structure that describes a
+new hash table. The space for the structure is provided by the
+caller, not by the hash module. The value of \fIkeyType\fR indicates
+what kinds of keys will be used for all entries in the table.
+\fIKeyType\fR must have one of the following values:
.IP \fBTCL_STRING_KEYS\fR 25
Keys are null-terminated ASCII strings.
They are passed to hashing routines using the address of the
@@ -112,8 +127,18 @@ 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)
actually point to a string.
+.IP \fBTCL_CUSTOM_TYPE_KEYS\fR 25
+Keys are of arbitrary type, and are stored in the entry. Hashing
+and comparison is determined by \fItypePtr\fR. The Tcl_HashKeyType
+structure is described in the section
+\fBTHE TCL_HASHKEYTYPE STRUCTURE\fR below.
+.IP \fBTCL_CUSTOM_PTR_KEYS\fR 25
+Keys are pointers to an arbitrary type, and are stored in the entry. Hashing
+and comparison is determined by \fItypePtr\fR. The Tcl_HashKeyType
+structure is described in the section
+\fBTHE TCL_HASHKEYTYPE STRUCTURE\fR below.
.IP \fIother\fR 25
-If \fIkeyType\fR is not TCL_STRING_KEYS or TCL_ONE_WORD_KEYS,
+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
\fIkeyType\fR gives the number of ints in each key.
@@ -203,6 +228,78 @@ the values of entries.
However, users of the hashing routines should never refer directly
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:
+.CS
+typedef struct Tcl_HashKeyType {
+ int \fIversion\fR;
+ int \fIflags\fR;
+ Tcl_HashKeyProc *\fIhashKeyProc\fR;
+ Tcl_CompareHashKeysProc *\fIcompareKeysProc\fR;
+ Tcl_AllocHashEntryProc *\fIallocEntryProc\fR;
+ Tcl_FreeHashEntryProc *\fIfreeEntryProc\fR;
+} Tcl_HashKeyType;
+.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.
+.PP
+The \fIflags\fR member is 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 randomising the bits and
+then using the upper N bits as the index into the table.
+.PP
+The \fIhashKeyProc\fR member contains the address of a function
+called to calculate a hash value for the key.
+.CS
+typedef unsigned int (Tcl_HashKeyProc) (
+ Tcl_HashTable *\fItablePtr\fR,
+ VOID *\fIkeyPtr\fR);
+.CE
+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.
+.CS
+typedef int (Tcl_CompareHashKeysProc) (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 initialise the key.
+.CS
+typedef Tcl_HashEntry *(Tcl_AllocHashEntryProc) (
+ 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.
+.CS
+typedef void (Tcl_FreeHashEntryProc) (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.
.SH KEYWORDS
hash table, key, lookup, search, value
diff --git a/tcl/doc/InitStubs.3 b/tcl/doc/InitStubs.3
index aa12b8e6589..e452cccbf85 100644
--- a/tcl/doc/InitStubs.3
+++ b/tcl/doc/InitStubs.3
@@ -1,5 +1,5 @@
'\"
-'\" Copyright (c) 1999 Scriptics Corportation
+'\" Copyright (c) 1998-1999 Scriptics Corporation
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -15,13 +15,13 @@ Tcl_InitStubs \- initialize the Tcl stubs mechanism
.nf
\fB#include <tcl.h>\fR
.sp
-char *
+CONST char *
\fBTcl_InitStubs\fR(\fIinterp, version, exact\fR)
.SH ARGUMENTS
.AS Tcl_Interp *interp in
.AP Tcl_Interp *interp in
Tcl interpreter handle.
-.AP char *version in
+.AP "CONST char" *version in
A version string consisting of one or more decimal numbers
separated by dots.
.AP int exact in
@@ -86,6 +86,6 @@ non-zero means that only the specified \fIversion\fR is acceptable.
of Tcl satisfying the request, or NULL if the Tcl version is not
acceptable, does not support stubs, or any other error condition occurred.
.SH "SEE ALSO"
-\fBTk_InitStubs\fR
+Tk_InitStubs
.SH KEYWORDS
stubs
diff --git a/tcl/doc/IntObj.3 b/tcl/doc/IntObj.3
index e94fd235b69..d162c48ae31 100644
--- a/tcl/doc/IntObj.3
+++ b/tcl/doc/IntObj.3
@@ -10,7 +10,7 @@
.TH Tcl_IntObj 3 8.0 Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_NewIntObj, Tcl_NewLongObj, Tcl_SetIntObj, Tcl_SetLongObj, Tcl_GetIntFromObj, Tcl_GetLongFromObj \- manipulate Tcl objects as integers
+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
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -21,29 +21,51 @@ Tcl_Obj *
Tcl_Obj *
\fBTcl_NewLongObj\fR(\fIlongValue\fR)
.sp
+.VS 8.4
+Tcl_Obj *
+\fBTcl_NewWideIntObj\fR(\fIwideValue\fR)
+.VE 8.4
+.sp
\fBTcl_SetIntObj\fR(\fIobjPtr, intValue\fR)
.sp
\fBTcl_SetLongObj\fR(\fIobjPtr, longValue\fR)
.sp
+.VS 8.4
+\fBTcl_SetWideIntObj\fR(\fIobjPtr, wideValue\fR)
+.VE 8.4
+.sp
int
\fBTcl_GetIntFromObj\fR(\fIinterp, objPtr, intPtr\fR)
.sp
int
\fBTcl_GetLongFromObj\fR(\fIinterp, objPtr, longPtr\fR)
+.sp
+.VS 8.4
+int
+\fBTcl_GetWideIntFromObj\fR(\fIinterp, objPtr, widePtr\fR)
+.VE 8.4
.SH ARGUMENTS
-.AS Tcl_Interp *interp
+.AS Tcl_WideInt *interp
.AP int intValue in
Integer value used to initialize or set an integer object.
.AP long longValue in
Long integer value used to initialize or set an integer object.
+.AP Tcl_WideInt wideValue in
+.VS 8.4
+Wide integer value (minimum 64-bits wide where supported by the
+compiler) used to initialize or set a wide integer object.
+.VE 8.4
.AP Tcl_Obj *objPtr in/out
-For \fBTcl_SetIntObj\fR and \fBTcl_SetLongObj\fR,
-this points to the object to be converted to integer type.
-For \fBTcl_GetIntFromObj\fR and \fBTcl_GetLongFromObj\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,
-an attempt will be made to convert it to one.
+For \fBTcl_SetIntObj\fR, \fBTcl_SetLongObj\fR, and
+.VS 8.4
+\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
+.VE 8.4
+attempt will be made to convert it to one.
.AP Tcl_Interp *interp in/out
If an error occurs during conversion,
an error message is left in the interpreter's result object
@@ -54,34 +76,54 @@ obtained by \fBTcl_GetIntFromObj\fR from \fIobjPtr\fR.
.AP long *longPtr out
Points to place to store the long integer value
obtained by \fBTcl_GetLongFromObj\fR from \fIobjPtr\fR.
+.AP Tcl_WideInt *widePtr out
+.VS 8.4
+Points to place to store the wide integer value
+obtained by \fBTcl_GetWideIntFromObj\fR from \fIobjPtr\fR.
+.VE 8.4
.BE
.SH DESCRIPTION
.PP
These procedures are used to create, modify, and read
-integer Tcl objects from C code.
+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.
+or modify an existing object to have integer type,
+.VS 8.4
+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.
+.VE 8.4
\fBTcl_NewIntObj\fR and \fBTcl_SetIntObj\fR set the object to have the
integer value given by \fIintValue\fR,
-while \fBTcl_NewLongObj\fR and \fBTcl_SetLongObj\fR
+\fBTcl_NewLongObj\fR and \fBTcl_SetLongObj\fR
set the object to have the
-long integer value given by \fIlongValue\fR.
-\fBTcl_NewIntObj\fR and \fBTcl_NewLongObj\fR
+long integer value given by \fIlongValue\fR,
+.VS 8.4
+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 member.
-\fBTcl_SetIntObj\fR and \fBTcl_SetLongObj\fR
+\fIlongValue\fR or \fIwideValue\fR member (as appropriate).
+\fBTcl_SetIntObj\fR, \fBTcl_SetLongObj\fR
+and \fBTcl_SetWideIntObj\fR
+.VE 8.4
invalidate any old string representation and,
if the object is not already an integer object,
free any old internal representation.
.PP
\fBTcl_GetIntFromObj\fR and \fBTcl_GetLongFromObj\fR
-attempt to return an integer value from the Tcl object \fIobjPtr\fR.
+attempt to return an integer value from the Tcl object \fIobjPtr\fR,
+.VS 8.4
+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
+.VE 8.4
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
@@ -91,11 +133,14 @@ Also, if the long integer held in the object's internal representation
\fBTcl_GetIntFromObj\fR returns \fBTCL_ERROR\fR
and leaves an error message in the interpreter's result object
unless \fIinterp\fR is NULL.
-Otherwise, both procedures return \fBTCL_OK\fR and
-store the integer or the long integer value
-in the address given by \fIintPtr\fR and \fIlongPtr\fR respectively.
-If the object is not already an integer object,
-the conversion will free any old internal representation.
+Otherwise, all three procedures return \fBTCL_OK\fR and
+store the integer, long integer value
+.VS 8.4
+or wide integer in the address given by \fIintPtr\fR, \fIlongPtr\fR
+and \fIwidePtr\fR
+.VE 8.4
+respectively. If the object is not already an integer or wide integer
+object, the conversion will free any old internal representation.
.SH "SEE ALSO"
Tcl_NewObj, Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_GetObjResult
diff --git a/tcl/doc/Interp.3 b/tcl/doc/Interp.3
index b3d5f7b7330..fee2836fa5a 100644
--- a/tcl/doc/Interp.3
+++ b/tcl/doc/Interp.3
@@ -124,4 +124,3 @@ occurred.
.SH KEYWORDS
free, initialized, interpreter, malloc, result
-
diff --git a/tcl/doc/LinkVar.3 b/tcl/doc/LinkVar.3
index abc031ab639..d8c085b3963 100644
--- a/tcl/doc/LinkVar.3
+++ b/tcl/doc/LinkVar.3
@@ -27,13 +27,15 @@ int
.AP Tcl_Interp *interp in
Interpreter that contains \fIvarName\fR.
Also used by \fBTcl_LinkVar\fR to return error messages.
-.AP char *varName in
-Name of global variable. Must be in writable memory: Tcl may make
-temporary modifications to it while parsing the variable name.
+.AP "CONST char" *varName in
+Name of global variable.
.AP char *addr in
Address of C variable that is to be linked to \fIvarName\fR.
.AP int type in
Type of C variable. Must be one of TCL_LINK_INT, TCL_LINK_DOUBLE,
+.VS 8.4
+TCL_LINK_WIDE_INT,
+.VE 8.4
TCL_LINK_BOOLEAN, or TCL_LINK_STRING, optionally OR'ed with
TCL_LINK_READ_ONLY to make Tcl variable read-only.
.BE
@@ -58,17 +60,27 @@ TCL_LINK_READ_ONLY:
\fBTCL_LINK_INT\fR
The C variable is of type \fBint\fR.
Any value written into the Tcl variable must have a proper integer
-form acceptable to \fBTcl_GetInt\fR; attempts to write
+form acceptable to \fBTcl_GetIntFromObj\fR; attempts to write
non-integer values into \fIvarName\fR will be rejected with
Tcl errors.
.TP
\fBTCL_LINK_DOUBLE\fR
The C variable is of type \fBdouble\fR.
Any value written into the Tcl variable must have a proper real
-form acceptable to \fBTcl_GetDouble\fR; attempts to write
+form acceptable to \fBTcl_GetDoubleFromObj\fR; attempts to write
non-real values into \fIvarName\fR will be rejected with
Tcl errors.
.TP
+\fBTCL_LINK_WIDE_INT\fR
+.VS 8.4
+The C variable is of type \fBTcl_WideInt\fR (which is an integer type
+at least 64-bits wide on all platforms that can support it.)
+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.
+.VE 8.4
+.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'';
@@ -76,7 +88,7 @@ otherwise it will read from Tcl as ``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
-form acceptable to \fBTcl_GetBoolean\fR; attempts to write
+form acceptable to \fBTcl_GetBooleanFromObj\fR; attempts to write
non-boolean values into \fIvarName\fR will be rejected with
Tcl errors.
.TP
@@ -84,7 +96,7 @@ Tcl errors.
The C variable is of type \fBchar *\fR.
.VS
If its value is not null then it must be a pointer to a string
-allocated with \fBTcl_Alloc\fR.
+allocated with \fBTcl_Alloc\fR or \fBckalloc\fR.
.VE
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
@@ -113,4 +125,3 @@ variable are invoked.
.SH KEYWORDS
boolean, integer, link, read-only, real, string, traces, variable
-
diff --git a/tcl/doc/Macintosh.3 b/tcl/doc/Macintosh.3
new file mode 100644
index 00000000000..febde03395d
--- /dev/null
+++ b/tcl/doc/Macintosh.3
@@ -0,0 +1,111 @@
+'\"
+'\" Copyright (c) 1997-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$
+'\"
+.so man.macros
+.TH Tcl_MacSetEventProc 3 "8.1" Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_MacSetEventProc, Tcl_MacConvertTextResource, Tcl_MacEvalResource, Tcl_MacFindResource, Tcl_GetOSTypeFromObj, Tcl_SetOSTypeObj, Tcl_NewOSTypeObj \- procedures to handle Macintosh resources and other Macintosh specifics
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+int
+\fBTcl_MacEvalResource\fR(\fIinterp, resourceName, resourceNumber, fileName\fR)
+.sp
+char*
+\fBTcl_MacConvertTextResource\fR(\fIresource\fR)
+.sp
+Handle
+\fBTcl_MacFindResource\fR(\fIinterp, resourceType, resourceName, resourceNumber, resFileRef, releaseIt\fR)
+.sp
+Tcl_Obj*
+\fBTcl_NewOSTypeObj\fR(\fInewOSType\fR)
+.sp
+void
+\fBTcl_SetOSTypeObj\fR(\fIobjPtr, newOSType\fR)
+.sp
+int
+\fBTcl_GetOSTypeFromObj\fR(\fIinterp, objPtr, osTypePtr\fR)
+.sp
+void
+\fBTcl_MacSetEventProc\fR(\fIprocPtr\fR)
+.SH ARGUMENTS
+.AP Tcl_Interp *interp in
+Interpreter to use for error reporting, or NULL if no error reporting is
+desired.
+.AP "CONST char" *resourceName in
+Name of TEXT resource to source, NULL if number should be used.
+.AP int resourceNumber in
+Resource id of source.
+.AP "CONST char" *fileName in
+Name of file to process. NULL if application resource.
+.AP Handle resource in
+Handle to TEXT resource.
+.AP long resourceType in
+Type of resource to load.
+.AP "CONST char" *resFileRef in
+Registered resource file reference, NULL if searching all open resource files.
+.AP int *releaseIt out
+Should we release this resource when done.
+.AP int newOSType in
+Int used to initialize the new object or set the object's value.
+.AP Tcl_Obj *objPtr in
+Object whose internal representation is to be set or retrieved.
+.AP osTypePtr out
+Place to store the resulting integer.
+.AP Tcl_MacConvertEventPtr procPtr in
+Reference to the new function to handle all incoming Mac events.
+
+.BE
+.SH INTRODUCTION
+.PP
+The described routines are used to implement the Macintosh specific
+\fBresource\fR command and the Mac specific notifier.. They manipulate
+or use Macintosh resources and provide administration for open
+resource file references.
+
+.SH DESCRIPTION
+.PP
+\fBTcl_MacEvalResource\fR extends the \fBsource\fR command to
+Macintosh resources. It sources Tcl code from a Text resource.
+Currently only sources the resource by name, file IDs may be supported
+at a later date.
+.PP
+\fBTcl_MacConvertTextResource\fR converts a TEXT resource into a Tcl
+suitable string. It mallocs the returned memory, converts ``\\r'' to
+``\\n'', and appends a NULL. The caller has the responsibility for
+freeing the memory.
+.PP
+\fBTcl_MacFindResource\fR provides a higher level interface for
+loading resources. It is used by \fBresource read\fR.
+.PP
+\fBTcl_NewOSTypeObj\fR is used to create a new resource name type
+object. The object type is "ostype".
+.PP
+\fBTcl_SetOSTypeObj\fR modifies an object to be a resource type and to
+have the specified long value.
+.PP
+\fBTcl_GetOSTypeFromObj\fR attempts to return an int from the Tcl
+object "objPtr". If the object is not already an int, an attempt will
+be made to convert it to one.
+.PP
+\fBTcl_MacSetEventProc\fR sets the event handling procedure for the
+application. This function will be passed all incoming Mac events.
+This function usually controls the console or some other entity like
+Tk.
+
+.SH RESOURCE TYPES
+.PP
+Resource types are 4-byte values used by the macintosh resource
+facility to tag parts of the resource fork in a file so that the OS
+knows how to handle them. As all 4 bytes are restricted to printable
+characters such a type can be interpreted as a 4 character string too.
+
+.SH KEYWORDS
+macintosh, mac, resource, notifier
diff --git a/tcl/doc/Notifier.3 b/tcl/doc/Notifier.3
index 58a29db5903..fcf3093cf50 100644
--- a/tcl/doc/Notifier.3
+++ b/tcl/doc/Notifier.3
@@ -101,7 +101,7 @@ What types of events to service. These flags are the same as those
passed to \fBTcl_DoOneEvent\fR.
.VS 8.1
.AP int mode in
-Inidicates whether events should be serviced by \fBTcl_ServiceAll\fR.
+Indicates whether events should be serviced by \fBTcl_ServiceAll\fR.
Must be one of \fBTCL_SERVICE_NONE\fR or \fBTCL_SERVICE_ALL\fR.
.VE
.BE
@@ -466,7 +466,7 @@ procedures.
.PP
\fBTcl_InitNotifier\fR initializes the notifier state and returns
a handle to the notifier state. Tcl calls this
-procedure when intializing a Tcl interpreter. Similarly,
+procedure when initializing a Tcl interpreter. Similarly,
\fBTcl_FinalizeNotifier\fR shuts down the notifier, and is
called by \fBTcl_Finalize\fR when shutting down a Tcl interpreter.
.PP
@@ -600,4 +600,3 @@ mode.
\fBTcl_DoOneEvent\fR, \fBThread(3)\fR
.SH KEYWORDS
event, notifier, event queue, event sources, file events, timer, idle, service mode, threads
-
diff --git a/tcl/doc/Object.3 b/tcl/doc/Object.3
index 6b62eccd935..ccc78e1b65c 100644
--- a/tcl/doc/Object.3
+++ b/tcl/doc/Object.3
@@ -335,4 +335,3 @@ Tcl_ConvertToType, Tcl_GetIntFromObj, Tcl_ListObjAppendElement, Tcl_ListObjIndex
.SH KEYWORDS
internal representation, object, object creation, object type, reference counting, string representation, type conversion
-
diff --git a/tcl/doc/ObjectType.3 b/tcl/doc/ObjectType.3
index c95606f1798..5e386bac1da 100644
--- a/tcl/doc/ObjectType.3
+++ b/tcl/doc/ObjectType.3
@@ -29,9 +29,9 @@ int
.AS Tcl_ObjType *typeName in
.AP Tcl_ObjType *typePtr in
Points to the structure containing information about the Tcl object type.
-This storage must must live forever,
+This storage must live forever,
typically by being statically allocated.
-.AP char *typeName in
+.AP "CONST char" *typeName in
The name of a Tcl object type that \fBTcl_GetObjType\fR should look up.
.AP Tcl_Interp *interp in
Interpreter to use for error reporting.
@@ -55,7 +55,7 @@ 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
that implement the type.
-If the type table already containes a type
+If the type table already contains a type
with the same name as in \fItypePtr\fR,
it is replaced with the new type.
The Tcl_ObjType structure is described
@@ -134,6 +134,8 @@ 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
Tcl_ObjType structure.
+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 \fIupdateStringProc\fR member contains the address of a function
called to create a valid string representation
@@ -147,8 +149,8 @@ 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 be treated as conventional null character-terminated C strings.
-Storage for the byte array must be allocated in the heap by \fBTcl_Alloc\fR.
-Note that \fIupdateStringProc\fRs must allocate
+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 builtin list type, for example,
builds an array of strings for each element object
diff --git a/tcl/doc/OpenFileChnl.3 b/tcl/doc/OpenFileChnl.3
index b0728185ea1..4631a2fcd46 100644
--- a/tcl/doc/OpenFileChnl.3
+++ b/tcl/doc/OpenFileChnl.3
@@ -10,23 +10,19 @@
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
-Tcl_OpenFileChannel, Tcl_OpenCommandChannel, Tcl_MakeFileChannel, Tcl_GetChannel, Tcl_GetChannelNames, Tcl_GetChannelNamesEx, Tcl_RegisterChannel, Tcl_UnregisterChannel, Tcl_Close, Tcl_ReadChars, Tcl_Read, Tcl_GetsObj, Tcl_Gets, Tcl_WriteObj, Tcl_WriteChars, Tcl_Write, Tcl_Flush, Tcl_Seek, Tcl_Tell, Tcl_GetChannelOption, Tcl_SetChannelOption, Tcl_Eof, Tcl_InputBlocked, Tcl_InputBuffered, Tcl_Ungets \- buffered I/O facilities using channels
+Tcl_OpenFileChannel, Tcl_OpenCommandChannel, Tcl_MakeFileChannel, Tcl_GetChannel, Tcl_GetChannelNames, Tcl_GetChannelNamesEx, Tcl_RegisterChannel, Tcl_UnregisterChannel, Tcl_DetachChannel, Tcl_IsStandardChannel, Tcl_Close, Tcl_ReadChars, Tcl_Read, Tcl_GetsObj, Tcl_Gets, Tcl_WriteObj, Tcl_WriteChars, Tcl_Write, Tcl_Flush, Tcl_Seek, Tcl_Tell, Tcl_GetChannelOption, Tcl_SetChannelOption, Tcl_Eof, Tcl_InputBlocked, Tcl_InputBuffered, Tcl_OutputBuffered, Tcl_Ungets, Tcl_ReadRaw, Tcl_WriteRaw \- buffered I/O facilities using channels
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
-typedef ... Tcl_Channel;
-.sp
Tcl_Channel
\fBTcl_OpenFileChannel\fR(\fIinterp, fileName, mode, permissions\fR)
.sp
Tcl_Channel
\fBTcl_OpenCommandChannel\fR(\fIinterp, argc, argv, flags\fR)
-.VS 8.0
.sp
Tcl_Channel
\fBTcl_MakeFileChannel\fR(\fIhandle, readOrWrite\fR)
-.VE
.sp
Tcl_Channel
\fBTcl_GetChannel\fR(\fIinterp, channelName, modePtr\fR)
@@ -46,6 +42,12 @@ int
\fBTcl_UnregisterChannel\fR(\fIinterp, channel\fR)
.sp
int
+\fBTcl_DetachChannel\fR(\fIinterp, channel\fR)
+.sp
+int
+\fBTcl_IsStandardChannel\fR(\fIchannel\fR)
+.sp
+int
\fBTcl_Close\fR(\fIinterp, channel\fR)
.sp
.VS 8.1
@@ -53,7 +55,7 @@ int
\fBTcl_ReadChars\fR(\fIchannel, readObjPtr, charsToRead, appendFlag\fR)
.sp
int
-\fBTcl_Read\fR(\fIchannel, byteBuf, bytesToRead\fR)
+\fBTcl_Read\fR(\fIchannel, readBuf, bytesToRead\fR)
.sp
int
\fBTcl_GetsObj\fR(\fIchannel, lineObjPtr\fR)
@@ -73,6 +75,14 @@ int
int
\fBTcl_Write\fR(\fIchannel, byteBuf, bytesToWrite\fR)
.VE
+.VS 8.3.2
+.sp
+int
+\fBTcl_ReadRaw\fR(\fIchannel, readBuf, bytesToRead\fR)
+.sp
+int
+\fBTcl_WriteRaw\fR(\fIchannel, byteBuf, bytesToWrite\fR)
+.VE
.sp
int
\fBTcl_Eof\fR(\fIchannel\fR)
@@ -85,6 +95,11 @@ int
.sp
int
\fBTcl_InputBuffered\fR(\fIchannel\fR)
+.VS 8.4
+.sp
+int
+\fBTcl_OutputBuffered\fR(\fIchannel\fR)
+.VE
.sp
int
\fBTcl_Seek\fR(\fIchannel, offset, seekMode\fR)
@@ -102,18 +117,17 @@ int
.AS Tcl_ChannelType newClientProcPtr in
.AP Tcl_Interp *interp in
Used for error reporting and to look up a channel registered in it.
-.AP char *fileName in
+.AP "CONST char" *fileName in
The name of a local or network file.
-.AP char *mode in
+.AP "CONST char" *mode in
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. For
-\fBTcl_OpenCommandChannel\fR, may be NULL.
+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
permissions will be set on the created file.
.AP int argc in
The number of elements in \fIargv\fR.
-.AP char **argv in
+.AP "CONST char" **argv in
Arguments for constructing a command pipeline. These values have the same
meaning as the non-switch arguments to the Tcl \fBexec\fR command.
.AP int flags in
@@ -126,20 +140,22 @@ input of the invoking process; likewise for \fBTCL_STDOUT\fR and
redirect stdio handles to override the stdio handles for which
\fBTCL_STDIN\fR, \fBTCL_STDOUT\fR and \fBTCL_STDERR\fR have been set. If it
is set, then such redirections cause an error.
-.VS 8.0
.AP ClientData handle in
Operating system specific handle for I/O to a file. For Unix this is a
file descriptor, for Windows it is a HANDLE.
.AP int readOrWrite in
OR-ed combination of \fBTCL_READABLE\fR and \fBTCL_WRITABLE\fR to indicate
what operations are valid on \fIhandle\fR.
-.AP char *channelName in
+.AP "CONST char" *channelName in
The name of the channel.
-.VE
.AP int *modePtr out
Points at an integer variable that will receive an OR-ed combination of
\fBTCL_READABLE\fR and \fBTCL_WRITABLE\fR denoting whether the channel is
open for reading and writing.
+.VS 8.3
+.AP "CONST char" *pattern in
+The pattern to match on, passed to Tcl_StringMatch, or NULL.
+.VE
.AP Tcl_Channel channel in
A Tcl channel for input or output. Must have been the return value
from a procedure such as \fBTcl_OpenFileChannel\fR.
@@ -167,11 +183,20 @@ object.
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
appended to any data already in the dynamic string.
+.VS 8.3
+.AP "CONST char" *input in
+The input to add to a channel buffer.
+.AP int inputLen in
+Length of the input
+.AP int addAtEnd in
+Flag indicating whether the input should be added to the end or
+beginning of the channel buffer.
+.VE
.AP Tcl_Obj *writeObjPtr in
A pointer to a Tcl Object whose contents will be output to the channel.
.AP "CONST char" *charBuf in
A buffer containing the characters to output to the channel.
-.AP char *byteBuf in
+.AP "CONST char" *byteBuf in
A buffer containing the bytes to output to the channel.
.AP int bytesToWrite in
The number of bytes to consume from \fIcharBuf\fR or \fIbyteBuf\fR and
@@ -185,25 +210,14 @@ given by \fIseekMode\fR. May be either positive or negative.
Relative to which point to seek; used with \fIoffset\fR to calculate the new
access point for the channel. Legal values are \fBSEEK_SET\fR,
\fBSEEK_CUR\fR, and \fBSEEK_END\fR.
-.AP char *optionName in
+.AP "CONST char" *optionName in
The name of an option applicable to this channel, such as \fB\-blocking\fR.
May have any of the values accepted by the \fBfconfigure\fR command.
.AP Tcl_DString *optionValue in
Where to store the value of an option or a list of all options and their
values. Must have been initialized by the caller.
-.AP char *newValue in
+.AP "CONST char" *newValue in
New value for the option given by \fIoptionName\fR.
-.VS 8.3
-.AP char *pattern in
-The pattern to match on, passed to Tcl_StringMatch, or NULL.
-.AP char *input in
-The input to add to a channel buffer.
-.AP int inputLen in
-Length of the input
-.AP int addToEnd in
-Flag indicating whether the input should be added to the end or
-beginning of the channel buffer.
-.VE
.BE
.SH DESCRIPTION
@@ -236,7 +250,11 @@ If an error occurs while opening the channel, \fBTcl_OpenFileChannel\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, \fBTcl_OpenFileChannel\fR
-leaves an error message in \fIinterp\fR's result after any error.
+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
+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.
@@ -297,7 +315,7 @@ replacement for the standard channel.
\fBTcl_GetChannel\fR returns a channel given the \fIchannelName\fR used to
create it with \fBTcl_CreateChannel\fR and a pointer to a Tcl interpreter in
\fIinterp\fR. If a channel by that name is not registered in that interpreter,
-the procedure returns NULL. If the \fImode\fR argument is not NULL, it
+the procedure returns NULL. If the \fImodePtr\fR argument is not NULL, it
points at an integer variable that will receive an OR-ed combination of
\fBTCL_READABLE\fR and \fBTCL_WRITABLE\fR describing whether the channel is
open for reading and writing.
@@ -307,7 +325,7 @@ names of the registered channels to the interpreter's result as a
list object. \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 occured writing to the result, otherwise it is \fBTCL_ERROR\fR,
+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
@@ -327,6 +345,13 @@ be registered in a Tcl interpreter and it will only be closed when the
matching number of calls to \fBTcl_UnregisterChannel\fR have been made.
This allows code executing outside of any interpreter to safely hold a
reference to a channel that is also registered in a Tcl interpreter.
+.PP
+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
+them.
.SH TCL_UNREGISTERCHANNEL
.PP
@@ -339,7 +364,33 @@ interpreter, the channel is also closed and destroyed.
Code not associated with a Tcl interpreter can call
\fBTcl_UnregisterChannel\fR with \fIinterp\fR as NULL, to indicate to Tcl
that it no longer holds a reference to that channel. If this is the last
-reference to the channel, it will now be closed.
+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
+TCL_ERROR if passed one of those channels.
+.PP
+Code not associated with a Tcl interpreter can call
+\fBTcl_DetachChannel\fR with \fIinterp\fR as NULL, to indicate to Tcl
+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.
+.PP
+No attempt is made to check whether the given channel or the standard
+channels are initialized or otherwise valid.
.SH TCL_CLOSE
.PP
@@ -378,7 +429,7 @@ corresponding calls to \fBTcl_UnregisterChannel\fR.
to UTF-8 based on the channel's encoding and storing the produced data in
\fIreadObjPtr\fR's string representation. The return value of
\fBTcl_ReadChars\fR is the number of characters, up to \fIcharsToRead\fR,
-that were stored in \fIobjPtr\fR. If an error occurs while reading, the
+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
@@ -415,11 +466,19 @@ converting to or from UTF-8.
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
-\fIbuf\fR, performing end-of-line translations on the way. The return value
-of \fBTcl_Read\fR is the number of bytes, up to \fItoRead\fR, written in
-\fIbuf\fR. The buffer produced by \fBTcl_Read\fR is not NULL terminated.
+\fIreadBuf\fR, performing end-of-line translations on the way. The return value
+of \fBTcl_Read\fR is the number of bytes, up to \fIbytesToRead\fR, written in
+\fIreadBuf\fR. The buffer produced by \fBTcl_Read\fR is not NULL terminated.
Its contents are valid from the zeroth position up to and excluding the
position indicated by the return value.
+.PP
+\fBTcl_ReadRaw\fR is the same as \fBTcl_Read\fR but does not
+compensate for stacking. While \fBTcl_Read\fR (and the other functions
+in the API) always get their data from the topmost channel in the
+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
@@ -445,16 +504,16 @@ procedure may be invoked to determine if the channel is blocked because
of input unavailability.
.PP
\fBTcl_Gets\fR is the same as \fBTcl_GetsObj\fR except the resulting
-characters are appended to the appended to the dynamic string given by
-\fIdsPtr\fR rather than a Tcl object.
+characters are appended to the dynamic string given by
+\fIlineRead\fR rather than a Tcl object.
.SH "TCL_UNGETS"
.PP
\fBTcl_Ungets\fR is used to add data to the input queue of a channel,
-at either the head or tail of the queue. \fIInput\fR is a pointer to
-the data that is to be added. \fIInputLen\fR gives the length of the
-input to add. \fIAddAtEnd\fR, in non-zero, indicates that the data is
-to be added at the end of queue; otherwise it will be added at the
+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
added to the input queue. \fBTcl_Ungets\fR returns \fIinputLen\fR or
-1 if an error occurs.
@@ -504,6 +563,15 @@ Tcl extensions. It accepts \fIbytesToWrite\fR bytes of data at
\fIbyteBuf\fR and queues them for output to \fIchannel\fR. If
\fIbytesToWrite\fR is negative, \fBTcl_Write\fR expects \fIbyteBuf\fR to be
NULL terminated and it outputs everything up to the NULL.
+.PP
+\fBTcl_WriteRaw\fR is the same as \fBTcl_Write\fR but does not
+compensate for stacking. While \fBTcl_Write\fR (and the other
+functions in the API) always feed their input to the topmost channel
+in the stack the supplied channel is part of, \fBTcl_WriteRaw\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 transformation into the channel below
+it.
.VE
.SH TCL_FLUSH
@@ -538,7 +606,7 @@ value is \-1 if the channel does not support seeking.
.SH TCL_GETCHANNELOPTION
.PP
-\fBTcl_GetChannelOption\fR retrieves, in \fIdsPtr\fR, the value of one of
+\fBTcl_GetChannelOption\fR retrieves, in \fIoptionValue\fR, the value of one of
the options currently in effect for a channel, or a list of all options and
their values. The \fIchannel\fR argument identifies the channel for which
to query an option or retrieve all options and their values.
@@ -560,9 +628,8 @@ error code.
.SH TCL_SETCHANNELOPTION
.PP
-\fBTcl_SetChannelOption\fR sets a new value for an option on \fIchannel\fR.
-\fIOptionName\fR is the option to set and \fInewValue\fR is the value to
-set.
+\fBTcl_SetChannelOption\fR sets a new value \fInewValue\fR
+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.
@@ -585,7 +652,13 @@ The call always returns zero if the channel is in blocking mode.
buffered in the internal buffers for a channel. If the channel is not open
for reading, this function always returns zero.
-.VS 8.0
+.SH TCL_OUTPUTBUFFERED
+.VS 8.4
+\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.
+.VE
+
.SH "PLATFORM ISSUES"
.PP
The handles returned from \fBTcl_GetChannelHandle\fR depend on the
@@ -597,12 +670,10 @@ the channel was created with \fBTcl_OpenFileChannel\fR,
channel types may return a different type of handle on Windows
platforms. On the Macintosh platform, the handle is a file reference
number as returned from \fBHOpenDF\fR.
-.VE
.SH "SEE ALSO"
-DString(3), fconfigure(n), filename(n), fopen(2), Tcl_CreateChannel(3)
+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/tcl/doc/OpenTcp.3 b/tcl/doc/OpenTcp.3
index a16e0de95b2..1e91595050c 100644
--- a/tcl/doc/OpenTcp.3
+++ b/tcl/doc/OpenTcp.3
@@ -31,12 +31,12 @@ Tcl interpreter to use for error reporting. If non-NULL and an
error occurs, an error message is left in the interpreter's result.
.AP int port in
A port number to connect to as a client or to listen on as a server.
-.AP char *host in
+.AP "CONST char" *host in
A string specifying a host name or address for the remote end of the connection.
.AP int myport in
A port number for the client's end of the socket. If 0, a port number
is allocated at random.
-.AP char *myaddr in
+.AP "CONST char" *myaddr in
A string specifying the host name or address for network interface to use
for the local end of the connection. If NULL, a default interface is
chosen.
@@ -177,4 +177,3 @@ Tcl_OpenFileChannel(3), Tcl_RegisterChannel(3), vwait(n)
.SH KEYWORDS
client, server, TCP
-
diff --git a/tcl/doc/Panic.3 b/tcl/doc/Panic.3
new file mode 100644
index 00000000000..6921510568d
--- /dev/null
+++ b/tcl/doc/Panic.3
@@ -0,0 +1,108 @@
+'\"
+'\" 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_Panic 3 8.4 Tcl "Tcl Library Procedures"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+Tcl_Panic, Tcl_PanicVA, Tcl_SetPanicProc, panic, panicVA \- report fatal error and abort
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+void
+\fBTcl_Panic\fR(\fIformat\fR, \fIarg\fR, \fIarg\fR, \fI...\fR)
+.sp
+void
+\fBTcl_PanicVA\fR(\fIformat\fR, \fIargList\fR)
+.sp
+void
+\fBTcl_SetPanicProc\fR(\fIpanicProc\fR)
+.sp
+void
+\fBpanic\fR(\fIformat\fR, \fIarg\fR, \fIarg\fR, \fI...\fR)
+.sp
+void
+\fBpanicVA\fR(\fIformat\fR, \fIargList\fR)
+.sp
+.SH ARGUMENTS
+.AS Tcl_PanicProc *panicProc
+.AP "CONST char*" format in
+A printf-style format string.
+.AP "" arg in
+Arguments matching the format string.
+.AP va_list argList in
+An argument list of arguments matching the format string.
+Must have been initialized using \fBTCL_VARARGS_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
+inconsistent state, or that its C procedures have been called in a
+manner inconsistent with their documentation, it calls \fBTcl_Panic\fR
+to display a message describing the error and abort the process. The
+\fIformat\fR argument is a format string describing how to format the
+remaining arguments \fIarg\fR into an error message, according to the
+same formatting rules used by the \fBprintf\fR family of functions. The
+same formatting rules are also used by the builtin Tcl command
+\fBformat\fR.
+.PP
+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.
+.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(
+ 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.
+.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).
+.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
+by any extension or application that wishes to abort the process and
+have a panic message displayed the same way that panic messages from Tcl
+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. The
+procedures \fBpanic\fR and \fBpanicVA\fR are synonyms (implemented as
+macros) for \fBTcl_Panic\fR and \fBTcl_PanicVA\fR, respectively. They
+exist to support old code; new code should use direct calls to
+\fBTcl_Panic\fR or \fBTcl_PanicVA\fR.
+
+.SH "SEE ALSO"
+abort(3), printf(3), exec(n), format(n)
+
+.SH KEYWORDS
+abort, fatal, error
+
diff --git a/tcl/doc/ParseCmd.3 b/tcl/doc/ParseCmd.3
index a9c0fb2e634..407b390a2c7 100644
--- a/tcl/doc/ParseCmd.3
+++ b/tcl/doc/ParseCmd.3
@@ -10,7 +10,7 @@
.TH Tcl_ParseCommand 3 8.3 Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces, Tcl_ParseQuotedString, Tcl_ParseVarName, Tcl_ParseVar, Tcl_FreeParse, Tcl_EvalTokens \- parse Tcl scripts and expressions
+Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces, Tcl_ParseQuotedString, Tcl_ParseVarName, Tcl_ParseVar, Tcl_FreeParse, Tcl_EvalTokens, Tcl_EvalTokensStandard \- parse Tcl scripts and expressions
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -30,22 +30,26 @@ int
int
\fBTcl_ParseVarName\fR(\fIinterp, string, numBytes, parsePtr, append\fR)
.sp
-char *
+CONST char *
\fBTcl_ParseVar\fR(\fIinterp, string, termPtr\fR)
.sp
\fBTcl_FreeParse\fR(\fIusedParsePtr\fR)
.sp
Tcl_Obj *
\fBTcl_EvalTokens\fR(\fIinterp, tokenPtr, numTokens\fR)
+.sp
+Tcl_Obj *
+\fBTcl_EvalTokensStandard\fR(\fIinterp, tokenPtr, numTokens\fR)
.SH ARGUMENTS
.AS Tcl_Interp *usedParsePtr
.AP Tcl_Interp *interp out
-For procedures other than \fBTcl_FreeParse\fR and \fBTcl_EvalTokens\fR,
-used only for error reporting;
+For procedures other than \fBTcl_FreeParse\fR, \fBTcl_EvalTokens\fR
+and \fBTcl_EvalTokensStandard\fR, used only for error reporting;
if NULL, then no error messages are left after errors.
-For \fBTcl_EvalTokens\fR, determines the context for evaluating the
+For \fBTcl_EvalTokens\fR and \fBTcl_EvalTokensStandard\fR,
+determines the context for evaluating the
script and also is used for error reporting; must not be NULL.
-.AP char *string in
+.AP "CONST char" *string in
Pointer to first character in string to parse.
.AP int numBytes in
Number of bytes in \fIstring\fR, not including any terminating null
@@ -67,7 +71,7 @@ Any previous information in this structure
is ignored, unless \fIappend\fR is non-zero in a call to
\fBTcl_ParseBraces\fR, \fBTcl_ParseQuotedString\fR,
or \fBTcl_ParseVarName\fR.
-.AP char **termPtr out
+.AP "CONST char" **termPtr out
If not NULL, points to a location where
\fBTcl_ParseBraces\fR, \fBTcl_ParseQuotedString\fR, and
\fBTcl_ParseVar\fR will store a pointer to the character
@@ -125,7 +129,7 @@ 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
in the location given by \fI*termPtr\fR.
-If an error occurrs while parsing the string
+If an error occurs while parsing the string
then \fBTCL_ERROR\fR is returned,
an error message is left in \fIinterp\fR's result,
and no information is left at \fI*parsePtr\fR or \fI*termPtr\fR.
@@ -141,7 +145,7 @@ 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
in the location given by \fI*termPtr\fR.
-If an error occurrs while parsing the string
+If an error occurs while parsing the string
then \fBTCL_ERROR\fR is returned,
an error message is left in \fIinterp\fR's result,
and no information is left at \fI*parsePtr\fR or \fI*termPtr\fR.
@@ -154,7 +158,7 @@ If a variable name was parsed successfully, \fBTcl_ParseVarName\fR
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
-occurrs while parsing the command then \fBTCL_ERROR\fR is returned, an
+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
NULL), and no information is left at \fI*parsePtr\fR.
.PP
@@ -178,18 +182,27 @@ These procedures ignore any existing information in
so if repeated calls are being made to any of them
then \fBTcl_FreeParse\fR must be invoked once after each call.
.PP
-\fBTcl_EvalTokens\fR evaluates a sequence of parse tokens from a Tcl_Parse
-structure. The tokens typically consist
+\fBTcl_EvalTokensStandard\fR evaluates a sequence of parse tokens from
+a Tcl_Parse structure. The tokens typically consist
of all the tokens in a word or all the tokens that make up the index for
-a reference to an array variable. \fBTcl_EvalTokens\fR performs the
-substitutions requested by the tokens, concatenates the
-resulting values, and returns the result in a new Tcl_Obj. The
-reference count of the object returned as result has been
+a reference to an array variable. \fBTcl_EvalTokensStandard\fR performs the
+substitutions requested by the tokens and concatenates the
+resulting values.
+The return value from \fBTcl_EvalTokensStandard\fR is a Tcl completion
+code with one of the values \fBTCL_OK\fR, \fBTCL_ERROR\fR,
+\fBTCL_RETURN\fR, \fBTCL_BREAK\fR, or \fBTCL_CONTINUE\fR.
+In addition, a result value or error message is left in \fIinterp\fR's
+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
incremented, so the caller must
invoke \fBTcl_DecrRefCount\fR when it is finished with the object.
-If an error 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.
+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
@@ -332,7 +345,7 @@ this includes the sub-tokens for any nested \fBTCL_TOKEN_SUB_EXPR\fR tokens.
\fBTCL_TOKEN_OPERATOR\fR
The token describes one operator of an expression
such as \fB&&\fR or \fBhypot\fR.
-An \fBTCL_TOKEN_OPERATOR\fR token is always preceeded by a
+An \fBTCL_TOKEN_OPERATOR\fR token is always preceded by a
\fBTCL_TOKEN_SUB_EXPR\fR token
that describes the operator and its operands;
the \fBTCL_TOKEN_SUB_EXPR\fR token's \fInumComponents\fR field
@@ -436,4 +449,3 @@ referenced by code outside of these procedures.
.SH KEYWORDS
backslash substitution, braces, command, expression, parse, token, variable substitution
-
diff --git a/tcl/doc/PkgRequire.3 b/tcl/doc/PkgRequire.3
index e797c51f1dd..664c5d5aa21 100644
--- a/tcl/doc/PkgRequire.3
+++ b/tcl/doc/PkgRequire.3
@@ -15,16 +15,16 @@ Tcl_PkgRequire, Tcl_PkgRequireEx, Tcl_PkgPresent, Tcl_PkgPresentEx, Tcl_PkgProvi
.nf
\fB#include <tcl.h>\fR
.sp
-char *
+CONST char *
\fBTcl_PkgRequire\fR(\fIinterp, name, version, exact\fR)
.sp
-char *
+CONST char *
\fBTcl_PkgRequireEx\fR(\fIinterp, name, version, exact, clientDataPtr\fR)
.sp
-char *
+CONST char *
\fBTcl_PkgPresent\fR(\fIinterp, name, version, exact\fR)
.sp
-char *
+CONST char *
\fBTcl_PkgPresentEx\fR(\fIinterp, name, version, exact, clientDataPtr\fR)
.sp
int
@@ -33,12 +33,12 @@ int
int
\fBTcl_PkgProvideEx\fR(\fIinterp, name, version, clientData\fR)
.SH ARGUMENTS
-.AS Tcl_FreeProc clientDataPtr
+.AS ClientData clientDataPtr
.AP Tcl_Interp *interp in
Interpreter where package is needed or available.
-.AP char *name in
+.AP "CONST char" *name in
Name of package.
-.AP char *version in
+.AP "CONST char" *version in
A version string consisting of one or more decimal numbers
separated by dots.
.AP int exact in
@@ -85,4 +85,3 @@ functions.
.SH KEYWORDS
package, present, provide, require, version
-
diff --git a/tcl/doc/Preserve.3 b/tcl/doc/Preserve.3
index 277735cb98d..f69f3f06e19 100644
--- a/tcl/doc/Preserve.3
+++ b/tcl/doc/Preserve.3
@@ -89,6 +89,12 @@ The type of \fIblockPtr\fR (\fBchar *\fR) is different than the type of the
\fIclientData\fR argument to \fBTcl_EventuallyFree\fR for historical
reasons, but the value is the same.
.PP
+When the \fIclientData\fR argument to \fBTcl_EventuallyFree\fR
+refers to storage allocated and returned by a prior call to
+\fBTcl_Alloc\fR, \fBckalloc\fR, or another function of the Tcl library,
+then the \fIfreeProc\fR argument should be given the special value of
+\fBTCL_DYNAMIC\fR.
+.PP
This mechanism can be used to solve the problem described above
by placing \fBTcl_Preserve\fR and \fBTcl_Release\fR calls around
actions that may cause undesired storage re-allocation. The
@@ -99,5 +105,8 @@ 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/tcl/doc/RecEvalObj.3 b/tcl/doc/RecEvalObj.3
index d3b301da4a0..eb1d39c12d1 100644
--- a/tcl/doc/RecEvalObj.3
+++ b/tcl/doc/RecEvalObj.3
@@ -53,4 +53,3 @@ Tcl_EvalObjEx, Tcl_GetObjResult
.SH KEYWORDS
command, event, execute, history, interpreter, object, record
-
diff --git a/tcl/doc/RecordEval.3 b/tcl/doc/RecordEval.3
index 6a52832542b..5ce33a1fb12 100644
--- a/tcl/doc/RecordEval.3
+++ b/tcl/doc/RecordEval.3
@@ -22,7 +22,7 @@ int
.AS Tcl_Interp *interp;
.AP Tcl_Interp *interp in
Tcl interpreter in which to evaluate command.
-.AP char *cmd in
+.AP "CONST char" *cmd in
Command (or sequence of commands) to execute.
.AP int flags in
An OR'ed combination of flag bits. TCL_NO_EVAL means record the
@@ -55,4 +55,3 @@ Tcl_RecordAndEvalObj
.SH KEYWORDS
command, event, execute, history, interpreter, record
-
diff --git a/tcl/doc/RegExp.3 b/tcl/doc/RegExp.3
index a9774546249..75d05096507 100644
--- a/tcl/doc/RegExp.3
+++ b/tcl/doc/RegExp.3
@@ -1,7 +1,7 @@
'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
-'\" Copyright (c) 1998-1999 Scriptics Corportation
+'\" Copyright (c) 1998-1999 Scriptics Corporation
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -57,7 +57,7 @@ compiled regular expression is cached in the object.
.VE 8.1
.AP char *string in
String to check for a match with a regular expression.
-.AP char *pattern in
+.AP "CONST char" *pattern in
String in the form of a regular expression pattern.
.AP Tcl_RegExp regexp in
Compiled regular expression. Must have been returned previously
@@ -71,12 +71,14 @@ will be allowed.
Specifies which range is desired: 0 means the range of the entire
match, 1 or greater means the range that matched a parenthesized
sub-expression.
-.AP char **startPtr out
+.VS 8.4
+.AP "CONST char" **startPtr out
The address of the first character in the range is stored here, or
NULL if there is no such range.
-.AP char **endPtr out
+.AP "CONST char" **endPtr out
The address of the character just after the last one in the range
is stored here, or NULL if there is no such range.
+.VE 8.4
.VS 8.1
.AP int cflags in
OR-ed combination of compilation flags. See below for more information.
@@ -166,7 +168,7 @@ of characters that matched the entire pattern; otherwise,
information is returned about the range of characters that matched the
\fIindex\fR'th parenthesized subexpression within the pattern.
If there is no range corresponding to \fIindex\fR then NULL
-is stored in \fI*firstPtr\fR and \fI*lastPtr\fR.
+is stored in \fI*startPtr\fR and \fI*endPtr\fR.
.PP
.VS 8.1
\fBTcl_GetRegExpFromObj\fR, \fBTcl_RegExpExecObj\fR, and
@@ -178,7 +180,7 @@ 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.
.PP
-\fBTcl_GetRegExpFromObj\fR attepts to return a compiled regular
+\fBTcl_GetRegExpFromObj\fR attempts to return a compiled regular
expression from the \fIpatObj\fR. If the object 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
@@ -344,4 +346,3 @@ match might occur if additional text is appended to the string.
re_syntax(n)
.SH KEYWORDS
match, pattern, regular expression, string, subexpression, Tcl_RegExpIndices, Tcl_RegExpInfo
-
diff --git a/tcl/doc/SetErrno.3 b/tcl/doc/SetErrno.3
index a764ed558ec..252cd824b35 100644
--- a/tcl/doc/SetErrno.3
+++ b/tcl/doc/SetErrno.3
@@ -20,14 +20,14 @@ void
int
\fBTcl_GetErrno\fR()
.sp
-char *
+CONST char *
\fBTcl_ErrnoId\fR()
.sp
-char *
-\fBTcl_ErrnoMsg\fR()
+CONST char *
+\fBTcl_ErrnoMsg\fR(\fIerrorCode\fR)
.sp
.SH ARGUMENTS
-.AS Tcl_Interp *errorCode in
+.AS int errorCode in
.AP int errorCode in
A POSIX error code such as \fBENOENT\fR.
.BE
@@ -50,11 +50,15 @@ via \fBerrno\fR should call \fBTcl_SetErrno\fR rather than setting
Procedures wishing to access \fBerrno\fR should call this procedure
instead of accessing \fBerrno\fR directly.
.PP
-\fBTcl_ErrnoId\fR and \fBTcl_ErrnoMsg\fR return a string
-representation of the current \fBerrno\fR value. \fBTcl_ErrnoId\fR
+\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". \fBTcl_ErrnoMsg\fR returns a human-readable string such as
-"permission denied". The strings returned by these functions are
+"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
+\fIerrorCode\fR argument. The \fIerrorCode\fR argument is
+typically the value returned by \fBTcl_GetErrno\fR.
+The strings returned by these functions are
statically allocated and the caller must not free or modify them.
.SH KEYWORDS
diff --git a/tcl/doc/SetResult.3 b/tcl/doc/SetResult.3
index 6a571ceee3d..ff788458966 100644
--- a/tcl/doc/SetResult.3
+++ b/tcl/doc/SetResult.3
@@ -23,7 +23,7 @@ Tcl_Obj *
.sp
\fBTcl_SetResult\fR(\fIinterp, string, freeProc\fR)
.sp
-char *
+CONST char *
\fBTcl_GetStringResult\fR(\fIinterp\fR)
.sp
\fBTcl_AppendResult\fR(\fIinterp, string, string, ... , \fB(char *) NULL\fR)
@@ -223,4 +223,3 @@ Tcl_AddErrorInfo, Tcl_CreateObjCommand, Tcl_SetErrorCode, Tcl_Interp
.SH KEYWORDS
append, command, element, list, object, result, return value, interpreter
-
diff --git a/tcl/doc/SetVar.3 b/tcl/doc/SetVar.3
index ce2b4ed7a62..ed839885a92 100644
--- a/tcl/doc/SetVar.3
+++ b/tcl/doc/SetVar.3
@@ -21,10 +21,10 @@ Tcl_Obj *
\fBTcl_SetVar2Ex\fR(\fIinterp, name1, name2, newValuePtr, flags\fR)
.VE
.sp
-char *
+CONST char *
\fBTcl_SetVar\fR(\fIinterp, varName, newValue, flags\fR)
.sp
-char *
+CONST char *
\fBTcl_SetVar2\fR(\fIinterp, name1, name2, newValue, flags\fR)
.sp
Tcl_Obj *
@@ -35,10 +35,10 @@ Tcl_Obj *
\fBTcl_GetVar2Ex\fR(\fIinterp, name1, name2, flags\fR)
.VE
.sp
-char *
+CONST char *
\fBTcl_GetVar\fR(\fIinterp, varName, flags\fR)
.sp
-char *
+CONST char *
\fBTcl_GetVar2\fR(\fIinterp, name1, name2, flags\fR)
.sp
Tcl_Obj *
@@ -53,13 +53,13 @@ int
.AS Tcl_Interp *newValuePtr
.AP Tcl_Interp *interp in
Interpreter containing variable.
-.AP char *name1 in
+.AP "CONST char" *name1 in
Contains the name of an array variable (if \fIname2\fR is non-NULL)
or (if \fIname2\fR is NULL) either the name of a scalar variable
or a complete name including both variable name and index.
May include \fB::\fR namespace qualifiers
to specify a variable in a particular namespace.
-.AP char *name2 in
+.AP "CONST char" *name2 in
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
@@ -69,16 +69,13 @@ Points to a Tcl object containing the new value for the variable.
.AP int flags in
OR-ed combination of bits providing additional information. See below
for valid values.
-.AP char *varName in
+.AP "CONST char" *varName in
Name of variable.
May include \fB::\fR namespace qualifiers
to specify a variable in a particular namespace.
May refer to a scalar variable or an element of
an array.
-If the name references an element of an array, then the name
-must be in writable memory: Tcl will make temporary modifications
-to it while looking up the name.
-.AP char *newValue in
+.AP "CONST char" *newValue in
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
diff --git a/tcl/doc/Signal.3 b/tcl/doc/Signal.3
new file mode 100644
index 00000000000..4e5907d9bc5
--- /dev/null
+++ b/tcl/doc/Signal.3
@@ -0,0 +1,38 @@
+'\"
+'\" Copyright (c) 2001 ActiveState Tool Corp.
+'\"
+'\" 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_SignalId 3 8.3 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_SignalId, Tcl_SignalMsg \- Convert signal codes
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+CONST char *
+\fBTcl_SignalId\fR(\fIsig\fR)
+.sp
+CONST char *
+\fBTcl_SignalMsg\fR(\fIsig\fR)
+.sp
+.SH ARGUMENTS
+.AP int sig in
+A POSIX signal number such as \fBSIGPIPE\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+\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
+statically allocated and the caller must not free or modify them.
+
+.SH KEYWORDS
+signals, signal numbers
diff --git a/tcl/doc/SplitList.3 b/tcl/doc/SplitList.3
index 0dd0c023ab0..ccc491d0de3 100644
--- a/tcl/doc/SplitList.3
+++ b/tcl/doc/SplitList.3
@@ -34,7 +34,7 @@ int
int
\fBTcl_ConvertCountedElement\fR(\fIsrc, length, dst, flags\fR)
.SH ARGUMENTS
-.AS Tcl_Interp ***argvPtr
+.AS "CONST char * CONST" ***argvPtr
.AP Tcl_Interp *interp out
Interpreter to use for error reporting. If NULL, then no error message
is left.
@@ -42,17 +42,17 @@ is left.
Pointer to a string with proper list structure.
.AP int *argcPtr out
Filled in with number of elements in \fIlist\fR.
-.AP char ***argvPtr out
+.AP "CONST char" ***argvPtr out
\fI*argvPtr\fR will be filled in with the address of an array of
pointers to the strings that are the extracted elements of \fIlist\fR.
There will be \fI*argcPtr\fR valid entries in the array, followed by
a NULL entry.
.AP int argc in
Number of elements in \fIargv\fR.
-.AP char **argv in
+.AP "CONST char * CONST" *argv in
Array of strings to merge together into a single list.
Each string will become a separate element of the list.
-.AP char *src in
+.AP "CONST char" *src in
String that is to become an element of a list.
.AP int *flagsPtr in
Pointer to word to fill in with information about \fIsrc\fR.
@@ -173,4 +173,3 @@ argument, and the string may contain embedded nulls.
.SH KEYWORDS
backslash, convert, element, list, merge, split, strings
-
diff --git a/tcl/doc/SplitPath.3 b/tcl/doc/SplitPath.3
index 7491a40e014..7b4eb2a24b9 100644
--- a/tcl/doc/SplitPath.3
+++ b/tcl/doc/SplitPath.3
@@ -24,19 +24,19 @@ Tcl_PathType
\fBTcl_GetPathType\fR(\fIpath\fR)
.SH ARGUMENTS
.AS Tcl_DString ***argvPtr
-.AP char *path in
+.AP "CONST char * CONST" *argvPtr in
File path in a form appropriate for the current platform (see the
\fBfilename\fR manual entry for acceptable forms for path names).
.AP int *argcPtr out
Filled in with number of path elements in \fIpath\fR.
-.AP char ***argvPtr out
+.AP "CONST char" ***argvPtr out
\fI*argvPtr\fR will be filled in with the address of an array of
pointers to the strings that are the extracted elements of \fIpath\fR.
There will be \fI*argcPtr\fR valid entries in the array, followed by
a NULL entry.
.AP int argc in
Number of elements in \fIargv\fR.
-.AP char **argv in
+.AP "CONST char * CONST" *argv in
Array of path elements to merge together into a single path.
.AP Tcl_DString *resultPtr in/out
A pointer to an initialized \fBTcl_DString\fR to which the result of
@@ -45,6 +45,9 @@ 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
+the \fBFileSystem\fR man page, which are more efficient.
+.PP
These procedures may be used to disassemble and reassemble file
paths in a platform independent manner: they provide C-level access to
the same functionality as the \fBfile split\fR, \fBfile join\fR, and
diff --git a/tcl/doc/StaticPkg.3 b/tcl/doc/StaticPkg.3
index d19d2f15642..006698cea3a 100644
--- a/tcl/doc/StaticPkg.3
+++ b/tcl/doc/StaticPkg.3
@@ -23,7 +23,7 @@ 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.
-.AP char *pkgName in
+.AP "CONST char" *pkgName in
Name of the package; should be properly capitalized (first letter
upper-case, all others lower-case).
.AP Tcl_PackageInitProc *initProc in
@@ -67,4 +67,3 @@ initialization procedure to be invoked.
.SH KEYWORDS
initialization procedure, package, static linking
-
diff --git a/tcl/doc/StdChannels.3 b/tcl/doc/StdChannels.3
new file mode 100644
index 00000000000..cb205ac4333
--- /dev/null
+++ b/tcl/doc/StdChannels.3
@@ -0,0 +1,122 @@
+'\"
+'\" Copyright (c) 2001 by ActiveState Corporation
+'\"
+'\" 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 "Standard Channels" 3 7.5 Tcl "Tcl Library Procedures"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+Tcl_StandardChannels \- How the Tcl library deals with the standard channels
+
+.SH DESCRIPTION
+.PP
+This page explains the initialization and use of standard channels in
+the Tcl library.
+.PP
+The term \fIstandard channels\fR comes out of the Unix world and
+refers to the three channels automatically opened by the OS for
+each new application. They are \fBstdin\fR, \fBstdout\fR and
+\fBstderr\fR. The first is the standard input an application can read
+from, the other two refer to writable channels, one for regular
+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
+.PP
+The public API procedures dealing directly with standard channels are
+\fBTcl_GetStdChannel\fR and \fBTcl_SetStdChannel\fR. Additional public
+APIs to consider are \fBTcl_RegisterChannel\fR,
+\fBTcl_CreateChannel\fR and \fBTcl_GetChannel\fR.
+.SH "INITIALIZATION OF TCL STANDARD CHANNELS"
+.PP
+Standard channels are initialized by the Tcl library in three cases:
+when explicitly requested, when implicitly required before returning
+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
+successfully opened; for example, in a Tcl application run as a
+Windows NT service.)
+.TP
+1)
+A single standard channel is initialized when it is explicitly
+specified in a call to \fBTcl_SetStdChannel\fR. The state of the
+other standard channels are unaffected.
+.sp
+Missing platform-specific standard channels do not matter here. This
+approach is not available at the script level.
+.TP
+2)
+All uninitialized standard channels are initialized to
+platform-specific default values:
+.RS
+.TP
+(a)
+when open channels are listed with \fBTcl_GetChannelNames\fR (or the
+\fBfile channels\fR script command), or
+.TP
+(b)
+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
+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
+the application are designated as the Tcl standard channels.
+.RE
+.TP
+3)
+All uninitialized standard channels are initialized to
+platform-specific default values when a user-requested channel is
+registered with \fBTcl_RegisterChannel\fR.
+.sp
+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
+above, closing this Tcl standard channel will cause the next call to
+\fBTcl_CreateChannel\fR to make the new channel the new standard
+channel, too. If more than one Tcl standard channel was closed
+\fBTcl_CreateChannel\fR will fill the empty slots in the order
+\fBstdin\fR, \fBstdout\fR and \fBstderr\fR.
+.PP
+\fBTcl_CreateChannel\fR will not try to reinitialize an empty slot if
+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
+.PP
+The Tcl shell (or rather \fBTcl_Main\fR) uses method 2 to initialize
+the standard channels.
+
+.SH wish
+.PP
+The windowing shell (or rather \fBTk_MainEx\fR) 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/tcl/doc/StrMatch.3 b/tcl/doc/StrMatch.3
index f291d96823c..947a8f92d3d 100644
--- a/tcl/doc/StrMatch.3
+++ b/tcl/doc/StrMatch.3
@@ -18,21 +18,18 @@ Tcl_StringMatch, Tcl_StringCaseMatch \- test whether a string matches a pattern
.sp
int
\fBTcl_StringMatch\fR(\fIstring\fR, \fIpattern\fR)
-.VS 8.1
.sp
-\fBTcl_StringCaseMatch\fR(\fIstring, pattern, nocase\fR)
-.VE 8.1
+int
+\fBTcl_StringCaseMatch\fR(\fIstring\fR, \fIpattern\fR, \fInocase\fR)
.SH ARGUMENTS
.AP char *string in
String to test.
.AP char *pattern in
Pattern to match against string. May contain special
characters from the set *?\e[].
-.VS 8.1
.AP int nocase in
Specifies whether the match should be done case-sensitive (0) or
case-insensitive (1).
-.VE 8.1
.BE
.SH DESCRIPTION
diff --git a/tcl/doc/StringObj.3 b/tcl/doc/StringObj.3
index 1d366b6135a..820b35a3e6e 100644
--- a/tcl/doc/StringObj.3
+++ b/tcl/doc/StringObj.3
@@ -10,33 +10,31 @@
.TH Tcl_StringObj 3 8.1 Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_NewStringObj, Tcl_NewUnicodeObj, Tcl_SetStringObj, Tcl_SetUnicodeObj, Tcl_GetStringFromObj, Tcl_GetString, Tcl_GetUnicode, Tcl_GetUniChar, Tcl_GetCharLength, Tcl_GetRange, Tcl_AppendToObj, Tcl_AppendUnicodeToObj, Tcl_AppendStringsToObj, Tcl_AppendStringsToObjVA, Tcl_AppendObjToObj, Tcl_SetObjLength, Tcl_ConcatObj \- manipulate Tcl objects as strings
+Tcl_NewStringObj, Tcl_NewUnicodeObj, Tcl_SetStringObj, Tcl_SetUnicodeObj, Tcl_GetStringFromObj, Tcl_GetString, Tcl_GetUnicodeFromObj, Tcl_GetUnicode, Tcl_GetUniChar, Tcl_GetCharLength, Tcl_GetRange, Tcl_AppendToObj, Tcl_AppendUnicodeToObj, Tcl_AppendStringsToObj, Tcl_AppendStringsToObjVA, Tcl_AppendObjToObj, Tcl_SetObjLength, Tcl_ConcatObj, Tcl_AttemptSetObjLength \- manipulate Tcl objects as strings
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Obj *
\fBTcl_NewStringObj\fR(\fIbytes, length\fR)
-.VS 8.1.2
.sp
Tcl_Obj *
\fBTcl_NewUnicodeObj\fR(\fIunicode, numChars\fR)
-.VE
.sp
void
\fBTcl_SetStringObj\fR(\fIobjPtr, bytes, length\fR)
-.VS 8.1.2
.sp
void
\fBTcl_SetUnicodeObj\fR(\fIobjPtr, unicode, numChars\fR)
-.VE
.sp
char *
\fBTcl_GetStringFromObj\fR(\fIobjPtr, lengthPtr\fR)
.sp
char *
\fBTcl_GetString\fR(\fIobjPtr\fR)
-.VS 8.1.2
+.sp
+Tcl_UniChar *
+\fBTcl_GetUnicodeFromObj\fR(\fIobjPtr, lengthPtr\fR)
.sp
Tcl_UniChar *
\fBTcl_GetUnicode\fR(\fIobjPtr\fR)
@@ -49,15 +47,12 @@ int
.sp
Tcl_Obj *
\fBTcl_GetRange\fR(\fIobjPtr, first, last\fR)
-.VE
.sp
void
\fBTcl_AppendToObj\fR(\fIobjPtr, bytes, length\fR)
-.VS 8.1.2
.sp
void
\fBTcl_AppendUnicodeToObj\fR(\fIobjPtr, unicode, numChars\fR)
-.VE
.sp
void
\fBTcl_AppendObjToObj\fR(\fIobjPtr, appendObjPtr\fR)
@@ -71,11 +66,14 @@ void
void
\fBTcl_SetObjLength\fR(\fIobjPtr, newLength\fR)
.sp
+int
+\fBTcl_AttemptSetObjLength\fR(\fIobjPtr, newLength\fR)
+.sp
Tcl_Obj *
\fBTcl_ConcatObj\fR(\fIobjc, objv\fR)
.SH ARGUMENTS
.AS Tcl_Interp *appendObjPtr in/out
-.AP char *bytes in
+.AP "CONST char" *bytes in
Points to the first byte of an array of bytes
used to set or append to a string object.
This byte array may contain embedded null bytes
@@ -84,12 +82,11 @@ unless \fIlength\fR is negative.
The number of bytes to copy from \fIbytes\fR when
initializing, setting, or appending to a string object.
If negative, all bytes up to the first null are used.
-.AP Tcl_UniChar *unicode in
+.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.
This byte array may contain embedded null characters
unless \fInumChars\fR is negative.
-.VS 8.1.2
.AP int numChars in
The number of Unicode characters to copy from \fIunicode\fR when
initializing, setting, or appending to a string object.
@@ -102,7 +99,6 @@ returned as a new object.
.AP int last in
The index of the last Unicode character in the Unicode range to be
returned as a new object.
-.VE
.AP Tcl_Obj *objPtr in/out
Points to an object to manipulate.
.AP Tcl_Obj *appendObjPtr in
@@ -110,7 +106,7 @@ The object 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 the length of an object's string representation.
-.AP char *string in
+.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
@@ -132,12 +128,13 @@ of the object 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.
-.VS 8.1.2
Also, indexing and length computations are optimized because the
Unicode string representation is calculated and cached as needed.
-.VE
+When using the \fBTcl_Append*\fR family of functions where the
+interpreter's result is the object 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.
.PP
-.VS 8.1.2
\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
\fIbytes\fR and \fIlength\fR. \fBTcl_NewUnicodeObj\fR and
@@ -149,7 +146,6 @@ All four procedures set the object 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.
-.VE
.PP
\fBTcl_GetStringFromObj\fR and \fBTcl_GetString\fR return an object's
string representation. This is given by the returned byte pointer and
@@ -158,13 +154,31 @@ string representation. This is given by the returned byte pointer and
representation is invalid (its byte pointer is NULL), the string
representation is regenerated from the object's internal
representation. The storage referenced by the returned byte pointer
-is owned by the object manager and should not be modified by the
-caller. The procedure \fBTcl_GetString\fR is used in the common case
+is owned by the object 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
+limited purpose, the pointer returned by \fBTcl_GetStringFromObj\fR
+or \fBTcl_GetString\fR should be treated as read-only. It is
+recommended that this pointer be assigned to a (CONST char *) variable.
+Even in the limited situations where writing to this pointer is
+acceptable, one should take care to respect the copy-on-write
+semantics required by \fBTcl_Obj\fR's, with appropriate calls
+to \fBTcl_IsShared\fR and \fBTcl_DuplicateObj\fR prior to any
+in-place modification of the string representation.
+The procedure \fBTcl_GetString\fR is used in the common case
where the caller does not need the length of the string
representation.
.PP
-.VS 8.1.2
-\fBTcl_GetUnicode\fR returns an object's value as a Unicode string.
+\fBTcl_GetUnicodeFromObj\fR and \fBTcl_GetUnicode\fR return an object'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
+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.
.PP
@@ -200,7 +214,6 @@ object's string value).
appends the string or Unicode value (whichever exists and is best
suited to be appended to \fIobjPtr\fR) of \fIappendObjPtr\fR to
\fIobjPtr\fR.
-.VE
.PP
\fBTcl_AppendStringsToObj\fR is similar to \fBTcl_AppendToObj\fR
except that it can be passed more than one value to append and
@@ -227,6 +240,16 @@ 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.
.PP
+\fBTcl_AttemptSetObjLength\fR is identical in function to
+\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
+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
value is the space-separated concatenation of the string
representations of all of the objects in the \fIobjv\fR
diff --git a/tcl/doc/SubstObj.3 b/tcl/doc/SubstObj.3
new file mode 100644
index 00000000000..0dd598e3cca
--- /dev/null
+++ b/tcl/doc/SubstObj.3
@@ -0,0 +1,71 @@
+'\"
+'\" Copyright (c) 2001 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$
+'\"
+.so man.macros
+.TH Tcl_SubstObj 3 8.4 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_SubstObj \- perform substitutions on Tcl objects
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+Tcl_Obj *
+\fBTcl_SubstObj\fR(\fIinterp, objPtr, flags\fR)
+.SH ARGUMENTS
+.AS Tcl_Interp **termPtr;
+.AP Tcl_Interp *interp in
+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.
+.AP int flags in
+ORed combination of flag bits that specify which substitutions to
+perform. The flags \fBTCL_SUBST_COMMANDS\fR,
+\fBTCL_SUBST_VARIABLES\fR and \fBTCL_SUBST_BACKSLASHES\fR are
+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
+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.
+.PP
+Three kinds of substitutions are supported. When the
+\fBTCL_SUBST_BACKSLASHES\fR bit is set in \fIflags\fR, sequences that
+look like backslash substitutions for Tcl commands are replaced by
+their corresponding character.
+.PP
+When the \fBTCL_SUBST_VARIABLES\fR bit is set in \fIflags\fR,
+sequences that look like variable substitutions for Tcl commands are
+replaced by the contents of the named variable.
+.PP
+When th \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
+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/tcl/doc/TCL_MEM_DEBUG.3 b/tcl/doc/TCL_MEM_DEBUG.3
index 1950d149a15..251e6ae17aa 100644
--- a/tcl/doc/TCL_MEM_DEBUG.3
+++ b/tcl/doc/TCL_MEM_DEBUG.3
@@ -18,7 +18,7 @@ includes C and Tcl functions which can aid with debugging
memory leaks, memory allocation overruns, and other memory related
errors.
-.SH ENABLING MEMORY DEBUGGING
+.SH "ENABLING MEMORY DEBUGGING"
.PP
To enable memory debugging, Tcl should be recompiled from scratch with
\fBTCL_MEM_DEBUG\fR defined. This will also compile in a non-stub
@@ -34,14 +34,15 @@ 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
+.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
-returned to the caller. (The size of the guard zone is defined by the
-C #define \fBGUARD_SIZE\fR in \fIbaseline/src/ckalloc.c\fR -- it can
+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
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
@@ -54,7 +55,7 @@ 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
+.SH "DEBUGGING DIFFICULT MEMORY CORRUPTION PROBLEMS"
.PP
Normally, Tcl compiled with memory debugging enabled will make it easy
to isolate a corruption problem. Turning on memory validation with
@@ -73,7 +74,7 @@ of the caller, but they can actually be anything you want. Remember
to remove the calls after you find the problem.
.SH "SEE ALSO"
-memory, Tcl_ValidateAllMemory, Tcl_DumpActiveMemory
+ckalloc, memory, Tcl_ValidateAllMemory, Tcl_DumpActiveMemory
.SH KEYWORDS
memory, debug
diff --git a/tcl/doc/Tcl.n b/tcl/doc/Tcl.n
index 5462083de37..4f601ffae4c 100644
--- a/tcl/doc/Tcl.n
+++ b/tcl/doc/Tcl.n
@@ -82,13 +82,14 @@ 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 terminated
-by any character that isn't a letter, digit, or underscore.
+\fIName\fR is the name of a scalar variable; the name is a sequence
+of one or more characters that are a letter, digit, or underscore.
.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, and underscores.
+\fIName\fR must contain only letters, digits, and underscores,
+but may be an empty string.
Command substitutions, variable substitutions, and backslash
substitutions are performed on the characters of \fIindex\fR.
.TP 15
diff --git a/tcl/doc/Tcl_Main.3 b/tcl/doc/Tcl_Main.3
index 75549225629..2615656083b 100644
--- a/tcl/doc/Tcl_Main.3
+++ b/tcl/doc/Tcl_Main.3
@@ -1,6 +1,7 @@
'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" Copyright (c) 2000 Ajuba Solutions.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -8,15 +9,17 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH Tcl_Main 3 7.4 Tcl "Tcl Library Procedures"
+.TH Tcl_Main 3 8.4 Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_Main \- main program for Tcl-based applications
+Tcl_Main, Tcl_SetMainLoop \- main program 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_SetMainLoop\fR(\fImainLoopProc\fR)
.SH ARGUMENTS
.AS Tcl_AppInitProc *appInitProc
.AP int argc in
@@ -26,36 +29,121 @@ Array of strings containing command-line arguments.
.AP Tcl_AppInitProc *appInitProc in
Address of an application-specific initialization procedure.
The value for this argument is usually \fBTcl_AppInit\fR.
+.AP Tcl_MainLoopProc *mainLoopProc in
+Address of an application-specific event loop procedure.
.BE
.SH DESCRIPTION
.PP
-\fBTcl_Main\fR acts as the main program for most Tcl-based applications.
-Starting with Tcl 7.4 it is not called \fBmain\fR anymore because it
-is part of the Tcl library and having a function \fBmain\fR
-in a library (particularly a shared library) causes problems on many
-systems.
+\fBTcl_Main\fR can serve as the main program for Tcl-based shell
+applications. A ``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
+to developers of shell applications, so they do not have to
+reproduce all of the code for proper initialization of the Tcl
+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.
+
+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
+of embedding style and having a function \fBmain\fR in a library
+(particularly a shared library) causes problems on many systems.
Having \fBmain\fR in the Tcl library would also make it hard to use
Tcl in C++ programs, since C++ programs must have special C++
\fBmain\fR functions.
.PP
-Normally each application contains a small \fBmain\fR function that does
-nothing but invoke \fBTcl_Main\fR.
+Normally each shell application contains a small \fBmain\fR function
+that does nothing but invoke \fBTcl_Main\fR.
\fBTcl_Main\fR then does all the work of creating and running a
\fBtclsh\fR-like application.
.PP
-When it is 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, such as defining
-application-specific commands. The procedure must have an interface
-that matches the type \fBTcl_AppInitProc\fR:
+\fBTcl_Main\fR is not provided by the public interface of Tcl's
+stub library. Programs that call \fBTcl_Main\fR must be linked
+against the standard Tcl library. Extensions (stub-enabled or
+not) are not intended to call \fBTcl_Main\fR.
+.PP
+\fBTcl_Main\fR is not thread-safe. It should only be called by
+a single master thread of a multi-threaded application. This
+restriction is not a problem with normal use described above.
+.PP
+\fBTcl_Main\fR and therefore all applications based upon it, like
+\fBtclsh\fR, use \fBTcl_GetStdChannel\fR to initialize the standard
+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 \fIargv[1]\fR exists and
+does not begin with the character \fI-\fR, it is taken to be the
+name of a file containing a \fIstartup script\fR, which \fBTcl_Main\fR
+will attempt to evaluate. Otherwise, \fBTcl_Main\fR will enter an
+interactive mode.
+.PP
+In either mode, \fBTcl_Main\fR will define 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
+created by \fBTcl_Main\fR, such as defining application-specific
+commands. The procedure must have an interface that matches the
+type \fBTcl_AppInitProc\fR:
.CS
typedef int Tcl_AppInitProc(Tcl_Interp *\fIinterp\fR);
.CE
-\fIAppInitProc\fR is almost always a pointer to \fBTcl_AppInit\fR;
-for more details on this procedure, see the documentation
-for \fBTcl_AppInit\fR.
+
+\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,
+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
+channel may be customized by defining the Tcl variables \fItcl_prompt1\fR
+and \fItcl_prompt2\fR as described in the documentation for \fBtclsh\fR.
+The prompts and command evaluation results are written to the standard
+output channel only if the Tcl variable \fItcl_interactive\fR in the
+master interpreter holds a non-zero integer value.
+.PP
+.VS 8.4
+\fBTcl_SetMainLoop\fR allows setting an event loop procedure to be run.
+This allows, for example, Tk to be dynamically loaded and set its event
+loop. The event loop will run following the startup script. If you
+are in interactive mode, setting the main loop procedure will cause the
+prompt to become fileevent based and then the loop procedure is called.
+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:
+.CS
+typedef void Tcl_MainLoopProc(void);
+.CE
+.VE 8.4
+.PP
+\fBTcl_Main\fR does not return. Normally a program based on
+\fBTcl_Main\fR will terminate when the \fBexit\fR command is
+evaluated. In interactive mode, if an EOF or channel error
+is encountered on the standard input channel, then \fBTcl_Main\fR
+itself will evaluate the \fBexit\fR command after the main loop
+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)
.SH KEYWORDS
application-specific initialization, command-line arguments, main program
diff --git a/tcl/doc/Thread.3 b/tcl/doc/Thread.3
index d2e2972b553..16ee07c8265 100644
--- a/tcl/doc/Thread.3
+++ b/tcl/doc/Thread.3
@@ -11,7 +11,7 @@
.TH Threads 3 "8.1" Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_ConditionNotify, Tcl_ConditionWait, Tcl_ConditionFinalize, Tcl_GetThreadData, Tcl_MutexLock, Tcl_MutexUnlock, Tcl_MutexFinalize, Tcl_CreateThread \- Tcl thread support.
+Tcl_ConditionNotify, Tcl_ConditionWait, Tcl_ConditionFinalize, Tcl_GetThreadData, Tcl_MutexLock, Tcl_MutexUnlock, Tcl_MutexFinalize, Tcl_CreateThread, Tcl_JoinThread \- Tcl thread support.
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -39,6 +39,9 @@ void
.sp
int
\fBTcl_CreateThread\fR(\fIidPtr, threadProc, clientData, stackSize, flags\fR)
+.sp
+int
+\fBTcl_JoinThread\fR(\fIid, result\fR)
.SH ARGUMENTS
.AS Tcl_ThreadDataKey *keyPtr
.AP Tcl_Condition *condPtr in
@@ -57,7 +60,7 @@ The size of the thread local storage block. This amount of data
is allocated and initialized to zero the first time each thread
calls \fBTcl_GetThreadData\fR.
.AP Tcl_ThreadId *idPtr out
-The refered storage will contain the id of the newly created thread as
+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.
@@ -72,7 +75,7 @@ The size of the stack given to the new thread.
Bitmask containing flags allowing the caller to modify behaviour of
the new thread.
.AP int *result out
-The refered storage is used to place the exit code of the thread
+The referred storage is used to place the exit code of the thread
waited upon into it.
.BE
.SH INTRODUCTION
@@ -82,7 +85,7 @@ customizing the Tcl core. To enable Tcl multithreading support,
you must include the \fB--enable-threads\fR option to \fBconfigure\fR
when you configure and compile your Tcl core.
.PP
-An important contstraint of the Tcl threads implementation is that
+An important constraint of the Tcl threads implementation is that
\fIonly the thread that created a Tcl interpreter can use that
interpreter\fR. In other words, multiple threads can not access
the same Tcl interpreter. (However, as was the case in previous
@@ -98,7 +101,7 @@ the default size as specified by the operating system is to be used
for the new thread. As for the flags, currently are only the values
\fBTCL_THREAD_NOFLAGS\fR and \fBTCL_THREAD_JOINABLE\fR defined. The
first of them invokes the default behaviour with no
-specialities. Using the second value marks the new thread as
+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.
.PP
@@ -114,6 +117,20 @@ for terminating threads and invoking optional per-thread exit
handlers. See the \fBTcl_Exit\fR page for more information on these
procedures.
.PP
+.VS
+The \fBTcl_JoinThread\fR function is provided to allow threads to wait
+upon the exit of another thread, which must have been marked as
+joinable through usage of the \fBTCL_THREAD_JOINABLE\fR-flag during
+its creation via \fBTcl_CreateThread\fR.
+.PP
+Trying to wait for the exit of a non-joinable thread or a thread which
+is already waited upon will result in an error. Waiting for a joinable
+thread which already exited is possible, the system will retain the
+necessary information until after the call to \fBTcl_JoinThread\fR.
+This means that not calling \fBTcl_JoinThread\fR for a joinable thread
+will cause a memory leak.
+.VE
+.PP
Tcl provides \fBTcl_ThreadQueueEvent\fR and \fBTcl_ThreadAlert\fR
for handling event queueing in multithreaded applications. See
the \fBNotifier\fR manual page for more information on these procedures.
@@ -192,4 +209,3 @@ Tcl_ExitThread, Tcl_FinalizeThread,
Tcl_CreateThreadExitHandler, Tcl_DeleteThreadExitHandler
.SH KEYWORDS
thread, mutex, condition variable, thread local storage
-
diff --git a/tcl/doc/TraceCmd.3 b/tcl/doc/TraceCmd.3
new file mode 100644
index 00000000000..0b8f8adcb8d
--- /dev/null
+++ b/tcl/doc/TraceCmd.3
@@ -0,0 +1,170 @@
+'\"
+'\" Copyright (c) 2002 Donal K. Fellows
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" CVS: @(#) $Id$
+'\"
+.so man.macros
+.TH Tcl_TraceCommand 3 7.4 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_CommandTraceInfo, Tcl_TraceCommand, Tcl_UntraceCommand \- monitor renames and deletes of a command
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+ClientData
+\fBTcl_CommandTraceInfo(\fIinterp, cmdName, flags, proc, prevClientData\fB)\fR
+.sp
+int
+\fBTcl_TraceCommand(\fIinterp, cmdName, flags, proc, clientData\fB)\fR
+.sp
+void
+\fBTcl_UntraceCommand(\fIinterp, cmdName, flags, proc, clientData\fB)\fR
+.SH ARGUMENTS
+.AS Tcl_CommandTraceProc prevClientData
+.AP Tcl_Interp *interp in
+Interpreter containing the command.
+.AP "CONST char" *cmdName in
+Name of command.
+.AP int flags in
+OR-ed collection of the value TCL_TRACE_RENAME and TCL_TRACE_DELETE.
+.AP Tcl_CommandTraceProc *proc in
+Procedure to call when specified operations occur to \fIcmdName\fR.
+.AP ClientData clientData in
+Arbitrary argument to pass to \fIproc\fR.
+.AP ClientData prevClientData in
+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
+performed on a Tcl command, so that the C procedure is invoked
+whenever the command is renamed or deleted. If the trace is created
+successfully then \fBTcl_TraceCommand\fR returns TCL_OK. If an error
+occurred (e.g. \fIcmdName\fR specifies a non-existent command) then
+TCL_ERROR is returned and an error message is left in the
+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
+of any of the following values:
+.TP
+\fBTCL_TRACE_RENAME\fR
+Invoke \fIproc\fR whenever the command is renamed.
+.TP
+\fBTCL_TRACE_DELETE\fR
+Invoke \fIproc\fR when the command is deleted.
+.PP
+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:
+.CS
+typedef void Tcl_CommandTraceProc(
+ ClientData \fIclientData\fR,
+ Tcl_Interp *\fIinterp\fR,
+ CONST char *\fIoldName\fR,
+ CONST char *\fInewName\fR,
+ int \fIflags\fR);
+.CE
+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
+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
+several pieces of information. One of the bits TCL_TRACE_RENAME and
+TCL_TRACE_DELETE will be set in \fIflags\fR to indicate which
+operation is being performed on the command. The bit
+TCL_TRACE_DESTROYED will be set in \fIflags\fR if the trace is about
+to be destroyed; this information may be useful to \fIproc\fR so that
+it can clean up its own internal data structures (see the section
+TCL_TRACE_DESTROYED below for more details). Lastly, the bit
+TCL_INTERP_DESTROYED will be set if the entire interpreter is being
+destroyed. When this bit is set, \fIproc\fR must be especially
+careful in the things it does (see the section TCL_INTERP_DESTROYED
+below).
+.PP
+\fBTcl_UntraceCommand\fR may be used to remove a trace. If the
+command specified by \fIinterp\fR, \fIcmdName\fR, and \fIflags\fR has
+a trace set with \fIflags\fR, \fIproc\fR, and \fIclientData\fR, then
+the corresponding trace is removed. If no such trace exists, then the
+call to \fBTcl_UntraceCommand\fR has no effect. The same bits are
+valid for \fIflags\fR as for calls to \fBTcl_TraceCommand\fR.
+.PP
+\fBTcl_CommandTraceInfo\fR may be used to retrieve information about
+traces set on a given command.
+The return value from \fBTcl_CommandTraceInfo\fR is the \fIclientData\fR
+associated with a particular trace.
+The trace must be on the command specified by the \fIinterp\fR,
+\fIcmdName\fR, and \fIflags\fR arguments (note that currently the
+flags are ignored; \fIflags\fR should be set to 0 for future
+compatibility) and its trace procedure must the same as the \fIproc\fR
+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
+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
+\fIprevClientData\fR, or NULL if no trace matches \fIprevClientData\fR
+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
+names simultaneously, and the command still exists during delete
+traces (if TCL_INTERP_DESTROYED 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.
+When this happens, all of the trace procedures will be invoked on each
+access, in order from most-recently-created to least-recently-created.
+Attempts to delete the command during a delete trace will fail
+silently, since the command is already scheduled for deletion anyway.
+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 TCL_TRACE_DESTROYED bit
+is set in \fIflags\fR.
+
+'\" Perhaps need some more comments here? - DKF
+
+.SH "TCL_INTERP_DESTROYED"
+.PP
+When an interpreter is destroyed, unset traces are called for
+all of its commands.
+The TCL_INTERP_DESTROYED bit will be set in the \fIflags\fR
+argument passed to the trace procedures.
+Trace procedures must be extremely careful in what they do if
+the TCL_INTERP_DESTROYED bit is set.
+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
+from misusing the interpreter during traces with TCL_INTERP_DESTROYED
+set.
+
+.SH KEYWORDS
+clientData, trace, command
diff --git a/tcl/doc/TraceVar.3 b/tcl/doc/TraceVar.3
index 3048d18713c..4d8266fd1e5 100644
--- a/tcl/doc/TraceVar.3
+++ b/tcl/doc/TraceVar.3
@@ -35,25 +35,23 @@ ClientData
.AS Tcl_VarTraceProc prevClientData
.AP Tcl_Interp *interp in
Interpreter containing variable.
-.AP char *varName in
+.AP "CONST char" *varName in
Name of variable. May refer to a scalar variable, to
an array variable with no index, or to an array variable
with a parenthesized index.
-If the name references an element of an array, then it
-must be in writable memory: Tcl will make temporary modifications
-to it while looking up the name.
.AP int flags in
-OR-ed combination of the values TCL_TRACE_READS, TCL_TRACE_WRITES, and
-TCL_TRACE_UNSETS, TCL_TRACE_ARRAY, and TCL_GLOBAL_ONLY.
+OR-ed combination of the values TCL_TRACE_READS, TCL_TRACE_WRITES,
+TCL_TRACE_UNSETS, TCL_TRACE_ARRAY, TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
+TCL_TRACE_RESULT_DYNAMIC and TCL_TRACE_RESULT_OBJECT.
Not all flags are used by all
procedures. See below for more information.
.AP Tcl_VarTraceProc *proc in
Procedure to invoke whenever one of the traced operations occurs.
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIproc\fR.
-.AP char *name1 in
+.AP "CONST char" *name1 in
Name of scalar or array variable (without array index).
-.AP char *name2 in
+.AP "CONST char" *name2 in
For a trace on an element of an array, gives the index of the
element. For traces on scalar variables or on whole arrays,
is NULL.
@@ -84,6 +82,11 @@ Normally, the variable will be looked up at the current level of
procedure call; if this bit is set then the variable will be looked
up at global level, ignoring any active procedures.
.TP
+\fBTCL_NAMESPACE_ONLY\fR
+Normally, the variable will be looked up at the current level of
+procedure call; if this bit is set then the variable will be looked
+up in the current namespace, ignoring any active procedures.
+.TP
\fBTCL_TRACE_READS\fR
Invoke \fIproc\fR whenever an attempt is made to read the variable.
.TP
@@ -102,6 +105,21 @@ Invoke \fIproc\fR whenever the array command is invoked.
This gives the trace procedure a chance to update the array before
array names or array get is called. Note that this is called
before an array set, but that will trigger write traces.
+.VS 8.4
+.TP
+\fBTCL_TRACE_RESULT_DYNAMIC\fR
+The result of invoking the \fIproc\fR is a dynamically allocated
+string that will be released by the Tcl library via a call to
+\fBckfree\fR. Must not be specified at the same time as
+TCL_TRACE_RESULT_OBJECT.
+.TP
+\fBTCL_TRACE_RESULT_OBJECT\fR
+The result of invoking the \fIproc\fR is a Tcl_Obj* (cast to a char*)
+with a reference count of at least one. The ownership of that
+reference will be transferred to the Tcl core for release (when the
+core has finished with it) via a call to \fBTcl_DecrRefCount\fR. Must
+not be specified at the same time as TCL_TRACE_RESULT_DYNAMIC.
+.VE 8.4
.PP
Whenever one of the specified operations occurs on the variable,
\fIproc\fR will be invoked.
@@ -135,6 +153,11 @@ accessed is a global one not accessible from the current level of
procedure call: the trace procedure will need to pass this flag
back to variable-related procedures like \fBTcl_GetVar\fR if it
attempts to access the variable.
+The bit TCL_NAMESPACE_ONLY will be set whenever the variable being
+accessed is a namespace one not accessible from the current level of
+procedure call: the trace procedure will need to pass this flag
+back to variable-related procedures like \fBTcl_GetVar\fR if it
+attempts to access the variable.
The bit TCL_TRACE_DESTROYED will be set in \fIflags\fR if the trace is
about to be destroyed; this information may be useful to \fIproc\fR
so that it can clean up its own internal data structures (see
@@ -159,9 +182,10 @@ traces set on a given variable.
The return value from \fBTcl_VarTraceInfo\fR is the \fIclientData\fR
associated with a particular trace.
The trace must be on the variable specified by the \fIinterp\fR,
-\fIvarName\fR, and \fIflags\fR arguments (only the TCL_GLOBAL_ONLY
-bit from \fIflags\fR is used; other bits are ignored) and its trace procedure
-must the same as the \fIproc\fR argument.
+\fIvarName\fR, and \fIflags\fR arguments (only the TCL_GLOBAL_ONLY and
+TCL_NAMESPACE_ONLY bits from \fIflags\fR is used; other bits are
+ignored) and its trace procedure must the same as the \fIproc\fR
+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.
@@ -297,7 +321,14 @@ successful completion.
If \fIproc\fR returns a non-NULL value it signifies that an
error occurred.
The return value must be a pointer to a static character string
-containing an error message.
+containing an error message,
+.VS 8.4
+unless (\fIexactly\fR one of) the TCL_TRACE_RESULT_DYNAMIC and
+TCL_TRACE_RESULT_OBJECT flags is set, which specify that the result is
+either a dynamic string (to be released with \fBckfree\fR) or a
+Tcl_Obj* (cast to char* and to be released with
+\fBTcl_DecrRefCount\fR) containing the error message.
+.VE 8.4
If a trace procedure returns an error, no further traces are
invoked for the access and the traced access aborts with the
given message.
@@ -364,4 +395,3 @@ nor is there Tcl-level access to array traces.
.SH KEYWORDS
clientData, trace, variable
-
diff --git a/tcl/doc/Translate.3 b/tcl/doc/Translate.3
index 68b1edd6317..fb2566608f0 100644
--- a/tcl/doc/Translate.3
+++ b/tcl/doc/Translate.3
@@ -22,7 +22,7 @@ char *
.AS Tcl_DString *bufferPtr
.AP Tcl_Interp *interp in
Interpreter in which to report an error, if any.
-.AP char *name in
+.AP "CONST char" *name in
File name, which may start with a ``~''.
.AP Tcl_DString *bufferPtr in/out
If needed, this dynamic string is used to store the new file name.
@@ -64,4 +64,3 @@ filename
.SH KEYWORDS
file name, home directory, tilde, translate, user
-
diff --git a/tcl/doc/UniCharIsAlpha.3 b/tcl/doc/UniCharIsAlpha.3
new file mode 100644
index 00000000000..1cfc6db7f1d
--- /dev/null
+++ b/tcl/doc/UniCharIsAlpha.3
@@ -0,0 +1,92 @@
+'\"
+'\" 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.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.so man.macros
+.TH Tcl_UniCharIsAlpha 3 "8.1" Tcl "Tcl Library Procedures"
+.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
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+int
+\fBTcl_UniCharIsAlnum\fR(\fIch\fR)
+.sp
+int
+\fBTcl_UniCharIsAlpha\fR(\fIch\fR)
+.sp
+int
+\fBTcl_UniCharIsControl\fR(\fIch\fR)
+.sp
+int
+\fBTcl_UniCharIsDigit\fR(\fIch\fR)
+.sp
+int
+\fBTcl_UniCharIsGraph\fR(\fIch\fR)
+.sp
+int
+\fBTcl_UniCharIsLower\fR(\fIch\fR)
+.sp
+int
+\fBTcl_UniCharIsPrint\fR(\fIch\fR)
+.sp
+int
+\fBTcl_UniCharIsPunct\fR(\fIch\fR)
+.sp
+int
+\fBTcl_UniCharIsSpace\fR(\fIch\fR)
+.sp
+int
+\fBTcl_UniCharIsUpper\fR(\fIch\fR)
+.sp
+int
+\fBTcl_UniCharIsWordChar\fR(\fIch\fR)
+.SH ARGUMENTS
+.AP int ch in
+The Tcl_UniChar to be examined.
+.BE
+
+.SH DESCRIPTION
+.PP
+All of the routines described examine Tcl_UniChars and return a
+boolean value. A non-zero return value means that the character does
+belong to the character class associated with the called routine. The
+rest of this document just describes the character classes associated
+with the various routines.
+.PP
+Note: A Tcl_UniChar is a Unicode character represented as an unsigned,
+fixed-size quantity.
+
+.SH CHARACTER CLASSES
+.PP
+\fBTcl_UniCharIsAlnum\fR tests if the character is an alphanumeric Unicode character.
+.PP
+\fBTcl_UniCharIsAlpha\fR tests if the character is an alphabetic Unicode character.
+.PP
+\fBTcl_UniCharIsControl\fR tests if the character is a Unicode control character.
+.PP
+\fBTcl_UniCharIsDigit\fR tests if the character is a numeric Unicode character.
+.PP
+\fBTcl_UniCharIsGraph\fR tests if the character is any Unicode print character except space.
+.PP
+\fBTcl_UniCharIsLower\fR tests if the character is a lowercase Unicode character.
+.PP
+\fBTcl_UniCharIsPrint\fR tests if the character is a Unicode print character.
+.PP
+\fBTcl_UniCharIsPunct\fR tests if the character is a Unicode punctuation character.
+.PP
+\fBTcl_UniCharIsSpace\fR tests if the character is a whitespace Unicode character.
+.PP
+\fBTcl_UniCharIsUpper\fR tests if the character is an uppercase Unicode character.
+.PP
+\fBTcl_UniCharIsWordChar\fR tests if the character is alphanumeric or
+a connector punctuation mark.
+
+.SH KEYWORDS
+unicode, classification
diff --git a/tcl/doc/UpVar.3 b/tcl/doc/UpVar.3
index 6e60d2a7182..dbdf4501b44 100644
--- a/tcl/doc/UpVar.3
+++ b/tcl/doc/UpVar.3
@@ -25,15 +25,15 @@ int
.AS Tcl_VarTraceProc prevClientData
.AP Tcl_Interp *interp in
Interpreter containing variables; also used for error reporting.
-.AP char *frameName in
+.AP "CONST char" *frameName in
Identifies the stack frame containing source variable.
May have any of the forms accepted by
the \fBupvar\fR command, such as \fB#0\fR or \fB1\fR.
-.AP char *sourceName in
+.AP "CONST char" *sourceName in
Name of source variable, in the frame given by \fIframeName\fR.
May refer to a scalar variable or to an array variable with a
parenthesized index.
-.AP char *destName in
+.AP "CONST char" *destName in
Name of destination variable, which is to be linked to source
variable so that references to \fIdestName\fR
refer to the other variable. Must not currently exist except as
@@ -42,10 +42,10 @@ an upvar-ed variable.
Either TCL_GLOBAL_ONLY 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).
-.AP char *name1 in
+.AP "CONST char" *name1 in
First part of source variable's name (scalar name, or name of array
without array index).
-.AP char *name2 in
+.AP "CONST char" *name2 in
If source variable is an element of an array, gives the index of the element.
For scalar source variables, is NULL.
.BE
@@ -73,4 +73,3 @@ it must exist as a linked variable.
.SH KEYWORDS
linked variable, upvar, variable
-
diff --git a/tcl/doc/Utf.3 b/tcl/doc/Utf.3
index db954f7e6b7..696c0c8d63a 100644
--- a/tcl/doc/Utf.3
+++ b/tcl/doc/Utf.3
@@ -10,7 +10,7 @@
.TH Utf 3 "8.1" Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_UniChar, 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.
+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.
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -22,18 +22,28 @@ int
.sp
int
\fBTcl_UtfToUniChar\fR(\fIsrc, chPtr\fR)
+.VS 8.4
.sp
char *
\fBTcl_UniCharToUtfDString\fR(\fIuniStr, numChars, dstPtr\fR)
.sp
Tcl_UniChar *
\fBTcl_UtfToUniCharDString\fR(\fIsrc, len, dstPtr\fR)
+.VE 8.4
.sp
int
\fBTcl_UniCharLen\fR(\fIuniStr\fR)
.sp
int
\fBTcl_UniCharNcmp\fR(\fIuniStr, uniStr, num\fR)
+.VS 8.4
+.sp
+int
+\fBTcl_UniCharNcasecmp\fR(\fIuniStr, uniStr, num\fR)
+.sp
+int
+\fBTcl_UniCharCaseMatch\fR(\fIuniStr, uniPattern, nocase\fR)
+.VE 8.4
.sp
int
\fBTcl_UtfNcmp\fR(\fIsrc, src, num\fR)
@@ -46,24 +56,28 @@ int
.sp
int
\fBTcl_NumUtfChars\fR(\fIsrc, len\fR)
+.VS 8.4
.sp
-char *
+CONST char *
\fBTcl_UtfFindFirst\fR(\fIsrc, ch\fR)
.sp
-char *
+CONST char *
\fBTcl_UtfFindLast\fR(\fIsrc, ch\fR)
.sp
-char *
+CONST char *
\fBTcl_UtfNext\fR(\fIsrc\fR)
.sp
-char *
+CONST char *
\fBTcl_UtfPrev\fR(\fIsrc, start\fR)
+.VE 8.4
.sp
Tcl_UniChar
\fBTcl_UniCharAtIndex\fR(\fIsrc, index\fR)
+.VS 8.4
.sp
-char *
+CONST char *
\fBTcl_UtfAtIndex\fR(\fIsrc, index\fR)
+.VE 8.4
.sp
int
\fBTcl_UtfBackslash\fR(\fIsrc, readPtr, dst\fR)
@@ -80,6 +94,8 @@ Filled with the Tcl_UniChar represented by the head of the UTF-8 string.
Pointer to a UTF-8 string.
.AP "CONST Tcl_UniChar" *uniStr in
A NULL-terminated Unicode string.
+.AP "CONST Tcl_UniChar" *uniPattern in
+A NULL-terminated Unicode string.
.AP int len in
The length of the UTF-8 string in bytes (not UTF-8 characters). If
negative, all bytes up to the first null byte are used.
@@ -100,6 +116,11 @@ including the backslash character.
.AP char *dst out
Buffer in which the bytes represented by the backslash sequence are stored.
At most TCL_UTF_MAX bytes are stored in the buffer.
+.VS 8.4
+.AP int nocase in
+Specifies whether the match should be done case-sensitive (0) or
+case-insensitive (1).
+.VE 8.4
.BE
.SH DESCRIPTION
@@ -134,8 +155,8 @@ The return value is a pointer to the UTF-8 representation of the
Unicode string. Storage for the return value is appended to the
end of the \fBTcl_DString\fR.
.PP
-\fBTcl_UtfToUniCharDString\fR coverts the given UTF-8 string to Unicode,
-storing the result in the previously-initialized \fBTcl_Dstring\fR.
+\fBTcl_UtfToUniCharDString\fR converts the given UTF-8 string to Unicode,
+storing the result in the previously-initialized \fBTcl_DString\fR.
you may either specify the length of the given UTF-8 string or "-1",
in which case \fBTcl_UtfToUniCharDString\fR uses \fBstrlen\fR to
calculate the length. The return value is a pointer to the Unicode
@@ -147,15 +168,22 @@ is terminated with a Unicode NULL character.
characters. It accepts a NULL-terminated Unicode string and returns
the number of Unicode characters (not bytes) in that string.
.PP
-\fBTcl_UniCharNcmp\fR corresponds to \fBstrncmp\fR for Unicode
-characters. It accepts two NULL-terminated Unicode strings
-and the number of characters to compare. (Both strings are
-assumed to be at least \fIlen\fR characters long.)
-\fBTcl_UniCharNcmp\fR compares the two strings character-by-character
-according to the Unicode character ordering. It returns an integer
-greater than, equal to,
-or less than 0 if the first string is greater than, equal to, or
-less than the second string respectively.
+\fBTcl_UniCharNcmp\fR and \fBTcl_UniCharNcasecmp\fR correspond to
+\fBstrncmp\fR and \fBstrncasecmp\fR, respectively, for Unicode characters.
+They accepts two NULL-terminated Unicode strings and the number of characters
+to compare. Both strings are assumed to be at least \fIlen\fR characters
+long. \fBTcl_UniCharNcmp\fR compares the two strings character-by-character
+according to the Unicode character ordering. It returns an integer greater
+than, equal to, or less than 0 if the first string is greater than, equal
+to, or less than the second string respectively. \fBTcl_UniCharNcasecmp\fR
+is the Unicode case insensitive version.
+.PP
+.VS 8.4
+\fBTcl_UniCharCaseMatch\fR is the Unicode equivalent to
+\fBTcl_StringCaseMatch\fR. It accepts a NULL-terminated Unicode string,
+a Unicode pattern, and a boolean value specifying whether the match should
+be case sensitive and returns whether the string matches the pattern.
+.VE 8.4
.PP
\fBTcl_UtfNcmp\fR corresponds to \fBstrncmp\fR for UTF-8 strings. It
accepts two NULL-terminated UTF-8 strings and the number of characters
@@ -184,12 +212,12 @@ returns the number of Tcl_UniChars that are represented by the UTF-8 string
length is negative, all bytes up to the first NULL byte are used.
.PP
\fBTcl_UtfFindFirst\fR corresponds to \fBstrchr\fR for UTF-8 strings. It
-returns a pointer to the first occurance of the Tcl_UniChar \fIch\fR
+returns a pointer to the first occurrence of the Tcl_UniChar \fIch\fR
in the NULL-terminated UTF-8 string \fIsrc\fR. The NULL terminator is
considered part of the UTF-8 string.
.PP
\fBTcl_UtfFindLast\fR corresponds to \fBstrrchr\fR for UTF-8 strings. It
-returns a pointer to the last occurance of the Tcl_UniChar \fIch\fR
+returns a pointer to the last occurrence of the Tcl_UniChar \fIch\fR
in the NULL terminated UTF-8 string \fIsrc\fR. The NULL terminator is
considered part of the UTF-8 string.
.PP
@@ -230,4 +258,3 @@ supported by \fBTcl_UtfBackslash\fR.
.SH KEYWORDS
utf, unicode, backslash
-
diff --git a/tcl/doc/WrongNumArgs.3 b/tcl/doc/WrongNumArgs.3
index 26b8bf8bc0e..e3b18b3c6cd 100644
--- a/tcl/doc/WrongNumArgs.3
+++ b/tcl/doc/WrongNumArgs.3
@@ -26,7 +26,7 @@ Number of leading arguments from \fIobjv\fR to include in error
message.
.AP Tcl_Obj "*CONST\ objv[]" in
Arguments to command that had the wrong number of arguments.
-.AP char *message in
+.AP "CONST char" *message in
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.
@@ -63,9 +63,9 @@ 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
-origionally passed in. Using the above example, lets assume that
+originally passed in. Using the above example, lets assume that
\fIbar\fR is actually an abbreviation for \fIbarfly\fR and the object
-is now an indexObject becasue it was passed to
+is now an indexObject because it was passed to
\fBTcl_GetIndexFromObj\fR. In this case the error message would be:
.CS
wrong # args: should be "foo barfly fileName count"
diff --git a/tcl/doc/after.n b/tcl/doc/after.n
index 3d51b4af16d..209bf09d10c 100644
--- a/tcl/doc/after.n
+++ b/tcl/doc/after.n
@@ -103,7 +103,7 @@ In applications that are not normally event-driven, such as
and \fBupdate\fR commands.
.SH "SEE ALSO"
-bgerror
+bgerror(n), concat(n), update(n), vwait(n)
.SH KEYWORDS
cancel, delay, idle callback, sleep, time
diff --git a/tcl/doc/append.n b/tcl/doc/append.n
index 1ecf946d923..2b28e894524 100644
--- a/tcl/doc/append.n
+++ b/tcl/doc/append.n
@@ -28,5 +28,8 @@ variables incrementally.
For example, ``\fBappend a $b\fR'' is much more efficient than
``\fBset a $a$b\fR'' if \fB$a\fR is long.
+.SH "SEE ALSO"
+concat(n), lappend(n)
+
.SH KEYWORDS
append, variable
diff --git a/tcl/doc/array.n b/tcl/doc/array.n
index 288e95b05e0..764b4aca29c 100644
--- a/tcl/doc/array.n
+++ b/tcl/doc/array.n
@@ -63,15 +63,19 @@ match \fIpattern\fR (using the matching rules of
If \fIarrayName\fR isn't the name of an array variable, or if
the array contains no elements, then an empty list is returned.
.TP
-\fBarray names \fIarrayName\fR ?\fIpattern\fR?
+\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 (using the matching
-rules of \fBstring match\fR).
+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
+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
+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 variable, then an empty string is
-returned.
+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
+variable, then an empty string is returned.
.TP
\fBarray nextelement \fIarrayName searchId\fR
Returns the name of the next element in \fIarrayName\fR, or
@@ -111,15 +115,27 @@ The return value is a
search identifier that must be used in \fBarray nextelement\fR
and \fBarray donesearch\fR commands; it allows multiple
searches to be underway simultaneously for the same array.
+.VS 8.4
+.TP
+\fBarray statistics \fIarrayName\fR
+Returns statistics about the distribution of data within the hashtable
+that represents the array. This information includes the number of
+entries in the table, the number of buckets, and the utilization of
+the buckets.
+.VE 8.4
.VS 8.3
.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
-of an array variable or there are no matching elements in the array, then
-an empty string is returned. If \fIpattern\fR is omitted and is it an
-array variable, then the command unsets the entire array.
+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.
+The command always returns an empty string.
.VE 8.3
+.SH "SEE ALSO"
+list(n), string(n), variable(n), trace(n)
+
.SH KEYWORDS
array, element names, search
diff --git a/tcl/doc/bgerror.n b/tcl/doc/bgerror.n
index 4ca2065e2e6..fb84ab09bca 100644
--- a/tcl/doc/bgerror.n
+++ b/tcl/doc/bgerror.n
@@ -31,38 +31,49 @@ with the \fBafter\fR command, then it is a background error.
For a non-background error, the error can simply be returned up
through nested Tcl command evaluations until it reaches the top-level
code in the application; then the application can report the error
-in whatever way it wishes.
-When a background error occurs, the unwinding ends in
-the Tcl library and there is no obvious way for Tcl to report
-the error.
+in whatever way it wishes. When a background error occurs, the
+unwinding ends in the Tcl library and there is no obvious way for Tcl
+to report the error.
.PP
When Tcl detects a background error, it saves information about the
-error and invokes the \fBbgerror\fR command later as an idle event handler.
-Before invoking \fBbgerror\fR, Tcl restores the \fBerrorInfo\fR
-and \fBerrorCode\fR variables to their values at the time the
-error occurred, then it invokes \fBbgerror\fR with
-the error message as its only argument.
-Tcl assumes that the application has implemented the \fBbgerror\fR
-command, and that the command will report the error in a way that
-makes sense for the application. Tcl will ignore any result returned
-by the \fBbgerror\fR command as long as no error is generated.
+error and invokes the \fBbgerror\fR command later as an idle event
+handler. Before invoking \fBbgerror\fR, Tcl restores the
+\fBerrorInfo\fR and \fBerrorCode\fR variables to their values at the
+time the error occurred, then it invokes \fBbgerror\fR with the error
+message as its only argument. Tcl assumes that the application has
+implemented the \fBbgerror\fR command, and that the command will
+report the error in a way that makes sense for the application. Tcl
+will ignore any result returned by the \fBbgerror\fR command as long
+as no error is generated.
.PP
-If another Tcl error occurs within the \fBbgerror\fR command
-(for example, because no \fBbgerror\fR command has been defined)
-then Tcl reports the error itself by writing a message to stderr.
+If another Tcl error occurs within the \fBbgerror\fR command (for
+example, because no \fBbgerror\fR command has been defined) then Tcl
+reports the error itself by writing a message to stderr.
.PP
-If several background errors accumulate before \fBbgerror\fR
-is invoked to process them, \fBbgerror\fR will be invoked once
-for each error, in the order they occurred.
-However, if \fBbgerror\fR returns with a break exception, then
-any remaining errors are skipped without calling \fBbgerror\fR.
+If several background errors accumulate before \fBbgerror\fR is
+invoked to process them, \fBbgerror\fR will be invoked once for each
+error, in the order they occurred. However, if \fBbgerror\fR returns
+with a break exception, then any remaining errors are skipped without
+calling \fBbgerror\fR.
.PP
-Tcl has no default implementation for \fBbgerror\fR.
-However, in applications using Tk there is a default
-\fBbgerror\fR procedure
-which posts a dialog box containing
-the error message and offers the user a chance to see a stack
-trace showing where the error occurred.
+Tcl has no default implementation for \fBbgerror\fR. However, in
+applications using Tk there is a default \fBbgerror\fR procedure which
+posts a dialog box containing the error message and offers the user a
+chance to see a stack trace showing where the error occurred. In
+addition to allowing the user to view the stack trace, the dialog
+provides an additional application configurable button which may be
+used, for example, to save the stack trace to a file. By default,
+this is the behavior associated with that button. This behavior can
+be redefined by setting the option database values
+\fB*ErrorDialog.function.text\fR, to specify the caption for the
+function button, and \fB*ErrorDialog.function.command\fR, to specify
+the command to be run. The text of the stack trace is appended to the
+command when it is evaluated. If either of these options is set to
+the empty string, then the additional button will not be displayed in
+the dialog.
+
+.SH "SEE ALSO"
+after(n), tclvars(n)
.SH KEYWORDS
background error, reporting
diff --git a/tcl/doc/binary.n b/tcl/doc/binary.n
index f21d691e4ae..07ab50fce7d 100644
--- a/tcl/doc/binary.n
+++ b/tcl/doc/binary.n
@@ -22,11 +22,11 @@ binary \- Insert and extract fields from binary strings
.PP
This command provides facilities for manipulating binary data. The
first form, \fBbinary format\fR, creates a binary string from normal
-Tcl values. For example, given the values 16 and 22, 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 from a binary
-string and returns it as ordinary Tcl string values.
+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
+from a binary string and returns it as ordinary Tcl string values.
.SH "BINARY FORMAT"
.PP
@@ -199,6 +199,30 @@ For example,
will return a string equivalent to
\fB\\x00\\x00\\x00\\x03\\xff\\xff\\xff\\xfd\\x00\\x01\\x00\\x00\fR
.RE
+.IP \fBw\fR 5
+.VS 8.4
+This form is the same as \fBw\fR except that it stores one or more
+64-bit integers in little-endian byte order in the output string. The
+low-order 64-bits of each integer are stored as an eight-byte value at
+the cursor position with the least significant byte stored first. For
+example,
+.RS
+.CS
+\fBbinary format w 7810179016327718216\fR
+.CE
+will return the string \fBHelloTcl\fR
+.RE
+.IP \fBW\fR 5
+This form is the same as \fBw\fR except that it stores one or more one
+or more 64-bit integers in big-endian byte order in the output string.
+For example,
+.RS
+.CS
+\fBbinary format W 4785469626960341345\fR
+.CE
+will return the string \fBBigEndian\fR
+.VE
+.RE
.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 in the machine's native
@@ -259,7 +283,7 @@ will return \fBdghi\fR.
Moves the cursor to the absolute location in the output string
specified by \fIcount\fR. Position 0 refers to the first byte in the
output string. If \fIcount\fR refers to a position beyond the last
-byte stored so far, then null bytes will be placed in the unitialized
+byte stored so far, then null bytes will be placed in the uninitialized
locations and the cursor will be placed at the specified location. If
\fIcount\fR is \fB*\fR, then the cursor is moved to the current end of
the output string. If \fIcount\fR is omitted, then an error will be
@@ -458,11 +482,39 @@ as \fIcount\fR 32-bit signed integers represented in big-endian byte
order. For example,
.RS
.CS
-\fBbinary \\x00\\x00\\x00\\x05\\x00\\x00\\x00\\x07\\xff\\xff\\xff\\xf0 I2I* var1 var2\fR
+\fBbinary scan \\x00\\x00\\x00\\x05\\x00\\x00\\x00\\x07\\xff\\xff\\xff\\xf0 I2I* var1 var2\fR
.CE
will return \fB2\fR with \fB5 7\fR stored in \fBvar1\fR and \fB-16\fR
stored in \fBvar2\fR.
.RE
+.IP \fBw\fR 5
+.VS 8.4
+The data is interpreted as \fIcount\fR 64-bit signed integers
+represented in little-endian byte order. The integers are stored in
+the corresponding variable as a list. If \fIcount\fR is \fB*\fR, then
+all of the remaining bytes in \fBstring\fR will be scanned. If
+\fIcount\fR is omitted, then one 64-bit integer will be scanned. For
+example,
+.RS
+.CS
+\fBbinary scan \\x05\\x00\\x00\\x00\\x07\\x00\\x00\\x00\\xf0\\xff\\xff\\xff wi* var1 var2\fR
+.CE
+will return \fB2\fR with \fB30064771077\fR stored in \fBvar1\fR and
+\fB-16\fR stored in \fBvar2\fR. Note that the integers returned are
+signed and cannot be represented by Tcl as unsigned values.
+.RE
+.IP \fBW\fR 5
+This form is the same as \fBw\fR except that the data is interpreted
+as \fIcount\fR 64-bit signed integers represented in big-endian byte
+order. For example,
+.RS
+.CS
+\fBbinary scan \\x00\\x00\\x00\\x05\\x00\\x00\\x00\\x07\\xff\\xff\\xff\\xf0 WI* var1 var2\fR
+.CE
+will return \fB2\fR with \fB21474836487\fR stored in \fBvar1\fR and \fB-16\fR
+stored in \fBvar2\fR.
+.VE
+.RE
.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
@@ -542,8 +594,7 @@ element of the \fBtcl_platform\fR array to decide which type character
to use when formatting or scanning integers.
.SH "SEE ALSO"
-format, scan, tclvars
+format(n), scan(n), tclvars(n)
.SH KEYWORDS
binary, format, scan
-
diff --git a/tcl/doc/break.n b/tcl/doc/break.n
index 866ff0d4a63..12749345847 100644
--- a/tcl/doc/break.n
+++ b/tcl/doc/break.n
@@ -30,5 +30,8 @@ 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 "SEE ALSO"
+catch(n), continue(n), for(n), foreach(n), while(n)
+
.SH KEYWORDS
abort, break, loop
diff --git a/tcl/doc/case.n b/tcl/doc/case.n
index 33cdd4cf087..b13c847004e 100644
--- a/tcl/doc/case.n
+++ b/tcl/doc/case.n
@@ -55,5 +55,8 @@ 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.
+.SH "SEE ALSO"
+switch(n)
+
.SH KEYWORDS
case, match, regular expression
diff --git a/tcl/doc/catch.n b/tcl/doc/catch.n
index c38c4a53113..89a6c830dbc 100644
--- a/tcl/doc/catch.n
+++ b/tcl/doc/catch.n
@@ -62,5 +62,8 @@ proc foo {} {
}
.CE
+.SH "SEE ALSO"
+error(n), break(n), continue(n)
+
.SH KEYWORDS
catch, error
diff --git a/tcl/doc/cd.n b/tcl/doc/cd.n
index fc5ed29eab5..3bf7c27c4b8 100644
--- a/tcl/doc/cd.n
+++ b/tcl/doc/cd.n
@@ -24,5 +24,8 @@ home directory (as specified in the HOME environment variable) if
\fIdirName\fR is not given.
Returns an empty string.
+.SH "SEE ALSO"
+filename(n), glob(n), pwd(n)
+
.SH KEYWORDS
working directory
diff --git a/tcl/doc/clock.n b/tcl/doc/clock.n
index d43f590d8a0..73ac4f0cd1a 100644
--- a/tcl/doc/clock.n
+++ b/tcl/doc/clock.n
@@ -2,6 +2,7 @@
'\" Copyright (c) 1992-1995 Karl Lehenbauer and Mark Diekhans.
'\" Copyright (c) 1995-1997 Sun Microsystems, Inc.
'\" Copyright (c) 1998-1999 Scriptics Corporation
+'\" Copyright (c) 2002 ActiveState Corporation
'\"
'\" This documentation is derived from the time and date facilities of
'\" TclX, by Mark Diekhans and Karl Lehenbauer.
@@ -12,7 +13,7 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH clock n 8.3 Tcl "Tcl Built-In Commands"
+.TH clock n 8.4 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -60,34 +61,93 @@ Full weekday name (Monday, Tuesday, etc.).
Abbreviated month name (Jan, Feb, etc.).
.IP \fB%B\fR
Full month name.
+.VS 8.4
.IP \fB%c\fR
-Locale specific date and time.
+Locale specific date and time. The format for date and time
+in the default "C" locale on Unix/Mac is "%a %b %d %H:%M:%S %Y".
+On Windows, this value is the locale specific long date and time, as
+specified in the Regional Options control panel settings.
+.IP \fB%C\fR
+First two digits of the four-digit year (19 or 20).
+.VE 8.4
.IP \fB%d\fR
Day of month (01 - 31).
+.VS 8.4
+'\" Since the inclusion of compat/strftime.c, %D, %e, %h should work on all
+'\" platforms.
+.IP \fB%D\fR
+Date as %m/%d/%y.
+.IP \fB%e\fR
+Day of month (1 - 31), no leading zeros.
+.IP \fB%h\fR
+Abbreviated month name.
+.VE 8.4
.IP \fB%H\fR
Hour in 24-hour format (00 - 23).
+.VS 8.4
.IP \fB%I\fR
-Hour in 12-hour format (00 - 12).
+Hour in 12-hour format (01 - 12).
+.VE 8.4
.IP \fB%j\fR
Day of year (001 - 366).
+.VS 8.4
+.IP \fB%k\fR
+Hour in 24-hour format, without leading zeros (0 - 23).
+.IP \fB%l\fR
+Hour in 12-hour format, without leading zeros (1 - 12).
+.VE 8.4
.IP \fB%m\fR
Month number (01 - 12).
.IP \fB%M\fR
Minute (00 - 59).
+.VS 8.4
+.IP \fB%n\fR
+Insert a newline.
+.VE 8.4
.IP \fB%p\fR
AM/PM indicator.
+.VS 8.4
+.IP \fB%r\fR
+Time in a locale-specific "meridian" format. The "meridian"
+format in the default "C" locale is "%I:%M:%S %p".
+.IP \fB%R\fR
+Time as %H:%M.
+.IP \fB%s\fR
+Count of seconds since the epoch, expressed as a decimal integer.
+.VE 8.4
.IP \fB%S\fR
Seconds (00 - 59).
+.VS 8.4
+.IP \fB%t\fR
+Insert a tab.
+.IP \fB%T\fR
+Time as %H:%M:%S.
+.IP \fB%u\fR
+Weekday number (Monday = 1, Sunday = 7).
+.VE 8.4
.IP \fB%U\fR
Week of year (00 - 52), Sunday is the first day of the week.
+.VS 8.4
+.IP \fB%V\fR
+Week of year according to ISO-8601 rules. Week 1 of a given
+year is the week containing 4 January.
.IP \fB%w\fR
-Weekday number (Sunday = 0).
+Weekday number (Sunday = 0, Saturday = 6).
+.VE 8.4
.IP \fB%W\fR
Week of year (00 - 52), Monday is the first day of the week.
+.VS 8.4
.IP \fB%x\fR
-Locale specific date format.
+Locale specific date format. The format for a date in the default "C"
+locale for Unix/Mac is "%m/%d/%y".
+On Windows, this value is the locale specific short date format, as
+specified in the Regional Options control panel settings.
.IP \fB%X\fR
-Locale specific time format.
+Locale specific 24-hour time format. The format for a
+24-hour time in the default "C" locale for Unix/Mac is "%H:%M:%S".
+On Windows, this value is the locale specific time format, as
+specified in the Regional Options control panel settings.
+.VE 8.4
.IP \fB%y\fR
Year without century (00 - 99).
.IP \fB%Y\fR
@@ -95,31 +155,36 @@ Year with century (e.g. 1990)
.IP \fB%Z\fR
Time zone name.
.RE
+.VS 8.4
.sp
-.RS
-In addition, the following field descriptors may be supported on some
-systems (e.g. Unix but not Windows):
-.IP \fB%D\fR
-Date as %m/%d/%y.
-.IP \fB%e\fR
-Day of month (1 - 31), no leading zeros.
-.IP \fB%h\fR
-Abbreviated month name.
-.IP \fB%n\fR
-Insert a newline.
-.IP \fB%r\fR
-Time as %I:%M:%S %p.
-.IP \fB%R\fR
-Time as %H:%M.
-.IP \fB%t\fR
-Insert a tab.
-.IP \fB%T\fR
-Time as %H:%M:%S.
-.RE
-.sp
+'\" All the field descriptors should be portable now that
+'\" compat/strftime.c is in place, with the possible exception
+'\" of the time zone name.
+'\".RS
+'\"In addition, the following field descriptors may be supported on some
+'\"systems (e.g. Unix but not Windows):
+'\".IP \fB%D\fR
+'\"Date as %m/%d/%y.
+'\".IP \fB%e\fR
+'\"Day of month (1 - 31), no leading zeros.
+'\".IP \fB%h\fR
+'\"Abbreviated month name.
+'\".IP \fB%n\fR
+'\"Insert a newline.
+'\".IP \fB%r\fR
+'\"Time as %I:%M:%S %p.
+'\".IP \fB%R\fR
+'\"Time as %H:%M.
+'\".IP \fB%t\fR
+'\"Insert a tab.
+'\".IP \fB%T\fR
+'\"Time as %H:%M:%S.
+'\".RE
+'\".sp
+.VE 8.4
.RS
If the \fB\-format\fR argument is not specified, the format string
-"\fB%a %b %d %H:%M:%S %Z %Y\fR" is used. If the \fB\-gmt\fR argument
+\fB"%a %b %d %H:%M:%S %Z %Y"\fR is used. If the \fB\-gmt\fR argument
is present the next argument must be a boolean which if true specifies
that the time will be formatted as Greenwich Mean Time. If false
then the local timezone will be used as defined by the operating
@@ -210,6 +275,8 @@ unit of the value is seconds, allowing it to be used for relative time
calculations. The value is usually defined as total elapsed time from
an ``epoch''. You shouldn't assume the value of the epoch.
+.SH "SEE ALSO"
+date(1), time(n)
+
.SH KEYWORDS
clock, date, time
-
diff --git a/tcl/doc/close.n b/tcl/doc/close.n
index 6d0b0df50d6..f7e7527e48d 100644
--- a/tcl/doc/close.n
+++ b/tcl/doc/close.n
@@ -19,9 +19,15 @@ close \- Close an open channel.
.SH DESCRIPTION
.PP
-Closes the channel given by \fIchannelId\fR. \fIChannelId\fR must be a
-channel identifier such as the return value from a previous \fBopen\fR
-or \fBsocket\fR command.
+Closes the channel given by \fIchannelId\fR.
+.PP
+.VS
+\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.
+.VE
+.PP
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.
@@ -55,5 +61,8 @@ that all output is correctly flushed before the process exits.
The command returns an empty string, and may generate an error if
an error occurs while flushing output.
+.SH "SEE ALSO"
+file(n), open(n), socket(n), eof(n), Tcl_StandardChannels(3)
+
.SH KEYWORDS
blocking, channel, close, nonblocking
diff --git a/tcl/doc/concat.n b/tcl/doc/concat.n
index 6124f54440b..70e1f611f54 100644
--- a/tcl/doc/concat.n
+++ b/tcl/doc/concat.n
@@ -8,7 +8,7 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH concat n "" Tcl "Tcl Built-In Commands"
+.TH concat n 8.3 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -19,12 +19,11 @@ concat \- Join lists together
.SH DESCRIPTION
.PP
-This command treats each argument as a list and concatenates them
+This command joins each of its arguments together with spaces after
+trimming leading and trailing spaces from each of them. If all the
+arguments are lists, this has the same effect as concatenating them
into a single list.
-It also eliminates leading and trailing spaces in the \fIarg\fR's
-and adds a single separator space between \fIarg\fR's.
-It permits any number of arguments. For example,
-the command
+It permits any number of arguments. For example, the command
.CS
\fBconcat a b {c d e} {f {g h}}\fR
.CE
@@ -32,9 +31,20 @@ will return
.CS
\fBa b c d e f {g h}\fR
.CE
+as its result, and
+.CS
+\fBconcat " a b {c " d " e} f"\fR
+.CE
+will return
+.CS
+\fBa b {c d e} f\fR
+.CE
as its result.
.PP
If no \fIarg\fRs are supplied, the result is an empty string.
+.SH "SEE ALSO"
+append(n), eval(n)
+
.SH KEYWORDS
concatenate, join, lists
diff --git a/tcl/doc/continue.n b/tcl/doc/continue.n
index 75babe8874c..efd749b5e85 100644
--- a/tcl/doc/continue.n
+++ b/tcl/doc/continue.n
@@ -30,5 +30,8 @@ Catch exceptions are also handled in a few other situations, such
as the \fBcatch\fR command and the outermost scripts of procedure
bodies.
+.SH "SEE ALSO"
+break(n), for(n), foreach(n), while(n)
+
.SH KEYWORDS
continue, iteration, loop
diff --git a/tcl/doc/dde.n b/tcl/doc/dde.n
index 3a8015afa79..a81b4b8cadb 100644
--- a/tcl/doc/dde.n
+++ b/tcl/doc/dde.n
@@ -1,5 +1,6 @@
'\"
'\" Copyright (c) 1997 Sun Microsystems, Inc.
+'\" Copyright (c) 2001 ActiveState Corporation.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -7,18 +8,26 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH dde n 8.1 Tcl "Tcl Built-In Commands"
+.TH dde n 1.2 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.1\fR
+\fBpackage require dde 1.2\fR
.sp
-\fBdde \fIservername \fR?\fItopic\fR?
+\fBdde \fIservername\fR ?\fItopic\fR?
.sp
-\fBdde ?\-async?\fR \fIcommand service topic \fR?\fIdata\fR?
+\fBdde \fIexecute\fR ?\fI\-async\fR? \fIservice topic \fR?\fIdata\fR?
+.sp
+\fBdde \fIpoke\fR \fIservice topic item data\fR
+.sp
+\fBdde \fIrequest\fR ?\fI\-binary\fR? \fIservice topic \fR?\fIdata\fR?
+.sp
+\fBdde \fIservices\fR \fIservice topic \fR?\fIdata\fR?
+.sp
+\fBdde \fIeval\fR ?\fI\-async\fR? \fIservice topic \fR?\fIdata\fR?
.BE
.SH DESCRIPTION
@@ -33,14 +42,9 @@ interpreter given by \fBdde servername\fR. Other applications have their
own \fIservice names\fR and \fItopics\fR. For instance, Microsoft Excel
has the service name \fBExcel\fR.
.PP
-The only option to the \fBdde\fR command is:
+The \fBeval\fR and \fBexecute\fR commands accept the option \fB\-async\fR:
.TP
-\fB\-async\fR
-Requests asynchronous invocation. This is valid only for the
-\fBexecute\fR subcommand. Normally, the \fBdde execute\fR subcommand
-waits until the command completes, returning appropriate error
-messages. When the \fB\-async\fR option is used, the command returns
-immediately, and no error information is available.
+
.SH "DDE COMMANDS"
.PP
The following commands are a subset of the full Dynamic Data Exchange
@@ -52,16 +56,16 @@ 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.
.TP
-\fBdde execute \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 work on. The \fIdata\fR field is given
-to the remote application. Typically, the application treats the
-\fIdata\fR field as a script, and the script is run in the
-application. The command returns an error if the script did not
-run. If the \fB\-async\fR flag was used, the command
-returns immediately with no error.
+\fBdde execute\fR ?\fI\-async\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
+work on. The \fIdata\fR field is given to the remote application.
+Typically, the application treats the \fIdata\fR field as a script, and the
+script is run in the application. The \fI\-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.
.TP
\fBdde poke \fIservice topic item data\fR
\fBdde poke\fR passes the \fIdata\fR to the server indicated by
@@ -72,13 +76,15 @@ 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.
.TP
-\fBdde request \fIservice topic item\fR
+\fBdde request\fR ?\fI\-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,
\fItopic\fR is typically the name of the file, and \fIitem\fR is
application-specific. The command returns the value of \fIitem\fR as
-defined in the application.
+defined in the application. Normally this is interpreted to be a
+string with terminating null. If \fI\-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
@@ -91,11 +97,14 @@ for a given service are returned. If both are not null, if that
service-topic pair currently exists, it is returned; otherwise, null
is returned.
.TP
-\fBdde eval \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. This command can be used to replace send on
-Windows.
+\fBdde eval\fR ?\fI\-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 \fI\-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. This command can be used to replace send on Windows.
+
.SH "DDE AND TCL"
A Tcl interpreter always has a service name of \fBTclEval\fR. Each
different interpreter of all running Tcl applications must be
@@ -128,8 +137,9 @@ without adding the \fB&\fR to place the process in the background).
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 "SEE ALSO"
-tk, winfo, send
+tk(n), winfo(n), send(n)
+
.SH KEYWORDS
application, dde, name, remote execution
-
diff --git a/tcl/doc/encoding.n b/tcl/doc/encoding.n
index 740b9dfadf3..a49b7e4d4c2 100644
--- a/tcl/doc/encoding.n
+++ b/tcl/doc/encoding.n
@@ -73,7 +73,7 @@ would return the Unicode string "\\u306F", which is the Hiragana
letter HA.
.SH "SEE ALSO"
-Tcl_GetEncoding
+Tcl_GetEncoding(3)
.SH KEYWORDS
encoding
diff --git a/tcl/doc/eof.n b/tcl/doc/eof.n
index f1435f7f818..0f59574322b 100644
--- a/tcl/doc/eof.n
+++ b/tcl/doc/eof.n
@@ -22,6 +22,16 @@ eof \- Check for end of file condition on channel
Returns 1 if an end of file condition occurred during the most
recent input operation on \fIchannelId\fR (such as \fBgets\fR),
0 otherwise.
+.PP
+.VS
+\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.
+.VE
+
+.SH "SEE ALSO"
+file(n), open(n), close(n), fblocked(n), Tcl_StandardChannels(3)
.SH KEYWORDS
channel, end of file
diff --git a/tcl/doc/error.n b/tcl/doc/error.n
index 11ee279b560..3db111203e5 100644
--- a/tcl/doc/error.n
+++ b/tcl/doc/error.n
@@ -54,5 +54,8 @@ present, then \fBerrorCode\fR is automatically reset to
``NONE'' by the Tcl interpreter as part of processing the
error generated by the command.
+.SH "SEE ALSO"
+catch(n), tclvars(n)
+
.SH KEYWORDS
error, errorCode, errorInfo
diff --git a/tcl/doc/eval.n b/tcl/doc/eval.n
index a8abd20f902..7ac59485eac 100644
--- a/tcl/doc/eval.n
+++ b/tcl/doc/eval.n
@@ -25,6 +25,11 @@ script containing one or more commands.
fashion as the \fBconcat\fR command, passes the concatenated string to the
Tcl interpreter recursively, and returns the result of that
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 KEYWORDS
concatenate, evaluate, script
+
+.SH "SEE ALSO"
+catch(n), concat(n), error(n), list(n), subst(n), tclvars(n)
diff --git a/tcl/doc/exec.n b/tcl/doc/exec.n
index dc85e3754f1..8d97346743d 100644
--- a/tcl/doc/exec.n
+++ b/tcl/doc/exec.n
@@ -197,7 +197,8 @@ the program.
.sp
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'').
+instead of ``applbakery.default''), which can be obtained with the
+\fBfile attributes $fileName -shortname\fR command.
.sp
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
@@ -207,13 +208,34 @@ 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
+Note that there are two general types of Win32 console applications:
+.RS
+1) CLI -- CommandLine Interface, simple stdio exchange. \fBnetstat.exe\fR for
+example.
+.br
+2) TUI -- 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
+\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 communication between a TUI application
+is desired.
+.sp
+.RE
.TP
\fBWindows NT\fR
.
-When attempting to execute an application, \fBexec\fR first searches for the
-name as it was specified. Then, in order, \fB.com\fR, \fB.exe\fR, and \fB.bat\fR
-are appended to the end of the specified name and it searches for
-the longer name. If a directory name was not specified as part of the
+When attempting to execute an application, \fBexec\fR first searches for
+the name as it was specified. Then, in order, \fB.com\fR, \fB.exe\fR, and
+\fB.bat\fR are appended to the end of the specified name and it searches
+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
@@ -233,16 +255,16 @@ The directories listed in the path.
.RE
.sp
In order to execute the shell builtin commands like \fBdir\fR and \fBcopy\fR,
-the caller must prepend ``\fBcmd.exe /c\0\fR'' to the desired command.
+the caller must prepend ``\fBcmd.exe /c\0\fR'' to the desired command.
.sp
.RE
.TP
\fBWindows 95\fR
.
-When attempting to execute an application, \fBexec\fR first searches for the
-name as it was specified. Then, in order, \fB.com\fR, \fB.exe\fR, and \fB.bat\fR
-are appended to the end of the specified name and it searches for
-the longer name. If a directory name was not specified as part of the
+When attempting to execute an application, \fBexec\fR first searches for
+the name as it was specified. Then, in order, \fB.com\fR, \fB.exe\fR, and
+\fB.bat\fR are appended to the end of the specified name and it searches
+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
@@ -301,9 +323,7 @@ The \fBexec\fR command is not implemented and does not exist under Macintosh.
The \fBexec\fR command is fully functional and works as described.
.SH "SEE ALSO"
-open(n)
-.VE
+error(n), open(n)
.SH KEYWORDS
execute, pipeline, redirection, subprocess
-
diff --git a/tcl/doc/exit.n b/tcl/doc/exit.n
index d7fac6fb610..d383845e3fc 100644
--- a/tcl/doc/exit.n
+++ b/tcl/doc/exit.n
@@ -24,5 +24,8 @@ system as the exit status.
If \fIreturnCode\fR isn't specified then it defaults
to 0.
+.SH "SEE ALSO"
+exec(n), tclvars(n)
+
.SH KEYWORDS
exit, process
diff --git a/tcl/doc/expr.n b/tcl/doc/expr.n
index 0827aed933d..651a2ff0589 100644
--- a/tcl/doc/expr.n
+++ b/tcl/doc/expr.n
@@ -8,7 +8,7 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH expr n 8.3 Tcl "Tcl Built-In Commands"
+.TH expr n 8.4 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -55,6 +55,13 @@ If no numeric interpretation is possible, then an operand is left
as a string (and only a limited set of operators may be applied to
it).
.PP
+.VS 8.4
+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.)
+.VE 8.4
+.PP
Operands may be specified in any of the following ways:
.IP [1]
As an numeric value, either integer or floating-point.
@@ -133,6 +140,12 @@ in which case string comparison is used.
\fB==\0\0!=\fR
Boolean equal and not equal. Each operator produces a zero/one result.
Valid for all operand types.
+.VS 8.4
+.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.
+.VE 8.4
.TP 20
\fB&\fR
Bit-wise AND. Valid for integer operands only.
@@ -199,22 +212,25 @@ 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
-Returns the arc cosine of \fIarg\fR, in the range [0,pi]
-radians. \fIArg\fR should be in the range [-1,1].
+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].
.TP
\fBasin(\fIarg\fB)\fR
-Returns the arc sine of \fIarg\fR, in the range [-pi/2,pi/2] radians.
-\fIArg\fR should be in the range [-1,1].
+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 [-pi/2,pi/2] radians.
+Returns the arc tangent of \fIarg\fR, in the range [\fI-pi/2\fR,\fIpi/2\fR]
+radians.
.TP
-\fBatan2(\fIx, y\fB)\fR
-Returns the arc tangent of \fIy\fR/\fIx\fR, in the range [-pi,pi]
-radians. \fIx\fR and \fIy\fR cannot both be 0.
+\fBatan2(\fIy, x\fB)\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.
.TP
\fBceil(\fIarg\fB)\fR
-Returns the smallest integer value not less than \fIarg\fR.
+Returns the smallest integral floating point value (i.e. with a zero
+fractional part) not less than \fIarg\fR.
.TP
\fBcos(\fIarg\fB)\fR
Returns the cosine of \fIarg\fR, measured in radians.
@@ -228,11 +244,12 @@ If \fIarg\fR is a floating value, returns \fIarg\fR, otherwise converts
\fIarg\fR to floating and returns the converted value.
.TP
\fBexp(\fIarg\fB)\fR
-Returns the exponential of \fIarg\fR, defined as e**\fIarg\fR. If the
-result would cause an overflow, an error is returned.
+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
-Returns the largest integral value not greater than \fIarg\fR.
+Returns the largest integral floating point value (i.e. with a zero
+fractional part) not greater than \fIarg\fR.
.TP
\fBfmod(\fIx, y\fB)\fR
Returns the floating-point remainder of the division of \fIx\fR by
@@ -240,11 +257,15 @@ Returns the floating-point remainder of the division of \fIx\fR by
.TP
\fBhypot(\fIx, y\fB)\fR
Computes the length of the hypotenuse of a right-angled triangle
-(\fIx\fR*\fIx\fR+\fIy\fR*\fIy\fR).
+\fBsqrt(\fIx\fR*\fIx\fR+\fIy\fR*\fIy\fB)\fR.
.TP
\fBint(\fIarg\fB)\fR
-If \fIarg\fR is an integer value, returns \fIarg\fR, otherwise converts
-\fIarg\fR to integer by truncation and returns the converted value.
+.VS 8.4
+If \fIarg\fR is an integer value, 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.
+.VE 8.4
.TP
\fBlog(\fIarg\fB)\fR
Returns the natural logarithm of \fIarg\fR. \fIArg\fR must be a
@@ -259,10 +280,10 @@ 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
-Returns a floating point number from zero to just less than one or,
-in mathematical terms, the range [0,1). The seed comes from the
-internal clock of the machine or may be set manual with the srand
-function.
+Returns a floating point number from zero to just less than one or, in
+mathematical terms, the range [\fI0\fR,\fI1\fR). The seed comes from
+the internal clock of the machine or may be set manual with the
+\fBsrand\fR function.
.TP
\fBround(\fIarg\fB)\fR
If \fIarg\fR is an integer value, returns \fIarg\fR, otherwise converts
@@ -281,13 +302,19 @@ Returns the square root of \fIarg\fR. \fIArg\fR must be non-negative.
\fBsrand(\fIarg\fB)\fR
The \fIarg\fR, which must be an integer, is used to reset the seed for
the random number generator. Returns the first random number from
-that seed. Each interpreter has it's own seed.
+that seed. Each interpreter has its own seed.
.TP
\fBtan(\fIarg\fB)\fR
Returns the tangent of \fIarg\fR, measured in radians.
.TP
\fBtanh(\fIarg\fB)\fR
Returns the hyperbolic tangent of \fIarg\fR.
+.TP
+\fBwide(\fIarg\fB)\fR
+.VS 8.4
+Converts \fIarg\fR to a value at least 64-bits wide (by sign-extension
+if \fIarg\fR is a 32-bit number.)
+.VE 8.4
.PP
In addition to these predefined functions, applications may
define additional functions using \fBTcl_CreateMathFunc\fR().
@@ -332,7 +359,10 @@ returns \fB4.0\fR, not \fB4\fR.
.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.
+or floating-point when it can,
+.VS 8.4
+except in the case of the \fBeq\fR and \fBne\fR operators.
+.VE 8.4
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
@@ -349,6 +379,9 @@ 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
when you really want string comparison and the values of the
operands could be arbitrary; it's better in these cases to use
+.VS 8.4
+the \fBeq\fR or \fBne\fR operators, or
+.VE 8.4
the \fBstring\fR command instead.
.SH "PERFORMANCE CONSIDERATIONS"
@@ -383,6 +416,8 @@ unbraced expressions that contain command substitutions.
These expressions must be implemented by generating new code
each time the expression is executed.
+.SH "SEE ALSO"
+array(n), string(n), Tcl(n)
+
.SH KEYWORDS
arithmetic, boolean, compare, expression, fuzzy comparison
-
diff --git a/tcl/doc/fblocked.n b/tcl/doc/fblocked.n
index 3e3922a3931..c3b12be3864 100644
--- a/tcl/doc/fblocked.n
+++ b/tcl/doc/fblocked.n
@@ -25,8 +25,15 @@ characters available for input and no end-of-line sequence, \fBgets\fR
returns an empty string and a subsequent call to \fBfblocked\fR will
return 1.
.PP
+.VS
+\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.
+.VE
+
.SH "SEE ALSO"
-gets(n), read(n)
+gets(n), open(n), read(n), Tcl_StandardChannels(3)
.SH KEYWORDS
blocking, nonblocking
diff --git a/tcl/doc/fconfigure.n b/tcl/doc/fconfigure.n
index dc84a52dd9d..2b062a18264 100644
--- a/tcl/doc/fconfigure.n
+++ b/tcl/doc/fconfigure.n
@@ -7,7 +7,7 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH fconfigure n 8.1 Tcl "Tcl Built-In Commands"
+.TH fconfigure n 8.3 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -19,11 +19,16 @@ fconfigure \- Set and get options on a channel
\fBfconfigure \fIchannelId\fR \fIname value \fR?\fIname value ...\fR?
.fi
.BE
-
.SH DESCRIPTION
.PP
The \fBfconfigure\fR command sets and retrieves options for channels.
-\fIChannelId\fR identifies the channel for which to set or query an option.
+.PP
+\fIChannelId\fR identifies the channel for which to set or query an
+option and must refer to 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
If no \fIname\fR or \fIvalue\fR arguments are supplied, the command
returns a list containing alternating option names and values for the channel.
If \fIname\fR is supplied but no \fIvalue\fR then the command returns
@@ -61,7 +66,7 @@ automatically after every output operation. The default is for
\fB\-buffering\fR to be set to \fBfull\fR except for channels that
connect to terminal-like devices; for these channels the initial setting
is \fBline\fR. Additionally, \fBstdin\fR and \fBstdout\fR are
-intially set to \fBline\fR, and \fBstderr\fR is set to \fBnone\fR.
+initially set to \fBline\fR, and \fBstderr\fR is set to \fBnone\fR.
.TP
\fB\-buffersize\fR \fInewSize\fR
.
@@ -69,7 +74,6 @@ intially set to \fBline\fR, and \fBstderr\fR is set to \fBnone\fR.
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.
-.VS 8.1 br
.TP
\fB\-encoding\fR \fIname\fR
.
@@ -93,7 +97,6 @@ The default encoding for newly opened channels is the same platform- and
locale-dependent system encoding used for interfacing with the operating
system.
.RE
-.VE
.TP
\fB\-eofchar\fR \fIchar\fR
.TP
@@ -154,7 +157,6 @@ Tcl chooses \fBcrlf\fR, for all Unix flavors, it chooses \fBlf\fR, for the
Macintosh platform it chooses \fBcr\fR and for the various flavors of
Windows it chooses \fBcrlf\fR. The default setting for
\fB\-translation\fR is \fBauto\fR for both input and output.
-.VS 8.1 br
.TP
\fBbinary\fR
.
@@ -163,7 +165,6 @@ No end-of-line translations are performed. This is nearly identical to
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.
-.VE
.TP
\fBcr\fR
.
@@ -192,8 +193,213 @@ platforms.
.RE
.PP
+.SH "STANDARD CHANNELS"
+.PP
+The Tcl standard channels (\fBstdin\fR, \fBstdout\fR, and \fBstderr\fR)
+can be configured through this command like every other channel opened
+by the Tcl library. Beyond the standard options described above they
+will also support any special option according to their current type.
+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.
+
+.VS 8.4
+.SH "SERIAL PORT CONFIGURATION OPTIONS"
+.PP
+If \fIchannelId\fR refers to a serial port, then the following
+additional configuration options are available on Windows and
+Unix systems with a POSIX serial interface:
+
+.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
+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.
+
+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.
+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.
+
+.TP
+\fB\-queue\fR
+.
+(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
+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
+with active hardware handshake \fBrtscts\fR (or \fBdtrdsr\fR).
+The result is unpredictable.
+The \fB-ttycontrol\fR option cannot be queried.
+
+.TP
+\fB\-ttystatus\fR
+.
+(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,
+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
+interpreter (the smallest value always wins). Use this option only if
+you want to poll the serial port more or less often than 10 msec
+(the default).
+
+.TP
+\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
+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.
+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
+communications. A negative voltage (-3V..-12V) define a mark (on=1) bit and
+a positive voltage (+3..+12V) define a space (off=0) bit (RS-232C). The
+following signals are specified for incoming and outgoing data, status
+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.
+.RS
+.IP \fBTXD(output)\fR
+\fBTransmitted Data:\fR Outgoing serial data.
+.IP \fBRXD(input)\fR
+\fBReceived Data:\fRIncoming serial data.
+.IP \fBRTS(output)\fR
+\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
+\fBClear To Send:\fR The complement to RTS. Indicates that the modem is
+ready to receive data.
+.IP \fBDTR(output)\fR
+\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
+\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
+\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
+TXD or RXD lines for a long period of time, usually 250 to 500
+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.
+.RE
+
+.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
+\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
+locate the problem. The following error codes may be returned.
+.RS
+.IP \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
+temporary bottleneck and/or make your script faster.
+.IP \fBTXFULL\fR
+Windows output buffer overrun. Complement to RXOVER. This error should
+practically not happen, because Tcl cares about the output buffer status.
+.IP \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.
+.IP \fBRXPARITY\fR
+A parity error has been detected by your UART.
+Wrong parity settings with \fBfconfigure -mode\fR or a noisy data line (RXD)
+may cause this error.
+.IP \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)
+may cause this error.
+.IP \fBBREAK\fR
+A BREAK condition has been detected by your UART (see above).
+.RE
+.VE
+
.SH "SEE ALSO"
-close(n), flush(n), gets(n), puts(n), read(n), socket(n)
+close(n), flush(n), gets(n), puts(n), read(n), socket(n),
+Tcl_StandardChannels(3)
.SH KEYWORDS
blocking, buffering, carriage return, end of line, flushing, linemode,
diff --git a/tcl/doc/fcopy.n b/tcl/doc/fcopy.n
index a381a4b4e0b..13bb45c45f5 100644
--- a/tcl/doc/fcopy.n
+++ b/tcl/doc/fcopy.n
@@ -71,6 +71,19 @@ 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.
+.PP
+\fBFcopy\fR obeys the encodings configured for the channels. This
+means that the incoming characters are converted internally first
+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 option. No conversion is done if both channels are
+set to encoding "binary". 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
+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 EXAMPLE
.PP
diff --git a/tcl/doc/file.n b/tcl/doc/file.n
index 886e32f9c3e..6bb0e3969ac 100644
--- a/tcl/doc/file.n
+++ b/tcl/doc/file.n
@@ -36,9 +36,9 @@ doesn't 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
-.br
+.TP
\fBfile attributes \fIname\fR ?\fBoption\fR?
-.br
+.TP
\fBfile attributes \fIname\fR ?\fBoption value option value...\fR?
.RS
This subcommand returns or sets platform specific values associated
@@ -88,34 +88,42 @@ is determined using the same rules as for \fBstring match\fR.
.VE
.TP
\fBfile copy \fR?\fB\-force\fR? ?\fB\-\|\-\fR? \fIsource\fR \fItarget\fR
-.br
+.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,
+the pathname \fItarget\fR. If \fItarget\fR is an existing directory,
then the second form is used. The second form makes a copy inside
\fItargetDir\fR of each \fIsource\fR file listed. If a directory is
specified as a \fIsource\fR, then the contents of the directory will be
-recursively copied into \fItargetDir\fR. Existing files will not be
-overwritten unless the \fB\-force\fR option is specified. Trying to
-overwrite a non-empty directory, overwrite a directory with a file, or a
-file with a directory will all result in errors even if \fI\-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.
+recursively copied into \fItargetDir\fR. Existing files will not be
+overwritten unless the \fB\-force\fR option is specified. When copying
+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 a file with a directory will all result in errors even if
+\fI\-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 ... ?
.
-Removes the file or directory specified by each \fIpathname\fR argument.
-Non-empty directories will be removed only if the \fB\-force\fR option is
-specified. Trying to delete a non-existant 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. 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.
+Removes the file or directory specified by each \fIpathname\fR
+argument. Non-empty directories will be removed only if the
+\fB\-force\fR option is specified. When operating on symbolic links,
+the links themselves will be deleted, not the objects they point to.
+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.
+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.
.TP
\fBfile dirname \fIname\fR
Returns a name comprised of all of the path components in \fIname\fR
@@ -183,6 +191,37 @@ is always canonical for the current platform: \fB/\fR for Unix and
Windows, and \fB:\fR for Macintosh.
.RE
.TP
+\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,
+seems to be the case with hard links, which look just like ordinary
+files), then an error is returned.
+.
+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
+link called \fIlinkName\fR which points to the existing filesystem object
+at \fItarget\fR, 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 link is created.
+.
+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".
+.
+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 not support any links
+at present, but most Unix platforms support both symbolic and hard links
+(the latter for files only), MacOS supports symbolic links and Windows
+NT/2000/XP (on NTFS drives) support symbolic directory links and hard
+file links.
+.TP
\fBfile lstat \fIname varName\fR
.
Same as \fBstat\fR option (see below) except uses the \fIlstat\fR
@@ -216,6 +255,24 @@ 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 or AppleScript on the Macintosh.
.TP
+\fBfile normalize \fIname\fR
+.
+.RS
+Returns a unique normalised 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''
+format for the native platform. On MacOS, 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 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
+.TP
\fBfile owned \fIname\fR
.
Returns \fB1\fR if file \fIname\fR is owned by the current user, \fB0\fR
@@ -242,20 +299,22 @@ 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
support symbolic links this option is undefined.
-.PP
+.TP
\fBfile rename \fR?\fB\-force\fR? ?\fB\-\|\-\fR? \fIsource\fR \fItarget\fR
-.br
+.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
-\fItarget\fR is an existing directory, then the second form is used. The
-second form moves each \fIsource\fR file or directory into the directory
-\fItargetDir\fR. Existing files will not be overwritten unless the
-\fB\-force\fR option is specified. Trying to overwrite a non-empty
-directory, overwrite a directory with a file, or a file with a directory
-will all result in errors. Arguments are processed in the order specified,
+\fItarget\fR is an existing directory, then the second form is used.
+The second form moves each \fIsource\fR file or directory into the
+directory \fItargetDir\fR. Existing files will not be overwritten
+unless the \fB\-force\fR option is specified. When operating inside a
+single filesystem, Tcl will rename symbolic links rather than the
+things that they point to. Trying to overwrite a non-empty directory,
+overwrite a directory with a file, or a file with a directory will all
+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.
@@ -267,6 +326,14 @@ 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.
.TP
+\fBfile separator\fR ?\fIname\fR?
+.
+If no argument is given, returns the character which is used to separate
+path segments for native files on this platform. If a path is given,
+the filesystem responsible for that path is asked to return its
+separator character. If no file system accepts \fIname\fR, an error
+is generated.
+.TP
\fBfile size \fIname\fR
.
Returns a decimal string giving the size of file \fIname\fR in bytes. If
@@ -282,7 +349,7 @@ unless they are needed ensure that an element is unambiguously relative.
For example, under Unix
.RS
.CS
-\fBfile split /foo/~bar/baz\fR
+file split /foo/~bar/baz
.CE
returns \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
@@ -303,6 +370,21 @@ values. The \fBtype\fR element gives the type of the file in the same
form returned by the command \fBfile type\fR. This command returns an
empty string.
.TP
+\fBfile system \fIname\fR
+.
+Returns a list of two elements, the first of which is the name of the
+filesystem to use for the file, and the second 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 be null. For example the native files have a
+first element 'native', and a second element which is a platform-specific
+type name for the file's system (e.g. 'NTFS', 'FAT', etc), or possibly
+the empty string if no further information is available or if this
+is not implemented. 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.
+.TP
\fBfile tail \fIname\fR
.
Returns all of the characters in \fIname\fR after the last directory
@@ -338,7 +420,8 @@ These commands always operate using the real user and group identifiers,
not the effective ones.
.SH "SEE ALSO"
-filename
+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
diff --git a/tcl/doc/fileevent.n b/tcl/doc/fileevent.n
index 68c9b29aaf2..f2fa4ba0576 100644
--- a/tcl/doc/fileevent.n
+++ b/tcl/doc/fileevent.n
@@ -34,9 +34,14 @@ appear to the user to ``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.
.PP
-The \fIchannelId\fR argument to \fBfileevent\fR refers to an open channel,
-such as the return value from a previous \fBopen\fR or \fBsocket\fR
-command.
+.VS
+The \fIchannelId\fR argument to \fBfileevent\fR refers to 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.
+.VE
+.PP
If the \fIscript\fR argument is specified, then \fBfileevent\fR
creates a new event handler: \fIscript\fR will be evaluated
whenever the channel becomes readable or writable (depending on the
@@ -96,13 +101,28 @@ 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
+.CS
+ proc GetData {chan} {
+ if {![eof $chan]} {
+ puts [gets $chan]
+ }
+ }
+
+ fileevent $chan readable [list GetData $chan]
+
+.CE
+In this setup \fBGetData\fR will be called with the channel as an
+argument whenever $chan becomes readable.
+
.SH CREDITS
.PP
\fBfileevent\fR is based on the \fBaddinput\fR command created
by Mark Diekhans.
.SH "SEE ALSO"
-bgerror, fconfigure, gets, puts, read
+bgerror(n), fconfigure(n), gets(n), puts(n), read(n), Tcl_StandardChannels(3)
.SH KEYWORDS
asynchronous I/O, blocking, channel, event handler, nonblocking, readable,
diff --git a/tcl/doc/filename.n b/tcl/doc/filename.n
index 31001e41c61..3954c7edd56 100644
--- a/tcl/doc/filename.n
+++ b/tcl/doc/filename.n
@@ -136,7 +136,9 @@ 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
specifier followed by an absolute or relative path. UNC paths follow the
-general form \fB\e\eservername\esharename\epath\efile\fR. In both forms,
+general form \fB\e\eservername\esharename\epath\efile\fR, but must at
+the very least contain the server and share components, i.e.
+\fB\e\eservername\esharename\fR. In both forms,
the file names \fB.\fR and \fB..\fR are special and refer to the current
directory and the parent of the current directory respectively. The
following examples illustrate various forms of path names:
@@ -144,7 +146,9 @@ following examples illustrate various forms of path names:
.TP 15
\fB\&\e\eHost\eshare/file\fR
Absolute UNC path to a file called \fBfile\fR in the root directory of
-the export point \fBshare\fR on the host \fBHost\fR.
+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.
.TP 15
\fBc:foo\fR
Volume-relative path to a file \fBfoo\fR in the current directory on drive
@@ -161,6 +165,11 @@ directory on the current volume.
\fB\&\efoo\fR
Volume-relative path to a file \fBfoo\fR in the root directory of the current
volume.
+.TP 15
+\fB\&\e\efoo\fR
+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"
@@ -177,9 +186,13 @@ substitution.
.PP
The Macintosh and Windows platforms do not support tilde substitution
when a user name follows the tilde. On these platforms, attempts to
-use a tilde followed by a user name will generate an error. File
-names that have a tilde without a user name will be substituted using
-the \fB$HOME\fR environment variable, just like for Unix.
+use a tilde followed by a user name will generate an error that the
+user does not exist when Tcl attempts to interpret that part of the
+path or otherwise access the 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
@@ -191,7 +204,14 @@ should choose file names that do not contain special characters like:
alphanumeric characters only. Also Windows 3.1 only supports file
names with a root of no more than 8 characters and an extension of no
more than 3 characters.
+.PP
+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.
.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/tcl/doc/flush.n b/tcl/doc/flush.n
index d7cd1e13116..f1f9854de74 100644
--- a/tcl/doc/flush.n
+++ b/tcl/doc/flush.n
@@ -20,8 +20,15 @@ flush \- Flush buffered output for a channel
.SH DESCRIPTION
.PP
Flushes any output that has been buffered for \fIchannelId\fR.
-\fIChannelId\fR must be a channel identifier such as returned by a previous
-\fBopen\fR or \fBsocket\fR command, and it must have been opened for writing.
+.PP
+.VS
+\fIChannelId\fR must be an identifier for an open channel such as a
+Tcl standard channel (\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. The
+channel must have been opened for writing.
+.VE
+.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 buffered output has been
@@ -29,7 +36,7 @@ flushed; the remainder will be flushed in the background as fast as the
underlying file or device is able to absorb it.
.SH "SEE ALSO"
-open(n), socket(n)
+file(n), open(n), socket(n), Tcl_StandardChannels(3)
.SH KEYWORDS
blocking, buffer, channel, flush, nonblocking, output
diff --git a/tcl/doc/for.n b/tcl/doc/for.n
index 7e426045340..1c73b12fcff 100644
--- a/tcl/doc/for.n
+++ b/tcl/doc/for.n
@@ -56,5 +56,8 @@ for {set x 0} {$x<10} {incr x} {
}
.CE
+.SH "SEE ALSO"
+break, continue, foreach, while
+
.SH KEYWORDS
for, iteration, looping
diff --git a/tcl/doc/foreach.n b/tcl/doc/foreach.n
index 7790b5ff22b..58b4146894b 100644
--- a/tcl/doc/foreach.n
+++ b/tcl/doc/foreach.n
@@ -82,5 +82,9 @@ foreach i {a b c} {j k} {d e f g} {
# The value of x is "a d e b f g c {} {}"
# There are 3 iterations of the loop.
.DE
+
+.SH "SEE ALSO"
+for(n), while(n), break(n), continue(n)
+
.SH KEYWORDS
foreach, iteration, list, looping
diff --git a/tcl/doc/format.n b/tcl/doc/format.n
index 9d196e204b1..e3a984a4f48 100644
--- a/tcl/doc/format.n
+++ b/tcl/doc/format.n
@@ -131,7 +131,12 @@ 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.
-The \fBl\fR modifier is ignored.
+.VS 8.4
+If it is \fBl\fR it specifies that the numeric value should be (at
+least) a 64-bit value. If neither \fBh\fR or \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.
+.VE
.PP
The last thing in a conversion specifier is an alphabetic character
that determines what kind of conversion to perform.
@@ -203,12 +208,19 @@ differences:
For \fB%c\fR conversions the argument must be a decimal string,
which will then be converted to the corresponding character value.
.IP [3]
-The \fBl\fR modifier is ignored; integer values are always converted
-as if there were no modifier present and real values are always
-converted as if the \fBl\fR modifier were present (i.e. type
-\fBdouble\fR is used for the internal representation).
+The \fBl\fR modifier
+.VS 8.4
+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).
+.VE 8.4
If the \fBh\fR modifier is specified then integer values are truncated
-to \fBshort\fR before conversion.
+to \fBshort\fR before conversion. Both \fBh\fR and \fBl\fR modifiers
+are ignored on all other conversions.
+
+.SH "SEE ALSO"
+sprintf(3), string(n)
.SH KEYWORDS
conversion specifier, format, sprintf, string, substitution
diff --git a/tcl/doc/gets.n b/tcl/doc/gets.n
index d27c0b29c34..bca4f790676 100644
--- a/tcl/doc/gets.n
+++ b/tcl/doc/gets.n
@@ -22,6 +22,15 @@ gets \- Read a line from a channel
This command reads the next line from \fIchannelId\fR, returns everything
in the line up to (but not including) the end-of-line character(s), and
discards the end-of-line character(s).
+.PP
+.VS
+\fIChannelId\fR must be an identifier for an open channel such as the
+Tcl standard input channel (\fBstdin\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. The channel must have
+been opened for input.
+.VE
+.PP
If \fIvarName\fR is omitted the line is returned as the result of the
command.
If \fIvarName\fR is specified then the line is placed in the variable by
@@ -44,7 +53,7 @@ The \fBeof\fR and \fBfblocked\fR commands can be used to distinguish
these three cases.
.SH "SEE ALSO"
-eof(n), fblocked(n)
+file(n), eof(n), fblocked(n), Tcl_StandardChannels(3)
.SH KEYWORDS
blocking, channel, end of file, end of line, line, nonblocking, read
diff --git a/tcl/doc/glob.n b/tcl/doc/glob.n
index 458e1ff6121..e5cc80ca64b 100644
--- a/tcl/doc/glob.n
+++ b/tcl/doc/glob.n
@@ -33,7 +33,8 @@ Search for files which match the given patterns starting in the given
\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
-\fB\-path\fR.
+\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
@@ -48,9 +49,22 @@ switch an error is returned if the result list would be empty.
\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 even when the names contain glob-sensitive
+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.
+\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
+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
+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
@@ -73,7 +87,7 @@ 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
or \fI{macintosh creator XXXX}\fR will match types or creators
-respectively. Unrecognised 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
@@ -114,8 +128,14 @@ Matches the character \fIx\fR.
\fB{\fIa\fB,\fIb\fB,\fI...\fR}
Matches any of the strings \fIa\fR, \fIb\fR, etc.
.LP
-As with csh, a ``.'' at the beginning of a file's name or just
-after a ``/'' must be matched explicitly or with a {} construct.
+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
@@ -146,14 +166,27 @@ 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).
.TP
\fBMacintosh\fR
.
-When using the options, \fB\-dir\fR, \fB\-join\fR or \fB\-path\fR, glob
+When using the options, \fB\-directory\fR, \fB\-join\fR or \fB\-path\fR, glob
assumes the directory separator for the entire pattern is the standard
``:''. When not using these options, glob examines each pattern argument
and uses ``/'' unless the pattern contains a ``:''.
+.SH "SEE ALSO"
+file(n)
.SH KEYWORDS
exist, file, glob, pattern
diff --git a/tcl/doc/global.n b/tcl/doc/global.n
index bc27815b89b..35b94a55b6f 100644
--- a/tcl/doc/global.n
+++ b/tcl/doc/global.n
@@ -27,9 +27,10 @@ For the duration of the current procedure
(and only while executing in the current procedure),
any reference to any of the \fIvarname\fRs
will refer to the global variable by the same name.
+.PP
.SH "SEE ALSO"
-namespace(n), variable(n)
+namespace(n), upvar(n), variable(n)
.SH KEYWORDS
global, namespace, procedure, variable
diff --git a/tcl/doc/http.n b/tcl/doc/http.n
index fb2de76392e..07d6af4102c 100644
--- a/tcl/doc/http.n
+++ b/tcl/doc/http.n
@@ -8,13 +8,13 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH "Http" n 8.3 Tcl "Tcl Built-In Commands"
+.TH "http" n 2.4 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.0 protocol.
.SH SYNOPSIS
-\fBpackage require http ?2.3?\fP
+\fBpackage require http ?2.4?\fR
.sp
\fB::http::config \fI?options?\fR
.sp
@@ -52,7 +52,7 @@ protocol. The package implements the GET, POST, and HEAD operations
of HTTP/1.0. 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 extened to support
+a restricted set of hosts. This package can be extended to support
additional HTTP transport protocols, such as HTTPS, by providing
a custom \fBsocket\fR command, via \fBhttp::register\fR.
.PP
@@ -110,11 +110,11 @@ non-empty.
.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.2."\fR
+is \fB"Tcl http client package 2.4."\fR
.RE
.TP
\fB::http::geturl\fP \fIurl\fP ?\fIoptions\fP?
-The \fB::http::geturl \fR command is the main procedure in the package.
+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
@@ -126,13 +126,16 @@ that is invoked when the HTTP transaction completes.
\fB::http::geturl\fR takes several options:
.RS
.TP
+\fB\-binary\fP \fIboolean\fP
+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
The blocksize 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).
+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
Copy the URL contents to channel \fIname\fR instead of saving it in
@@ -349,7 +352,7 @@ HTTP reply headers or data, no exception is thrown. This is because
after writing the HTTP headers, \fB::http::geturl\fP 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 it's \fIerror\fP,
+\fB::http::status\fP to check the status and if its \fIerror\fP,
calling \fB::http::error\fP to get the error message.
.PP
Alternatively, if the main program flow reaches a point where it needs
@@ -407,6 +410,15 @@ the array are supported:
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.
.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.
@@ -505,12 +517,10 @@ proc ::http::copy { url file {chunk 4096} } {
proc ::http::Progress {args} {
puts -nonewline stderr . ; flush stderr
}
-
.DE
+
.SH "SEE ALSO"
safe(n), socket(n), safesock(n)
+
.SH KEYWORDS
security policy, socket
-
-
-
diff --git a/tcl/doc/if.n b/tcl/doc/if.n
index 98c314569ce..f9db9905539 100644
--- a/tcl/doc/if.n
+++ b/tcl/doc/if.n
@@ -39,5 +39,8 @@ 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 "SEE ALSO"
+expr(n), for(n), foreach(n)
+
.SH KEYWORDS
boolean, conditional, else, false, if, true
diff --git a/tcl/doc/incr.n b/tcl/doc/incr.n
index c681ad74d1f..82bd907024e 100644
--- a/tcl/doc/incr.n
+++ b/tcl/doc/incr.n
@@ -27,5 +27,8 @@ integer) is added to the value of variable \fIvarName\fR; otherwise
The new value is stored as a decimal string in variable \fIvarName\fR
and also returned as result.
+.SH "SEE ALSO"
+expr(n)
+
.SH KEYWORDS
add, increment, variable, value
diff --git a/tcl/doc/info.n b/tcl/doc/info.n
index 44df52f37bf..6d246d10513 100644
--- a/tcl/doc/info.n
+++ b/tcl/doc/info.n
@@ -2,6 +2,7 @@
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
'\" Copyright (c) 1993-1997 Bell Labs Innovations for Lucent Technologies
+'\" Copyright (c) 1998-2000 Ajuba Solutions
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -9,7 +10,7 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH info n 7.5 Tcl "Tcl Built-In Commands"
+.TH info n 8.4 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -74,6 +75,15 @@ into variable \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.
+.VS 8.4
+.TP
+\fBinfo functions \fR?\fIpattern\fR?
+If \fIpattern\fR isn't 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.
+.VE
.TP
\fBinfo globals \fR?\fIpattern\fR?
If \fIpattern\fR isn't specified, returns a list of all the names
@@ -86,6 +96,13 @@ are returned. Matching is determined using the same rules as for
\fBinfo hostname\fR
Returns the name of the computer on which this invocation is being
executed.
+.VS
+Note that this name is not guaranteed to be the fully qualified domain
+name of the host. Where machines have several different names (as is
+common on systems with both TCP/IP (DNS) and NetBIOS-based networking
+installed,) it is the name that is suitable for TCP/IP networking that
+is returned.
+.VE
.TP
\fBinfo level\fR ?\fInumber\fR?
If \fInumber\fR is not specified, this command returns a number
@@ -123,8 +140,8 @@ an empty string for the \fIinterp\fR argument.
If \fIpattern\fR isn't 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 and \fBupvar\fR commands
-will not be returned.
+Variables defined with the \fBglobal\fR, \fBupvar\fR and
+\fBvariable\fR commands will not be returned.
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.
@@ -147,12 +164,15 @@ matching \fIpattern\fR are returned.
Matching is determined using the same rules as for
\fBstring match\fR.
.TP
-\fBinfo script\fR
+\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
-of the innermost file being processed. Otherwise the command returns an
-empty string.
+of the innermost file being processed. If \fIfilename\fR is specified,
+then the return value of this command will be modified for the
+duration of the active invocation to return that name. This is
+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
@@ -181,5 +201,12 @@ the resulting list of variable names
has each matching namespace variable qualified with the name
of its namespace.
+.SH "SEE ALSO"
+global(n), proc(n)
+
.SH KEYWORDS
command, information, interpreter, level, namespace, procedure, variable
+
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/tcl/doc/interp.n b/tcl/doc/interp.n
index ee29c11e110..b591746753b 100644
--- a/tcl/doc/interp.n
+++ b/tcl/doc/interp.n
@@ -147,6 +147,8 @@ value such as \fB\-safe\fR. The result of the command is the name of the
new interpreter. The name of a slave interpreter must be unique among all
the slaves for its master; an error occurs if a slave interpreter by the
given name already exists in this master.
+The initial recursion limit of the slave interpreter is set to the
+current recursion limit of its parent interpreter.
.TP
\fBinterp\fR \fBdelete \fR?\fIpath ...?\fR
Deletes zero or more interpreters given by the optional \fIpath\fR
@@ -175,7 +177,7 @@ it back under a new \fIexposedCmdName\fR name (this name is currently
accepted only if it is a valid global name space name without any ::),
in the interpreter
denoted by \fIpath\fR.
-If an exposed command with the targetted name already exists, this command
+If an exposed command with the targeted name already exists, this command
fails.
Hidden commands are explained in more detail in HIDDEN COMMANDS, below.
.TP
@@ -184,7 +186,7 @@ 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
by \fIpath\fR.
-If a hidden command with the targetted name already exists, this command
+If a hidden command with the targeted name already exists, this command
fails.
Currently both \fIexposedCmdName\fR and \fIhiddenCmdName\fR can
not contain namespace qualifiers, or an error is raised.
@@ -222,6 +224,23 @@ The command has no effect if the interpreter identified by \fIpath\fR is
already trusted.
.VE
.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
+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
+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.
+.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
@@ -307,7 +326,7 @@ This command exposes the hidden command \fIhiddenName\fR, eventually bringing
it back under a new \fIexposedCmdName\fR name (this name is currently
accepted only if it is a valid global name space name without any ::),
in \fIslave\fR.
-If an exposed command with the targetted name already exists, this command
+If an exposed command with the targeted name already exists, this command
fails.
For more details on hidden commands, see HIDDEN COMMANDS, below.
.TP
@@ -315,7 +334,7 @@ For more details on hidden commands, see HIDDEN COMMANDS, below.
This command hides the exposed command \fIexposedCmdName\fR, renaming it to
the hidden command \fIhiddenCmdName\fR, or keeping the same name if the
the argument is not given, in the \fIslave\fR interpreter.
-If a hidden command with the targetted name already exists, this command
+If a hidden command with the targeted name already exists, this command
fails.
Currently both \fIexposedCmdName\fR and \fIhiddenCmdName\fR can
not contain namespace qualifiers, or an error is raised.
@@ -349,7 +368,22 @@ 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.
.VE
-
+.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
+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.
.SH "SAFE INTERPRETERS"
.PP
A safe interpreter is one with restricted functionality, so that
@@ -381,15 +415,15 @@ close concat continue eof
error eval expr fblocked
fcopy fileevent flush for
foreach format gets global
-history 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 trace unset update
+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
.DE
@@ -398,12 +432,43 @@ The following commands are hidden by \fBinterp create\fR when it
creates a safe interpreter:
.DS
.ta 1.2i 2.4i 3.6i
-\fBcd exec exit fconfigure
-file glob load open
-pwd socket source vwait\fR
+\fBcd encoding exec exit
+fconfigure file glob load
+open pwd socket source\fR
.DE
These commands can be recreated later as Tcl procedures or aliases, or
re-exposed by \fBinterp expose\fR.
+.PP
+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
+.DE
+Note in particular that safe interpreters have no default \fBunknown\fR
+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
+.DE
+can only be provided by explicit definition of an \fBunknown\fR command
+in the safe interpreter. This will involve exposing the \fBsource\fR
+command. This is most easily accomplished by creating the safe interpreter
+with Tcl's \fBSafe\-Tcl\fR mechanism. \fBSafe\-Tcl\fR provides safe
+versions of \fBsource\fR, \fBload\fR, and other Tcl commands needed
+to support autoloading of commands and the loading of packages.
.VE
.PP
In addition, the \fBenv\fR variable is not present in a safe interpreter,
@@ -419,6 +484,9 @@ If extensions are loaded into a safe interpreter, they may also restrict
their own functionality to eliminate unsafe commands. For a discussion of
management of extensions for safety see the manual entries for
\fBSafe\-Tcl\fR and the \fBload\fR Tcl command.
+.PP
+A safe interpreter may not alter the recursion limit of any interpreter,
+including itself.
.SH "ALIAS INVOCATION"
.PP
@@ -516,7 +584,7 @@ interpreter using \fBinterp expose\fR and \fBinterp hide\fR. The \fBinterp
expose\fR command moves a hidden command to the
set of exposed commands in the interpreter identified by \fIpath\fR,
potentially renaming the command in the process. If an exposed command by
-the targetted name already exists, the operation fails. Similarly,
+the targeted name already exists, the operation fails. Similarly,
\fBinterp hide\fR moves an exposed command to the set of hidden commands in
that interpreter. Safe interpreters are not allowed to move commands
between the set of hidden and exposed commands, in either themselves or
diff --git a/tcl/doc/join.n b/tcl/doc/join.n
index f5be56b66cf..645f89ad162 100644
--- a/tcl/doc/join.n
+++ b/tcl/doc/join.n
@@ -25,5 +25,8 @@ 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 "SEE ALSO"
+list(n), lappend(n)
+
.SH KEYWORDS
element, join, list, separator
diff --git a/tcl/doc/lappend.n b/tcl/doc/lappend.n
index 1351dedc40a..ffe9d39727c 100644
--- a/tcl/doc/lappend.n
+++ b/tcl/doc/lappend.n
@@ -1,6 +1,7 @@
'\"
'\" 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.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -31,5 +32,12 @@ 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.
+.SH "SEE ALSO"
+list(n), lindex(n), linsert(n), llength(n),
+.VS 8.4
+lset(n)
+.VE
+lsort(n), lrange(n)
+
.SH KEYWORDS
append, element, list, variable
diff --git a/tcl/doc/library.n b/tcl/doc/library.n
index 54ef6ad50da..f4125434721 100644
--- a/tcl/doc/library.n
+++ b/tcl/doc/library.n
@@ -81,7 +81,8 @@ the imported commands specified by \fIpattern\fR reside in an
autoloaded library. If so, the commands are loaded so that they will
be available to the interpreter for creating the import links. If the
commands do not reside in an autoloaded library, \fBauto_import\fR
-does nothing.
+does nothing. The pattern matching is performed according to the
+matching rules of \fBnamespace import\fR.
.TP
\fBauto_load \fIcmd\fR
This command attempts to load the definition for a Tcl command named
@@ -304,8 +305,7 @@ infinitely.
The variable is unset before \fBunknown\fR returns.
.SH "SEE ALSO"
-re_syntax(n)
+info(n), re_syntax(n)
.SH KEYWORDS
auto-exec, auto-load, library, unknown, word, whitespace
-
diff --git a/tcl/doc/license.terms b/tcl/doc/license.terms
index 9df3e600352..f1dcaa5245c 100644
--- a/tcl/doc/license.terms
+++ b/tcl/doc/license.terms
@@ -1,7 +1,8 @@
This software is copyrighted by the Regents of the University of
-California, Sun Microsystems, Inc., Scriptics Corporation,
-and other parties. The following terms apply to all files associated
-with the software unless explicitly disclaimed in individual files.
+California, Sun Microsystems, Inc., Scriptics Corporation, ActiveState
+Corporation and other parties. The following terms apply to all files
+associated with the software unless explicitly disclaimed in
+individual files.
The authors hereby grant permission to use, copy, modify, distribute,
and license this software and its documentation for any purpose, provided
diff --git a/tcl/doc/lindex.n b/tcl/doc/lindex.n
index ec18d168a58..2966aed4aac 100644
--- a/tcl/doc/lindex.n
+++ b/tcl/doc/lindex.n
@@ -1,6 +1,7 @@
'\"
'\" 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.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -8,20 +9,39 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH lindex n 8.2 Tcl "Tcl Built-In Commands"
+.TH lindex n 8.4 Tcl "Tcl Built-In Commands"
.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
-This command treats \fIlist\fR as a Tcl list and returns the
+.VS 8.4
+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 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:
+.CS
+lindex list
+.CE
+or
+.CS
+lindex list {}
+.CE
+In this case, the return value of \fBlindex\fR is simply the value of the
+\fIlist\fR parameter.
+.PP
+When presented with a single index, the \fBlindex\fR command
+treats \fIlist\fR as a Tcl list and returns the
+.VE
\fIindex\fR'th element from it (0 refers to the first element of the list).
-In extracting the element, \fIlindex\fR observes the same rules
+In extracting the element, \fBlindex\fR observes the same rules
concerning braces and quotes and backslashes as the Tcl command
interpreter; however, variable
substitution and command substitution do not occur.
@@ -31,7 +51,43 @@ string is returned.
If \fIindex\fR has the value \fBend\fR, it refers to the last element
in the list, and \fBend\-\fIinteger\fR refers to the last element in
the list minus the specified integer offset.
-
+.PP
+.VS 8.4
+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,
+.CS
+lindex $a 1 2 3
+.CE
+or
+.CS
+lindex $a {1 2 3}
+.CE
+is synonymous with
+.CS
+lindex [lindex [lindex $a 1] 2] 3
+.CE
+.SH EXAMPLES
+.CS
+lindex {a b c} => a b c
+lindex {a b c} {} => a b c
+lindex {a b c} 0 => a
+lindex {a b c} 2 => c
+lindex {a b c} end => c
+lindex {a b c} end-1 => b
+lindex {{a b c} {d e f} {g h i}} 2 1 => h
+lindex {{a b c} {d e f} {g h i}} {2 1} => h
+lindex {{{a b} {c d}} {{e f} {g h}}} 1 1 0 => g
+lindex {{{a b} {c d}} {{e f} {g h}}} {1 1 0} => g
+.CE
+.VE
+.SH "SEE ALSO"
+list(n), lappend(n), linsert(n), llength(n), lsearch(n),
+.VS 8.4
+lset(n),
+.VE
+lsort(n),
+lrange(n), lreplace(n)
.SH KEYWORDS
element, index, list
diff --git a/tcl/doc/linsert.n b/tcl/doc/linsert.n
index a44bfbcd3b8..a87ee759c1a 100644
--- a/tcl/doc/linsert.n
+++ b/tcl/doc/linsert.n
@@ -1,6 +1,7 @@
'\"
'\" 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.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -29,5 +30,12 @@ elements in the list, then the new elements are appended to the list.
\fBend\-\fIinteger\fR refers to the last element in the list minus the
specified integer offset.
+
+.SH "SEE ALSO"
+.VS 8.4
+list(n), lappend(n), lindex(n), llength(n), lsearch(n),
+lset(n), lsort(n), lrange(n), lreplace(n)
+.VE
+
.SH KEYWORDS
element, insert, list
diff --git a/tcl/doc/list.n b/tcl/doc/list.n
index 92a25cc640e..d3e0b2c9181 100644
--- a/tcl/doc/list.n
+++ b/tcl/doc/list.n
@@ -1,6 +1,7 @@
'\"
'\" 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.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -21,7 +22,7 @@ list \- Create a list
.PP
This command returns a list comprised of all the \fIarg\fRs,
or an empty string if no \fIarg\fRs are specified.
-Braces and backslashes get added as necessary, so that the \fBindex\fR command
+Braces and backslashes get added as necessary, so that the \fBlindex\fR command
may be used on the result to re-extract the original arguments, and also
so that \fBeval\fR may be used to execute the resulting list, with
\fIarg1\fR comprising the command's name and the other \fIarg\fRs comprising
@@ -41,5 +42,13 @@ while \fBconcat\fR with the same arguments will return
\fBa b c d e f {g h}\fR
.CE
+.SH "SEE ALSO"
+lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
+.VS 8.4
+lset(n),
+.VE
+lsort(n),
+lrange(n), lreplace(n)
+
.SH KEYWORDS
element, list
diff --git a/tcl/doc/llength.n b/tcl/doc/llength.n
index e581d1036e6..559dbb02c9f 100644
--- a/tcl/doc/llength.n
+++ b/tcl/doc/llength.n
@@ -1,6 +1,7 @@
'\"
'\" 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.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -22,5 +23,11 @@ llength \- Count the number of elements in a list
Treats \fIlist\fR as a list and returns a decimal string giving
the number of elements in it.
+.SH "SEE ALSO"
+.VS 8.4
+list(n), lappend(n), lindex(n), linsert(n), lsearch(n),
+lset(n), lsort(n), lrange(n), lreplace(n)
+.VE
+
.SH KEYWORDS
element, list, length
diff --git a/tcl/doc/load.n b/tcl/doc/load.n
index e57e54c3aa1..a0809e8b957 100644
--- a/tcl/doc/load.n
+++ b/tcl/doc/load.n
@@ -129,8 +129,7 @@ behavior of this varies from system to system (some systems may
detect the redundant loads, others may not).
.SH "SEE ALSO"
-\fBinfo sharedlibextension\fR, Tcl_StaticPackage, safe(n)
+info sharedlibextension, Tcl_StaticPackage(3), safe(n)
.SH KEYWORDS
binary code, loading, safe interpreter, shared library
-
diff --git a/tcl/doc/lrange.n b/tcl/doc/lrange.n
index 719ca29a359..2a379e270f4 100644
--- a/tcl/doc/lrange.n
+++ b/tcl/doc/lrange.n
@@ -1,6 +1,7 @@
'\"
'\" 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.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -35,5 +36,11 @@ 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''
+.SH "SEE ALSO"
+.VS 8.4
+list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
+lset(n), lreplace(n), lsort(n)
+.VE
+
.SH KEYWORDS
element, list, range, sublist
diff --git a/tcl/doc/lreplace.n b/tcl/doc/lreplace.n
index 3f357e92d7c..0eef9120de5 100644
--- a/tcl/doc/lreplace.n
+++ b/tcl/doc/lreplace.n
@@ -1,6 +1,7 @@
'\"
'\" 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.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -43,5 +44,11 @@ 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 "SEE ALSO"
+.VS 8.4
+list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
+lset(n), lrange(n), lsort(n)
+.VE
+
.SH KEYWORDS
element, list, replace
diff --git a/tcl/doc/lsearch.n b/tcl/doc/lsearch.n
index b44cc142877..2ac41bd11ba 100644
--- a/tcl/doc/lsearch.n
+++ b/tcl/doc/lsearch.n
@@ -1,6 +1,7 @@
'\"
'\" 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.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -8,25 +9,45 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH lsearch n 7.0 Tcl "Tcl Built-In Commands"
+.TH lsearch n 8.4 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
lsearch \- See if a list contains a particular element
.SH SYNOPSIS
-\fBlsearch \fR?\fImode\fR? \fIlist pattern\fR
+\fBlsearch \fR?\fIoptions\fR? \fIlist pattern\fR
.BE
.SH DESCRIPTION
.PP
This command searches the elements of \fIlist\fR to see if one
-of them matches \fIpattern\fR.
-If so, the command returns the index of the first matching
-element.
-If not, the command returns \fB\-1\fR.
-The \fImode\fR argument indicates how the elements of the list are to
-be matched against \fIpattern\fR and it must have one of the following
-values:
+of them matches \fIpattern\fR. If so, the command returns the index
+of the first matching element
+.VS 8.4
+(unless the options \fB\-all\fR or \fB\-inline\fR are specified.)
+.VE 8.4
+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 it must have one of the following values:
+.TP
+\fB\-all\fR
+.VS 8.4
+Changes the result to be the list of all matching indices (or all
+matching values if \fB\-inline\fR is specified as well.)
+.VE 8.4
+.TP
+\fB\-ascii\fR
+The list elements are to be examined as ASCII strings. This option is only
+meaningful when used with \fB\-exact\fR or \fB\-sorted\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\-dictionary\fR
+The list elements are to be compared using dictionary-style
+comparisons. This option is only meaningful when used with
+\fB\-exact\fR or \fB\-sorted\fR.
.TP
\fB\-exact\fR
The list element must contain exactly the same string as \fIpattern\fR.
@@ -35,12 +56,79 @@ The list element must contain exactly the same string as \fIpattern\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\-increasing\fR
+The list elements are sorted in increasing order. This option is only
+meaningful when used with \fB\-sorted\fR.
+.TP
+\fB\-inline\fR
+.VS 8.4
+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.
+.VE 8.4
+.TP
+\fB\-integer\fR
+The list elements are to be compared as integers. This option is only
+meaningful when used with \fB\-exact\fR or \fB\-sorted\fR.
+.TP
+\fB\-not\fR
+.VS 8.4
+This negates the sense of the match, returning the index of the first
+non-matching value in the list.
+.VE 8.4
+.TP
+\fB\-real\fR
+The list elements are to be compared as floating-point values. This
+option is only meaningful when used with \fB\-exact\fR or \fB\-sorted\fR.
+.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 cannot be used with \fB\-all\fR, \fB\-glob\fR, \fB\-not\fR or
+\fB\-regexp\fR.
+.TP
+\fB\-start\fR \fIindex\fR
+.VS 8.4
+The list is searched starting at position \fIindex\fR. If \fIindex\fR
+has the value \fBend\fR, it refers to the last element in the list,
+and \fBend\-\fIinteger\fR refers to the last element in the list minus
+the specified integer offset.
+.VE 8.4
.PP
-If \fImode\fR is omitted then it defaults to \fB\-glob\fR.
+If \fIoption\fR is omitted then it defaults to \fB\-glob\fR. If more
+than one of \fB\-exact\fR, \fB\-glob\fR, \fB\-regexp\fR, and
+\fB\-sorted\fR is specified, whichever option is specified last takes
+precedence. If more than one of \fB\-ascii\fR, \fB\-dictionary\fR,
+\fB\-integer\fR and \fB\-real\fR is specified, the option specified
+last takes precedence. If more than one of \fB\-increasing\fR and
+\fB\-decreasing\fR is specified, the option specified last takes
+precedence.
+
+.VS 8.4
+.SH EXAMPLES
+.CS
+lsearch {a b c d e} c => 2
+lsearch -all {a b c a b c} c => 2 5
+lsearch -inline {a20 b35 c47} b* => b35
+lsearch -inline -not {a20 b35 c47} b* => a20
+lsearch -all -inline -not {a20 b35 c47} b* => a20 c47
+lsearch -all -not {a20 b35 c47} b* => 0 2
+lsearch -start 3 {a b c a b c} c => 5
+.CE
+.VE 8.4
+
+.SH "SEE ALSO"
+.VS 8.4
+foreach(n), list(n), lappend(n), lindex(n), linsert(n), llength(n),
+lset(n), lsort(n), lrange(n), lreplace(n)
+.VE
.SH KEYWORDS
list, match, pattern, regular expression, search, string
diff --git a/tcl/doc/lset.n b/tcl/doc/lset.n
new file mode 100644
index 00000000000..c16d2b06531
--- /dev/null
+++ b/tcl/doc/lset.n
@@ -0,0 +1,110 @@
+'\"
+'\" 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$
+'\"
+.so man.macros
+.TH lset n 8.4 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+lset \- Change an element in a list
+.SH SYNOPSIS
+\fBlset \fIlist ?index...? newValue\fR
+.BE
+.SH DESCRIPTION
+.PP
+The \fBlset\fP command accepts a parameter, \fIlist\fP, which
+it interprets as the name of a variable containing a Tcl list.
+It also accepts zero or more \fIindices\fP 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.
+Finally, it accepts a new value for an element of \fIlist\fP.
+.PP
+If no indices are presented, the command takes the form:
+.CS
+lset list newValue
+.CE
+or
+.CS
+lset list {} newValue
+.CE
+In this case, \fInewValue\fP replaces the old value of the variable \fIlist\fP.
+.PP
+When presented with a single index, the \fBlset\fR command
+treats the content of the \fIlist\fR variable as a Tcl list.
+It addresses the \fIindex\fR'th element in it
+(0 refers to the first element of the list).
+When interpreting the list, \fBlset\fR observes the same rules
+concerning braces and quotes and backslashes as the Tcl command
+interpreter; however, variable
+substitution and command substitution do not occur.
+The command constructs a new list in which the designated element is
+replaced with \fInewValue\fP. This new list is stored in the
+variable \fIlist\fP, and is also the return value from the \fBlset\fP
+command.
+.PP
+If \fIindex\fR is negative or greater than or equal to the number
+of elements in \fI$list\fR, then an error occurs.
+.PP
+If \fIindex\fR has the value \fBend\fR, it refers to the last element
+in the list, and \fBend\-\fIinteger\fR refers to the last element in
+the list minus the specified integer offset.
+.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,
+.CS
+lset a 1 2 newValue
+.CE
+or
+.CS
+lset a {1 2} newValue
+.CE
+replaces element 2 of sublist 1 with \fInewValue\fP.
+.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.
+.SH EXAMPLES
+In each of these examples, the initial value of \fIx\fP is:
+.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}
+.CE
+The indicated return value also becomes the new value of \fIx\fP.
+.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 {d e f}
+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
+.CE
+In the following examples, the initial value of \fIx\fP is:
+.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}}
+.CE
+The indicated return value also becomes the new value of \fIx\fP.
+.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}}
+.CE
+.SH "SEE ALSO"
+list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
+lsort(n), lrange(n), lreplace(n)
+
+.SH KEYWORDS
+element, index, list, replace, set
diff --git a/tcl/doc/lsort.n b/tcl/doc/lsort.n
index 6f609384db5..c6a8d916d46 100644
--- a/tcl/doc/lsort.n
+++ b/tcl/doc/lsort.n
@@ -2,6 +2,7 @@
'\" 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.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -65,19 +66,33 @@ Sort the list in decreasing order (``largest'' items first).
.TP 20
\fB\-index\0\fIindex\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 \fIindex\fR'th element from each sublist
-and sort based on the given element. The keyword \fBend\fP is allowed
-for the \fIindex\fP to sort on the last sublist element. For example,
+itself be a proper Tcl sublist. Instead of sorting based on whole
+sublists, \fBlsort\fR will extract the \fIindex\fR'th element from
+each sublist and sort based on the given element. The keyword
+\fBend\fP is allowed for the \fIindex\fP to sort on the last sublist
+element,
+.VS 8.4
+and \fBend-\fIindex\fR sorts on a sublist element offset from
+the end.
+.VE
+For example,
.RS
.CS
lsort -integer -index 1 {{First 24} {Second 18} {Third 30}}
.CE
-returns \fB{Second 18} {First 24} {Third 30}\fR.
+returns \fB{Second 18} {First 24} {Third 30}\fR, and
+.VS 8.4
+'\"
+'\" 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}}
+.CE
+returns \fB{c 4 5 6 d h} {a 1 e i} {b 2 3 f g}\fR.
+.VE
This option is much more efficient than using \fB\-command\fR
to achieve the same effect.
.RE
-.VS 8.3
.TP 20
\fB\-unique\fR
If this option is specified, then only the last set of duplicate
@@ -86,6 +101,93 @@ 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
considered duplicates and only the second element, \fB{1 b}\fR, would
be retained.
+
+.SH "NOTES"
+.PP
+The options to \fBlsort\fR only control what sort of comparison is
+used, and do not necessarily constrain what the values themselves
+actually are. This distinction is only noticeable when the list to be
+sorted has fewer than two elements.
+.PP
+The \fBlsort\fR command is reentrant, meaning it is safe to use as
+part of the implementation of a command used in the \fB\-command\fR
+option.
+
+.SH "EXAMPLES"
+
+.PP
+Sorting a list using ASCII sorting:
+.CS
+% lsort {a10 B2 b1 a1 a2}
+B2 a1 a10 a2 b1
+.CE
+
+.PP
+Sorting a list using Dictionary sorting:
+.CS
+% lsort -dictionary {a10 B2 b1 a1 a2}
+a1 a2 a10 b1 B2
+.CE
+
+.PP
+Sorting lists of integers:
+.CS
+% lsort -integer {5 3 1 2 11 4}
+1 2 3 4 5 11
+% lsort -integer {1 2 0x5 7 0 4 -1}
+-1 0 1 2 4 0x5 7
+.CE
+
+.PP
+Sorting lists of floating-point numbers:
+.CS
+% lsort -real {5 3 1 2 11 4}
+1 2 3 4 5 11
+% lsort -real {.5 0.07e1 0.4 6e-1}
+0.4 .5 6e-1 0.07e1
+.CE
+
+.PP
+Sorting using indices:
+.CS
+% # Note the space character before the c
+% lsort {{a 5} { c 3} {b 4} {e 1} {d 2}}
+{ c 3} {a 5} {b 4} {d 2} {e 1}
+% lsort -index 0 {{a 5} { c 3} {b 4} {e 1} {d 2}}
+{a 5} {b 4} { c 3} {d 2} {e 1}
+% lsort -index 1 {{a 5} { c 3} {b 4} {e 1} {d 2}}
+{e 1} {d 2} { c 3} {b 4} {a 5}
+.CE
+
+.PP
+Stripping duplicate values using sorting:
+.CS
+% lsort -unique {a b c a b c a b c}
+a b c
+.CE
+
+.PP
+More complex sorting using a comparison function:
+.CS
+% proc compare {a b} {
+ set a0 [lindex $a 0]
+ set b0 [lindex $b 0]
+ if {$a0 < $b0} {
+ return -1
+ } elseif {$a0 > $b0} {
+ return 1
+ }
+ return [string compare [lindex $a 1] [lindex $b 1]]
+}
+% lsort -command compare \\
+ {{3 apple} {0x2 carrot} {1 dingo} {2 banana}}
+{1 dingo} {2 banana} {0x2 carrot} {3 apple}
+.CE
+
+.SH "SEE ALSO"
+.VS 8.4
+list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
+lset(n), lrange(n), lreplace(n)
.VE
.SH KEYWORDS
diff --git a/tcl/doc/man.macros b/tcl/doc/man.macros
index ae66ef928af..2f418cbae96 100644
--- a/tcl/doc/man.macros
+++ b/tcl/doc/man.macros
@@ -199,7 +199,7 @@
.SH "STANDARD OPTIONS"
.LP
.nf
-.ta 4c 8c 12c
+.ta 5.5c 11c
.ft B
..
'\" # SE - end of list of standard options
diff --git a/tcl/doc/memory.n b/tcl/doc/memory.n
index df412f34287..227c5bd2c11 100644
--- a/tcl/doc/memory.n
+++ b/tcl/doc/memory.n
@@ -19,15 +19,42 @@ The \fBmemory\fR command gives the Tcl developer control of Tcl's memory
debugging capabilities. The memory command has several suboptions, which are
described below. It is only available when Tcl has been compiled with
memory debugging enabled (when \fBTCL_MEM_DEBUG\fR is defined at
-compile time).
+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.
+If you are running Tcl under a C debugger, it should then enter the debugger
+command mode.
.TP
\fBmemory info\fR
-Produces a report containing the total allocations and frees since
+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
+Turn on or off the pre-initialization of all allocated memory
+with bogus bytes. Useful for detecting the use of uninitialized 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
+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
Turns memory tracing on or off. When memory tracing is on, every call
@@ -35,22 +62,12 @@ 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
.CS
ckalloc 40e478 98 tclProc.c 1406
.CE
Calls to \fBckfree\fR are traced in the same manner.
-.TP
-\fBmemory validate [on|off]\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
-allocated by \fBckalloc\fR. This has a large performance impact and
-should only be used when overwrite problems are strongly suspected.
-The advantage of enabling memory validation is that a guard zone
-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.
+.RE
.TP
\fBmemory trace_on_at_malloc\fR \fIcount\fR
Enable memory tracing after \fIcount\fR \fBckalloc\fR's have been performed.
@@ -63,20 +80,20 @@ 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 break_on_malloc\fR \fIcount\fR
-After the \fBcount\fR allocations have been performed, \fBckalloc\fR's
-output 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.
-If you are running Tcl under a C debugger, it should then enter the debugger
-command mode.
-.TP
-\fB memory display\fR \fIfile\fR
-Write a list of all currently allocated memory to the specified file.
+\fBmemory validate [on|off]\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
+allocated by \fBckalloc\fR. This has a large performance impact and
+should only be used when overwrite problems are strongly suspected.
+The advantage of enabling memory validation is that a guard zone
+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
-
-
diff --git a/tcl/doc/msgcat.n b/tcl/doc/msgcat.n
index 37c2a76fcd5..1c11f174450 100644
--- a/tcl/doc/msgcat.n
+++ b/tcl/doc/msgcat.n
@@ -7,13 +7,19 @@
'\" SCCS: @(#) msgcat.n
'\"
.so man.macros
-.TH "msgcat" n 8.1 Tcl "Tcl Built-In Commands"
+.TH "msgcat" n 1.3 msgcat "Tcl Bundled Packages"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
msgcat \- Tcl message catalog
.SH SYNOPSIS
-\fB::msgcat::mc \fIsrc-string\fR
+\fBpackage require Tcl 8.2\fR
+.sp
+\fBpackage require msgcat 1.3\fR
+.sp
+\fB::msgcat::mc \fIsrc-string\fR ?\fIarg arg ...\fR?
+.sp
+\fB::msgcat::mcmax ?\fIsrc-string src-string ...\fR?
.sp
\fB::msgcat::mclocale \fR?\fInewLocale\fR?
.sp
@@ -23,6 +29,8 @@ msgcat \- Tcl message catalog
.sp
\fB::msgcat::mcset \fIlocale src-string \fR?\fItranslate-string\fR?
.sp
+\fB::msgcat::mcmset \fIlocale src-trans-list\fR
+.sp
\fB::msgcat::mcunknown \fIlocale src-string\fR
.BE
@@ -58,38 +66,63 @@ returned from \fB::msgcat::mcunknown\fR is returned.
.PP
\fB::msgcat::mc\fR is the main function used to localize an
application. Instead of using an English string directly, an
-applicaton can pass the English string through \fB::msgcat::mc\fR and
+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.
.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?
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.
-The initial locale defaults to the locale specified in
-the user's environment. See \fBLOCALE AND SUBLOCALE SPECIFICATION\fR
+is set to \fInewLocale\fR. msgcat stores and compares the locale in a
+case-insensitive manner, and returns locales in lowercase.
+The initial locale is determined by the locale specified in
+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
-preference. If the user has specified LANG=en_US_funky,
-this procedure would return {en_US_funky en_US en}.
+preference. The list is derived from the current
+locale set in msgcat by \fBmsgcat::mclocale\fR, and
+cannot be set independently. For example, if the
+current locale is en_US_funky, then \fBmsgcat::mcpreferences\fR
+returns {en_US_funky en_US en}.
.TP
\fB::msgcat::mcload \fIdirname\fR
Searches the specified directory for files that match
-the language specifications returned by \fB::msgcat::mcpreferences\fR.
-Each file located is sourced. The file extension is ``.msg''.
-The number of message files which matched the specification
+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
+read in order, assuming a UTF-8 encoding. The file contents are
+then evaluated as a Tcl script. This means that non-Latin characters
+may be present in the message file either directly in their UTF-8
+encoded form, or by use of the backslash-u quoting recognized by Tcl
+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. If \fItranslate-string\fR is not
-specified, \fIsrc-string\fR is used for both. The function
-returns \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.
+\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?} \fBmsgcat::mcmset\fR can be significantly
+faster than multiple invocations of \fBmsgcat::mcset\fR. The function
+returns the number of translations set.
.TP
\fB::msgcat::mcunknown \fIlocale src-string\fR
This routine is called by \fB::msgcat::mc\fR in the case when
@@ -98,27 +131,43 @@ current locale. The default action is to return
\fIsrc-string\fR. 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 vaue
-of \fB::msgcat::mcunknown\fR is used as the return vaue for the call
+same stack context as the call to \fB::msgcat::mc\fR. The return value
+of \fB::msgcat::mcunknown\fR is used as the return value for the call
to \fB::msgcat::mc\fR.
-.SH "LOCALE AND SUBLOCALE SPECIFICATION"
+.SH "LOCALE SPECIFICATION"
.PP
-The locale is specified by a locale string.
+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
codes are specified in standards ISO-639 and ISO-3166.
-For example, the locale ``en'' specifies English and
- ``en_US'' specifes U.S. English.
+For example, the locale ``en'' specifies English and ``en_US'' specifies
+U.S. English.
.PP
-The locale defaults to the value in \fBenv(LANG)\fR at the time the
-\fBmsgcat\fR package is loaded. If \fBenv(LANG)\fR is not defined, then the
-locale defaults to ``C''.
+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
+.CS
+language[_country][.codeset][@modifier]
+.CE
+to extract its parts. The initial locale is then set by calling
+\fBmsgcat::mclocale\fR with the argument
+.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
-en_UK_Funky, the locales ``en_UK_Funky'', ``en_UK'', and ``en'' are
+en_GB_Funky, the locales ``en_GB_Funky'', ``en_GB'', and ``en'' are
searched in order until a matching translation string is found. If no
translation string is available, then \fB::msgcat::unknown\fR is
called.
@@ -151,7 +200,7 @@ 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.
.PP
-For example, executing the code
+For example, executing (in the ``en'' locale) the code
.CS
mcset en m1 ":: message1"
mcset en m2 ":: message2"
@@ -181,17 +230,22 @@ 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 locale specifier followed
-by ``.msg''. For example:
+The message file name is a msgcat locale specifier (all lowercase)
+followed by ``.msg''. For example:
.CS
es.msg -- spanish
-en_UK.msg -- UK English
+en_gb.msg -- United Kingdom English
.CE
.IP [3]
-The file contains a series of calls to mcset, setting the
-necessary translation strings for the language. For example:
+The file contains a series of calls to \fBmcset\fR and
+\fBmcmset\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:
.CS
-::msgcat::mcset es "Free Beer!" "Cerveza Gracias!"
+namespace eval ::mypackage {
+ ::msgcat::mcset es "Free Beer!" "Cerveza Gracias!"
+}
.CE
.SH "RECOMMENDED MESSAGE SETUP FOR PACKAGES"
@@ -212,7 +266,7 @@ initialization script:
::msgcat::mcload [file join [file dirname [info script]] msgs]
.CE
-.SH "POSTITIONAL CODES FOR FORMAT AND SCAN COMMANDS"
+.SH "POSITIONAL CODES FOR FORMAT AND SCAN COMMANDS"
.PP
It is possible that a message string used as an argument
to \fBformat\fR might have positionally dependent parameters that
@@ -240,5 +294,6 @@ 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
diff --git a/tcl/doc/namespace.n b/tcl/doc/namespace.n
index 85adcdadd76..bd4588f110a 100644
--- a/tcl/doc/namespace.n
+++ b/tcl/doc/namespace.n
@@ -1,6 +1,7 @@
'\"
'\" Copyright (c) 1993-1997 Bell Labs Innovations for Lucent Technologies
'\" Copyright (c) 1997 Sun Microsystems, Inc.
+'\" Copyright (c) 2000 Scriptics Corporation.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -59,7 +60,7 @@ Then \fBeval "$script 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
-\fBnamespace eval ::a::b {foo bar x y}\fR.
+\fB::namespace eval ::a::b {foo bar x y}\fR.
This command is needed because
extensions like Tk normally execute callback scripts
in the global namespace.
@@ -100,6 +101,10 @@ If \fInamespace\fR has leading namespace qualifiers
and any leading namespaces do not exist,
they are automatically created.
.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?
Specifies which commands are exported from a namespace.
The exported commands are those that can be later imported
@@ -122,16 +127,21 @@ 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 qualified name such as
-\fBfoo::x\fR or \fBa::b::p*\fR.
+Each \fIpattern\fR is a simple or qualified name such as
+\fBx\fR, \fBfoo::x\fR or \fBa::b::p*\fR.
Qualified names contain \fB::\fRs and qualify a name
with the name of one or more namespaces.
-Each \fIpattern\fR is qualified with the name of an exporting namespace
+Each \fIqualified pattern\fR 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.
-This command first finds the matching exported commands.
-It then checks whether any of those those commands
+For each \fIsimple pattern\fR 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.
+It then checks whether any of those commands
were previously imported by the current namespace.
If so, this command deletes the corresponding imported commands.
In effect, this un-does the action of a \fBnamespace import\fR command.
diff --git a/tcl/doc/open.n b/tcl/doc/open.n
index 833ae11ef30..82d565ed370 100644
--- a/tcl/doc/open.n
+++ b/tcl/doc/open.n
@@ -8,7 +8,7 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH open n 7.6 Tcl "Tcl Built-In Commands"
+.TH open n 8.3 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -24,9 +24,7 @@ open \- Open a file-based or command pipeline channel
.SH DESCRIPTION
.PP
-.VS
This command opens a file, serial port, or command pipeline and returns a
-.VE
channel identifier that may be used in future invocations of commands like
\fBread\fR, \fBputs\fR, and \fBclose\fR.
If the first character of \fIfileName\fR is not \fB|\fR then
@@ -108,6 +106,15 @@ 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.
+.PP
+Note that if you are going to be reading or writing binary data from
+the channel created by this command, you should use the
+\fBfconfigure\fR command to change the \fB-translation\fR option of
+the channel to \fBbinary\fR before transferring any binary data. This
+is in contrast to the ``b'' character passed as part of the equivalent
+of the \fIaccess\fR parameter to some versions of the C library
+\fIfopen()\fR function.
+
.SH "COMMAND PIPELINES"
.PP
If the first character of \fIfileName\fR is ``|'' then the
@@ -123,50 +130,22 @@ output unless overridden by the command.
If read-only access is used (e.g. \fIaccess\fR is \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
+command, using the channel id returned by \fBopen\fR as argument.
+
+.VS 8.4
.SH "SERIAL COMMUNICATIONS"
-.VS
.PP
If \fIfileName\fR refers to a serial port, then the specified serial port
is opened and initialized in a platform-dependent manner. Acceptable
values for the \fIfileName\fR to use to open a serial port are described in
the PORTABILITY ISSUES section.
-
-.SH "CONFIGURATION OPTIONS"
-The \fBfconfigure\fR command can be used to query and set the following
-configuration option for open serial ports:
-.TP
-\fB\-mode \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
-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\-pollinterval \fImsec\fR
-.
-This option, available only on Windows for serial ports, is used to
-set the maximum time between polling for fileevents. This affects the
-time interval between checking for events throughout the Tcl
-interpreter (the smallest value always wins). Use this option only if
-you want to poll the serial port more often than 10 msec (the default).
-.TP
-\fB\-lasterror\fR
-.
-This option is available only on Windows for serial ports, and is
-query only (will only be reported when directly requested).
-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 (e.g. FRAME RXOVER).
+.PP
+The \fBfconfigure\fR command can be used to query and set additional
+configuration options specific to serial ports.
.VE
-.VS
.SH "PORTABILITY ISSUES"
-.sp
.TP
\fBWindows \fR(all versions)
.
@@ -251,9 +230,11 @@ input, but is redirected from a file, then the above problem does not occur.
See the PORTABILITY ISSUES section of the \fBexec\fR command for additional
information not specific to command pipelines about executing
applications on the various platforms
+
.SH "SEE ALSO"
-close(n), filename(n), gets(n), read(n), puts(n), exec(n)
-.VE
+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
diff --git a/tcl/doc/package.n b/tcl/doc/package.n
index d0c7e61e9fe..e9f4ee4a3e6 100644
--- a/tcl/doc/package.n
+++ b/tcl/doc/package.n
@@ -114,12 +114,14 @@ 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.
-If so, the script for the highest acceptable version number is invoked;
+If so, the script for the highest acceptable version number is evaluated
+in the global namespace;
it must do whatever is necessary to load the package,
including calling \fBpackage provide\fR for the package.
If the \fBpackage ifneeded\fR database does not contain an acceptable
version of the package and a \fBpackage unknown\fR command has been
-specified for the interpreter then that command is invoked; when
+specified for the interpreter then that command is evaluated in the
+global namespace; when
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
@@ -189,6 +191,8 @@ Once you've done this, packages will be loaded automatically
in response to \fBpackage require\fR commands.
See the documentation for \fBpkg_mkIndex\fR for details.
+.SH "SEE ALSO"
+msgcat(n), packagens(n), pkgMkIndex(n)
+
.SH KEYWORDS
package, version
-
diff --git a/tcl/doc/packagens.n b/tcl/doc/packagens.n
index 3854b675adf..e0266683e43 100644
--- a/tcl/doc/packagens.n
+++ b/tcl/doc/packagens.n
@@ -46,8 +46,10 @@ 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 paramter must be given.
+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/tcl/doc/pid.n b/tcl/doc/pid.n
index 912e85c2e5c..23510d24ee8 100644
--- a/tcl/doc/pid.n
+++ b/tcl/doc/pid.n
@@ -30,5 +30,8 @@ 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.
+.SH "SEE ALSO"
+exec(n), open(n)
+
.SH KEYWORDS
file, pipeline, process identifier
diff --git a/tcl/doc/pkgMkIndex.n b/tcl/doc/pkgMkIndex.n
index 9980d108296..6622de2eba0 100644
--- a/tcl/doc/pkgMkIndex.n
+++ b/tcl/doc/pkgMkIndex.n
@@ -15,7 +15,7 @@ pkg_mkIndex \- Build an index for automatic loading of packages
.SH SYNOPSIS
.nf
.VS 8.3.0
-\fBpkg_mkIndex ?\fI\-lazy\fR? ?\fI\-load pkgPat\fR? ?\fI\-verbose\fR? \fIdir\fR ?\fIpattern pattern ...\fR?
+\fBpkg_mkIndex ?\fI\-direct\fR? ?\fI\-lazy\fR? ?\fI\-load pkgPat\fR? ?\fI\-verbose\fR? \fIdir\fR ?\fIpattern pattern ...\fR?
.VE
.fi
.BE
@@ -102,6 +102,10 @@ interpreters.
.SH OPTIONS
The optional switches are:
.TP 15
+\fB\-direct\fR
+The generated index will implement direct loading of the package
+upon \fBpackage require\fR. This is the default.
+.TP 15
\fB\-lazy\fR
The generated index will manage to delay loading the package until the
use of one of the commands provided by the package, instead of loading
@@ -201,7 +205,7 @@ 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 API's such as \fBTcl_PkgRequire\fP API
+C-level APIs such as \fBTcl_PkgRequire\fP 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.
@@ -232,5 +236,8 @@ If you must use \fB\-load\fP,
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
diff --git a/tcl/doc/proc.n b/tcl/doc/proc.n
index f7b3ac22e79..fd0e356d91e 100644
--- a/tcl/doc/proc.n
+++ b/tcl/doc/proc.n
@@ -70,5 +70,8 @@ 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 "SEE ALSO"
+info(n), unknown(n)
+
.SH KEYWORDS
argument, procedure
diff --git a/tcl/doc/puts.n b/tcl/doc/puts.n
index 88e3a42dc0d..e5ab57d7c65 100644
--- a/tcl/doc/puts.n
+++ b/tcl/doc/puts.n
@@ -21,9 +21,16 @@ puts \- Write to a channel
.PP
Writes the characters given by \fIstring\fR to the channel given
by \fIchannelId\fR.
-\fIChannelId\fR must be a channel identifier such as returned from a
-previous invocation of \fBopen\fR or \fBsocket\fR. It must have been opened
-for output. If no \fIchannelId\fR is specified then it defaults to
+.PP
+.VS
+\fIChannelId\fR must be an identifier for an open channel such as a
+Tcl standard channel (\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. The channel
+must have been opened for output.
+.VE
+.PP
+If no \fIchannelId\fR is specified then it defaults to
\fBstdout\fR. \fBPuts\fR normally outputs a newline character after
\fIstring\fR, but this feature may be suppressed by specifying the
\fB\-nonewline\fR switch.
@@ -63,7 +70,7 @@ be used in an event-driven fashion with the \fBfileevent\fR command
via a file event that the channel is ready for more output data).
.SH "SEE ALSO"
-fileevent(n)
+file(n), fileevent(n), Tcl_StandardChannels(3)
.SH KEYWORDS
channel, newline, output, write
diff --git a/tcl/doc/pwd.n b/tcl/doc/pwd.n
index 892324191e0..17b50e618be 100644
--- a/tcl/doc/pwd.n
+++ b/tcl/doc/pwd.n
@@ -21,5 +21,8 @@ pwd \- Return the current working directory
.PP
Returns the path name of the current working directory.
+.SH "SEE ALSO"
+file(n), cd(n), glob(n), filename(n)
+
.SH KEYWORDS
working directory
diff --git a/tcl/doc/read.n b/tcl/doc/read.n
index 113c9c61626..0595ce0af4d 100644
--- a/tcl/doc/read.n
+++ b/tcl/doc/read.n
@@ -22,16 +22,23 @@ read \- Read from a channel
.SH DESCRIPTION
.PP
In the first form, the \fBread\fR command reads all of the data from
-\fIchannelId\fR up to the end of the file.
-If the \fB\-nonewline\fR switch is specified then the last character
-of the file is discarded if it is a newline.
-.VS 8.1
-In the second form, the extra argument specifies how many characters to
-read. Exactly that many characters will be read and returned, unless
-there are fewer than \fInumChars\fR left in the file; in this case
-all the remaining characters are returned. If the channel is
-configured to use a multi-byte encoding, then the number of characters
-read may not be the same as the number of bytes read.
+\fIchannelId\fR up to the end of the file. If the \fB\-nonewline\fR
+switch is specified then the last character of the file is discarded
+if it is a newline. In the second form, the extra argument specifies
+how many characters to read. Exactly that many characters will be
+read and returned, unless there are fewer than \fInumChars\fR left in
+the file; in this case all the remaining characters are returned. If
+the channel is configured to use a multi-byte encoding, then the
+number of characters read may not be the same as the number of bytes
+read.
+.PP
+.VS
+\fIChannelId\fR must be an identifier for an open channel such as the
+Tcl standard input channel (\fBstdin\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. The channel must have
+been opened for input.
+.VE
.PP
If \fIchannelId\fR is in nonblocking mode, the command may not read as
many characters as requested: once all available input has been read,
@@ -40,10 +47,8 @@ blocking for more input. If the channel is configured to use a
multi-byte encoding, then there may actually be some bytes remaining
in the internal buffers that do not form a complete character. These
bytes will not be returned until a complete character is available or
-end-of-file is reached.
-.VE 8.1
-The \fB\-nonewline\fR switch is ignored if the command returns
-before reaching the end of the file.
+end-of-file is reached. The \fB\-nonewline\fR switch is ignored if
+the command returns before reaching the end of the file.
.PP
\fBRead\fR translates end-of-line sequences in the input into
newline characters according to the \fB\-translation\fR option
@@ -51,8 +56,27 @@ 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
+
+For most applications a channel connected to a serial port should be
+configured to be nonblocking: \fBfconfigure \fIchannelId \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 has been configured for the channel, then \fBread\fR will
+block forever.
+
+
.SH "SEE ALSO"
-eof(n), fblocked(n), fconfigure(n)
+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
diff --git a/tcl/doc/regexp.n b/tcl/doc/regexp.n
index 6e598903ff6..4777e1f385f 100644
--- a/tcl/doc/regexp.n
+++ b/tcl/doc/regexp.n
@@ -49,7 +49,7 @@ expression. This switch is primarily intended for debugging purposes.
\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 METASYNTAX, below).
+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.
@@ -67,17 +67,18 @@ matches an empty string after any newline in addition to its normal
function, and `$' 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 METASYNTAX, below).
+\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
stop at newlines. This is the same as specifying the \fB(?p)\fR
-embedded option (see METASYNTAX, below).
+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
beginning and end of a line respectively. This is the same as
-specifying the \fB(?w)\fR embedded option (see METASYNTAX, below).
+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
@@ -127,8 +128,7 @@ portion of the expression that wasn't matched), then the corresponding
has been specified or to an empty string otherwise.
.SH "SEE ALSO"
-re_syntax(n)
+re_syntax(n), regsub(n)
.SH KEYWORDS
match, regular expression, string
-
diff --git a/tcl/doc/registry.n b/tcl/doc/registry.n
index d205f606ccf..702ac816a8a 100644
--- a/tcl/doc/registry.n
+++ b/tcl/doc/registry.n
@@ -7,7 +7,7 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH registry n 8.0 Tcl "Tcl Built-In Commands"
+.TH registry n 1.0 registry "Tcl Bundled Packages"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -55,7 +55,7 @@ are:
If the optional \fIvalueName\fR argument is present, the specified
value under \fIkeyName\fR will be deleted from the registry. If the
optional \fIvalueName\fR is omitted, the specified key and any subkeys
-or values beneath it in the registry heirarchy will be deleted. If
+or values beneath it in the registry hierarchy will be deleted. If
the key could not be deleted then an error is generated. If the key
did not exist, the command has no effect.
.TP
diff --git a/tcl/doc/regsub.n b/tcl/doc/regsub.n
index 0e0f60b69ed..8ec98feb1bf 100644
--- a/tcl/doc/regsub.n
+++ b/tcl/doc/regsub.n
@@ -15,18 +15,26 @@
.SH NAME
regsub \- Perform substitutions based on regular expression pattern matching
.SH SYNOPSIS
-\fBregsub \fR?\fIswitches\fR? \fIexp string subSpec varName\fR
+.VS 8.4
+\fBregsub \fR?\fIswitches\fR? \fIexp string subSpec \fR?\fIvarName\fR?
+.VE 8.4
.BE
.SH DESCRIPTION
.PP
This command matches the regular expression \fIexp\fR against
\fIstring\fR,
-and it copies \fIstring\fR to the variable whose name is
-given by \fIvarName\fR.
+.VS 8.4
+and either copies \fIstring\fR to the variable whose name is
+given by \fIvarName\fR or returns \fIstring\fR if \fIvarName\fR is not
+present.
+.VE 8.4
(Regular expression matching is described in the \fBre_syntax\fR
reference page.)
If there is a match, then while copying \fIstring\fR to \fIvarName\fR
+.VS 8.4
+(or to the result of this command if \fIvarName\fR is not present)
+.VE 8.4
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
@@ -60,7 +68,7 @@ from the corresponding match.
\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 METASYNTAX, below).
+the \fB(?x)\fR embedded option (see the \fBre_syntax\fR manual page).
.TP 15
\fB\-line\fR
Enables newline-sensitive matching. By default, newline is a
@@ -70,23 +78,23 @@ matches an empty string after any newline in addition to its normal
function, and `$' 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 METASYNTAX, below).
+\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
stop at newlines. This is the same as specifying the \fB(?p)\fR
-embedded option (see METASYNTAX, below).
+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
beginning and end of a line respectively. This is the same as
-specifying the \fB(?w)\fR embedded option (see METASYNTAX, below).
+specifying the \fB(?w)\fR embedded option (see the \fBre_syntax\fR
+manual page).
.TP 10
\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.
-.VS 8.3
.TP 10
\fB\-start\fR \fIindex\fR
Specifies a character index offset into the string to start
@@ -94,17 +102,21 @@ matching the regular expression at. When using this switch, `^'
will not match the beginning of the line, and \\A will still
match the start of the string at \fIindex\fR.
\fIindex\fR will be constrained to the bounds of the input string.
-.VE 8.3
.TP 10
\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
-The command returns a count of the number of matching ranges that
-were found and replaced.
+.VS 8.4
+If \fIvarName\fR is supplied, the command returns a count of the
+number of matching ranges that were found and replaced, otherwise the
+string after replacement is returned.
+.VE 8.4
See the manual entry for \fBregexp\fR for details on the interpretation
of regular expressions.
+.SH "SEE ALSO"
+regexp(n), re_syntax(n)
+
.SH KEYWORDS
match, pattern, regular expression, substitute
-
diff --git a/tcl/doc/rename.n b/tcl/doc/rename.n
index 9ff53cf37cc..e16ea24e04a 100644
--- a/tcl/doc/rename.n
+++ b/tcl/doc/rename.n
@@ -28,5 +28,8 @@ 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 "SEE ALSO"
+namespace(n), proc(n)
+
.SH KEYWORDS
command, delete, namespace, rename
diff --git a/tcl/doc/resource.n b/tcl/doc/resource.n
index 3a1748bd0e8..38f94d712fc 100644
--- a/tcl/doc/resource.n
+++ b/tcl/doc/resource.n
@@ -121,7 +121,7 @@ name.
\fB\-file\fR \fIresourceRef\fR
If the \fB-file\fR option is specified then the resource will be
written in the file pointed to by \fIresourceRef\fR, otherwise the
-most resently open resource will be used.
+most recently open resource will be used.
.TP
\fB\-force\fR
If the target resource already exists, then by default Tcl will not
@@ -149,7 +149,7 @@ numbers if the name is NULL.
The resource command is only available on Macintosh.
.SH "SEE ALSO"
-open
+open(n)
.SH KEYWORDS
open, resource
diff --git a/tcl/doc/return.n b/tcl/doc/return.n
index bba4854237b..f1b204861dd 100644
--- a/tcl/doc/return.n
+++ b/tcl/doc/return.n
@@ -85,5 +85,8 @@ a value for the \fBerrorCode\fR variable.
If the option is not specified then \fBerrorCode\fR will
default to \fBNONE\fR.
+.SH "SEE ALSO"
+break(n), continue(n), error(n), proc(n)
+
.SH KEYWORDS
break, continue, error, procedure, return
diff --git a/tcl/doc/safe.n b/tcl/doc/safe.n
index 08f32a5a810..4a3025dc82e 100644
--- a/tcl/doc/safe.n
+++ b/tcl/doc/safe.n
@@ -246,7 +246,7 @@ subcommands. For more details on what these subcommands do see the manual
page for the \fBfile\fR command.
.TP
\fBencoding\fR ?\fIsubCmd args...\fR?
-The \fBenconding\fR alias provides access to a safe subset of the
+The \fBencoding\fR alias provides access to a safe subset of the
subcommands of the \fBencoding\fR command; it disallows setting of
the system encoding, but allows all other subcommands including
\fBsystem\fR to check the current encoding.
diff --git a/tcl/doc/scan.n b/tcl/doc/scan.n
index 55628609cdd..7ecef394078 100644
--- a/tcl/doc/scan.n
+++ b/tcl/doc/scan.n
@@ -9,7 +9,7 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH scan n 8.3 Tcl "Tcl Built-In Commands"
+.TH scan n 8.4 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -28,13 +28,11 @@ 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.
-.VS 8.3
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
the end of the input string is reached before any conversions have been
performed.
-.VE 8.3
.SH "DETAILS ON SCANNING"
.PP
@@ -46,12 +44,13 @@ Otherwise, if it isn't 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.
+.VS 8.4
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
-.VS 8.1
instead of assigned to a variable; a XPG3 position specifier; a number
-.VE 8.1
-indicating a maximum field width; and a conversion character.
+indicating a maximum field width; a field size modifier; and a
+conversion character.
+.VE 8.4
All of these fields are optional except for the conversion character.
The fields that are present must appear in the order given above.
.PP
@@ -61,7 +60,6 @@ specifier 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.
-.VS 8.1
.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
@@ -72,32 +70,62 @@ 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.
-.VE 8.1
.PP
The following conversion characters are supported:
.TP 10
\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.
+.VS 8.4
+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.
+.VE 8.4
.TP 10
\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.
+.VS 8.4
+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.
+.VE 8.4
.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.
-.VS 8.1
+.VS 8.4
+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.
+.VE 8.4
.TP 10
\fBu\fR
The input field must be a decimal integer. The value is stored in the
variable as an unsigned decimal integer string.
+.VS 8.4
+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.
+.VE 8.4
.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.
-.VE 8.1
+.VS 8.4
+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.
+.VE 8.4
.TP 10
\fBc\fR
A single character is read in and its binary value is stored in
@@ -127,13 +155,11 @@ 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
bracket for the set.
-.VS 8.1
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.
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.
-.VE 8.1
.TP 10
\fB[^\fIchars\fB]\fR
The input field consists of any number of characters not in
@@ -142,7 +168,6 @@ 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
the set.
-.VS 8.1
If \fIchars\fR
contains a sequence of the form \fIa\fB\-\fIb\fR then any
character between \fIa\fR and \fIb\fR (inclusive) will be excluded
@@ -152,8 +177,7 @@ it is treated as part of \fIchars\fR rather than indicating a range.
.TP 10
\fBn\fR
No input is consumed from the input string. Instead, the total number
-of chacters scanned from the input string so far is stored in the variable.
-.VE 8.1
+of characters scanned from the input string so far is stored in the variable.
.LP
The number of characters read from the input for a conversion is the
largest number that makes sense for that particular conversion (e.g.
@@ -169,27 +193,25 @@ then no variable is assigned and the next scan argument is not consumed.
.PP
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:
-.VS 8.1
.IP [1]
\fB%p\fR conversion specifier is not currently supported.
-.VE 8.1
.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.
.IP [3]
-The \fBl\fR, \fBh\fR, and \fBL\fR modifiers are ignored; integer
-values are always converted as if there were no modifier present
-and real values are always converted as if the \fBl\fR modifier
-were present (i.e. type \fBdouble\fR is used for the internal
-representation).
-.VS 8.3
+.VS 8.4
+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).
+.VE 8.4
.IP [4]
If the end of the input string is reached before any conversions have been
-performed and no variables are given, and empty string is returned.
-.VE 8.3
+performed and no variables are given, an empty string is returned.
+
+.SH "SEE ALSO"
+format(n), sscanf(3)
.SH KEYWORDS
conversion specifier, parse, scan
-
diff --git a/tcl/doc/seek.n b/tcl/doc/seek.n
index 7c3bb818ae7..7b156db5242 100644
--- a/tcl/doc/seek.n
+++ b/tcl/doc/seek.n
@@ -20,8 +20,14 @@ seek \- Change the access position for an open channel
.SH DESCRIPTION
.PP
Changes the current access position for \fIchannelId\fR.
-\fIChannelId\fR must be a channel identifier such as returned from a
-previous invocation of \fBopen\fR or \fBsocket\fR.
+.PP
+.VS
+\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.
+.VE
+.PP
The \fIoffset\fR and \fIorigin\fR
arguments specify the position at which the next read or write will occur
for \fIchannelId\fR. \fIOffset\fR must be an integer (which may be
@@ -57,5 +63,8 @@ offsets. Both \fBseek\fR and \fBtell\fR operate in terms of bytes,
not characters, unlike \fBread\fR.
.VE 8.1
+.SH "SEE ALSO"
+file(n), open(n), close(n), gets(n), tell(n), Tcl_StandardChannels(3)
+
.SH KEYWORDS
access position, file, seek
diff --git a/tcl/doc/set.n b/tcl/doc/set.n
index 78c5b3bcb64..a0fc0112dbc 100644
--- a/tcl/doc/set.n
+++ b/tcl/doc/set.n
@@ -44,5 +44,8 @@ was invoked to declare \fIvarName\fR to be global,
or unless a \fBvariable\fR command
was invoked to declare \fIvarName\fR to be a namespace variable.
+.SH "SEE ALSO"
+expr(n), proc(n), trace(n), unset(n)
+
.SH KEYWORDS
read, write, variable
diff --git a/tcl/doc/socket.n b/tcl/doc/socket.n
index 7a7486722e5..cc7afcbbf2d 100644
--- a/tcl/doc/socket.n
+++ b/tcl/doc/socket.n
@@ -100,18 +100,22 @@ new connections are opened. If the application doesn't 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.
+.PP
+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 my be retrieved from the created server socket using the
+\fBfconfigure\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
configuration options for socket channels:
-.VS 8.0.5
.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.
-.VE 8.0.5
.TP
\fB\-sockname\fR
This option returns a list of three elements, the address, the host name
diff --git a/tcl/doc/source.n b/tcl/doc/source.n
index ba6449645d2..f59cfae962a 100644
--- a/tcl/doc/source.n
+++ b/tcl/doc/source.n
@@ -1,6 +1,7 @@
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" Copyright (c) 2000 Scriptics Corporation.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -31,7 +32,17 @@ of the script then the \fBsource\fR command will return that error.
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
+.VS 8.4
+The end-of-file character for files is '\\32' (^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''.
+.VE 8.4
+.PP
The \fI\-rsrc\fR and \fI\-rsrcid\fR forms of this command are only
available on Macintosh computers. These versions of the command
allow you to source a script from a \fBTEXT\fR resource. You may specify
@@ -40,5 +51,8 @@ searches all open resource files, which include the current
application and any loaded C extensions. Alternatively, you may
specify the \fIfileName\fR where the \fBTEXT\fR resource can be found.
+.SH "SEE ALSO"
+file(n), cd(n)
+
.SH KEYWORDS
file, script
diff --git a/tcl/doc/split.n b/tcl/doc/split.n
index 4bea7897dc0..deb08a67ad0 100644
--- a/tcl/doc/split.n
+++ b/tcl/doc/split.n
@@ -40,5 +40,8 @@ returns \fB"comp unix misc"\fR and
.CE
returns \fB"H e l l o { } w o r l d"\fR.
+.SH "SEE ALSO"
+join(n), list(n), string(n)
+
.SH KEYWORDS
list, split, string
diff --git a/tcl/doc/string.n b/tcl/doc/string.n
index 2aaec95474b..bc6b9d99aca 100644
--- a/tcl/doc/string.n
+++ b/tcl/doc/string.n
@@ -21,7 +21,6 @@ string \- Manipulate strings
.PP
Performs one of several string operations, depending on \fIoption\fR.
The legal \fIoption\fRs (which may be abbreviated) are:
-.VS 8.1
.TP
\fBstring bytelength \fIstring\fR
Returns a decimal string giving the number of bytes used to represent
@@ -29,40 +28,35 @@ Returns a decimal string giving the number of bytes used to represent
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. Refer to the \fBTcl_NumUtfChars\fR
-manual entry for more details on the UTF\-8 representation.
+\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
-.VE 8.1
-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 than \fIstring2\fR.
-.VS 8.1
-If \fB\-length\fR is specified, then only 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.
+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
+than \fIstring2\fR. If \fB\-length\fR is specified, then only 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 equal\fR ?\fB\-nocase\fR? ?\fB-length int\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 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.
+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
+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?
-.VE 8.1
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
-found, return \-1.
-.VS 8.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 the index. For example,
+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
+the index. For example,
.RS
.CS
\fBstring first a 0a23456789abcdef 5\fR
@@ -73,29 +67,22 @@ will return \fB10\fR, but
.CE
will return \fB\-1\fR.
.RE
-.VE 8.1
.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.
-.VS 8.1
-\fIcharIndex\fR may be specified as
-follows:
+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:
.RS
.IP \fIinteger\fR 10
-The char specified at this integral index
+The char specified at this integral index.
.IP \fBend\fR 10
The last char of the string.
.IP \fBend\-\fIinteger\fR 10
-The last char of the string minus the specified integer
-offset (e.g. \fBend\-1\fR would refer to the "c" in "abcd").
+The last char of the string minus the specified integer offset
+(e.g. \fBend\-1\fR would refer to the "c" in "abcd").
.PP
-.VE 8.1
-If \fIcharIndex\fR is less than 0 or greater than
-or equal to the length of the string then an empty string is
-returned.
-.VS 8.1
+If \fIcharIndex\fR is less than 0 or greater than or equal to the
+length of the string then an empty string is returned.
.RE
.TP
\fBstring is \fIclass\fR ?\fB\-strict\fR? ?\fB\-failindex \fIvarname\fR? \fIstring\fR
@@ -105,16 +92,16 @@ empty string returns 0, otherwise and 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 classes
-are recognized (the class name can be abbreviated):
+will not be set if the function returns 1. The following character
+classes are recognized (the class name can be abbreviated):
.RS
.IP \fBalnum\fR 10
Any Unicode alphabet or digit character.
.IP \fBalpha\fR 10
Any Unicode alphabet character.
.IP \fBascii\fR 10
-Any character with a value less than \\u0080 (those that
-are in the 7\-bit ascii range).
+Any character with a value less than \\u0080 (those that are in the
+7\-bit ascii range).
.IP \fBboolean\fR 10
Any of the forms allowed to \fBTcl_GetBoolean\fR.
.IP \fBcontrol\fR 10
@@ -124,16 +111,17 @@ Any Unicode digit character. Note that this includes characters
outside of the [0\-9] range.
.IP \fBdouble\fR 10
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.
+whitespace. In case of under/overflow in the value, 0 is returned and
+the \fIvarname\fR will contain \-1.
.IP \fBfalse\fR 10
-Any of the forms allowed to \fBTcl_GetBoolean\fR where the value is false.
+Any of the forms allowed to \fBTcl_GetBoolean\fR where the value is
+false.
.IP \fBgraph\fR 10
Any Unicode printing character, except space.
.IP \fBinteger\fR 10
-Any of the valid forms for an 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 forms for an 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.
.IP \fBlower\fR 10
Any Unicode lower case alphabet character.
.IP \fBprint\fR 10
@@ -143,30 +131,29 @@ Any Unicode punctuation character.
.IP \fBspace\fR 10
Any Unicode space character.
.IP \fBtrue\fR 10
-Any of the forms allowed to \fBTcl_GetBoolean\fR where the value is true.
+Any of the forms allowed to \fBTcl_GetBoolean\fR where the value is
+true.
.IP \fBupper\fR 10
Any upper case alphabet character in the Unicode character set.
.IP \fBwordchar\fR 10
-Any Unicode word character. That is any alphanumeric character,
-and any Unicode connector punctuation characters (e.g. underscore).
+Any Unicode word character. That is any alphanumeric character, and
+any Unicode connector punctuation characters (e.g. underscore).
.IP \fBxdigit\fR 10
Any hexadecimal digit character ([0\-9A\-Fa\-f]).
.PP
In the case of \fBboolean\fR, \fBtrue\fR and \fBfalse\fR, if the
-function will return 0, then the \fIvarname\fR will always be set to 0,
-due to the varied nature of a valid boolean value.
+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 ?\fIstartIndex\fR?
-.VE 8.1
+\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
-is no match, then return \-1.
-.VS 8.1
-If \fIstartIndex\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 \fIstartIndex\fR will be considered by the search. For example,
+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
+will be considered by the search. For example,
.RS
.CS
\fBstring last a 0a23456789abcdef 15\fR
@@ -177,25 +164,25 @@ will return \fB10\fR, but
.CE
will return \fB1\fR.
.RE
-.VE 8.1
.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.
-.VS 8.1
+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.
.TP
\fBstring map\fR ?\fB\-nocase\fR? \fIcharMap string\fR
Replaces characters in \fIstring\fR based on the key-value pairs in
-\fIcharMap\fR. \fIcharMap\fR is a list of \fIkey value key value\fR ...
+\fIcharMap\fR. \fIcharMap\fR is a list of \fIkey value key value ...\fR
as in the form returned by \fBarray get\fR. Each instance of a
key in the string will be replaced with its corresponding value. If
\fB\-nocase\fR is specified, then matching is done without regard to
case differences. Both \fIkey\fR and \fIvalue\fR may be multiple
-characters. Replacement is done in an ordered manner, so the key 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,
+characters. Replacement is done in an ordered manner, so the key
+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
.CS
\fBstring map {abc 1 ab 2 a 3 1 0} 1abcaababcabababc\fR
@@ -204,53 +191,42 @@ will return the string \fB01321221\fR.
.RE
.TP
\fBstring match\fR ?\fB\-nocase\fR? \fIpattern\fR \fIstring\fR
-.VE 8.1
-See if \fIpattern\fR matches \fIstring\fR; return 1 if it does, 0
-if it doesn't.
-.VS 8.1
-If \fB\-nocase\fR is specified, then the pattern attempts to match
-against the string in a case insensitive manner.
-.VE 8.1
-For the two strings to match, their contents
-must be identical except that the following special sequences
-may appear in \fIpattern\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
+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:
.RS
.IP \fB*\fR 10
-Matches any sequence of characters in \fIstring\fR,
-including a null string.
+Matches any sequence of characters in \fIstring\fR, including a null
+string.
.IP \fB?\fR 10
Matches any single character in \fIstring\fR.
.IP \fB[\fIchars\fB]\fR 10
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.
-.VS 8.1
-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).
-.VE 8.1
+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).
.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 \fIpattern\fR.
+Matches the single character \fIx\fR. This provides a way of avoiding
+the special interpretation of the characters \fB*?[]\e\fR in
+\fIpattern\fR.
.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
-.VS 8.1
-first character of the string. \fIfirst\fR and \fIlast\fR may be
-specified as for the \fBindex\fR method.
-.VE 8.1
-If \fIfirst\fR is less than zero then it is treated as if it were zero, and
-if \fIlast\fR is greater than or equal to the length of the string then
-it is treated as if it were \fBend\fR. If \fIfirst\fR is greater than
-\fIlast\fR then an empty string is returned.
-.VS 8.1
+character whose index is \fIlast\fR. An index of 0 refers to the first
+character of the string. \fIfirst\fR and \fIlast\fR may be specified
+as for the \fBindex\fR method. If \fIfirst\fR is less than zero then
+it is treated as if it were zero, and if \fIlast\fR is greater than or
+equal to the length of the string then it is treated as if it were
+\fBend\fR. If \fIfirst\fR is greater than \fIlast\fR then an empty
+string is returned.
.TP
\fBstring repeat \fIstring count\fR
Returns \fIstring\fR repeated \fIcount\fR number of times.
@@ -261,61 +237,56 @@ 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 character of the string. \fIFirst\fR and \fIlast\fR may be
specified as for the \fBindex\fR method. If \fInewstring\fR is
-specified, then it is placed in the removed character range.
-If \fIfirst\fR is less than zero then it is treated as if it were zero, and
-if \fIlast\fR is greater than or equal to the length of the string 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.
+specified, then it is placed in the removed character range. If
+\fIfirst\fR is less than zero then it is treated as if it were zero,
+and if \fIlast\fR is greater than or equal to the length of the string
+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 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
+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.
.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
+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.
+\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.
.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.
-.VE 8.1
+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.
.TP
\fBstring trim \fIstring\fR ?\fIchars\fR?
-Returns a value equal to \fIstring\fR except that any leading
-or trailing characters from the set given by \fIchars\fR are
-removed.
-If \fIchars\fR is not specified then white space is removed
-(spaces, tabs, newlines, and carriage returns).
+Returns a value equal to \fIstring\fR except that any leading or
+trailing characters from the set given by \fIchars\fR are removed. If
+\fIchars\fR is not specified then white space is removed (spaces,
+tabs, newlines, and carriage returns).
.TP
\fBstring trimleft \fIstring\fR ?\fIchars\fR?
-Returns a value equal to \fIstring\fR except that any
-leading characters from the set given by \fIchars\fR are
-removed.
-If \fIchars\fR is not specified then white space is removed
-(spaces, tabs, newlines, and carriage returns).
+Returns a value equal to \fIstring\fR except that any leading
+characters from the set given by \fIchars\fR are removed. If
+\fIchars\fR is not specified then white space is removed (spaces,
+tabs, newlines, and carriage returns).
.TP
\fBstring trimright \fIstring\fR ?\fIchars\fR?
-Returns a value equal to \fIstring\fR except that any
-trailing characters from the set given by \fIchars\fR are
-removed.
-If \fIchars\fR is not specified then white space is removed
-(spaces, tabs, newlines, and carriage returns).
-.VS 8.1
+Returns a value equal to \fIstring\fR except that any trailing
+characters from the set given by \fIchars\fR are removed. If
+\fIchars\fR is not specified then white space is removed (spaces,
+tabs, newlines, and carriage returns).
.TP
\fBstring wordend \fIstring charIndex\fR
Returns the index of the character just after the last one in the word
@@ -332,7 +303,9 @@ 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.
-.VE 8.1
+
+.SH "SEE ALSO"
+expr(n), list(n)
.SH KEYWORDS
case conversion, compare, index, match, pattern, string, word, equal, ctype
diff --git a/tcl/doc/subst.n b/tcl/doc/subst.n
index 9fd17112aa7..31355bc407e 100644
--- a/tcl/doc/subst.n
+++ b/tcl/doc/subst.n
@@ -1,6 +1,7 @@
'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" Copyright (c) 2001 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -31,18 +32,94 @@ again by the \fIsubst\fR command.
If any of the \fB\-nobackslashes\fR, \fB\-nocommands\fR, or
\fB\-novariables\fR are specified, then the corresponding substitutions
are not performed.
-For example, if \fB\-nocommands\fR is specified, no command substitution
-is performed: open and close brackets are treated as ordinary characters
+For example, if \fB\-nocommands\fR is specified, command substitution
+is not performed: open and close brackets are treated as ordinary characters
with no special interpretation.
.PP
-Note: when it performs its substitutions, \fIsubst\fR does not
-give any special treatment to double quotes or curly braces. For
-example, the script
+.VS 8.4
+Note that the substitution of one kind can include substitution of
+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.
+.PP
+If an error occurs during substitution, then \fBsubst\fR will return
+that error. If a break exception occurs during command or variable
+substitution, the result of the whole substitution will be the
+string (as substituted) up to the start of the substitution that
+raised the exception. If a continue exception occurs during the
+evaluation of a command or variable substitution, an empty string
+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
+itself will either return an error, or will complete successfully.
+.VE
+.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
.CS
\fBset a 44
subst {xyz {$a}}\fR
.CE
-returns ``\fBxyz {44}\fR'', not ``\fBxyz {$a}\fR''.
+returns ``\fBxyz {44}\fR'', not ``\fBxyz {$a}\fR''
+.VS 8.4
+and the script
+.CS
+\fBset a "p\\} q \\{r"
+subst {xyz {$a}}\fR
+.CE
+return ``\fBxyz {p} q {r}\fR'', not ``\fBxyz {p\\} q \\{r}\fR''.
+.PP
+When command substitution is performed, it includes any variable
+substitution necessary to evaluate the script.
+.CS
+\fBset a 44
+subst -novariables {$a [format $a]}\fR
+.CE
+returns ``\fB$a 44\fR'', not ``\fB$a $a\fR''. Similarly, when
+variable substitution is performed, it includes any command
+substitution necessary to retrieve the value of the variable.
+.CS
+\fBproc b {} {return c}
+array set a {c c [b] tricky}
+subst -nocommands {[b] $a([b])}\fR
+.CE
+returns ``\fB[b] c\fR'', not ``\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
+.CS
+\fBsubst {abc,[break],def}\fR
+.CE
+returns ``\fBabc,\fR'', not ``\fBabc,,def\fR'' and the script
+.CS
+\fBsubst {abc,[continue;expr 1+2],def}\fR
+.CE
+returns ``\fBabc,,def\fR'', not ``\fBabc,3,def\fR''.
+.PP
+Other exceptional return codes substitute the returned value
+.CS
+\fBsubst {abc,[return foo;expr 1+2],def}\fR
+.CE
+returns ``\fBabc,foo,def\fR'', not ``\fBabc,3,def\fR'' and
+.CS
+\fBsubst {abc,[return -code 10 foo;expr 1+2],def}\fR
+.CE
+also returns ``\fBabc,foo,def\fR'', not ``\fBabc,3,def\fR''.
+.VE
+
+.SH "SEE ALSO"
+Tcl(n), eval(n), break(n), continue(n)
.SH KEYWORDS
backslash substitution, command substitution, variable substitution
diff --git a/tcl/doc/switch.n b/tcl/doc/switch.n
index f71ed5f0cd4..f4e8506a5ab 100644
--- a/tcl/doc/switch.n
+++ b/tcl/doc/switch.n
@@ -110,5 +110,8 @@ will return \fB1\fR, and
.CE
will return \fB3\fR.
+.SH "SEE ALSO"
+for(n), if(n), regexp(n)
+
.SH KEYWORDS
switch, match, regular expression
diff --git a/tcl/doc/tclsh.1 b/tcl/doc/tclsh.1
index 3ecfa211ab4..23c1cd9db06 100644
--- a/tcl/doc/tclsh.1
+++ b/tcl/doc/tclsh.1
@@ -80,6 +80,14 @@ instead to start up \fBtclsh\fR to reprocess the entire script.
When \fBtclsh\fR starts up, it treats all three lines as comments,
since the backslash at the end of the second line causes the third
line to be treated as part of the comment on the second line.
+.PP
+.VS
+You should note that it is also common practise to install tclsh with
+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.
+.VE
.SH "VARIABLES"
.PP
@@ -115,5 +123,12 @@ 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
incomplete commands.
+.SH "STANDARD CHANNELS"
+.PP
+See \fBTcl_StandardChannels\fR for more explanations.
+
+.SH "SEE ALSO"
+fconfigure(n), tclvars(n)
+
.SH KEYWORDS
argument, interpreter, prompt, script file, shell
diff --git a/tcl/doc/tcltest.n b/tcl/doc/tcltest.n
index 1a515653541..d4852309833 100644
--- a/tcl/doc/tcltest.n
+++ b/tcl/doc/tcltest.n
@@ -2,6 +2,8 @@
'\" Copyright (c) 1990-1994 The Regents of the University of California
'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
'\" Copyright (c) 1998-1999 Scriptics Corporation
+'\" Copyright (c) 2000 Ajuba Solutions
+'\" 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.
@@ -9,286 +11,550 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH "Tcltest" n 8.2 Tcl "Tcl Built-In Commands"
+.TH "tcltest" n 2.1 tcltest "Tcl Bundled Packages"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
-Tcltest \- Test harness support code and utilities
+tcltest \- Test harness support code and utilities
.SH SYNOPSIS
-\fBpackage require tcltest ?1.0?\fP
+.nf
+\fBpackage require tcltest ?2.1?\fR
.sp
-\fB::tcltest::test \fIname desc ?constraint? script expectedAnswer\fR
+\fBtcltest::test \fIname description ?option value ...?\fR
+\fBtcltest::test \fIname description ?constraints? body result\fR
.sp
-\fB::tcltest::cleanupTests \fI?runningMultipleTests?\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::runAllTests\fR
.sp
-\fB::tcltest::getMatchingTestFiles\fR
+.VS 2.1
+\fBtcltest::configure\fR
+\fBtcltest::configure \fIoption\fR
+\fBtcltest::configure \fIoption value ?option value ...?\fR
+\fBtcltest::customMatch \fImode command\fR
+.VE
+\fBtcltest::testConstraint \fIconstraint ?value?\fR
+\fBtcltest::outputChannel \fI?channelID?\fR
+\fBtcltest::errorChannel \fI?channelID?\fR
+\fBtcltest::interpreter \fI?interp?\fR
.sp
-\fB::tcltest::loadTestedCommands\fR
+\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
-\fB::tcltest::makeFile \fIcontents name\fR
-.sp
-\fB::tcltest::removeFile \fIname\fR
-.sp
-\fB::tcltest::makeDirectory \fIname\fR
-.sp
-\fB::tcltest::removeDirectory \fIname\fR
-.sp
-\fB::tcltest::viewFile \fIname\fR
-.sp
-\fB::tcltest::normalizeMsg \fImsg\fR
-.sp
-\fB::tcltest::bytestring \fIstring\fR
-.sp
-\fB::tcltest::saveState\fR
-.sp
-\fB::tcltest::restoreState\fR
-.sp
-\fB::tcltest::threadReap\fR
+\fBtcltest::test \fIname description optionList\fR
+\fBtcltest::bytestring \fIstring\fR
+\fBtcltest::normalizeMsg \fImsg\fR
+\fBtcltest::normalizePath \fIpathVar\fR
+\fBtcltest::workingDirectory \fI?dir?\fR
+.fi
.BE
.SH DESCRIPTION
.PP
-The \fBtcltest\fR package provides the user with utility tools for
-writing and running tests in the Tcl test suite. It can also be used
-to create a customized test harness for an extension.
+The \fBtcltest\fR package provides several utility commands useful
+in the construction of test suites for code instrumented to be
+run by evaluation of Tcl commands. Notably the built-in commands
+of the Tcl library itself are tested by a test suite using the
+tcltest package.
.PP
-The Tcl test suite consists of multiple .test files, each of which
-contains multiple test cases. Each test case consists of a call to
-the test command, which specifies the name of test, a short
-description, any constraints that apply to the test case, the script
-to be run, and expected results. See the sections \fI"Tests,"\fR
-\fI"Test Constraints,"\fR and \fI"Test Files and How to Run Them"\fR
-for more details.
+All the commands provided by the \fBtcltest\fR package are defined
+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
-It is also possible to add to this test harness to create your own
-customized test harness implementation. For more defails, see the
-section \fI"How to Customize the Test Harness"\fR.
+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
+test suites.
.PP
-This approach to testing was designed and initially implemented by
-Mary Ann May-Pumphrey of Sun Microsystems in the early 1990's. Many
-thanks to her for donating her work back to the public Tcl release.
+See \fBCREATING TEST SUITES WITH TCLTEST\fR below for an extended example
+of how to use the commands of \fBtcltest\fR to produce test suites
+for your Tcl-enabled code.
.SH COMMANDS
.TP
-\fB::tcltest::test\fP \fIname desc ?constraints? script expectedAnswer\fR
-The \fB::tcltest::test\fR command runs\fIscript\fR and compares
-its result to \fIexpectedAnswer\fR. It prints an error message if the two do
-not match. If \fB::tcltest::verbose\fR contains "p" or "s", it also prints
-out a message if the test passed or was skipped. The test will be
-skipped if it doesn't match the \fB::tcltest::match\fR variable, if it
-matches an element in \fB::tcltest::skip\fR, or if one of the elements
-of \fIconstraint\fR turns out not to be true. The
-\fB::tcltest::test\fR command has no defined return values. See the
-\fI"Writing a new test"\fR section for more details on this command.
-.TP
-\fB::tcltest::cleanupTests\fP \fI?runningMultipleTests?\fR
-This command should be called at the end of a test file. It prints
-statistics about the tests run and removes files that were created by
-\fB::tcltest::makeDirectory\fR and \fB::tcltest::makeFile\fR. Names
-of files and directories created outside of
-\fB::tcltest::makeFile\fR and \fB::tcltest::makeDirectory\fR and
-never deleted are printed to \fB::tcltest::outputChannel\fR. This command
-also restores the original shell environment, as described by the ::env
-array. \fIcalledFromAll\fR should be specified when
-\fB::tcltest::cleanupTests\fR is called from an "all.tcl" file. Tcl files
-files are generally used to run multiple tests. For more details on how to
-run multiple tests, please see the section \fI"Running test files"\fR.
-This proc has no defined return value.
-.TP
-\fB::tcltest::getMatchingTestFiles\fP
-This command is used when you want to run multiple test files. It returns
-the list of tests that should be sourced in an 'all.tcl' file. See the
-section \fI"Running test files"\fR for more information.
-.TP
-\fB::tcltest::loadTestedCommands\fP
-This command uses the script specified via the \fI-load\fR or
-\fI-loadfile\fR to load the commands checked by the test suite.
-Allowed to be empty, as the tested commands could have been compiled
-into the interpreter running the test suite.
-.TP
-\fB::tcltest::makeFile\fP \fIcontents name\fR
-Create a file that will be automatically be removed by
-\fB::tcltest::cleanupTests\fR at the end of a test file.
-This proc has no defined return value.
-.TP
-\fB::tcltest::removeFile\fP \fIname\fR
-Force the file referenced by \fIname\fR to be removed. This file name
-should be relative to \fI::tcltest::temporaryDirectory\fR. This proc has no
-defined return values.
-.TP
-\fB::tcltest::makeDirectory\fP \fIname\fR
-Create a directory named \fIname\fR that will automatically be removed
-by \fB::tcltest::cleanupTests\fR at the end of a test file. This proc
-has no defined return value.
-.TP
-\fB::tcltest::removeDirectory\fP \fIname\fR
-Force the directory referenced by \fIname\fR to be removed. This proc
-has no defined return value.
-.TP
-\fB::tcltest::viewFile\fP \fIfile\fR
-Returns the contents of \fIfile\fR.
-.TP
-\fB::tcltest::normalizeMsg\fP \fImsg\fR
-Remove extra newlines from \fImsg\fR.
-.TP
-\fB::tcltest::bytestring\fP \fIstring\fR
+\fBtest\fR \fIname description ?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
+test, as configured by the options of \fBtcltest\fR. The
+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.
+.TP
+\fBtest\fR \fIname description ?constraints? body 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]
+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 ``-''.
+.TP
+\fBloadTestedCommands\fR
+Evaluates in the caller's context the script specified by
+[\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
+Creates a file named \fIname\fR relative to
+directory \fIdirectory\fR and write \fIcontents\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].
+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
+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].
+Returns an empty string. Use this command to delete files
+created by [\fBmakeFile\fR].
+.TP
+\fBmakeDirectory\fR \fIname ?directory?\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 default value of \fIdirectory\fR is the directory
+[\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
+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].
+Returns an empty string. Use this command to delete any directories
+created by [\fBmakeDirectory\fR].
+.TP
+\fBviewFile\fR \fIfile ?directory?\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.
+The default value of \fIdirectory\fR is the directory
+[\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
+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
+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
+array. Returns an empty string.
+.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"
+.VS
+.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
+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
+arguments are not processed.
+.sp
+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].
+This allows the default values of the configuration options to be
+set by the environment.
+.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
+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
+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.
+.VE
+.TP
+\fBtestConstraint \fIconstraint ?boolean?\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.
+Any test that prints test related output should send
+that output to [\fBoutputChannel\fR] rather than letting
+that output default to stdout.
+.TP
+\fBerrorChannel\fR \fI?channelID?\fR
+Sets or returns the error channel ID. This defaults to stderr.
+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"
+.PP
+The remaining commands provided by \fBtcltest\fR have better
+alternatives provided by \fBtcltest\fR or \fBTcl\fR itself. They
+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
+argument quoted by braces, rather than needing to backslash quote
+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
+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
+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.
+.TP
+\fBworkingDirectory\fR \fI?directoryName?\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
+processing commands to modify strings as you wish, and
+[\fBcustomMatch\fR] allows flexible matching of actual and expected
+results.
+.TP
+\fBnormalizePath\fR \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]
+is a sufficient replacement.
+.TP
+\fBbytestring\fR \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.
-.TP
-\fB::tcltest::saveState\fP
-\fB::tcltest::restoreState\fP
-Save and restore the procedure and global variable names.
-A test file might contain calls to \fB::tcltest::saveState\fR and
-\fB::tcltest:restoreState\fR if it creates or deletes global variables
-or procs.
-.TP
-\fB::tcltest::threadReap\fP
-\fB::tcltest::threadReap\fR only works if \fItestthread\fR is
-defined, generally by compiling tcltest. If \fItestthread\fR is
-defined, \fB::tcltest::threadReap\fR kills all threads except for the
-main thread. It gets the ID of the main thread by calling
-\fItestthread names\fR during initialization. This value is stored in
-\fI::tcltest::mainThread\fR. \fB::tcltest::threadReap\fR returns the
-number of existing threads at completion.
+that a string result has a certain pattern of bytes. This is
+exactly equivalent to the Tcl command [\fBencoding convertfrom identity\fR].
.SH TESTS
-The \fBtest\fR procedure runs a test script and prints an error
-message if the script's result does not match the expected result.
-The following is the spec for the \fBtest\fR command:
-.DS
-test <name> <description> ?<constraint>? <script> <expectedAnswer>
-.DE
-The <name> argument should follow the pattern:
-.DS
-<target>-<majorNum>.<minorNum>
-.DE
+.PP
+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]
+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.
+.PP
+The valid options for [\fBtest\fR] are summarized:
+.CS
+.ta 0.8i
+test \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?
+.CE
+The \fIname\fR may be any string. It is conventional to choose
+a \fIname\fR according to the pattern:
+.CS
+\fItarget\fR-\fImajorNum\fR.\fIminorNum\fR
+.CE
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. Related tests
-should share a major number.
+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.''
.PP
-The <description> argument is a short textual description of the test,
-to help humans understand what it tests. The name of a Tcl or C
-function being tested should be included for regression tests. If the
-test case exists to reproduce a bug, include the bug ID in the
-description.
+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
+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].
.PP
-The optional <constraints> argument can be list of one or more
-keywords or an expression. If the <constraints> argument consists of
-keywords, each of these keywords must be the name of an element in the array
-\fI::tcltest::testConstraints\fR. If any of these elements is false or does
-not exist, the test is skipped. If the <constraints> argument
-consists of an expression, that expression is evaluated. If the
-expression evaluates to true, then the test is run.
+The \fIdescription\fR should be a short textual description of the
+test. The \fIdescription\fR is included in output produced by the
+test, typically test failure messages. Good \fIdescription\fR values
+should briefly explain the purpose of the test to users of a test suite.
+The name of a Tcl or C function being tested should be included in the
+description for regression tests. If the test case exists to reproduce
+a bug, include the bug ID in the description.
.PP
-Add appropriate constraints (e.g.,
-unixOnly) to any tests that should not always be run. For example, a
-test that should only be run on Unix should look like the following:
-.PP
-.DS
-test getAttribute-1.1 {testing file permissions} {unixOnly} {
- lindex [file attributes foo.tcl] 5
-} {00644}
-.DE
+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
+keywords, each of these keywords should be the name of a constraint
+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
+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.
+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
+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
+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.
+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.
+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
+values for \fImode\fR are \fBregexp\fR, \fBglob\fR, \fBexact\fR, and
+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
+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
+of the script(s) will be compared. Note that only output printed using
+[\fBputs\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
+evaluation of the script(s) will be compared. Note that only output
+printed using [\fBputs\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.
+.TP
+\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
+a code not in the \fIexpectedCodeList\fR, the test fails. All
+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.
.PP
-An example of a test that contains an expression:
+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
+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].
.PP
-.DS
-test unixNotfy-1.1 {Tcl_DeleteFileHandler} {unixOnly && !testthread} {
- catch {vwait x}
- set f [open foo w]
- fileevent $f writable {set x 1}
- vwait x
- close $f
- list [catch {vwait x} msg] $msg
-} {1 {can't wait for variable "x": would wait forever}}
-.DE
+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].
+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
+below. Any output produced by the test scripts themselves should be
+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.
+.SH "TEST CONSTRAINTS"
.PP
-See the "Test Constraints" section for a list of built-in
-constraints and information on how to add your own constraints.
+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
+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
+only if all constraints in the list are true-valued. Thus,
+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
+will only be run if the constraint \fBunix\fR is true, which indicates
+the test suite is being run on a Unix platform.
.PP
-The <script> argument contains the script to run to carry out the
-test. It must return a result that can be checked for correctness.
-If your script requires that a file be created on the fly, please use
-the ::tcltest::makeFile procedure. If your test requires that a small
-file (<50 lines) be checked in, please consider creating the file on
-the fly using the ::tcltest::makeFile procedure. Files created by the
-::tcltest::makeFile procedure will automatically be removed by the
-::tcltest::cleanupTests call at the end of each test file.
+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
+may appear within a test file, or within the script specified
+by the [\fBconfigure -load\fR] or [\fBconfigure -loadfile\fR]
+options.
.PP
-The <expectedAnswer> argument will be compared against the result of
-evaluating the <script> argument. If they match, the test passes,
-otherwise the test fails.
-.SH "TCLTEST NAMEPSACE VARIABLES"
-The following variables are also defined in the \fBtcltest\fR namespace and
-can be used by tests:
-.TP
-\fB::tcltest::outputChannel\fR
-output file ID - defaults to stdout and can be specified using
--outfile on the command line.
-Any test that prints test related output should send
-that output to \fI::tcltest::outputChannel\fR rather than letting
-that output default to stdout.
-.TP
-\fB::tcltest::errorChannel\fR
-error file ID - defaults to stderr and can be specified using -errfile
-on the command line.
-Any test that prints error messages should send
-that output to \fI::tcltest::errorChannel\fR rather than printing
-directly to stderr.
-.TP
-\fB::tcltest::mainThread\fR
-main thread ID - defaults to 1. This is the only thread that is not
-killed by ::tcltest::threadReap and is set according to the return
-value of \fItestthread names\fR at initialization.
-.TP
-\fB::tcltest::originalEnv\fR
-copy of the global "env" array at the beginning of the test run. This
-array is used to restore the "env" array to its original state when
-\fI::tcltest::cleanupTests\fR is called.
-.TP
-\fB::tcltest::workingDirectory\fR
-the directory in which the test suite was launched.
+The following is a list of constraints pre-defined by the
+\fBtcltest\fR package itself:
.TP
-\fB::tcltest::temporaryDirectory\fR
-the output directory - defaults to \fI::tcltest::workingDirectory\fR and can be
-specified using -tmpdir on the command line.
-.TP
-\fB::tcltest::testsDirectory\fR
-where the tests reside - defaults to \fI::tcltest::workingDirectory\fR
-if the script cannot determine where the \fItests\fR directory is
-located. It is possible to change the default by specifying
-\fI-testdir\fR on the commandline. This variable should be
-explicitly set if tests are being run from an all.tcl file.
-.TP
-\fB::tcltest::tcltest\fR
-the name of the executable used to invoke the test suite.
-.TP
-\fB::tcltest::loadScript\fR
-The script executed \fBloadTestedCommands\fR. Specified either by
-\fI-load\fR or \fI-loadfile\fR.
-.SH "TEST CONSTRAINTS"
-Constraints are used to determine whether a test should be skipped.
-Each constraint is stored as an index in the array
-\fI::tcltest::testConstraints\fR. For example, the unixOnly constraint is
-defined as the following:
-.DS
-set ::tcltest::testConstraints(unixOnly) \\
- [string equal $tcl_platform(platform) "unix"]
-.DE
-If a test is constrained by "unixOnly", then it will only be run if
-the value of ::tcltest::testConstraints(unixOnly) is true. Several
-constraints are defined in the \fBtcltest\fR package. To add file- or
-test-specific constraints, you can set the desired index of the
-::tcltest::testsConstraints array in your own test file.
-.PP
-The following is a list of constraints defined in the \fBtcltest\fR package:
+\fIsingleTestInterp\fR
+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
+test can only be run on any Unix platform
.TP
-\fIpc\fR
+\fIwin\fR
test can only be run on any Windows platform
.TP
\fInt\fR
@@ -303,16 +569,16 @@ test can only be run on any Windows 98 platform
\fImac\fR
test can only be run on any Mac platform
.TP
-\fIunixOrPc\fR
-test can only be run on a UNIX or PC platform
+\fIunixOrWin\fR
+test can only be run on a Unix or Windows platform
.TP
-\fImacOrPc\fR
-test can only be run on a Mac or PC platform
+\fImacOrWin\fR
+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
+test can only be run on a Mac or Unix platform
.TP
-\fItempNotPc\fR
+\fItempNotWin\fR
test can not be run on Windows. This flag is used to temporarily
disable a test.
.TP
@@ -321,10 +587,10 @@ 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
+test crashes if it's run on Unix. This flag is used to temporarily
disable a test.
.TP
-\fIpcCrash\fR
+\fIwinCrash\fR
test crashes if it's run on Windows. This flag is used to temporarily
disable a test.
.TP
@@ -335,28 +601,29 @@ disable a test.
\fIemptyTest\fR
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
-always causes tests to be skipped.
+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
-always causes tests to be skipped unless the user specifies otherwise.
-See the "Introduction" section for more details.
+has value false to cause tests to be skipped unless the user specifies
+otherwise.
.TP
\fInonPortable\fR
-test can only be run in the master Tcl/Tk development environment.
+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.
-These tests are only run in the main Tcl development directory where
-the configuration is well known. This constraint always causes tests
-to be skipped unless the user specifies otherwise.
+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 always
-causes tests to be skipped unless the user specifies otherwise.
+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,
-that is the global tcl_interactive variable is set to 1.
+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
@@ -367,8 +634,9 @@ 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 commands such as 'cat', 'echo',
-etc. available.
+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
.TP
\fIhasIsoLocale\fR
test can only be run if can switch to an ISO locale
@@ -384,118 +652,108 @@ test can only run if app has a working version of sprintf with respect
to the "e" format of floating-point numbers.
.TP
\fIstdio\fR
-test can only be run if the current app can be spawned via a pipe
-.SH "RUNNING TEST FILES"
-Use the following command to run a test file that uses package
-tcltest:
-.DS
-<shell> <testFile> ?<option> ?<value>?? ...
-.DE
-Command line options include (tcltest namespace variables that
-correspond to each flag are listed at the end of each flag description
-in parenthesis):
-.RS
-.TP
-\fB-help\fR
-display usage information.
-.TP
-\fB-verbose <level>\fR
-set the level of verbosity to a substring of "bps". See the "Test
-output" section for an explanation of this option. (::tcltest::verbose)
-.TP
-\fB-match <matchList>\fR
-only run tests that match one or more of the glob patterns in
-<matchList>. (::tcltest::match)
-.TP
-\fB-skip <skipList>\fR
-do not run tests that match one or more of the glob patterns in
-<skipList>. (::tcltest::skip)
-.TP
-\fB-file <globPatternList>\fR
-only source test files that match any of the items in
-<globPatternList> relative to ::tcltest::testsDirectory.
-This option
-only makes sense if you are running tests using "all.tcl" as the
-<testFile> instead of running single test files directly.
-(::tcltest::matchFiles)
-.TP
-\fB-notfile <globPatternList>\fR
-source files except for those that match any of the items in
-<globPatternList> relative to ::tcltest::testsDirectory.
-This option
-only makes sense if you are running tests using "all.tcl" as the
-<testFile> instead of running single test files directly.
-(::tcltest::skipFiles)
-.TP
-\fB-constraints <list>\fR
-tests with any constraints in <list> will not be skipped. Note that
-elements of <list> must exactly match the existing constraints. This
-is useful if you want to make sure that tests with a particular
-constraint are run (for example, if the tester wants to run all tests
-with the knownBug constraint).
-(::tcltest::testConstraints(\fIconstraintName\fR))
-.TP
-\fB-limitconstraints <bool>\fR
-If the argument to this flag is 1, the test harness limits test runs
-to those tests that match the constraints listed by the -constraints
-flag. Use of this flag requires use of the -constraints flag. The
-default value for this flag is 0 (false). This is useful if you want
-to run \fBonly\fR those tests that match the constraints listed using
-the -constraints option. A tester might want to do this if he were
-interested in running only those tests that are constrained to be
-unixOnly and no other tests.
-(::tcltest::limitConstraints)
-.TP
-\fB-load <script>\fR
-will use the specified script to load the commands under test
-(::tcltest::loadTestedCommands). The default is the empty
-script. See -loadfile below too. (::tcltest::loadScript)
-.TP
-\fB-loadfile <scriptfile>\fR
-will use the contents of the named file to load the commands under
-test (::tcltest::loadTestedCommands). See -load above too. The default
-is the empty script. (::tcltest::loadScript)
-.TP
-\fB-tmpdir <directoryName>\fR
-put any temporary files (created with ::tcltest::makeFile and
-::tcltest::makeDirectory) into the named directory. The default
-location is ::tcltest::workingDirectory. (::tcltest::temporaryDirectory)
-.TP
-\fB-testdir <directoryName>\fR
-search the test suite to execute in the named directory. The default
-location is ::tcltest::workingDirectory. (::tcltest::testsDirectory)
-.TP
-\fB-preservecore <level>\fR
-check for core files. This flag is used to determine how much
-checking should be done for core files. The default value for
-\fIlevel\fR 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 whenever ::tcltest::cleanupTests is
-called from an all.tcl file.
-.IP 1
-Check for core files at the end of each test command and whenever
-::tcltest::cleanupTests is called from all.tcl.
-.IP 2
-Check for core files at the end of all test commands and whenever
-::tcltest::cleanupTests is called from all.tcl. Save any core files
-produced in ::tcltest::temporaryDirectory.
-.RE
-.sp
-(::tcltest::preserveCore)
-.TP
-\fB-debug <debugLevel>\fR
-print debug information to stdout. This is used to debug code in the
-test harness. The default debug level is 0. Levels are defined as:
+test can only be run if [\fBinterpreter\fR] can be [\fBopen\fR]ed
+as a pipe.
+.PP
+The alternative mode of constraint control is enabled by setting
+[\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]
+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
+are run; all others are skipped. For example, one might set
+up a configuration with
+.CS
+configure -constraints knownBug \e
+ -limitconstraints true \e
+ -verbose pass
+.CE
+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"
+.PP
+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].
+.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
+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 if 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
+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
+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.
+.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
+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
+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].
+.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]
+and do not match any of the patterns in
+[\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.
+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,
+many directories in a directory tree can have all their
+test files evaluated by a single [\fBrunAllTests\fR]
+command.
+.SH "CONFIGURABLE OPTIONS"
+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
+each test file. No spawning when \fIboolean\fR is true. Default
+value is false.
+.TP
+\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:
.RS
.IP 0
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 -match or
-::tcltest::match (userSpecifiedNonMatch) or matches any of the tests
-specified by -skip or ::tcltest::skip (userSpecifiedSkip).
+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
+print warnings about possible lack of cleanup or balance in test files.
.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
@@ -504,256 +762,304 @@ in the current namespace as they are used.
Display information regarding what individual procs in the test
harness are doing.
.RE
-.sp
-(::tcltest::debug)
-.TP
-\fB-outfile <filename>\fR
-print output generated by the tcltest package to the named file. This
-defaults to stdout. Note that debug output always goes to stdout,
-regardless of this flag's setting. (::tcltest::outputChannel)
.TP
-\fB-errfile <filename>\fR
-print errors generated by the tcltest package to the named file. This
-defaults to stderr. (::tcltest::errorChannel)
+\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 \fBbody\fR.
+Levels are defined as:
+.RS
+.IP "body (b)"
+Display the body of failed tests
+.IP "pass (p)"
+Print output when a test passes
+.IP "skip (s)"
+Print output when a test is skipped
+.IP "start (t)"
+Print output whenever a test starts
+.IP "error (e)"
+Print errorInfo and errorCode, if they exist, when a test return code
+does not match its expected return code
.RE
+The single letter abbreviations noted above are also recognized
+so that [\fBconfigure -verbose pt\fR] is the same as
+[\fBconfigure -verbose {pass start}\fR].
+.TP
+\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
+test files have been evaluated.
+.IP 1
+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].
+.RE
+.TP
+\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
+Sets all the constraints in \fIlist\fR to true. Also used in
+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
+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
+what subdirectories to search for an \fBall.tcl\fR file. Default
+value is \fB*\fR.
+.TP
+\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.
+.TP
+\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].
+Default value is an empty script.
+.TP
+\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.
+.TP
+\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].
+.TP
+\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
+for writing, and the resulting channel will be set as the value
+of [\fBerrorChannel\fR].
+.SH "CREATING TEST SUITES WITH TCLTEST"
.PP
-A second way to run tets is to start up a shell, load the
-\fBtcltest\fR package, and then source an appropriate test file or use
-the test command. To use the options in interactive mode, set
-their corresponding tcltest namespace variables after loading the
-package.
-.PP
-See \fI"Test Constraints"\fR for all built-in constraint names
-that can be used in the \fB::tcltest::testConstraints\fR array.
-See \fI"Tcltest namespace variables"\fR for details on other variables
-defined in the \fBtcltest\fR namespace.
-.PP
-A final way to run tests would be to specify which test files to run
-within an \fIall.tcl\fR (or otherwise named) file. This is the
-approach used by the Tcl test suite. This file loads the tcltest
-package, sets the location of
-the test directory (::tcltest::testsDirectory), determines which test
-files to run, sources each of these files, calls
-::tcltest::cleanupTests and then exits.
-.PP
-A more elaborate \fIall.tcl\fR file might do some pre- and
-post-processing before sourcing
-each .test file, use separate interpreters for each file, or handle
-complex directory structures.
-For an example of an all.tcl file,
-please see the "Examples" section of this document.
-.SH "TEST OUTPUT"
-After all specified test files are run, the number of tests
-passed, skipped, and failed is printed to
-\fB::tcltest::outputChannel\fR. Aside from this
-statistical information, output can be controlled on a per-test basis
-by the \fB::tcltest::verbose\fR variable.
-.PP
-\fB::tcltest::verbose\fR can be set to any substring or permutation
-of "bps". In the string "bps", the 'b' stands for a test's "body",
-the 'p' stands for "passed" tests, and the 's' stands for "skipped"
-tests. The default value of \fB::tcltest::verbose\fR is "b". If 'b'
-is present, then the entire body of the test is printed for each
-failed test, otherwise only the test's name, desired output, and
-actual output, are printed for each failed test. If 'p' is present,
-then a line is printed for each passed test, otherwise no line is
-printed for passed tests. If 's' is present, then a line (containing
-the consraints that cause the test to be skipped) is printed for each
-skipped test, otherwise no line is printed for skipped tests.
-.PP
-You can set \fB::tcltest::verbose\fR either interactively (after the
-\fBtcltest\fR package has been loaded) or by using the command line
-argument \fB-verbose\fR, for example:
-.DS
-tclsh socket.test -verbose bps
-.DE
-.SH "CONTENTS OF A TEST FILE"
-Test files should begin by loading the \fBtcltest\fR package:
-.DS
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
- namespace import ::tcltest::*
-}
-.DE
-Test files should end by cleaning up after themselves and calling
-\fB::tcltest::cleanupTests\fR. The \fB::tcltest::cleanupTests\fR
-procedure prints statistics about the number of tests that passed,
-skipped, and failed, and removes all files that were created using the
-\fB::tcltest::makeFile\fR and \fB::tcltest::makeDirectory\fR procedures.
-.DS
-# Remove files created by these tests
-# Change to original working directory
-# Unset global arrays
-::tcltest::cleanupTests
-return
-.DE
-When naming test files, file names should end with a .test extension.
-The names of test files that contain regression (or glass-box) tests
-should correspond to the Tcl or C code file that they are testing.
-For example, the test file for the C file "tclCmdAH.c" is "cmdAH.test".
-Test files that contain black-box tests should match the pattern "*_bb.test".
-.SH "SELECTING TESTS FOR EXECUTION WITHIN A FILE"
-.PP
-Normally, all the tests in a file are run whenever the file is
-sourced. An individual test will be skipped if one of the following
-conditions is met:
+The fundamental element of a test suite is the individual [\fBtest\fR]
+command. We begin with several examples.
.IP [1]
-the \fIname\fR of the tests does not match (using glob style matching)
-one or more elements in the \fB::tcltest::match\fR variable
+Test of a script that returns normally.
+.CS
+test example-1.0 {normal return} {
+ format %s value
+} value
+.CE
.IP [2]
-the \fIname\fR of the tests matches (using glob style matching) one or
-more elements in the \fB::tcltest::skip\fR variable
+Test of a script that requires context setup and cleanup. Note the
+bracing and indenting style that avoids any need for line continuation.
+.CS
+test example-1.1 {test file existence} -setup {
+ set file [makeFile {} test]
+} -body {
+ file exists $file
+} -cleanup {
+ removeFile test
+} -result 1
+.CE
.IP [3]
-the \fIconstraints\fR argument to the \fB::tcltest::test\fR call, if
-given, contains one or more false elements.
-.PP
-You can set \fB::tcltest::match\fR and/or \fB::tcltest::skip\fR
-either interactively (after the \fBtcltest\fR package has been
-sourced), or by using the command line arguments \fB-match\fR and
-\fB-skip\fR, for example:
+Test of a script that raises an error.
+.CS
+test example-1.2 {error return} -body {
+ error message
+} -returnCodes error -result message
+.CE
+.IP [4]
+Test with a constraint.
+.CS
+test example-1.3 {user owns created files} -constraints {
+ unix
+} -setup {
+ set file [makeFile {} test]
+} -body {
+ file attributes $file -owner
+} -cleanup {
+ removeFile test
+} -result $::tcl_platform(user)
+.CE
.PP
+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
+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.
+Use constraints to skip tests, rather than conditional evaluation
+of [\fBtest\fR]. That is, do this:
+.IP [5]
+.CS
+testConstraint X [expr $myRequirement]
+test goodConditionalTest {} X {
+ # body
+} result
+.CE
+and do not do this:
+.IP [6]
.CS
-tclsh info.test -match '*-5.* *-7.*' -skip '*-7.1*'
+if $myRequirement {
+ test badConditionalTest {} {
+ #body
+ } result
+}
.CE
.PP
-Be sure to use the proper quoting convention so that your shell does
-not perform the glob substitution on the match or skip patterns you
-specify.
+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
+only be done if necessary, and any errors during setup will be reported,
+and not cause the test file to abort.
.PP
-Predefined constraints (e.g. \fIknownBug\fR and \fInonPortable\fR) can be
-overridden either interactively (after the \fBtcltest\fR package has been
-sourced) by setting the proper
-\fB::tcltest::testConstraints(\fIconstraint\fB)\fR variable
-or by using the \fB-constraints\fR command line option with the name of the
-constraint in the argument. The following example shows how to run
-tests that are constrained by the \fIknownBug\fR and \fInonPortable\fR
-restrictions:
+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
+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.
+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
+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]
+should be called.
+.IP [7]
+Here is a sketch of a sample test file illustrating those points:
.CS
-tclsh all.tcl -constraints "knownBug nonPortable"
+package require tcltest 2.2
+eval tcltest::configure $argv
+package require example
+namespace eval ::example::test {
+ namespace import ::tcltest::*
+ testConstraint X [expr {...}]
+ variable SETUP {#common setup code}
+ variable CLEANUP {#common cleanup code}
+ test example-1 {} -setup $SETUP {
+ # First test
+ } -cleanup $CLEANUP -result {...}
+ test example-2 {} -constraints X -setup $SETUP {
+ # Second test; constrained
+ } -cleanup $CLEANUP -result {...}
+ test example-3 {} {
+ # Third test; no context required
+ } {...}
+ cleanupTests
+}
+namespace delete ::example::test
.CE
.PP
-See the \fI"Constraints"\fR package for information about using
-built-in constraints and adding new ones.
-.SH "HOW TO CUSTOMIZE THE TEST HARNESS"
-To create your own custom test harness, create a .tcl file that contains your
-namespace. Within this file, require package \fBtcltest\fR. Commands
-that can be redefined to customize the test harness include:
-.TP
-\fB::tcltest::PrintUsageInfoHook\fP
-print additional usage information specific to your situation.
-.TP
-\fB::tcltest::processCmdLineArgsFlagHook\fP
-tell the test harness about additional flags that you want it to understand.
-.TP
-\fB::tcltest::processCmdLineArgsHook\fR \fIflags\fP
-process the additional flags that you told the harness about in
-::tcltest::processCmdLineArgsFlagHook.
-.TP
-\fB::tcltest::initConstraintsHook\fP
-used to add additional built-in constraints to those already defined
-by \fBtcltest\fR.
-.TP
-\fB::tcltest::cleanupTestsHook\fP
-do additional cleanup
-.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
+doing any necessary setup. This script is usually named \fBall.tcl\fR
+because that's 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:
+.CS
+package require Tcl 8.4
+package require tcltest 2.2
+package require example
+tcltest::configure -testdir \
+ [file dir [file normalize [info script]]]
+eval tcltest::configure $argv
+tcltest::runAllTests
+.CE
+.SH COMPATIBILITY
.PP
-To add new flags to your customized test harness, redefine
-\fB::tcltest::processCmdLineArgsAddFlagHook\fR to define additional flags to be
-parsed and \fB::tcltest::processCmdLineArgsHook\fR to actually process them.
-For example:
-.DS
-proc ::tcltest::processCmdLineArgsAddFlagHook {} {
- return [list -flag1 -flag2]
-}
-
-proc ::tcltest::processCmdLineArgsHook {flagArray} {
- array set flag $flagArray
-
- if {[info exists flag(-flag1)]} {
- # Handle flag1
- }
-
- if {[info exists flag(-flag2)]} {
- # Handle flag2
+A number of commands and variables in the \fB::tcltest\fR namespace
+provided by earlier releases of \fBtcltest\fR have not been documented
+here. They are no longer part of the supported public interface of
+\fBtcltest\fR and should not be used in new test suites. However,
+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
+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
+.CS
+eval tcltest::configure $::argv
+.CE
+to establish a configuration from command line arguments.
+.SH "KNOWN ISSUES"
+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:
+.CS
+test level-1.1 {level 1} {
+ -body {
+ test level-2.1 {level 2} {
+ }
}
-
- return
}
-.DE
-You may also want to add usage information for these flags. This
-information would be displayed whenever the user specifies -help. To
-define additional usage information, define your own
-::tcltest::PrintUsageInfoHook proc. Within this proc, you should
-print out additional usage information for any flags that you've
-implemented.
+.CE
+any script executed in level-2.1 may be executed at the same stack
+level as the script defined for level-1.1.
.PP
-To add new built-in
-constraints to the test harness, define your own version of
-\fB::tcltest::initConstraintsHook\fR.
-Within your proc, you can add to the \fB::tcltest::testConstraints\fR array.
-For example:
-.DS
-proc ::tcltest::initConstraintsHook {} {
- set ::tcltest::testConstraints(win95Or98) \\
- [expr {$::tcltest::testConstraints(95) || \\
- $::tcltest::testConstraints(98)}]
-}
-.DE
+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
+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.
.PP
-Finally, if you want to add additional cleanup code to your harness
-you can define your own \fB::tcltest::cleanupTestsHook\fR. For example:
-.DS
-proc ::tcltest::cleanupTestsHook {} {
- # Add your cleanup code here
-}
-.DE
-.SH EXAMPLES
-.IP [1]
-A simple test file (foo.test)
-.DS
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
- namespace import ::tcltest::*
-}
-
-test foo-1.1 {save 1 in variable name foo} {} {
- set foo 1
-} {1}
+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
+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 [\fBputs\fR] to produce output.
-::tcltest::cleanupTests
-return
-.DE
-.IP [2]
-A simple all.tcl
-.DS
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
- namespace import ::tcltest::*
-}
-
-set ::tcltest::testSingleFile false
-set ::tcltest::testsDirectory [file dir [info script]]
-
-foreach file [::tcltest::getMatchingTestFiles] {
- if {[catch {source $file} msg]} {
- puts stdout $msg
- }
-}
-
-::tclttest::cleanupTests 1
-return
-.DE
-.IP [3]
-Running a single test
-.DS
-tclsh foo.test
-.DE
-.IP [4]
-Running multiple tests
-.DS
-tclsh all.tcl -file 'foo*.test' -notfile 'foo2.test'
-.DE
.SH KEYWORDS
test, test harness, test suite
-
diff --git a/tcl/doc/tclvars.n b/tcl/doc/tclvars.n
index 8639cb3ee0d..fcddaa35574 100644
--- a/tcl/doc/tclvars.n
+++ b/tcl/doc/tclvars.n
@@ -43,7 +43,10 @@ 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
support many special cases. All other environment variables inherited by
-Tcl are left unmodified.
+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.
.VE
.RE
.RS
@@ -87,7 +90,7 @@ The path to the trash directory.
\fBSTART_UP_FOLDER\fR
The path to the start up directory.
.TP
-\fBPWD\fR
+\fBHOME\fR
The path to the application's default directory.
.PP
You can also create your own environment variables for the Macintosh.
@@ -245,10 +248,6 @@ retrieve any relevant information. In addition, extensions
and applications may add additional values to the array. The
predefined elements are:
-
-
-
-
.RS
.VS
.TP
@@ -259,7 +258,7 @@ The native byte order of this machine: either \fBlittleEndian\fR or
.TP
\fBdebug\fR
If this variable exists, then the interpreter
-was compiled with debugging symbols enabled. This varible will only
+was compiled with debugging symbols enabled. This variable will only
exist on Windows so extension writers can specify which package to load
depending on the C run-time library that is loaded.
.TP
@@ -295,6 +294,12 @@ 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 and Macintosh.
+.TP
+\fBwordSize\fR
+.VS 8.4
+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.)
+.VE 8.4
.RE
.TP
\fBtcl_precision\fR
@@ -346,6 +351,9 @@ 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.
+
+This variable and functionality only exist if
+TCL_COMPILE_DEBUG was defined during Tcl's compilation.
.TP
\fBtcl_traceExec\fR
The value of this variable can be set to control
@@ -368,6 +376,9 @@ tracking down suspected problems with the bytecode compiler
and interpreter.
It is also occasionally useful when converting
code to use Tcl8.0.
+
+This variable and functionality only exist if
+TCL_COMPILE_DEBUG was defined during Tcl's compilation.
.TP
\fBtcl_wordchars\fR
The value of this variable is a regular expression that can be set to
@@ -394,5 +405,8 @@ bug fixes that retain backward compatibility.
The value of this variable is returned by the \fBinfo tclversion\fR
command.
+.SH "SEE ALSO"
+eval(n)
+
.SH KEYWORDS
arithmetic, bytecode, compiler, error, environment, POSIX, precision, subprocess, variables
diff --git a/tcl/doc/tell.n b/tcl/doc/tell.n
index 0fac7df2c17..6bc13a59258 100644
--- a/tcl/doc/tell.n
+++ b/tcl/doc/tell.n
@@ -27,6 +27,16 @@ that this value is in terms of bytes, not characters like \fBread\fR.
.VE 8.1
The value returned is -1 for channels that do not support
seeking.
+.PP
+.VS
+\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.
+.VE
+
+.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/tcl/doc/time.n b/tcl/doc/time.n
index 66ba27b2dc0..e33dfffab7e 100644
--- a/tcl/doc/time.n
+++ b/tcl/doc/time.n
@@ -29,5 +29,8 @@ which indicates the average amount of time required per iteration,
in microseconds.
Time is measured in elapsed time, not CPU time.
+.SH "SEE ALSO"
+clock(n)
+
.SH KEYWORDS
script, time
diff --git a/tcl/doc/trace.n b/tcl/doc/trace.n
index 5ead91597f1..7d111fd1eba 100644
--- a/tcl/doc/trace.n
+++ b/tcl/doc/trace.n
@@ -1,6 +1,7 @@
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" Copyright (c) 2000 Ajuba Solutions.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -8,11 +9,11 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH trace n "" Tcl "Tcl Built-In Commands"
+.TH trace n "8.4" Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
-trace \- Monitor variable accesses
+trace \- Monitor variable accesses, command usages and command executions
.SH SYNOPSIS
\fBtrace \fIoption\fR ?\fIarg arg ...\fR?
.BE
@@ -20,12 +21,151 @@ trace \- Monitor variable accesses
.SH DESCRIPTION
.PP
This command causes Tcl commands to be executed whenever certain operations are
-invoked. At present, only variable tracing is implemented. The
-legal \fIoption\fR's (which may be abbreviated) are:
+invoked. The legal \fIoption\fR's (which may be abbreviated) are:
.TP
-\fBtrace variable \fIname ops command\fR
+\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.
+.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'.
+.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.
+.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
+.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).
+\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
+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.
+.RE
+.TP
+\fBtrace add execution\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.
+.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,
+just before the actual execution takes place.
+.TP
+\fBleave\fR
+Invoke \fIcommand\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 a \fIenterstep\fR trace would be
+invoked just before \fIputs "hello"\fR is executed.
+Setting a \fIenterstep\fR trace on a \fIcommand\fR
+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
+command is as follows:
+
+For \fBenter\fR and \fBenterstep\fR operations:
+.CS
+\fIcommand command-string op\fR
+.CE
+\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'
+error will occur.
+.TP
+For \fBleave\fR and \fBleavestep\fR operations:
+.CS
+\fIcommand 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
+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.
+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.
+
+\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.
+
+While \fIcommand\fR is executing during an execution trace, traces
+on \fIname\fR are temporarily disabled. This allows the \fIcommand\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
+\fIcommand\fR name as a whole will return that same error.
+
+When multiple traces are set on \fIname\fR, then for \fIenter\fR
+and \fIenterstep\fR operations, the traced commands are invoked
+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.
+
+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
-is accessed in one of the ways given by \fIops\fR. \fIName\fR may
+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
@@ -35,16 +175,23 @@ will not be given a value, so it will be visible to \fBnamespace which\fR
queries, but not to \fBinfo exists\fR queries.
.RS
.PP
-\fIOps\fR indicates which operations are of interest, and consists of
-one or more of the following letters:
+\fIOps\fR indicates which operations are of interest, and is a list of
+one or more of the following items:
+.TP
+\fBarray\fR
+Invoke \fIcommand\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
-\fBr\fR
+\fBread\fR
Invoke \fIcommand\fR whenever the variable is read.
.TP
-\fBw\fR
+\fBwrite\fR
Invoke \fIcommand\fR whenever the variable is written.
.TP
-\fBu\fR
+\fBunset\fR
Invoke \fIcommand\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
@@ -70,91 +217,143 @@ name used in the \fBtrace variable\fR command: the \fBupvar\fR
command allows a procedure to reference a variable under a
different name.
\fIOp\fR indicates what operation is being performed on the
-variable, and is one of \fBr\fR, \fBw\fR, or \fBu\fR as
+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
-the traced operation: if the variable was accessed as part of a
-Tcl procedure, then \fIcommand\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 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 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 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 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 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 old value of the variable.
+the traced operation: if the variable was accessed as part of a Tcl
+procedure, then \fIcommand\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
+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
+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
+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
+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
+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
+old value of the variable.
.PP
While \fIcommand\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.
-.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 because of a procedure return, then the
-trace will be invoked in the variable context of the procedure
-being returned to: the stack frame of the returning procedure
-will no longer exist.
-Traces are not disabled during unset traces, so if an unset trace
-command creates a new trace and accesses the variable, the
-trace will be invoked.
-Any errors in unset traces are ignored.
-.PP
-If there are multiple traces on a variable they are invoked
-in order of creation, most-recent first.
-If one trace returns an error, then no further traces are
-invoked for the variable.
-If an array element has a trace set, and there is also a trace
-set on the array as a whole, the trace on the overall array
-is invoked before the one on the element.
-.PP
-Once created, the trace remains in effect either until the
-trace is removed with the \fBtrace vdelete\fR command described
-below, until the variable is unset, or until the interpreter
-is deleted.
-Unsetting an element of array will remove any traces on that
-element, but will not remove traces on the overall array.
+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.
+.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
+because of a procedure return, then the trace will be invoked in the
+variable context of the procedure being returned to: the stack frame
+of the returning procedure will no longer exist. Traces are not
+disabled during unset traces, so if an unset trace command creates a
+new trace and accesses the variable, the trace will be invoked. Any
+errors in unset traces are ignored.
+.PP
+If there are multiple traces on a variable they are invoked in order
+of creation, most-recent first. If one trace returns an error, then
+no further traces are invoked for the variable. If an array element
+has a trace set, and there is also a trace set on the array as a
+whole, the trace on the overall array is invoked before the one on the
+element.
+.PP
+Once created, the trace remains in effect either until the trace is
+removed with the \fBtrace remove variable\fR command described below,
+until the variable is unset, or until the interpreter is deleted.
+Unsetting an element of array will remove any traces on that element,
+but will not remove traces on the overall array.
.PP
This command returns an empty string.
.RE
+.RE
+.TP
+\fBtrace remove \fItype name opList command\fR
+Where \fItype\fR is either \fBcommand\fR, \fBexecution\fR or \fBvariable\fR.
+.RS
+.TP
+\fBtrace remove command\fI name opList command\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
+an error.
+.TP
+\fBtrace remove execution\fI name opList command\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
+an error.
+.TP
+\fBtrace remove variable\fI name opList command\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
+an empty string.
+.RE
+.TP
+\fBtrace info \fItype name\fR
+Where \fItype\fR is either \fBcommand\fR, \fBexecution\fR or \fBvariable\fR.
+.RS
+.TP
+\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,
+then the result of the command will be an empty string. If \fIname\fR
+doesn't 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,
+then the result of the command will be an empty string. If \fIname\fR
+doesn't 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
+have any traces set, then the result of the command will be an empty
+string.
+.RE
+.PP
+For backwards compatibility, three other subcommands are available:
+.RS
+.TP
+\fBtrace variable \fIname ops command\fR
+This is equivalent to \fBtrace add variable \fIname ops command\fR.
.TP
\fBtrace vdelete \fIname ops command\fR
-If there is a trace set on variable \fIname\fR with the
-operations and command given by \fIops\fR and \fIcommand\fR,
-then the trace is removed, so that \fIcommand\fR will never
-again be invoked.
-Returns an empty string.
-.TP
-\fBtrace vinfo \fIname\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 \fIops\fR and \fIcommand\fR associated
-with the trace.
-If \fIname\fR doesn't exist or doesn't have any traces set, then
-the result of the command will be an empty string.
+This is equivalent to \fBtrace remove variable \fIname ops command\fR
+.TP
+\fBtrace vinfo \fIname\fR
+This is equivalent to \fBtrace info variable \fIname\fR
+.RE
+.PP
+These subcommands are deprecated and will likely be removed in a
+future version of Tcl. They use an older syntax in which \fBarray\fR,
+\fBread\fR, \fBwrite\fR, \fBunset\fR are replaced by \fBa\fR, \fBr\fR,
+\fBw\fR and \fBu\fR respectively, and the \fIops\fR argument is not a
+list, but simply a string concatenation of the operations, such as
+\fBrwua\fR.
+
+.SH "SEE ALSO"
+set(n), unset(n)
.SH KEYWORDS
-read, variable, write, trace, unset
+read, command, rename, variable, write, trace, unset
diff --git a/tcl/doc/unknown.n b/tcl/doc/unknown.n
index 3bf1ad2b09a..b8d1d3bf937 100644
--- a/tcl/doc/unknown.n
+++ b/tcl/doc/unknown.n
@@ -20,10 +20,11 @@ unknown \- Handle attempts to use non-existent commands
.SH DESCRIPTION
.PP
This command is invoked by the Tcl interpreter whenever a script
-tries to invoke a command that doesn't exist. The implementation
-of \fBunknown\fR isn't part of the Tcl core; instead, it is a
-library procedure defined by default when Tcl starts up. You
-can override the default \fBunknown\fR to change its functionality.
+tries to invoke a command that doesn't 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.
.PP
If the Tcl interpreter encounters a command name for which there
is not a defined command, then Tcl checks for the existence of
@@ -71,5 +72,8 @@ Under normal circumstances the return value from \fBunknown\fR
is the return value from the command that was eventually
executed.
+.SH "SEE ALSO"
+info(n), proc(n), interp(n), library(n)
+
.SH KEYWORDS
error, non-existent command
diff --git a/tcl/doc/unset.n b/tcl/doc/unset.n
index 94ac4ef2e9d..d89b9e3569e 100644
--- a/tcl/doc/unset.n
+++ b/tcl/doc/unset.n
@@ -1,6 +1,7 @@
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" Copyright (c) 2000 Ajuba Solutions.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -8,13 +9,13 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH unset n "" Tcl "Tcl Built-In Commands"
+.TH unset n 8.4 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
unset \- Delete variables
.SH SYNOPSIS
-\fBunset \fIname \fR?\fIname name ...\fR?
+\fBunset \fR?\fI\-nocomplain\fR? ?\fI\-\-\fR? ?\fIname name name ...\fR?
.BE
.SH DESCRIPTION
@@ -27,8 +28,20 @@ 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.
-An error occurs if any of the variables doesn't exist, and any variables
-after the non-existent one are not deleted.
+.VS 8.4
+If \fI\-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
+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.
+.VE 8.4
+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
+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 "SEE ALSO"
+set(n), trace(n)
.SH KEYWORDS
remove, variable
diff --git a/tcl/doc/update.n b/tcl/doc/update.n
index 3c8560b8911..106278843b9 100644
--- a/tcl/doc/update.n
+++ b/tcl/doc/update.n
@@ -44,6 +44,8 @@ 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 "SEE ALSO"
+after(n), bgerror(n)
+
.SH KEYWORDS
event, flush, handler, idle, update
-
diff --git a/tcl/doc/uplevel.n b/tcl/doc/uplevel.n
index 8dd64288cc7..ea3ae765b5b 100644
--- a/tcl/doc/uplevel.n
+++ b/tcl/doc/uplevel.n
@@ -74,7 +74,7 @@ Also, \fBuplevel #0\fR evaluates a script
at top-level in the outermost namespace (the global namespace).
.SH "SEE ALSO"
-namespace(n)
+namespace(n), upvar(n)
.SH KEYWORDS
context, level, namespace, stack frame, variables
diff --git a/tcl/doc/upvar.n b/tcl/doc/upvar.n
index e9876481ee4..8eb5b388d8a 100644
--- a/tcl/doc/upvar.n
+++ b/tcl/doc/upvar.n
@@ -106,7 +106,7 @@ made to \fImyVar\fR will not be passed to subprocesses correctly.
.VE
.SH "SEE ALSO"
-namespace(n)
+global(n), namespace(n), uplevel(n), variable(n)
.SH KEYWORDS
context, frame, global, level, namespace, procedure, variable
diff --git a/tcl/doc/variable.n b/tcl/doc/variable.n
index cc68fc470f5..3ef5abe91fb 100644
--- a/tcl/doc/variable.n
+++ b/tcl/doc/variable.n
@@ -42,7 +42,8 @@ command, but not to the \fBinfo exists\fR command.
.PP
If the \fBvariable\fR command is executed inside a Tcl procedure,
it creates local variables
-linked to the corresponding namespace variables.
+linked to the corresponding namespace variables (and therefore these
+variables are listed by \fBinfo locals\fR.)
In this way the \fBvariable\fR command resembles the \fBglobal\fR command,
although the \fBglobal\fR command
only links to variables in the global namespace.
@@ -59,7 +60,7 @@ elements within the array can be set using ordinary
\fBset\fR or \fBarray\fR commands.
.SH "SEE ALSO"
-global(n), namespace(n)
+global(n), namespace(n), upvar(n)
.SH KEYWORDS
global, namespace, procedure, variable
diff --git a/tcl/doc/vwait.n b/tcl/doc/vwait.n
index 2fdad04fc01..032786b1cce 100644
--- a/tcl/doc/vwait.n
+++ b/tcl/doc/vwait.n
@@ -36,5 +36,8 @@ 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.
+.SH "SEE ALSO"
+global(n)
+
.SH KEYWORDS
event, variable, wait
diff --git a/tcl/doc/while.n b/tcl/doc/while.n
index ddac08573ad..8a5442ff6cc 100644
--- a/tcl/doc/while.n
+++ b/tcl/doc/while.n
@@ -51,5 +51,8 @@ while {$x<10} {
}
.CE
+.SH "SEE ALSO"
+break(n), continue(n), for(n), foreach(n)
+
.SH KEYWORDS
boolean value, loop, test, while
diff --git a/tcl/generic/regc_cvec.c b/tcl/generic/regc_cvec.c
index 86765ea1f73..d2d56fc70a2 100644
--- a/tcl/generic/regc_cvec.c
+++ b/tcl/generic/regc_cvec.c
@@ -36,26 +36,27 @@
*/
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 */
+ int nchrs; /* to hold this many chrs... */
+ int nranges; /* ... and this many ranges... */
+ int nmcces; /* ... and this many MCCEs */
{
- size_t n;
- size_t nc;
- struct cvec *cv;
+ size_t n;
+ size_t nc;
+ struct cvec *cv;
- 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 = nc;
- cv->chrs = (chr *)&cv->mcces[nmcces]; /* chrs just after MCCE ptrs */
- cv->mccespace = nmcces;
- cv->ranges = cv->chrs + nchrs + nmcces*(MAXMCCE+1);
- cv->rangespace = nranges;
- return clearcvec(cv);
+ 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->rangespace = nranges;
+ return clearcvec(cv);
}
/*
@@ -65,20 +66,21 @@ int nmcces; /* ... and this many MCCEs */
*/
static struct cvec *
clearcvec(cv)
-struct cvec *cv;
+ struct cvec *cv; /* character vector */
{
- int i;
+ 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;
+ 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;
+ return cv;
}
/*
@@ -87,11 +89,11 @@ struct cvec *cv;
*/
static VOID
addchr(cv, c)
-struct cvec *cv;
-pchr c;
+ struct cvec *cv; /* character vector */
+ pchr c; /* character to add */
{
- assert(cv->nchrs < cv->chrspace - cv->nmccechrs);
- cv->chrs[cv->nchrs++] = (chr)c;
+ assert(cv->nchrs < cv->chrspace - cv->nmccechrs);
+ cv->chrs[cv->nchrs++] = (chr)c;
}
/*
@@ -100,14 +102,14 @@ pchr c;
*/
static VOID
addrange(cv, from, to)
-struct cvec *cv;
-pchr from;
-pchr to;
+ 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++;
+ assert(cv->nranges < cv->rangespace);
+ cv->ranges[cv->nranges*2] = (chr)from;
+ cv->ranges[cv->nranges*2 + 1] = (chr)to;
+ cv->nranges++;
}
/*
@@ -116,49 +118,55 @@ pchr to;
*/
static VOID
addmcce(cv, startp, endp)
-struct cvec *cv;
-chr *startp; /* beginning of text */
-chr *endp; /* just past end of text */
+ 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;
+ 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;
+ 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 */
+static int /* predicate */
haschr(cv, c)
-struct cvec *cv;
-pchr c;
+ struct cvec *cv; /* character vector */
+ pchr c; /* character to test for */
{
- int i;
- chr *p;
+ 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;
+ 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;
}
/*
@@ -167,23 +175,25 @@ pchr c;
*/
static struct cvec *
getcvec(v, nchrs, nranges, nmcces)
-struct vars *v;
-int nchrs; /* to hold this many chrs... */
-int nranges; /* ... and this many ranges... */
-int nmcces; /* ... and this many MCCEs */
+ struct vars *v; /* context */
+ int nchrs; /* to hold this many chrs... */
+ int nranges; /* ... and this many ranges... */
+ int nmcces; /* ... and this many MCCEs */
{
- if (v->cv != NULL && nchrs <= v->cv->chrspace &&
- nranges <= v->cv->rangespace &&
- nmcces <= v->cv->mccespace)
- return clearcvec(v->cv);
+ if (v->cv != NULL && nchrs <= v->cv->chrspace &&
+ nranges <= v->cv->rangespace && nmcces <= v->cv->mccespace) {
+ return clearcvec(v->cv);
+ }
- if (v->cv != NULL)
- freecvec(v->cv);
- v->cv = newcvec(nchrs, nranges, nmcces);
- if (v->cv == NULL)
- ERR(REG_ESPACE);
+ if (v->cv != NULL) {
+ freecvec(v->cv);
+ }
+ v->cv = newcvec(nchrs, nranges, nmcces);
+ if (v->cv == NULL) {
+ ERR(REG_ESPACE);
+ }
- return v->cv;
+ return v->cv;
}
/*
@@ -192,7 +202,7 @@ int nmcces; /* ... and this many MCCEs */
*/
static VOID
freecvec(cv)
-struct cvec *cv;
+ struct cvec *cv; /* character vector */
{
- FREE(cv);
+ FREE(cv);
}
diff --git a/tcl/generic/regc_locale.c b/tcl/generic/regc_locale.c
index 100ba0a9415..695b665b1f2 100644
--- a/tcl/generic/regc_locale.c
+++ b/tcl/generic/regc_locale.c
@@ -15,105 +15,105 @@
/* ASCII character-name table */
static struct cname {
- char *name;
- char code;
+ char *name;
+ char code;
} cnames[] = {
- {"NUL", '\0'},
- {"SOH", '\001'},
- {"STX", '\002'},
- {"ETX", '\003'},
- {"EOT", '\004'},
- {"ENQ", '\005'},
- {"ACK", '\006'},
- {"BEL", '\007'},
- {"alert", '\007'},
- {"BS", '\010'},
- {"backspace", '\b'},
- {"HT", '\011'},
- {"tab", '\t'},
- {"LF", '\012'},
- {"newline", '\n'},
- {"VT", '\013'},
- {"vertical-tab", '\v'},
- {"FF", '\014'},
- {"form-feed", '\f'},
- {"CR", '\015'},
- {"carriage-return", '\r'},
- {"SO", '\016'},
- {"SI", '\017'},
- {"DLE", '\020'},
- {"DC1", '\021'},
- {"DC2", '\022'},
- {"DC3", '\023'},
- {"DC4", '\024'},
- {"NAK", '\025'},
- {"SYN", '\026'},
- {"ETB", '\027'},
- {"CAN", '\030'},
- {"EM", '\031'},
- {"SUB", '\032'},
- {"ESC", '\033'},
- {"IS4", '\034'},
- {"FS", '\034'},
- {"IS3", '\035'},
- {"GS", '\035'},
- {"IS2", '\036'},
- {"RS", '\036'},
- {"IS1", '\037'},
- {"US", '\037'},
- {"space", ' '},
- {"exclamation-mark", '!'},
- {"quotation-mark", '"'},
- {"number-sign", '#'},
- {"dollar-sign", '$'},
- {"percent-sign", '%'},
- {"ampersand", '&'},
- {"apostrophe", '\''},
- {"left-parenthesis", '('},
- {"right-parenthesis", ')'},
- {"asterisk", '*'},
- {"plus-sign", '+'},
- {"comma", ','},
- {"hyphen", '-'},
- {"hyphen-minus", '-'},
- {"period", '.'},
- {"full-stop", '.'},
- {"slash", '/'},
- {"solidus", '/'},
- {"zero", '0'},
- {"one", '1'},
- {"two", '2'},
- {"three", '3'},
- {"four", '4'},
- {"five", '5'},
- {"six", '6'},
- {"seven", '7'},
- {"eight", '8'},
- {"nine", '9'},
- {"colon", ':'},
- {"semicolon", ';'},
- {"less-than-sign", '<'},
- {"equals-sign", '='},
- {"greater-than-sign", '>'},
- {"question-mark", '?'},
- {"commercial-at", '@'},
- {"left-square-bracket", '['},
- {"backslash", '\\'},
- {"reverse-solidus", '\\'},
- {"right-square-bracket", ']'},
- {"circumflex", '^'},
- {"circumflex-accent", '^'},
- {"underscore", '_'},
- {"low-line", '_'},
- {"grave-accent", '`'},
- {"left-brace", '{'},
- {"left-curly-bracket", '{'},
- {"vertical-line", '|'},
- {"right-brace", '}'},
- {"right-curly-bracket", '}'},
- {"tilde", '~'},
- {"DEL", '\177'},
- {NULL, 0}
+ {"NUL", '\0'},
+ {"SOH", '\001'},
+ {"STX", '\002'},
+ {"ETX", '\003'},
+ {"EOT", '\004'},
+ {"ENQ", '\005'},
+ {"ACK", '\006'},
+ {"BEL", '\007'},
+ {"alert", '\007'},
+ {"BS", '\010'},
+ {"backspace", '\b'},
+ {"HT", '\011'},
+ {"tab", '\t'},
+ {"LF", '\012'},
+ {"newline", '\n'},
+ {"VT", '\013'},
+ {"vertical-tab", '\v'},
+ {"FF", '\014'},
+ {"form-feed", '\f'},
+ {"CR", '\015'},
+ {"carriage-return", '\r'},
+ {"SO", '\016'},
+ {"SI", '\017'},
+ {"DLE", '\020'},
+ {"DC1", '\021'},
+ {"DC2", '\022'},
+ {"DC3", '\023'},
+ {"DC4", '\024'},
+ {"NAK", '\025'},
+ {"SYN", '\026'},
+ {"ETB", '\027'},
+ {"CAN", '\030'},
+ {"EM", '\031'},
+ {"SUB", '\032'},
+ {"ESC", '\033'},
+ {"IS4", '\034'},
+ {"FS", '\034'},
+ {"IS3", '\035'},
+ {"GS", '\035'},
+ {"IS2", '\036'},
+ {"RS", '\036'},
+ {"IS1", '\037'},
+ {"US", '\037'},
+ {"space", ' '},
+ {"exclamation-mark",'!'},
+ {"quotation-mark", '"'},
+ {"number-sign", '#'},
+ {"dollar-sign", '$'},
+ {"percent-sign", '%'},
+ {"ampersand", '&'},
+ {"apostrophe", '\''},
+ {"left-parenthesis",'('},
+ {"right-parenthesis", ')'},
+ {"asterisk", '*'},
+ {"plus-sign", '+'},
+ {"comma", ','},
+ {"hyphen", '-'},
+ {"hyphen-minus", '-'},
+ {"period", '.'},
+ {"full-stop", '.'},
+ {"slash", '/'},
+ {"solidus", '/'},
+ {"zero", '0'},
+ {"one", '1'},
+ {"two", '2'},
+ {"three", '3'},
+ {"four", '4'},
+ {"five", '5'},
+ {"six", '6'},
+ {"seven", '7'},
+ {"eight", '8'},
+ {"nine", '9'},
+ {"colon", ':'},
+ {"semicolon", ';'},
+ {"less-than-sign", '<'},
+ {"equals-sign", '='},
+ {"greater-than-sign", '>'},
+ {"question-mark", '?'},
+ {"commercial-at", '@'},
+ {"left-square-bracket", '['},
+ {"backslash", '\\'},
+ {"reverse-solidus", '\\'},
+ {"right-square-bracket", ']'},
+ {"circumflex", '^'},
+ {"circumflex-accent", '^'},
+ {"underscore", '_'},
+ {"low-line", '_'},
+ {"grave-accent", '`'},
+ {"left-brace", '{'},
+ {"left-curly-bracket", '{'},
+ {"vertical-line", '|'},
+ {"right-brace", '}'},
+ {"right-curly-bracket", '}'},
+ {"tilde", '~'},
+ {"DEL", '\177'},
+ {NULL, 0}
};
/* Unicode character-class tables */
@@ -123,17 +123,22 @@ typedef struct crange {
chr end;
} crange;
-/* Unicode: (Alphabetic) */
+/*
+ * Declarations of Unicode character ranges. This code
+ * is automatically generated by the tools/uniClass.tcl script
+ * 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, 0x01f5}, {0x01fa, 0x0217}, {0x0250, 0x02a8}, {0x02b0, 0x02b8},
+ {0x00f8, 0x021f}, {0x0222, 0x0233}, {0x0250, 0x02ad}, {0x02b0, 0x02b8},
{0x02bb, 0x02c1}, {0x02e0, 0x02e4}, {0x0388, 0x038a}, {0x038e, 0x03a1},
- {0x03a3, 0x03ce}, {0x03d0, 0x03d6}, {0x03e2, 0x03f3}, {0x0401, 0x040c},
- {0x040e, 0x044f}, {0x0451, 0x045c}, {0x045e, 0x0481}, {0x0490, 0x04c4},
- {0x04d0, 0x04eb}, {0x04ee, 0x04f5}, {0x0531, 0x0556}, {0x0561, 0x0587},
+ {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, 0x06b7}, {0x06ba, 0x06be}, {0x06c0, 0x06ce}, {0x06d0, 0x06d3},
+ {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},
@@ -144,90 +149,104 @@ static crange alphaRangeTable[] = {
{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}, {0x0e01, 0x0e30}, {0x0e40, 0x0e46},
+ {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, 0x0f69}, {0x0f88, 0x0f8b},
- {0x10a0, 0x10c5}, {0x10d0, 0x10f6}, {0x1100, 0x1159}, {0x115f, 0x11a2},
- {0x11a8, 0x11f9}, {0x1e00, 0x1e9b}, {0x1ea0, 0x1ef9}, {0x1f00, 0x1f15},
- {0x1f18, 0x1f1d}, {0x1f20, 0x1f45}, {0x1f48, 0x1f4d}, {0x1f50, 0x1f57},
- {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4}, {0x1fb6, 0x1fbc}, {0x1fc2, 0x1fc4},
- {0x1fc6, 0x1fcc}, {0x1fd0, 0x1fd3}, {0x1fd6, 0x1fdb}, {0x1fe0, 0x1fec},
- {0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffc}, {0x210a, 0x2113}, {0x2118, 0x211d},
- {0x212a, 0x2131}, {0x2133, 0x2138}, {0x3031, 0x3035}, {0x3041, 0x3094},
- {0x30a1, 0x30fa}, {0x30fc, 0x30fe}, {0x3105, 0x312c}, {0x3131, 0x318e},
- {0x4e00, 0x9fa5}, {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}
+ {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}
};
#define NUM_ALPHA_RANGE (sizeof(alphaRangeTable)/sizeof(crange))
static chr alphaCharTable[] = {
- 0x00aa, 0x00b5, 0x00ba, 0x02d0, 0x02d1, 0x037a, 0x0386, 0x038c, 0x03da,
- 0x03dc, 0x03de, 0x03e0, 0x04c7, 0x04c8, 0x04cb, 0x04cc, 0x04f8, 0x04f9,
- 0x0559, 0x06d5, 0x06e5, 0x06e6, 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, 0x0e32, 0x0e33, 0x0e81, 0x0e82, 0x0e84,
- 0x0e87, 0x0e88, 0x0e8a, 0x0e8d, 0x0ea5, 0x0ea7, 0x0eaa, 0x0eab, 0x0eb2,
- 0x0eb3, 0x0ebd, 0x0ec6, 0x0edc, 0x0edd, 0x0f00, 0x1f59, 0x1f5b, 0x1f5d,
- 0x1fbe, 0x207f, 0x2102, 0x2107, 0x2115, 0x2124, 0x2126, 0x2128, 0x3005,
- 0x3006, 0x309d, 0x309e, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, 0xfb44, 0xfe74
+ 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
};
#define NUM_ALPHA_CHAR (sizeof(alphaCharTable)/sizeof(chr))
-/* Unicode: (Decimal digit) */
+/* 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}, {0xff10, 0xff19}
+ {0x0e50, 0x0e59}, {0x0ed0, 0x0ed9}, {0x0f20, 0x0f29}, {0x1040, 0x1049},
+ {0x1369, 0x1371}, {0x17e0, 0x17e9}, {0x1810, 0x1819}, {0xff10, 0xff19}
};
#define NUM_DIGIT_RANGE (sizeof(digitRangeTable)/sizeof(crange))
-/* Unicode: (Punctuation) */
+/* no singletons of digit characters */
+
+/* Unicode: punctuation characters */
static crange punctRangeTable[] = {
{0x0021, 0x0023}, {0x0025, 0x002a}, {0x002c, 0x002f}, {0x005b, 0x005d},
- {0x055a, 0x055f}, {0x066a, 0x066d}, {0x0f04, 0x0f12}, {0x0f3a, 0x0f3d},
- {0x2010, 0x2027}, {0x2030, 0x2043}, {0x3001, 0x3003}, {0x3008, 0x3011},
- {0x3014, 0x301f}, {0xfe30, 0xfe44}, {0xfe49, 0xfe52}, {0xfe54, 0xfe61},
- {0xff01, 0xff03}, {0xff05, 0xff0a}, {0xff0c, 0xff0f}, {0xff3b, 0xff3d},
- {0xff61, 0xff65}
+ {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}
};
#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, 0x05be, 0x05c0,
- 0x05c3, 0x05f3, 0x05f4, 0x060c, 0x061b, 0x061f, 0x06d4, 0x0964, 0x0965,
- 0x0970, 0x0e5a, 0x0e5b, 0x0f85, 0x10fb, 0x2045, 0x2046, 0x207d, 0x207e,
- 0x208d, 0x208e, 0x2329, 0x232a, 0x3030, 0x30fb, 0xfd3e, 0xfd3f, 0xfe63,
- 0xfe68, 0xfe6a, 0xfe6b, 0xff1a, 0xff1b, 0xff1f, 0xff20, 0xff3f, 0xff5b,
- 0xff5d
+ 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
};
#define NUM_PUNCT_CHAR (sizeof(punctCharTable)/sizeof(chr))
-/* Unicode: (White space) */
+/* Unicode: white space characters */
static crange spaceRangeTable[] = {
- {0x0009, 0x000d}, {0x2000, 0x200b},
+ {0x0009, 0x000d}, {0x2000, 0x200b}
};
#define NUM_SPACE_RANGE (sizeof(spaceRangeTable)/sizeof(crange))
static chr spaceCharTable[] = {
- 0x0020, 0x00a0, 0x2028, 0x2029, 0x3000
+ 0x0020, 0x00a0, 0x1680, 0x2028, 0x2029, 0x202f, 0x3000
};
#define NUM_SPACE_CHAR (sizeof(spaceCharTable)/sizeof(chr))
@@ -236,8 +255,8 @@ static chr spaceCharTable[] = {
static crange lowerRangeTable[] = {
{0x0061, 0x007a}, {0x00df, 0x00f6}, {0x00f8, 0x00ff}, {0x017e, 0x0180},
- {0x0199, 0x019b}, {0x0250, 0x02a8}, {0x03ac, 0x03ce}, {0x03ef, 0x03f2},
- {0x0430, 0x044f}, {0x0451, 0x045c}, {0x0561, 0x0587}, {0x10d0, 0x10f6},
+ {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},
@@ -256,20 +275,22 @@ static chr lowerCharTable[] = {
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, 0x01ab, 0x01ad, 0x01b0,
- 0x01b4, 0x01b6, 0x01b9, 0x01ba, 0x01bd, 0x01c6, 0x01c9, 0x01cc, 0x01ce,
+ 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, 0x01fb, 0x01fd, 0x01ff, 0x0201, 0x0203, 0x0205, 0x0207,
- 0x0209, 0x020b, 0x020d, 0x020f, 0x0211, 0x0213, 0x0215, 0x0217, 0x0390,
- 0x03d0, 0x03d1, 0x03d5, 0x03d6, 0x03e3, 0x03e5, 0x03e7, 0x03e9, 0x03eb,
- 0x03ed, 0x045e, 0x045f, 0x0461, 0x0463, 0x0465, 0x0467, 0x0469, 0x046b,
- 0x046d, 0x046f, 0x0471, 0x0473, 0x0475, 0x0477, 0x0479, 0x047b, 0x047d,
- 0x047f, 0x0481, 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, 0x04ef,
+ 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,
@@ -285,7 +306,7 @@ static chr lowerCharTable[] = {
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, 0x2118, 0x212e, 0x212f, 0x2134
+ 0x210f, 0x2113, 0x212f, 0x2134, 0x2139
};
#define NUM_LOWER_CHAR (sizeof(lowerCharTable)/sizeof(chr))
@@ -294,14 +315,13 @@ static chr lowerCharTable[] = {
static crange upperRangeTable[] = {
{0x0041, 0x005a}, {0x00c0, 0x00d6}, {0x00d8, 0x00de}, {0x0189, 0x018b},
- {0x018e, 0x0191}, {0x0196, 0x0198}, {0x01b1, 0x01b3}, {0x0388, 0x038a},
- {0x0391, 0x03a1}, {0x03a3, 0x03ab}, {0x03d2, 0x03d4}, {0x0401, 0x040c},
- {0x040e, 0x042f}, {0x0531, 0x0556}, {0x10a0, 0x10c5}, {0x1f08, 0x1f0f},
+ {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}, {0x1f88, 0x1f8f}, {0x1f98, 0x1f9f}, {0x1fa8, 0x1faf},
- {0x1fb8, 0x1fbc}, {0x1fc8, 0x1fcc}, {0x1fd8, 0x1fdb}, {0x1fe8, 0x1fec},
- {0x1ff8, 0x1ffc}, {0x210b, 0x210d}, {0x2110, 0x2112}, {0x2119, 0x211d},
- {0x212a, 0x212d}, {0xff21, 0xff3a}
+ {0x1f68, 0x1f6f}, {0x1fb8, 0x1fbb}, {0x1fc8, 0x1fcb}, {0x1fd8, 0x1fdb},
+ {0x1fe8, 0x1fec}, {0x1ff8, 0x1ffb}, {0x210b, 0x210d}, {0x2110, 0x2112},
+ {0x2119, 0x211d}, {0x212a, 0x212d}, {0xff21, 0xff3a}
};
#define NUM_UPPER_RANGE (sizeof(upperRangeTable)/sizeof(crange))
@@ -320,15 +340,17 @@ static chr upperCharTable[] = {
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, 0x0386, 0x038c, 0x038e,
- 0x038f, 0x03da, 0x03dc, 0x03de, 0x03e0, 0x03e2, 0x03e4, 0x03e6, 0x03e8,
- 0x03ea, 0x03ec, 0x03ee, 0x0460, 0x0462, 0x0464, 0x0466, 0x0468, 0x046a,
- 0x046c, 0x046e, 0x0470, 0x0472, 0x0474, 0x0476, 0x0478, 0x047a, 0x047c,
- 0x047e, 0x0480, 0x0490, 0x0492, 0x0494, 0x0496, 0x0498, 0x049a, 0x049c,
- 0x049e, 0x04a0, 0x04a2, 0x04a4, 0x04a6, 0x04a8, 0x04aa, 0x04ac, 0x04ae,
- 0x04b0, 0x04b2, 0x04b4, 0x04b6, 0x04b8, 0x04ba, 0x04bc, 0x04be, 0x04c1,
- 0x04c3, 0x04c7, 0x04cb, 0x04d0, 0x04d2, 0x04d4, 0x04d6, 0x04d8, 0x04da,
- 0x04dc, 0x04de, 0x04e0, 0x04e2, 0x04e4, 0x04e6, 0x04e8, 0x04ea, 0x04ee,
+ 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,
@@ -349,66 +371,83 @@ static chr upperCharTable[] = {
#define NUM_UPPER_CHAR (sizeof(upperCharTable)/sizeof(chr))
-/*
- * The graph table includes the set of characters that are Unicode
- * print characters excluding space.
- */
+/* Unicode: unicode print characters excluding space */
static crange graphRangeTable[] = {
- {0x0021, 0x007e}, {0x00a0, 0x011f}, {0x0121, 0x01f5}, {0x01fa, 0x0217},
- {0x0250, 0x02a8}, {0x02b0, 0x02de}, {0x02e0, 0x02e9}, {0x0300, 0x031f},
- {0x0321, 0x0345}, {0x0384, 0x038a}, {0x038e, 0x03a1}, {0x03a3, 0x03ce},
- {0x03d0, 0x03d6}, {0x03e2, 0x03f3}, {0x0401, 0x040c}, {0x040e, 0x041f},
- {0x0421, 0x044f}, {0x0451, 0x045c}, {0x045e, 0x0486}, {0x0490, 0x04c4},
- {0x04d0, 0x04eb}, {0x04ee, 0x04f5}, {0x0531, 0x0556}, {0x0559, 0x055f},
+ {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, 0x0652},
- {0x0660, 0x066d}, {0x0670, 0x06b7}, {0x06ba, 0x06be}, {0x06c0, 0x06ce},
- {0x06d0, 0x06ed}, {0x06f0, 0x06f9}, {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},
- {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, 0x0f69}, {0x0f71, 0x0f8b}, {0x0f90, 0x0f95},
- {0x0f99, 0x0fad}, {0x0fb1, 0x0fb7}, {0x10a0, 0x10c5}, {0x10d0, 0x10f6},
- {0x1100, 0x111f}, {0x1121, 0x1159}, {0x115f, 0x11a2}, {0x11a8, 0x11f9},
+ {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}, {0x2030, 0x2046},
- {0x2074, 0x208e}, {0x20a0, 0x20ac}, {0x20d0, 0x20e1}, {0x2100, 0x211f},
- {0x2121, 0x2138}, {0x2153, 0x2182}, {0x2190, 0x21ea}, {0x2200, 0x221f},
- {0x2221, 0x22f1}, {0x2302, 0x231f}, {0x2321, 0x237a}, {0x2400, 0x241f},
- {0x2421, 0x2424}, {0x2440, 0x244a}, {0x2460, 0x24ea}, {0x2500, 0x251f},
- {0x2521, 0x2595}, {0x25a0, 0x25ef}, {0x2600, 0x2613}, {0x261a, 0x261f},
- {0x2621, 0x266f}, {0x2701, 0x2704}, {0x2706, 0x2709}, {0x270c, 0x271f},
- {0x2721, 0x2727}, {0x2729, 0x274b}, {0x274f, 0x2752}, {0x2758, 0x275e},
- {0x2761, 0x2767}, {0x2776, 0x2794}, {0x2798, 0x27af}, {0x27b1, 0x27be},
- {0x3000, 0x301f}, {0x3021, 0x3037}, {0x3041, 0x3094}, {0x3099, 0x309e},
- {0x30a1, 0x30fe}, {0x3105, 0x311f}, {0x3121, 0x312c}, {0x3131, 0x318e},
- {0x3190, 0x319f}, {0x3200, 0x321c}, {0x3221, 0x3243}, {0x3260, 0x327b},
- {0x327f, 0x32b0}, {0x32c0, 0x32cb}, {0x32d0, 0x32fe}, {0x3300, 0x331f},
- {0x3321, 0x3376}, {0x337b, 0x33dd}, {0x33e0, 0x33fe}, {0x4e00, 0x4e1f},
+ {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},
@@ -429,49 +468,55 @@ static crange graphRangeTable[] = {
{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}, {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},
- {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}
+ {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}
};
#define NUM_GRAPH_RANGE (sizeof(graphRangeTable)/sizeof(crange))
static chr graphCharTable[] = {
- 0x0360, 0x0361, 0x0374, 0x0375, 0x037a, 0x037e, 0x038c, 0x03da, 0x03dc,
- 0x03de, 0x03e0, 0x04c7, 0x04c8, 0x04cb, 0x04cc, 0x04f8, 0x04f9, 0x0589,
- 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, 0x0e81, 0x0e82, 0x0e84, 0x0e87, 0x0e88, 0x0e8a,
- 0x0e8d, 0x0ea5, 0x0ea7, 0x0eaa, 0x0eab, 0x0ec6, 0x0edc, 0x0edd, 0x0f97,
- 0x0fb9, 0x10fb, 0x1f59, 0x1f5b, 0x1f5d, 0x2070, 0x2300, 0x274d, 0x2756,
- 0x303f, 0xfb1e, 0xfb1f, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, 0xfb44, 0xfe74,
- 0xfffc, 0xfffd
+ 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
};
#define NUM_GRAPH_CHAR (sizeof(graphCharTable)/sizeof(chr))
+/*
+ * End of auto-generated Unicode character ranges declarations.
+ */
#define CH NOCELT
@@ -481,9 +526,12 @@ static chr graphCharTable[] = {
*/
static int
nmcces(v)
-struct vars *v;
+ struct vars *v; /* context */
{
- return 0;
+ /*
+ * No multi-character collating elements defined at the moment.
+ */
+ return 0;
}
/*
@@ -492,9 +540,9 @@ struct vars *v;
*/
static int
nleaders(v)
-struct vars *v;
+ struct vars *v; /* context */
{
- return 0;
+ return 0;
}
/*
@@ -503,10 +551,10 @@ struct vars *v;
*/
static struct cvec *
allmcces(v, cv)
-struct vars *v;
-struct cvec *cv; /* this is supposed to have enough room */
+ struct vars *v; /* context */
+ struct cvec *cv; /* this is supposed to have enough room */
{
- return clearcvec(cv);
+ return clearcvec(cv);
}
/*
@@ -515,36 +563,40 @@ struct cvec *cv; /* this is supposed to have enough room */
*/
static celt
element(v, startp, endp)
-struct vars *v;
-chr *startp; /* points to start of name */
-chr *endp; /* points just past end of name */
+ struct vars *v; /* context */
+ chr *startp; /* points to start of name */
+ chr *endp; /* points just past end of name */
{
- struct cname *cn;
- size_t len;
- Tcl_DString ds;
- char *np;
-
- /* generic: one-chr names stand for themselves */
- assert(startp < endp);
- len = endp - startp;
- if (len == 1)
- return *startp;
-
- NOTE(REG_ULOCALE);
-
- /* search table */
- Tcl_DStringInit(&ds);
- np = Tcl_UniCharToUtfDString(startp, (int)len, &ds);
- for (cn = cnames; cn->name != NULL; cn++)
- if (strlen(cn->name) == len && strncmp(cn->name, np, len) == 0)
- break; /* NOTE BREAK OUT */
- Tcl_DStringFree(&ds);
- if (cn->name != NULL)
- return CHR(cn->code);
-
- /* couldn't find it */
- ERR(REG_ECOLLATE);
- return 0;
+ struct cname *cn;
+ size_t len;
+ Tcl_DString ds;
+ CONST char *np;
+
+ /* generic: one-chr names stand for themselves */
+ assert(startp < endp);
+ len = endp - startp;
+ if (len == 1) {
+ return *startp;
+ }
+
+ NOTE(REG_ULOCALE);
+
+ /* search table */
+ Tcl_DStringInit(&ds);
+ np = Tcl_UniCharToUtfDString(startp, (int)len, &ds);
+ for (cn=cnames; cn->name!=NULL; cn++) {
+ if (strlen(cn->name)==len && strncmp(cn->name, np, len)==0) {
+ break; /* NOTE BREAK OUT */
+ }
+ }
+ Tcl_DStringFree(&ds);
+ if (cn->name != NULL) {
+ return CHR(cn->code);
+ }
+
+ /* couldn't find it */
+ ERR(REG_ECOLLATE);
+ return 0;
}
/*
@@ -553,71 +605,71 @@ chr *endp; /* points just past end of name */
*/
static struct cvec *
range(v, a, b, cases)
-struct vars *v;
-celt a;
-celt b; /* might equal a */
-int cases; /* case-independent? */
+ struct vars *v; /* context */
+ celt a; /* range start */
+ celt b; /* range end, might equal a */
+ int cases; /* case-independent? */
{
- int nchrs;
- struct cvec *cv;
- celt c, lc, uc, tc;
+ int nchrs;
+ struct cvec *cv;
+ celt c, lc, uc, tc;
- if (a != b && !before(a, b)) {
- ERR(REG_ERANGE);
- return NULL;
- }
+ if (a != b && !before(a, b)) {
+ ERR(REG_ERANGE);
+ return NULL;
+ }
- if (!cases) { /* easy version */
- cv = getcvec(v, 0, 1, 0);
- NOERRN();
- addrange(cv, a, b);
- return cv;
- }
+ if (!cases) { /* easy version */
+ cv = getcvec(v, 0, 1, 0);
+ 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;
+ nchrs = (b - a + 1)*2 + 4;
- cv = getcvec(v, nchrs, 0, 0);
- NOERRN();
+ cv = getcvec(v, nchrs, 0, 0);
+ NOERRN();
- for (c = a; c <= b; c++) {
- addchr(cv, c);
- lc = Tcl_UniCharToLower((chr)c);
- uc = Tcl_UniCharToUpper((chr)c);
- tc = Tcl_UniCharToTitle((chr)c);
- if (c != lc) {
- addchr(cv, lc);
- }
- if (c != uc) {
- addchr(cv, uc);
- }
- if (c != tc && tc != uc) {
- addchr(cv, tc);
- }
+ for (c=a; c<=b; c++) {
+ addchr(cv, c);
+ lc = Tcl_UniCharToLower((chr)c);
+ uc = Tcl_UniCharToUpper((chr)c);
+ tc = Tcl_UniCharToTitle((chr)c);
+ if (c != lc) {
+ addchr(cv, lc);
+ }
+ if (c != uc) {
+ addchr(cv, uc);
+ }
+ if (c != tc && tc != uc) {
+ addchr(cv, tc);
}
+ }
- return cv;
+ return cv;
}
/*
- before - is celt x before celt y, for purposes of range legality?
^ static int before(celt, celt);
*/
-static int /* predicate */
+static int /* predicate */
before(x, y)
-celt x;
-celt y;
+ celt x, y; /* collating elements */
{
- /* trivial because no MCCEs */
- if (x < y)
- return 1;
- return 0;
+ /* trivial because no MCCEs */
+ if (x < y) {
+ return 1;
+ }
+ return 0;
}
/*
@@ -627,31 +679,33 @@ celt y;
*/
static struct cvec *
eclass(v, c, cases)
-struct vars *v;
-celt c;
-int cases; /* all cases? */
+ 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 */
- if ((v->cflags&REG_FAKE) && c == 'x') {
- cv = getcvec(v, 4, 0, 0);
- addchr(cv, (chr)'x');
- addchr(cv, (chr)'y');
- if (cases) {
- addchr(cv, (chr)'X');
- addchr(cv, (chr)'Y');
- }
- return cv;
+ struct cvec *cv;
+
+ /* crude fake equivalence class for testing */
+ if ((v->cflags&REG_FAKE) && c == 'x') {
+ cv = getcvec(v, 4, 0, 0);
+ addchr(cv, (chr)'x');
+ addchr(cv, (chr)'y');
+ if (cases) {
+ addchr(cv, (chr)'X');
+ addchr(cv, (chr)'Y');
}
-
- /* otherwise, none */
- if (cases)
- return allcases(v, c);
- cv = getcvec(v, 1, 0, 0);
- assert(cv != NULL);
- addchr(cv, (chr)c);
return cv;
+ }
+
+ /* otherwise, none */
+ if (cases) {
+ return allcases(v, c);
+ }
+ cv = getcvec(v, 1, 0, 0);
+ assert(cv != NULL);
+ addchr(cv, (chr)c);
+ return cv;
}
/*
@@ -661,15 +715,16 @@ int cases; /* all cases? */
*/
static struct cvec *
cclass(v, startp, endp, cases)
-struct vars *v;
-chr *startp; /* where the name starts */
-chr *endp; /* just past the end of the name */
-int cases; /* case-independent? */
+ struct vars *v; /* context */
+ chr *startp; /* where the name starts */
+ chr *endp; /* just past the end of the name */
+ int cases; /* case-independent? */
{
size_t len;
struct cvec *cv = NULL;
Tcl_DString ds;
- char *np, **namePtr;
+ CONST char *np;
+ char **namePtr;
int i, index;
/*
@@ -709,7 +764,7 @@ int cases; /* case-independent? */
*/
index = -1;
- for (namePtr = classNames, i = 0; *namePtr != NULL; namePtr++, i++) {
+ for (namePtr=classNames,i=0 ; *namePtr!=NULL ; namePtr++,i++) {
if ((strlen(*namePtr) == len) && (strncmp(*namePtr, np, len) == 0)) {
index = i;
break;
@@ -726,129 +781,137 @@ int cases; /* case-independent? */
*/
switch((enum classes) index) {
- case CC_PRINT:
- case CC_ALNUM:
- cv = getcvec(v, NUM_ALPHA_CHAR,
- NUM_DIGIT_RANGE + NUM_ALPHA_RANGE, 0);
- if (cv) {
- for (i = 0; i < NUM_ALPHA_CHAR; i++) {
- addchr(cv, alphaCharTable[i]);
- }
- for (i = 0; i < NUM_ALPHA_RANGE; i++) {
- addrange(cv, alphaRangeTable[i].start,
- alphaRangeTable[i].end);
- }
- for (i = 0; i < NUM_DIGIT_RANGE; i++) {
- addrange(cv, digitRangeTable[i].start,
- digitRangeTable[i].end);
- }
+ case CC_PRINT:
+ case CC_ALNUM:
+ cv = getcvec(v, NUM_ALPHA_CHAR, NUM_DIGIT_RANGE + NUM_ALPHA_RANGE, 0);
+ if (cv) {
+ for (i=0 ; i<NUM_ALPHA_CHAR ; i++) {
+ addchr(cv, alphaCharTable[i]);
}
- break;
- case CC_ALPHA:
- cv = getcvec(v, NUM_ALPHA_CHAR, NUM_ALPHA_RANGE, 0);
- if (cv) {
- for (i = 0; i < NUM_ALPHA_RANGE; i++) {
- addrange(cv, alphaRangeTable[i].start,
- alphaRangeTable[i].end);
- }
- for (i = 0; i < NUM_ALPHA_CHAR; i++) {
- addchr(cv, alphaCharTable[i]);
- }
+ for (i=0 ; i<NUM_ALPHA_RANGE ; i++) {
+ addrange(cv, alphaRangeTable[i].start,
+ alphaRangeTable[i].end);
}
- break;
- case CC_ASCII:
- cv = getcvec(v, 0, 1, 0);
- if (cv) {
- addrange(cv, 0, 0x7f);
+ for (i=0 ; i<NUM_DIGIT_RANGE ; i++) {
+ addrange(cv, digitRangeTable[i].start,
+ digitRangeTable[i].end);
}
- break;
- case CC_BLANK:
- cv = getcvec(v, 2, 0, 0);
- addchr(cv, '\t');
- addchr(cv, ' ');
- break;
- case CC_CNTRL:
- cv = getcvec(v, 0, 2, 0);
- addrange(cv, 0x0, 0x1f);
- addrange(cv, 0x7f, 0x9f);
- break;
- case CC_DIGIT:
- cv = getcvec(v, 0, NUM_DIGIT_RANGE, 0);
- if (cv) {
- for (i = 0; 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);
+ if (cv) {
+ for (i=0 ; i<NUM_ALPHA_RANGE ; i++) {
+ addrange(cv, alphaRangeTable[i].start,
+ alphaRangeTable[i].end);
}
- break;
- case CC_PUNCT:
- cv = getcvec(v, NUM_PUNCT_CHAR, NUM_PUNCT_RANGE, 0);
- if (cv) {
- for (i = 0; i < NUM_PUNCT_RANGE; i++) {
- addrange(cv, punctRangeTable[i].start,
- punctRangeTable[i].end);
- }
- for (i = 0; i < NUM_PUNCT_CHAR; i++) {
- addchr(cv, punctCharTable[i]);
- }
+ for (i=0 ; i<NUM_ALPHA_CHAR ; i++) {
+ addchr(cv, alphaCharTable[i]);
}
- break;
- case CC_XDIGIT:
- cv = getcvec(v, 0, NUM_DIGIT_RANGE+2, 0);
- if (cv) {
- addrange(cv, '0', '9');
- addrange(cv, 'a', 'f');
- addrange(cv, 'A', 'F');
+ }
+ break;
+ case CC_ASCII:
+ cv = getcvec(v, 0, 1, 0);
+ if (cv) {
+ addrange(cv, 0, 0x7f);
+ }
+ break;
+ case CC_BLANK:
+ cv = getcvec(v, 2, 0, 0);
+ addchr(cv, '\t');
+ addchr(cv, ' ');
+ break;
+ case CC_CNTRL:
+ cv = getcvec(v, 0, 2, 0);
+ addrange(cv, 0x0, 0x1f);
+ addrange(cv, 0x7f, 0x9f);
+ break;
+ case CC_DIGIT:
+ cv = getcvec(v, 0, NUM_DIGIT_RANGE, 0);
+ if (cv) {
+ for (i=0 ; i<NUM_DIGIT_RANGE ; i++) {
+ addrange(cv, digitRangeTable[i].start,
+ digitRangeTable[i].end);
}
- break;
- case CC_SPACE:
- cv = getcvec(v, NUM_SPACE_CHAR, NUM_SPACE_RANGE, 0);
- if (cv) {
- for (i = 0; i < NUM_SPACE_RANGE; i++) {
- addrange(cv, spaceRangeTable[i].start,
- spaceRangeTable[i].end);
- }
- for (i = 0; i < NUM_SPACE_CHAR; i++) {
- addchr(cv, spaceCharTable[i]);
- }
+ }
+ break;
+ case CC_PUNCT:
+ cv = getcvec(v, NUM_PUNCT_CHAR, NUM_PUNCT_RANGE, 0);
+ if (cv) {
+ for (i=0 ; i<NUM_PUNCT_RANGE ; i++) {
+ addrange(cv, punctRangeTable[i].start,
+ punctRangeTable[i].end);
}
- break;
- case CC_LOWER:
- cv = getcvec(v, NUM_LOWER_CHAR, NUM_LOWER_RANGE, 0);
- if (cv) {
- for (i = 0; i < NUM_LOWER_RANGE; i++) {
- addrange(cv, lowerRangeTable[i].start,
- lowerRangeTable[i].end);
- }
- for (i = 0; i < NUM_LOWER_CHAR; i++) {
- addchr(cv, lowerCharTable[i]);
- }
+ for (i=0 ; i<NUM_PUNCT_CHAR ; i++) {
+ addchr(cv, punctCharTable[i]);
}
- break;
- case CC_UPPER:
- cv = getcvec(v, NUM_UPPER_CHAR, NUM_UPPER_RANGE, 0);
- if (cv) {
- for (i = 0; i < NUM_UPPER_RANGE; i++) {
- addrange(cv, upperRangeTable[i].start,
- upperRangeTable[i].end);
- }
- for (i = 0; i < NUM_UPPER_CHAR; i++) {
- addchr(cv, upperCharTable[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
+ * someone comes up with a better arrangement!)
+ */
+ cv = getcvec(v, 0, 3, 0);
+ 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);
+ if (cv) {
+ for (i=0 ; i<NUM_SPACE_RANGE ; i++) {
+ addrange(cv, spaceRangeTable[i].start,
+ spaceRangeTable[i].end);
}
- break;
- case CC_GRAPH:
- cv = getcvec(v, NUM_GRAPH_CHAR, NUM_GRAPH_RANGE, 0);
- if (cv) {
- for (i = 0; i < NUM_GRAPH_RANGE; i++) {
- addrange(cv, graphRangeTable[i].start,
- graphRangeTable[i].end);
- }
- for (i = 0; i < NUM_GRAPH_CHAR; i++) {
- addchr(cv, graphCharTable[i]);
- }
+ for (i=0 ; i<NUM_SPACE_CHAR ; i++) {
+ addchr(cv, spaceCharTable[i]);
}
- break;
+ }
+ break;
+ case CC_LOWER:
+ cv = getcvec(v, NUM_LOWER_CHAR, NUM_LOWER_RANGE, 0);
+ if (cv) {
+ for (i=0 ; i<NUM_LOWER_RANGE ; i++) {
+ addrange(cv, lowerRangeTable[i].start,
+ lowerRangeTable[i].end);
+ }
+ for (i=0 ; i<NUM_LOWER_CHAR ; i++) {
+ addchr(cv, lowerCharTable[i]);
+ }
+ }
+ break;
+ case CC_UPPER:
+ cv = getcvec(v, NUM_UPPER_CHAR, NUM_UPPER_RANGE, 0);
+ if (cv) {
+ for (i=0 ; i<NUM_UPPER_RANGE ; i++) {
+ addrange(cv, upperRangeTable[i].start,
+ upperRangeTable[i].end);
+ }
+ for (i=0 ; i<NUM_UPPER_CHAR ; i++) {
+ addchr(cv, upperCharTable[i]);
+ }
+ }
+ break;
+ case CC_GRAPH:
+ cv = getcvec(v, NUM_GRAPH_CHAR, NUM_GRAPH_RANGE, 0);
+ if (cv) {
+ for (i=0 ; i<NUM_GRAPH_RANGE ; i++) {
+ addrange(cv, graphRangeTable[i].start,
+ graphRangeTable[i].end);
+ }
+ for (i=0 ; i<NUM_GRAPH_CHAR ; i++) {
+ addchr(cv, graphCharTable[i]);
+ }
+ }
+ break;
}
if (cv == NULL) {
ERR(REG_ESPACE);
@@ -864,28 +927,28 @@ int cases; /* case-independent? */
*/
static struct cvec *
allcases(v, pc)
-struct vars *v;
-pchr pc;
+ struct vars *v; /* context */
+ pchr pc; /* character to get case equivs of */
{
- struct cvec *cv;
- chr c = (chr)pc;
- chr lc, uc, tc;
-
- lc = Tcl_UniCharToLower((chr)c);
- uc = Tcl_UniCharToUpper((chr)c);
- tc = Tcl_UniCharToTitle((chr)c);
-
- if (tc != uc) {
- cv = getcvec(v, 3, 0, 0);
- addchr(cv, tc);
- } else {
- cv = getcvec(v, 2, 0, 0);
- }
- addchr(cv, lc);
- if (lc != uc) {
- addchr(cv, uc);
- }
- return cv;
+ struct cvec *cv;
+ chr c = (chr)pc;
+ chr lc, uc, tc;
+
+ lc = Tcl_UniCharToLower((chr)c);
+ uc = Tcl_UniCharToUpper((chr)c);
+ tc = Tcl_UniCharToTitle((chr)c);
+
+ if (tc != uc) {
+ cv = getcvec(v, 3, 0, 0);
+ addchr(cv, tc);
+ } else {
+ cv = getcvec(v, 2, 0, 0);
+ }
+ addchr(cv, lc);
+ if (lc != uc) {
+ addchr(cv, uc);
+ }
+ return cv;
}
/*
@@ -896,13 +959,12 @@ pchr pc;
* stop at embedded NULs!
^ static int cmp(CONST chr *, CONST chr *, size_t);
*/
-static int /* 0 for equal, nonzero for unequal */
+static int /* 0 for equal, nonzero for unequal */
cmp(x, y, len)
-CONST chr *x;
-CONST chr *y;
-size_t len; /* exact length of comparison */
+ CONST chr *x, *y; /* strings to compare */
+ size_t len; /* exact length of comparison */
{
- return memcmp(VS(x), VS(y), len*sizeof(chr));
+ return memcmp(VS(x), VS(y), len*sizeof(chr));
}
/*
@@ -913,18 +975,15 @@ size_t len; /* exact length of comparison */
* stop at embedded NULs!
^ static int casecmp(CONST chr *, CONST chr *, size_t);
*/
-static int /* 0 for equal, nonzero for unequal */
+static int /* 0 for equal, nonzero for unequal */
casecmp(x, y, len)
-CONST chr *x;
-CONST chr *y;
-size_t len; /* exact length of comparison */
+ CONST chr *x, *y; /* strings to compare */
+ size_t len; /* exact length of comparison */
{
- size_t i;
- CONST chr *xp;
- CONST chr *yp;
-
- for (xp = x, yp = y, i = len; i > 0; i--)
- if (Tcl_UniCharToLower(*xp++) != Tcl_UniCharToLower(*yp++))
- return 1;
- return 0;
+ for (; len > 0; len--, x++, y++) {
+ if ((*x!=*y) && (Tcl_UniCharToLower(*x) != Tcl_UniCharToLower(*y))) {
+ return 1;
+ }
+ }
+ return 0;
}
diff --git a/tcl/generic/tcl.decls b/tcl/generic/tcl.decls
index 7b9a74bdf9b..676b2b58da3 100644
--- a/tcl/generic/tcl.decls
+++ b/tcl/generic/tcl.decls
@@ -7,6 +7,7 @@
#
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 2001, 2002 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.
#
@@ -27,15 +28,15 @@ hooks {tclPlat tclInt tclIntPlat}
# to preserve backwards compatibility.
declare 0 generic {
- int Tcl_PkgProvideEx(Tcl_Interp *interp, char *name, char *version, \
- ClientData clientData)
+ int Tcl_PkgProvideEx(Tcl_Interp* interp, CONST char* name,
+ CONST char* version, ClientData clientData)
}
declare 1 generic {
- char * Tcl_PkgRequireEx(Tcl_Interp *interp, char *name, char *version, \
- int exact, ClientData *clientDataPtr)
+ CONST84_RETURN char * Tcl_PkgRequireEx(Tcl_Interp *interp, CONST char *name,
+ CONST char *version, int exact, ClientData *clientDataPtr)
}
declare 2 generic {
- void Tcl_Panic(char *format, ...)
+ void Tcl_Panic(CONST char *format, ...)
}
declare 3 generic {
char * Tcl_Alloc(unsigned int size)
@@ -47,13 +48,14 @@ declare 5 generic {
char * Tcl_Realloc(char *ptr, unsigned int size)
}
declare 6 generic {
- char * Tcl_DbCkalloc(unsigned int size, char *file, int line)
+ char * Tcl_DbCkalloc(unsigned int size, CONST char *file, int line)
}
declare 7 generic {
- int Tcl_DbCkfree(char *ptr, char *file, int line)
+ int Tcl_DbCkfree(char *ptr, CONST char *file, int line)
}
declare 8 generic {
- char * Tcl_DbCkrealloc(char *ptr, unsigned int size, char *file, int line)
+ char * Tcl_DbCkrealloc(char *ptr, unsigned int size,
+ CONST char *file, int line)
}
# Tcl_CreateFileHandler and Tcl_DeleteFileHandler are only available on unix,
@@ -61,7 +63,7 @@ declare 8 generic {
# compatibility reasons.
declare 9 unix {
- void Tcl_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc, \
+ void Tcl_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc,
ClientData clientData)
}
declare 10 unix {
@@ -84,47 +86,48 @@ declare 15 generic {
void Tcl_AppendStringsToObj(Tcl_Obj *objPtr, ...)
}
declare 16 generic {
- void Tcl_AppendToObj(Tcl_Obj *objPtr, char *bytes, int length)
+ 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 18 generic {
- int Tcl_ConvertToType(Tcl_Interp *interp, Tcl_Obj *objPtr, \
+ int Tcl_ConvertToType(Tcl_Interp *interp, Tcl_Obj *objPtr,
Tcl_ObjType *typePtr)
}
declare 19 generic {
- void Tcl_DbDecrRefCount(Tcl_Obj *objPtr, char *file, int line)
+ void Tcl_DbDecrRefCount(Tcl_Obj *objPtr, CONST char *file, int line)
}
declare 20 generic {
- void Tcl_DbIncrRefCount(Tcl_Obj *objPtr, char *file, int line)
+ void Tcl_DbIncrRefCount(Tcl_Obj *objPtr, CONST char *file, int line)
}
declare 21 generic {
- int Tcl_DbIsShared(Tcl_Obj *objPtr, char *file, int line)
+ int Tcl_DbIsShared(Tcl_Obj *objPtr, CONST char *file, int line)
}
declare 22 generic {
- Tcl_Obj * Tcl_DbNewBooleanObj(int boolValue, char *file, int line)
+ Tcl_Obj * Tcl_DbNewBooleanObj(int boolValue, CONST char *file, int line)
}
declare 23 generic {
- Tcl_Obj * Tcl_DbNewByteArrayObj(unsigned char *bytes, int length, \
- char *file, int line)
+ Tcl_Obj * Tcl_DbNewByteArrayObj(CONST unsigned char *bytes, int length,
+ CONST char *file, int line)
}
declare 24 generic {
- Tcl_Obj * Tcl_DbNewDoubleObj(double doubleValue, char *file, int line)
+ Tcl_Obj * Tcl_DbNewDoubleObj(double doubleValue,
+ CONST char *file, int line)
}
declare 25 generic {
- Tcl_Obj * Tcl_DbNewListObj(int objc, Tcl_Obj *CONST objv[], char *file, \
- int line)
+ Tcl_Obj * Tcl_DbNewListObj(int objc, Tcl_Obj *CONST *objv,
+ CONST char *file, int line)
}
declare 26 generic {
- Tcl_Obj * Tcl_DbNewLongObj(long longValue, char *file, int line)
+ Tcl_Obj * Tcl_DbNewLongObj(long longValue, CONST char *file, int line)
}
declare 27 generic {
- Tcl_Obj * Tcl_DbNewObj(char *file, int line)
+ Tcl_Obj * Tcl_DbNewObj(CONST char *file, int line)
}
declare 28 generic {
- Tcl_Obj * Tcl_DbNewStringObj(CONST char *bytes, int length, \
- char *file, int line)
+ Tcl_Obj * Tcl_DbNewStringObj(CONST char *bytes, int length,
+ CONST char *file, int line)
}
declare 29 generic {
Tcl_Obj * Tcl_DuplicateObj(Tcl_Obj *objPtr)
@@ -133,28 +136,28 @@ declare 30 generic {
void TclFreeObj(Tcl_Obj *objPtr)
}
declare 31 generic {
- int Tcl_GetBoolean(Tcl_Interp *interp, char *str, int *boolPtr)
+ int Tcl_GetBoolean(Tcl_Interp *interp, CONST char *str, int *boolPtr)
}
declare 32 generic {
- int Tcl_GetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, \
+ int Tcl_GetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
int *boolPtr)
}
declare 33 generic {
unsigned char * Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, int *lengthPtr)
}
declare 34 generic {
- int Tcl_GetDouble(Tcl_Interp *interp, char *str, double *doublePtr)
+ int Tcl_GetDouble(Tcl_Interp *interp, CONST char *str, double *doublePtr)
}
declare 35 generic {
- int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, \
+ int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
double *doublePtr)
}
declare 36 generic {
- int Tcl_GetIndexFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, \
- char **tablePtr, char *msg, int flags, int *indexPtr)
+ int Tcl_GetIndexFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ CONST84 char **tablePtr, CONST char *msg, int flags, int *indexPtr)
}
declare 37 generic {
- int Tcl_GetInt(Tcl_Interp *interp, char *str, int *intPtr)
+ int Tcl_GetInt(Tcl_Interp *interp, CONST char *str, int *intPtr)
}
declare 38 generic {
int Tcl_GetIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr)
@@ -163,7 +166,7 @@ declare 39 generic {
int Tcl_GetLongFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr)
}
declare 40 generic {
- Tcl_ObjType * Tcl_GetObjType(char *typeName)
+ Tcl_ObjType * Tcl_GetObjType(CONST char *typeName)
}
declare 41 generic {
char * Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr)
@@ -172,33 +175,34 @@ declare 42 generic {
void Tcl_InvalidateStringRep(Tcl_Obj *objPtr)
}
declare 43 generic {
- int Tcl_ListObjAppendList(Tcl_Interp *interp, Tcl_Obj *listPtr, \
+ int Tcl_ListObjAppendList(Tcl_Interp *interp, Tcl_Obj *listPtr,
Tcl_Obj *elemListPtr)
}
declare 44 generic {
- int Tcl_ListObjAppendElement(Tcl_Interp *interp, Tcl_Obj *listPtr, \
+ int Tcl_ListObjAppendElement(Tcl_Interp *interp, Tcl_Obj *listPtr,
Tcl_Obj *objPtr)
}
declare 45 generic {
- int Tcl_ListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr, \
+ int Tcl_ListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr,
int *objcPtr, Tcl_Obj ***objvPtr)
}
declare 46 generic {
- int Tcl_ListObjIndex(Tcl_Interp *interp, Tcl_Obj *listPtr, int index, \
+ int Tcl_ListObjIndex(Tcl_Interp *interp, Tcl_Obj *listPtr, int index,
Tcl_Obj **objPtrPtr)
}
declare 47 generic {
- int Tcl_ListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr, int *intPtr)
+ int Tcl_ListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr,
+ int *lengthPtr)
}
declare 48 generic {
- int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, int first, \
+ int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, int first,
int count, int objc, Tcl_Obj *CONST objv[])
}
declare 49 generic {
- Tcl_Obj * Tcl_NewBooleanObj(int boolValue)
+ Tcl_Obj *Tcl_NewBooleanObj(int boolValue)
}
declare 50 generic {
- Tcl_Obj * Tcl_NewByteArrayObj(unsigned char *bytes, int length)
+ Tcl_Obj *Tcl_NewByteArrayObj(CONST unsigned char* bytes, int length)
}
declare 51 generic {
Tcl_Obj * Tcl_NewDoubleObj(double doubleValue)
@@ -225,7 +229,8 @@ declare 58 generic {
unsigned char * Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length)
}
declare 59 generic {
- void Tcl_SetByteArrayObj(Tcl_Obj *objPtr, unsigned char *bytes, int length)
+ void Tcl_SetByteArrayObj(Tcl_Obj *objPtr, CONST unsigned char *bytes,
+ int length)
}
declare 60 generic {
void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue)
@@ -243,13 +248,13 @@ declare 64 generic {
void Tcl_SetObjLength(Tcl_Obj *objPtr, int length)
}
declare 65 generic {
- void Tcl_SetStringObj(Tcl_Obj *objPtr, char *bytes, int length)
+ void Tcl_SetStringObj(Tcl_Obj* objPtr, CONST char* bytes, int length)
}
declare 66 generic {
void Tcl_AddErrorInfo(Tcl_Interp *interp, CONST char *message)
}
declare 67 generic {
- void Tcl_AddObjErrorInfo(Tcl_Interp *interp, CONST char *message, \
+ void Tcl_AddObjErrorInfo(Tcl_Interp *interp, CONST char *message,
int length)
}
declare 68 generic {
@@ -262,7 +267,7 @@ declare 70 generic {
void Tcl_AppendResult(Tcl_Interp *interp, ...)
}
declare 71 generic {
- Tcl_AsyncHandler Tcl_AsyncCreate(Tcl_AsyncProc *proc, \
+ Tcl_AsyncHandler Tcl_AsyncCreate(Tcl_AsyncProc *proc,
ClientData clientData)
}
declare 72 generic {
@@ -284,11 +289,11 @@ declare 77 generic {
char Tcl_Backslash(CONST char *src, int *readPtr)
}
declare 78 generic {
- int Tcl_BadChannelOption(Tcl_Interp *interp, char *optionName, \
- char *optionList)
+ int Tcl_BadChannelOption(Tcl_Interp *interp, CONST char *optionName,
+ CONST char *optionList)
}
declare 79 generic {
- void Tcl_CallWhenDeleted(Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, \
+ void Tcl_CallWhenDeleted(Tcl_Interp *interp, Tcl_InterpDeleteProc *proc,
ClientData clientData)
}
declare 80 generic {
@@ -298,46 +303,47 @@ declare 81 generic {
int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan)
}
declare 82 generic {
- int Tcl_CommandComplete(char *cmd)
+ int Tcl_CommandComplete(CONST char *cmd)
}
declare 83 generic {
- char * Tcl_Concat(int argc, char **argv)
+ char * Tcl_Concat(int argc, CONST84 char * CONST *argv)
}
declare 84 generic {
int Tcl_ConvertElement(CONST char *src, char *dst, int flags)
}
declare 85 generic {
- int Tcl_ConvertCountedElement(CONST char *src, int length, char *dst, \
+ int Tcl_ConvertCountedElement(CONST char *src, int length, char *dst,
int flags)
}
declare 86 generic {
- int Tcl_CreateAlias(Tcl_Interp *slave, char *slaveCmd, \
- Tcl_Interp *target, char *targetCmd, int argc, char **argv)
+ 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, char *slaveCmd, \
- Tcl_Interp *target, char *targetCmd, int objc, \
+ 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, char *chanName, \
- ClientData instanceData, int mask)
+ Tcl_Channel Tcl_CreateChannel(Tcl_ChannelType *typePtr,
+ CONST char *chanName, ClientData instanceData, int mask)
}
declare 89 generic {
- void Tcl_CreateChannelHandler(Tcl_Channel chan, int mask, \
+ void Tcl_CreateChannelHandler(Tcl_Channel chan, int mask,
Tcl_ChannelProc *proc, ClientData clientData)
}
declare 90 generic {
- void Tcl_CreateCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc, \
+ void Tcl_CreateCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc,
ClientData clientData)
}
declare 91 generic {
- Tcl_Command Tcl_CreateCommand(Tcl_Interp *interp, char *cmdName, \
- Tcl_CmdProc *proc, ClientData clientData, \
+ Tcl_Command Tcl_CreateCommand(Tcl_Interp *interp, CONST char *cmdName,
+ Tcl_CmdProc *proc, ClientData clientData,
Tcl_CmdDeleteProc *deleteProc)
}
declare 92 generic {
- void Tcl_CreateEventSource(Tcl_EventSetupProc *setupProc, \
+ void Tcl_CreateEventSource(Tcl_EventSetupProc *setupProc,
Tcl_EventCheckProc *checkProc, ClientData clientData)
}
declare 93 generic {
@@ -347,39 +353,41 @@ declare 94 generic {
Tcl_Interp * Tcl_CreateInterp(void)
}
declare 95 generic {
- void Tcl_CreateMathFunc(Tcl_Interp *interp, char *name, int numArgs, \
- Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData)
+ void Tcl_CreateMathFunc(Tcl_Interp *interp, CONST char *name,
+ int numArgs, Tcl_ValueType *argTypes,
+ Tcl_MathProc *proc, ClientData clientData)
}
declare 96 generic {
- Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp, char *cmdName, \
- Tcl_ObjCmdProc *proc, ClientData clientData, \
+ Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp,
+ CONST char *cmdName,
+ Tcl_ObjCmdProc *proc, ClientData clientData,
Tcl_CmdDeleteProc *deleteProc)
}
declare 97 generic {
- Tcl_Interp * Tcl_CreateSlave(Tcl_Interp *interp, char *slaveName, \
+ Tcl_Interp * Tcl_CreateSlave(Tcl_Interp *interp, CONST char *slaveName,
int isSafe)
}
declare 98 generic {
- Tcl_TimerToken Tcl_CreateTimerHandler(int milliseconds, \
+ Tcl_TimerToken Tcl_CreateTimerHandler(int milliseconds,
Tcl_TimerProc *proc, ClientData clientData)
}
declare 99 generic {
- Tcl_Trace Tcl_CreateTrace(Tcl_Interp *interp, int level, \
+ Tcl_Trace Tcl_CreateTrace(Tcl_Interp *interp, int level,
Tcl_CmdTraceProc *proc, ClientData clientData)
}
declare 100 generic {
- void Tcl_DeleteAssocData(Tcl_Interp *interp, char *name)
+ void Tcl_DeleteAssocData(Tcl_Interp *interp, CONST char *name)
}
declare 101 generic {
- void Tcl_DeleteChannelHandler(Tcl_Channel chan, Tcl_ChannelProc *proc, \
+ void Tcl_DeleteChannelHandler(Tcl_Channel chan, Tcl_ChannelProc *proc,
ClientData clientData)
}
declare 102 generic {
- void Tcl_DeleteCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc, \
+ void Tcl_DeleteCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc,
ClientData clientData)
}
declare 103 generic {
- int Tcl_DeleteCommand(Tcl_Interp *interp, char *cmdName)
+ int Tcl_DeleteCommand(Tcl_Interp *interp, CONST char *cmdName)
}
declare 104 generic {
int Tcl_DeleteCommandFromToken(Tcl_Interp *interp, Tcl_Command command)
@@ -388,7 +396,7 @@ declare 105 generic {
void Tcl_DeleteEvents(Tcl_EventDeleteProc *proc, ClientData clientData)
}
declare 106 generic {
- void Tcl_DeleteEventSource(Tcl_EventSetupProc *setupProc, \
+ void Tcl_DeleteEventSource(Tcl_EventSetupProc *setupProc,
Tcl_EventCheckProc *checkProc, ClientData clientData)
}
declare 107 generic {
@@ -413,7 +421,7 @@ declare 113 generic {
void Tcl_DeleteTrace(Tcl_Interp *interp, Tcl_Trace trace)
}
declare 114 generic {
- void Tcl_DontCallWhenDeleted(Tcl_Interp *interp, \
+ void Tcl_DontCallWhenDeleted(Tcl_Interp *interp,
Tcl_InterpDeleteProc *proc, ClientData clientData)
}
declare 115 generic {
@@ -453,16 +461,17 @@ declare 126 generic {
int Tcl_Eof(Tcl_Channel chan)
}
declare 127 generic {
- char * Tcl_ErrnoId(void)
+ CONST84_RETURN char * Tcl_ErrnoId(void)
}
declare 128 generic {
- char * Tcl_ErrnoMsg(int err)
+ CONST84_RETURN char * Tcl_ErrnoMsg(int err)
}
declare 129 generic {
- int Tcl_Eval(Tcl_Interp *interp, char *string)
+ int Tcl_Eval(Tcl_Interp *interp, CONST char *string)
}
+# This is obsolete, use Tcl_FSEvalFile
declare 130 generic {
- int Tcl_EvalFile(Tcl_Interp *interp, char *fileName)
+ int Tcl_EvalFile(Tcl_Interp *interp, CONST char *fileName)
}
declare 131 generic {
int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
@@ -474,33 +483,33 @@ declare 133 generic {
void Tcl_Exit(int status)
}
declare 134 generic {
- int Tcl_ExposeCommand(Tcl_Interp *interp, char *hiddenCmdToken, \
- char *cmdName)
+ int Tcl_ExposeCommand(Tcl_Interp *interp, CONST char *hiddenCmdToken,
+ CONST char *cmdName)
}
declare 135 generic {
- int Tcl_ExprBoolean(Tcl_Interp *interp, char *str, int *ptr)
+ int Tcl_ExprBoolean(Tcl_Interp *interp, CONST char *str, int *ptr)
}
declare 136 generic {
int Tcl_ExprBooleanObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *ptr)
}
declare 137 generic {
- int Tcl_ExprDouble(Tcl_Interp *interp, char *str, double *ptr)
+ int Tcl_ExprDouble(Tcl_Interp *interp, CONST char *str, double *ptr)
}
declare 138 generic {
int Tcl_ExprDoubleObj(Tcl_Interp *interp, Tcl_Obj *objPtr, double *ptr)
}
declare 139 generic {
- int Tcl_ExprLong(Tcl_Interp *interp, char *str, long *ptr)
+ int Tcl_ExprLong(Tcl_Interp *interp, CONST char *str, long *ptr)
}
declare 140 generic {
int Tcl_ExprLongObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *ptr)
}
declare 141 generic {
- int Tcl_ExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr, \
+ int Tcl_ExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
Tcl_Obj **resultPtrPtr)
}
declare 142 generic {
- int Tcl_ExprString(Tcl_Interp *interp, char *string)
+ int Tcl_ExprString(Tcl_Interp *interp, CONST char *string)
}
declare 143 generic {
void Tcl_Finalize(void)
@@ -509,7 +518,7 @@ declare 144 generic {
void Tcl_FindExecutable(CONST char *argv0)
}
declare 145 generic {
- Tcl_HashEntry * Tcl_FirstHashEntry(Tcl_HashTable *tablePtr, \
+ Tcl_HashEntry * Tcl_FirstHashEntry(Tcl_HashTable *tablePtr,
Tcl_HashSearch *searchPtr)
}
declare 146 generic {
@@ -519,28 +528,28 @@ declare 147 generic {
void Tcl_FreeResult(Tcl_Interp *interp)
}
declare 148 generic {
- int Tcl_GetAlias(Tcl_Interp *interp, char *slaveCmd, \
- Tcl_Interp **targetInterpPtr, char **targetCmdPtr, int *argcPtr, \
- char ***argvPtr)
+ 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, char *slaveCmd, \
- Tcl_Interp **targetInterpPtr, char **targetCmdPtr, int *objcPtr, \
- Tcl_Obj ***objv)
+ 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, char *name, \
+ ClientData Tcl_GetAssocData(Tcl_Interp *interp, CONST char *name,
Tcl_InterpDeleteProc **procPtr)
}
declare 151 generic {
- Tcl_Channel Tcl_GetChannel(Tcl_Interp *interp, char *chanName, \
+ Tcl_Channel Tcl_GetChannel(Tcl_Interp *interp, CONST char *chanName,
int *modePtr)
}
declare 152 generic {
int Tcl_GetChannelBufferSize(Tcl_Channel chan)
}
declare 153 generic {
- int Tcl_GetChannelHandle(Tcl_Channel chan, int direction, \
+ int Tcl_GetChannelHandle(Tcl_Channel chan, int direction,
ClientData *handlePtr)
}
declare 154 generic {
@@ -550,27 +559,28 @@ declare 155 generic {
int Tcl_GetChannelMode(Tcl_Channel chan)
}
declare 156 generic {
- char * Tcl_GetChannelName(Tcl_Channel chan)
+ CONST84_RETURN char * Tcl_GetChannelName(Tcl_Channel chan)
}
declare 157 generic {
- int Tcl_GetChannelOption(Tcl_Interp *interp, Tcl_Channel chan, \
- char *optionName, Tcl_DString *dsPtr)
+ int Tcl_GetChannelOption(Tcl_Interp *interp, Tcl_Channel chan,
+ CONST char *optionName, Tcl_DString *dsPtr)
}
declare 158 generic {
Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan)
}
declare 159 generic {
- int Tcl_GetCommandInfo(Tcl_Interp *interp, char *cmdName, \
+ int Tcl_GetCommandInfo(Tcl_Interp *interp, CONST char *cmdName,
Tcl_CmdInfo *infoPtr)
}
declare 160 generic {
- char * Tcl_GetCommandName(Tcl_Interp *interp, Tcl_Command command)
+ CONST84_RETURN char * Tcl_GetCommandName(Tcl_Interp *interp,
+ Tcl_Command command)
}
declare 161 generic {
int Tcl_GetErrno(void)
}
declare 162 generic {
- char * Tcl_GetHostName(void)
+ CONST84_RETURN char * Tcl_GetHostName(void)
}
declare 163 generic {
int Tcl_GetInterpPath(Tcl_Interp *askInterp, Tcl_Interp *slaveInterp)
@@ -589,12 +599,13 @@ declare 166 generic {
# generic interface, so we inlcude it here for compatibility reasons.
declare 167 unix {
- int Tcl_GetOpenFile(Tcl_Interp *interp, char *str, int forWriting, \
+ int Tcl_GetOpenFile(Tcl_Interp *interp, CONST char *str, 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(char *path)
+ Tcl_PathType Tcl_GetPathType(CONST char *path)
}
declare 169 generic {
int Tcl_Gets(Tcl_Channel chan, Tcl_DString *dsPtr)
@@ -606,29 +617,31 @@ declare 171 generic {
int Tcl_GetServiceMode(void)
}
declare 172 generic {
- Tcl_Interp * Tcl_GetSlave(Tcl_Interp *interp, char *slaveName)
+ Tcl_Interp * Tcl_GetSlave(Tcl_Interp *interp, CONST char *slaveName)
}
declare 173 generic {
Tcl_Channel Tcl_GetStdChannel(int type)
}
declare 174 generic {
- char * Tcl_GetStringResult(Tcl_Interp *interp)
+ CONST84_RETURN char * Tcl_GetStringResult(Tcl_Interp *interp)
}
declare 175 generic {
- char * Tcl_GetVar(Tcl_Interp *interp, char *varName, int flags)
+ CONST84_RETURN char * Tcl_GetVar(Tcl_Interp *interp, CONST char *varName,
+ int flags)
}
declare 176 generic {
- char * Tcl_GetVar2(Tcl_Interp *interp, char *part1, char *part2, int flags)
+ 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, char *command)
+ int Tcl_GlobalEval(Tcl_Interp *interp, CONST char *command)
}
declare 178 generic {
int Tcl_GlobalEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
}
declare 179 generic {
- int Tcl_HideCommand(Tcl_Interp *interp, char *cmdName, \
- char *hiddenCmdToken)
+ int Tcl_HideCommand(Tcl_Interp *interp, CONST char *cmdName,
+ CONST char *hiddenCmdToken)
}
declare 180 generic {
int Tcl_Init(Tcl_Interp *interp)
@@ -648,11 +661,14 @@ declare 184 generic {
declare 185 generic {
int Tcl_IsSafe(Tcl_Interp *interp)
}
+# Obsolete, use Tcl_FSJoinPath
declare 186 generic {
- char * Tcl_JoinPath(int argc, char **argv, Tcl_DString *resultPtr)
+ char * Tcl_JoinPath(int argc, CONST84 char * CONST *argv,
+ Tcl_DString *resultPtr)
}
declare 187 generic {
- int Tcl_LinkVar(Tcl_Interp *interp, char *varName, char *addr, int type)
+ int Tcl_LinkVar(Tcl_Interp *interp, CONST char *varName, char *addr,
+ int type)
}
# This slot is reserved for use by the plus patch:
@@ -670,7 +686,7 @@ declare 191 generic {
Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket)
}
declare 192 generic {
- char * Tcl_Merge(int argc, char **argv)
+ char * Tcl_Merge(int argc, CONST84 char * CONST *argv)
}
declare 193 generic {
Tcl_HashEntry * Tcl_NextHashEntry(Tcl_HashSearch *searchPtr)
@@ -679,28 +695,30 @@ declare 194 generic {
void Tcl_NotifyChannel(Tcl_Channel channel, int mask)
}
declare 195 generic {
- Tcl_Obj * Tcl_ObjGetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, \
+ 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, \
+ Tcl_Obj * Tcl_ObjSetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags)
}
declare 197 {unix win} {
- Tcl_Channel Tcl_OpenCommandChannel(Tcl_Interp *interp, int argc, \
- char **argv, int flags)
+ 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, char *fileName, \
- char *modeString, int permissions)
+ Tcl_Channel Tcl_OpenFileChannel(Tcl_Interp *interp, CONST char *fileName,
+ CONST char *modeString, int permissions)
}
declare 199 generic {
- Tcl_Channel Tcl_OpenTcpClient(Tcl_Interp *interp, int port, \
- char *address, char *myaddr, int myport, int async)
+ Tcl_Channel Tcl_OpenTcpClient(Tcl_Interp *interp, int port,
+ CONST char *address, CONST char *myaddr, int myport, int async)
}
declare 200 generic {
- Tcl_Channel Tcl_OpenTcpServer(Tcl_Interp *interp, int port, char *host, \
- Tcl_TcpAcceptProc *acceptProc, ClientData callbackData)
+ Tcl_Channel Tcl_OpenTcpServer(Tcl_Interp *interp, int port,
+ CONST char *host, Tcl_TcpAcceptProc *acceptProc,
+ ClientData callbackData)
}
declare 201 generic {
void Tcl_Preserve(ClientData data)
@@ -712,7 +730,7 @@ declare 203 generic {
int Tcl_PutEnv(CONST char *string)
}
declare 204 generic {
- char * Tcl_PosixError(Tcl_Interp *interp)
+ CONST84_RETURN char * Tcl_PosixError(Tcl_Interp *interp)
}
declare 205 generic {
void Tcl_QueueEvent(Tcl_Event *evPtr, Tcl_QueuePosition position)
@@ -724,7 +742,7 @@ declare 207 {unix win} {
void Tcl_ReapDetachedProcs(void)
}
declare 208 generic {
- int Tcl_RecordAndEval(Tcl_Interp *interp, char *cmd, int flags)
+ int Tcl_RecordAndEval(Tcl_Interp *interp, CONST char *cmd, int flags)
}
declare 209 generic {
int Tcl_RecordAndEvalObj(Tcl_Interp *interp, Tcl_Obj *cmdPtr, int flags)
@@ -736,18 +754,19 @@ declare 211 generic {
void Tcl_RegisterObjType(Tcl_ObjType *typePtr)
}
declare 212 generic {
- Tcl_RegExp Tcl_RegExpCompile(Tcl_Interp *interp, char *string)
+ Tcl_RegExp Tcl_RegExpCompile(Tcl_Interp *interp, CONST char *string)
}
declare 213 generic {
- int Tcl_RegExpExec(Tcl_Interp *interp, Tcl_RegExp regexp, \
+ int Tcl_RegExpExec(Tcl_Interp *interp, Tcl_RegExp regexp,
CONST char *str, CONST char *start)
}
declare 214 generic {
- int Tcl_RegExpMatch(Tcl_Interp *interp, char *str, char *pattern)
+ int Tcl_RegExpMatch(Tcl_Interp *interp, CONST char *str,
+ CONST char *pattern)
}
declare 215 generic {
- void Tcl_RegExpRange(Tcl_RegExp regexp, int index, char **startPtr, \
- char **endPtr)
+ void Tcl_RegExpRange(Tcl_RegExp regexp, int index,
+ CONST84 char **startPtr, CONST84 char **endPtr)
}
declare 216 generic {
void Tcl_Release(ClientData clientData)
@@ -761,8 +780,9 @@ declare 218 generic {
declare 219 generic {
int Tcl_ScanCountedElement(CONST char *str, int length, int *flagPtr)
}
+# Obsolete
declare 220 generic {
- int Tcl_Seek(Tcl_Channel chan, int offset, int mode)
+ int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode)
}
declare 221 generic {
int Tcl_ServiceAll(void)
@@ -771,19 +791,19 @@ declare 222 generic {
int Tcl_ServiceEvent(int flags)
}
declare 223 generic {
- void Tcl_SetAssocData(Tcl_Interp *interp, char *name, \
+ void Tcl_SetAssocData(Tcl_Interp *interp, CONST char *name,
Tcl_InterpDeleteProc *proc, ClientData clientData)
}
declare 224 generic {
void Tcl_SetChannelBufferSize(Tcl_Channel chan, int sz)
}
declare 225 generic {
- int Tcl_SetChannelOption(Tcl_Interp *interp, Tcl_Channel chan, \
- char *optionName, char *newValue)
+ int Tcl_SetChannelOption(Tcl_Interp *interp, Tcl_Channel chan,
+ CONST char *optionName, CONST char *newValue)
}
declare 226 generic {
- int Tcl_SetCommandInfo(Tcl_Interp *interp, char *cmdName, \
- Tcl_CmdInfo *infoPtr)
+ int Tcl_SetCommandInfo(Tcl_Interp *interp, CONST char *cmdName,
+ CONST Tcl_CmdInfo *infoPtr)
}
declare 227 generic {
void Tcl_SetErrno(int err)
@@ -801,7 +821,7 @@ declare 231 generic {
int Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth)
}
declare 232 generic {
- void Tcl_SetResult(Tcl_Interp *interp, char *str, \
+ void Tcl_SetResult(Tcl_Interp *interp, char *str,
Tcl_FreeProc *freeProc)
}
declare 233 generic {
@@ -817,110 +837,115 @@ declare 236 generic {
void Tcl_SetStdChannel(Tcl_Channel channel, int type)
}
declare 237 generic {
- char * Tcl_SetVar(Tcl_Interp *interp, char *varName, char *newValue, \
- int flags)
+ CONST84_RETURN char * Tcl_SetVar(Tcl_Interp *interp, CONST char *varName,
+ CONST char *newValue, int flags)
}
declare 238 generic {
- char * Tcl_SetVar2(Tcl_Interp *interp, char *part1, char *part2, \
- char *newValue, int flags)
+ CONST84_RETURN char * Tcl_SetVar2(Tcl_Interp *interp, CONST char *part1,
+ CONST char *part2, CONST char *newValue, int flags)
}
declare 239 generic {
- char * Tcl_SignalId(int sig)
+ CONST84_RETURN char * Tcl_SignalId(int sig)
}
declare 240 generic {
- char * Tcl_SignalMsg(int sig)
+ CONST84_RETURN char * Tcl_SignalMsg(int sig)
}
declare 241 generic {
void Tcl_SourceRCFile(Tcl_Interp *interp)
}
declare 242 generic {
- int Tcl_SplitList(Tcl_Interp *interp, CONST char *listStr, int *argcPtr, \
- char ***argvPtr)
+ 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, char ***argvPtr)
+ void Tcl_SplitPath(CONST char *path, int *argcPtr, CONST84 char ***argvPtr)
}
declare 244 generic {
- void Tcl_StaticPackage(Tcl_Interp *interp, char *pkgName, \
+ 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)
}
+# Obsolete
declare 246 generic {
- int Tcl_Tell(Tcl_Channel chan)
+ int Tcl_TellOld(Tcl_Channel chan)
}
declare 247 generic {
- int Tcl_TraceVar(Tcl_Interp *interp, char *varName, int flags, \
+ 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, char *part1, char *part2, \
+ 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, char *name, \
+ char * Tcl_TranslateFileName(Tcl_Interp *interp, CONST char *name,
Tcl_DString *bufferPtr)
}
declare 250 generic {
- int Tcl_Ungets(Tcl_Channel chan, char *str, int len, int atHead)
+ int Tcl_Ungets(Tcl_Channel chan, CONST char *str, int len, int atHead)
}
declare 251 generic {
- void Tcl_UnlinkVar(Tcl_Interp *interp, char *varName)
+ void Tcl_UnlinkVar(Tcl_Interp *interp, CONST char *varName)
}
declare 252 generic {
int Tcl_UnregisterChannel(Tcl_Interp *interp, Tcl_Channel chan)
}
declare 253 generic {
- int Tcl_UnsetVar(Tcl_Interp *interp, char *varName, int flags)
+ int Tcl_UnsetVar(Tcl_Interp *interp, CONST char *varName, int flags)
}
declare 254 generic {
- int Tcl_UnsetVar2(Tcl_Interp *interp, char *part1, char *part2, int flags)
+ int Tcl_UnsetVar2(Tcl_Interp *interp, CONST char *part1, CONST char *part2,
+ int flags)
}
declare 255 generic {
- void Tcl_UntraceVar(Tcl_Interp *interp, char *varName, int flags, \
+ 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, char *part1, char *part2, \
- int flags, Tcl_VarTraceProc *proc, ClientData clientData)
+ 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, char *varName)
+ void Tcl_UpdateLinkedVar(Tcl_Interp *interp, CONST char *varName)
}
declare 258 generic {
- int Tcl_UpVar(Tcl_Interp *interp, char *frameName, char *varName, \
- char *localName, int flags)
+ 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, char *frameName, char *part1, \
- char *part2, char *localName, int flags)
+ int Tcl_UpVar2(Tcl_Interp *interp, CONST char *frameName, CONST char *part1,
+ CONST char *part2, CONST char *localName, int flags)
}
declare 260 generic {
int Tcl_VarEval(Tcl_Interp *interp, ...)
}
declare 261 generic {
- ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, char *varName, \
+ 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, char *part1, \
- char *part2, int flags, Tcl_VarTraceProc *procPtr, \
+ 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, char *s, int slen)
+ int Tcl_Write(Tcl_Channel chan, CONST char *s, int slen)
}
declare 264 generic {
- void Tcl_WrongNumArgs(Tcl_Interp *interp, int objc, \
- Tcl_Obj *CONST objv[], char *message)
+ void Tcl_WrongNumArgs(Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[], CONST char *message)
}
declare 265 generic {
- int Tcl_DumpActiveMemory(char *fileName)
+ int Tcl_DumpActiveMemory(CONST char *fileName)
}
declare 266 generic {
- void Tcl_ValidateAllMemory(char *file, int line)
+ void Tcl_ValidateAllMemory(CONST char *file, int line)
}
+
declare 267 generic {
void Tcl_AppendResultVA(Tcl_Interp *interp, va_list argList)
}
@@ -928,25 +953,27 @@ declare 268 generic {
void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, va_list argList)
}
declare 269 generic {
- char * Tcl_HashStats(Tcl_HashTable *tablePtr)
+ CONST84_RETURN char * Tcl_HashStats(Tcl_HashTable *tablePtr)
}
declare 270 generic {
- char * Tcl_ParseVar(Tcl_Interp *interp, char *str, char **termPtr)
+ CONST84_RETURN char * Tcl_ParseVar(Tcl_Interp *interp, CONST char *str,
+ CONST84 char **termPtr)
}
declare 271 generic {
- char * Tcl_PkgPresent(Tcl_Interp *interp, char *name, char *version, \
- int exact)
+ CONST84_RETURN char * Tcl_PkgPresent(Tcl_Interp *interp, CONST char *name,
+ CONST char *version, int exact)
}
declare 272 generic {
- char * Tcl_PkgPresentEx(Tcl_Interp *interp, char *name, char *version, \
- int exact, ClientData *clientDataPtr)
+ CONST84_RETURN char * Tcl_PkgPresentEx(Tcl_Interp *interp, CONST char *name,
+ CONST char *version, int exact, ClientData *clientDataPtr)
}
declare 273 generic {
- int Tcl_PkgProvide(Tcl_Interp *interp, char *name, char *version)
+ int Tcl_PkgProvide(Tcl_Interp *interp, CONST char *name,
+ CONST char *version)
}
declare 274 generic {
- char * Tcl_PkgRequire(Tcl_Interp *interp, char *name, char *version, \
- int exact)
+ CONST84_RETURN char * Tcl_PkgRequire(Tcl_Interp *interp, CONST char *name,
+ CONST char *version, int exact)
}
declare 275 generic {
void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList)
@@ -957,8 +984,8 @@ declare 276 generic {
declare 277 generic {
Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options)
}
-declare 278 {unix win} {
- void Tcl_PanicVA(char *format, va_list argList)
+declare 278 generic {
+ void Tcl_PanicVA(CONST char *format, va_list argList)
}
declare 279 generic {
void Tcl_GetVersion(int *major, int *minor, int *patchLevel, int *type)
@@ -982,9 +1009,8 @@ declare 280 generic {
# 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)
+ Tcl_Channel Tcl_StackChannel(Tcl_Interp *interp, Tcl_ChannelType *typePtr,
+ ClientData instanceData, int mask, Tcl_Channel prevChan)
}
declare 282 generic {
int Tcl_UnstackChannel(Tcl_Interp *interp, Tcl_Channel chan)
@@ -992,9 +1018,13 @@ declare 282 generic {
declare 283 generic {
Tcl_Channel Tcl_GetStackedChannel(Tcl_Channel chan)
}
+
+# 284 was reserved, but added in 8.4a2
+declare 284 generic {
+ void Tcl_SetMainLoop(Tcl_MainLoopProc *proc)
+}
+
# Reserved for future use (8.0.x vs. 8.1)
-# declare 284 generic {
-# }
# declare 285 generic {
# }
@@ -1017,10 +1047,11 @@ declare 290 generic {
void Tcl_DiscardResult(Tcl_SavedResult *statePtr)
}
declare 291 generic {
- int Tcl_EvalEx(Tcl_Interp *interp, char *script, int numBytes, int flags)
+ 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[], \
+ int Tcl_EvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[],
int flags)
}
declare 293 generic {
@@ -1030,14 +1061,14 @@ declare 294 generic {
void Tcl_ExitThread(int status)
}
declare 295 generic {
- int Tcl_ExternalToUtf(Tcl_Interp *interp, Tcl_Encoding encoding, \
- CONST char *src, int srcLen, int flags, \
- Tcl_EncodingState *statePtr, char *dst, int dstLen, \
+ 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)
}
declare 296 generic {
- char * Tcl_ExternalToUtfDString(Tcl_Encoding encoding, CONST char *src, \
- int srcLen, Tcl_DString *dsPtr)
+ char * Tcl_ExternalToUtfDString(Tcl_Encoding encoding,
+ CONST char *src, int srcLen, Tcl_DString *dsPtr)
}
declare 297 generic {
void Tcl_FinalizeThread(void)
@@ -1055,21 +1086,22 @@ declare 301 generic {
Tcl_Encoding Tcl_GetEncoding(Tcl_Interp *interp, CONST char *name)
}
declare 302 generic {
- char * Tcl_GetEncodingName(Tcl_Encoding encoding)
+ CONST84_RETURN char * Tcl_GetEncodingName(Tcl_Encoding encoding)
}
declare 303 generic {
void Tcl_GetEncodingNames(Tcl_Interp *interp)
}
declare 304 generic {
- int Tcl_GetIndexFromObjStruct(Tcl_Interp *interp, Tcl_Obj *objPtr, \
- char **tablePtr, int offset, char *msg, int flags, int *indexPtr)
+ int Tcl_GetIndexFromObjStruct(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ CONST VOID *tablePtr, int offset, CONST char *msg, int flags,
+ int *indexPtr)
}
declare 305 generic {
VOID * Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr, int size)
}
declare 306 generic {
- Tcl_Obj * Tcl_GetVar2Ex(Tcl_Interp *interp, char *part1, char *part2, \
- int flags)
+ Tcl_Obj * Tcl_GetVar2Ex(Tcl_Interp *interp, CONST char *part1,
+ CONST char *part2, int flags)
}
declare 307 generic {
ClientData Tcl_InitNotifier(void)
@@ -1084,14 +1116,14 @@ declare 310 generic {
void Tcl_ConditionNotify(Tcl_Condition *condPtr)
}
declare 311 generic {
- void Tcl_ConditionWait(Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, \
+ void Tcl_ConditionWait(Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr,
Tcl_Time *timePtr)
}
declare 312 generic {
int Tcl_NumUtfChars(CONST char *src, int len)
}
declare 313 generic {
- int Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead, \
+ int Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead,
int appendFlag)
}
declare 314 generic {
@@ -1104,14 +1136,14 @@ declare 316 generic {
int Tcl_SetSystemEncoding(Tcl_Interp *interp, CONST char *name)
}
declare 317 generic {
- Tcl_Obj * Tcl_SetVar2Ex(Tcl_Interp *interp, char *part1, char *part2, \
- Tcl_Obj *newValuePtr, int flags)
+ Tcl_Obj * Tcl_SetVar2Ex(Tcl_Interp *interp, CONST char *part1,
+ CONST char *part2, Tcl_Obj *newValuePtr, int flags)
}
declare 318 generic {
void Tcl_ThreadAlert(Tcl_ThreadId threadId)
}
declare 319 generic {
- void Tcl_ThreadQueueEvent(Tcl_ThreadId threadId, Tcl_Event* evPtr, \
+ void Tcl_ThreadQueueEvent(Tcl_ThreadId threadId, Tcl_Event* evPtr,
Tcl_QueuePosition position)
}
declare 320 generic {
@@ -1130,7 +1162,7 @@ declare 324 generic {
int Tcl_UniCharToUtf(int ch, char *buf)
}
declare 325 generic {
- char * Tcl_UtfAtIndex(CONST char *src, int index)
+ CONST84_RETURN char * Tcl_UtfAtIndex(CONST char *src, int index)
}
declare 326 generic {
int Tcl_UtfCharComplete(CONST char *src, int len)
@@ -1139,26 +1171,26 @@ declare 327 generic {
int Tcl_UtfBackslash(CONST char *src, int *readPtr, char *dst)
}
declare 328 generic {
- char * Tcl_UtfFindFirst(CONST char *src, int ch)
+ CONST84_RETURN char * Tcl_UtfFindFirst(CONST char *src, int ch)
}
declare 329 generic {
- char * Tcl_UtfFindLast(CONST char *src, int ch)
+ CONST84_RETURN char * Tcl_UtfFindLast(CONST char *src, int ch)
}
declare 330 generic {
- char * Tcl_UtfNext(CONST char *src)
+ CONST84_RETURN char * Tcl_UtfNext(CONST char *src)
}
declare 331 generic {
- char * Tcl_UtfPrev(CONST char *src, CONST char *start)
+ CONST84_RETURN char * Tcl_UtfPrev(CONST char *src, CONST char *start)
}
declare 332 generic {
- int Tcl_UtfToExternal(Tcl_Interp *interp, Tcl_Encoding encoding, \
- CONST char *src, int srcLen, int flags, \
- Tcl_EncodingState *statePtr, char *dst, int dstLen, \
+ 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)
}
declare 333 generic {
- char * Tcl_UtfToExternalDString(Tcl_Encoding encoding, CONST char *src, \
- int srcLen, Tcl_DString *dsPtr)
+ char * Tcl_UtfToExternalDString(Tcl_Encoding encoding,
+ CONST char *src, int srcLen, Tcl_DString *dsPtr)
}
declare 334 generic {
int Tcl_UtfToLower(char *src)
@@ -1182,10 +1214,10 @@ declare 340 generic {
char * Tcl_GetString(Tcl_Obj *objPtr)
}
declare 341 generic {
- char * Tcl_GetDefaultEncodingDir(void)
+ CONST84_RETURN char * Tcl_GetDefaultEncodingDir(void)
}
declare 342 generic {
- void Tcl_SetDefaultEncodingDir(char *path)
+ void Tcl_SetDefaultEncodingDir(CONST char *path)
}
declare 343 generic {
void Tcl_AlertNotifier(ClientData clientData)
@@ -1215,55 +1247,59 @@ declare 351 generic {
int Tcl_UniCharIsWordChar(int ch)
}
declare 352 generic {
- int Tcl_UniCharLen(Tcl_UniChar *str)
+ int Tcl_UniCharLen(CONST Tcl_UniChar *str)
}
declare 353 generic {
- int Tcl_UniCharNcmp(CONST Tcl_UniChar *cs, CONST Tcl_UniChar *ct,\
- unsigned long n)
+ int Tcl_UniCharNcmp(CONST Tcl_UniChar *cs, CONST Tcl_UniChar *ct,
+ unsigned long n)
}
declare 354 generic {
- char * Tcl_UniCharToUtfDString(CONST Tcl_UniChar *string, int numChars, \
- Tcl_DString *dsPtr)
+ char * Tcl_UniCharToUtfDString(CONST Tcl_UniChar *string,
+ int numChars, Tcl_DString *dsPtr)
}
declare 355 generic {
- Tcl_UniChar * Tcl_UtfToUniCharDString(CONST char *string, int length, \
- Tcl_DString *dsPtr)
+ Tcl_UniChar * Tcl_UtfToUniCharDString(CONST char *string,
+ int length, Tcl_DString *dsPtr)
}
declare 356 generic {
- Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj, int flags)
+ Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj,
+ int flags)
}
declare 357 generic {
- Tcl_Obj *Tcl_EvalTokens (Tcl_Interp *interp, Tcl_Token *tokenPtr, \
+ Tcl_Obj *Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
int count)
}
declare 358 generic {
- void Tcl_FreeParse (Tcl_Parse *parsePtr)
+ void Tcl_FreeParse(Tcl_Parse *parsePtr)
}
declare 359 generic {
- void Tcl_LogCommandInfo (Tcl_Interp *interp, char *script, \
- char *command, int length)
+ void Tcl_LogCommandInfo(Tcl_Interp *interp, CONST char *script,
+ CONST char *command, int length)
}
declare 360 generic {
- int Tcl_ParseBraces (Tcl_Interp *interp, char *string, \
- int numBytes, Tcl_Parse *parsePtr,int append, char **termPtr)
+ int Tcl_ParseBraces(Tcl_Interp *interp, CONST char *string, int numBytes,
+ Tcl_Parse *parsePtr, int append, CONST84 char **termPtr)
}
declare 361 generic {
- int Tcl_ParseCommand (Tcl_Interp *interp, char *string, int numBytes, \
+ int Tcl_ParseCommand(Tcl_Interp *interp, CONST char *string, int numBytes,
int nested, Tcl_Parse *parsePtr)
}
declare 362 generic {
- int Tcl_ParseExpr(Tcl_Interp *interp, char *string, int numBytes, \
+ int Tcl_ParseExpr(Tcl_Interp *interp, CONST char *string, int numBytes,
Tcl_Parse *parsePtr)
}
declare 363 generic {
- int Tcl_ParseQuotedString(Tcl_Interp *interp, char *string, int numBytes, \
- Tcl_Parse *parsePtr, int append, char **termPtr)
+ int Tcl_ParseQuotedString(Tcl_Interp *interp, CONST char *string,
+ int numBytes, Tcl_Parse *parsePtr, int append,
+ CONST84 char **termPtr)
}
declare 364 generic {
- int Tcl_ParseVarName (Tcl_Interp *interp, char *string, \
- int numBytes, Tcl_Parse *parsePtr, int append)
+ int Tcl_ParseVarName(Tcl_Interp *interp, CONST char *string, 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 {
char *Tcl_GetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
}
@@ -1298,37 +1334,37 @@ declare 375 generic {
int Tcl_UniCharIsPunct(int ch)
}
declare 376 generic {
- int Tcl_RegExpExecObj(Tcl_Interp *interp, Tcl_RegExp regexp, \
+ int Tcl_RegExpExecObj(Tcl_Interp *interp, Tcl_RegExp regexp,
Tcl_Obj *objPtr, int offset, int nmatches, int flags)
}
declare 377 generic {
void Tcl_RegExpGetInfo(Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr)
}
declare 378 generic {
- Tcl_Obj * Tcl_NewUnicodeObj(Tcl_UniChar *unicode, int numChars)
+ Tcl_Obj * Tcl_NewUnicodeObj(CONST Tcl_UniChar *unicode, int numChars)
}
declare 379 generic {
- void Tcl_SetUnicodeObj(Tcl_Obj *objPtr, Tcl_UniChar *unicode, \
+ void Tcl_SetUnicodeObj(Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode,
int numChars)
}
declare 380 generic {
- int Tcl_GetCharLength (Tcl_Obj *objPtr)
+ int Tcl_GetCharLength(Tcl_Obj *objPtr)
}
declare 381 generic {
- Tcl_UniChar Tcl_GetUniChar (Tcl_Obj *objPtr, int index)
+ Tcl_UniChar Tcl_GetUniChar(Tcl_Obj *objPtr, int index)
}
declare 382 generic {
- Tcl_UniChar * Tcl_GetUnicode (Tcl_Obj *objPtr)
+ Tcl_UniChar * Tcl_GetUnicode(Tcl_Obj *objPtr)
}
declare 383 generic {
- Tcl_Obj * Tcl_GetRange (Tcl_Obj *objPtr, int first, int last)
+ Tcl_Obj * Tcl_GetRange(Tcl_Obj *objPtr, int first, int last)
}
declare 384 generic {
- void Tcl_AppendUnicodeToObj (Tcl_Obj *objPtr, \
- Tcl_UniChar *unicode, int length)
+ void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode,
+ int length)
}
declare 385 generic {
- int Tcl_RegExpMatchObj(Tcl_Interp *interp, Tcl_Obj *stringObj, \
+ int Tcl_RegExpMatchObj(Tcl_Interp *interp, Tcl_Obj *stringObj,
Tcl_Obj *patternObj)
}
declare 386 generic {
@@ -1341,43 +1377,44 @@ declare 388 generic {
int Tcl_GetChannelNames(Tcl_Interp *interp)
}
declare 389 generic {
- int Tcl_GetChannelNamesEx(Tcl_Interp *interp, char *pattern)
+ int Tcl_GetChannelNamesEx(Tcl_Interp *interp, CONST char *pattern)
}
declare 390 generic {
- int Tcl_ProcObjCmd(ClientData clientData, Tcl_Interp *interp, \
+ int Tcl_ProcObjCmd(ClientData clientData, Tcl_Interp *interp,
int objc, Tcl_Obj *CONST objv[])
}
declare 391 generic {
- void Tcl_ConditionFinalize (Tcl_Condition *condPtr)
+ void Tcl_ConditionFinalize(Tcl_Condition *condPtr)
}
declare 392 generic {
- void Tcl_MutexFinalize (Tcl_Mutex *mutex)
+ void Tcl_MutexFinalize(Tcl_Mutex *mutex)
}
declare 393 generic {
- int Tcl_CreateThread (Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc proc, \
+ int Tcl_CreateThread(Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc proc,
ClientData clientData, int stackSize, int flags)
}
+# Introduced in 8.3.2
declare 394 generic {
- int Tcl_ReadRaw (Tcl_Channel chan, char *dst, int bytesToRead)
+ int Tcl_ReadRaw(Tcl_Channel chan, char *dst, int bytesToRead)
}
declare 395 generic {
- int Tcl_WriteRaw (Tcl_Channel chan, char *src, int srcLen)
+ int Tcl_WriteRaw(Tcl_Channel chan, CONST char *src, int srcLen)
}
declare 396 generic {
- Tcl_Channel Tcl_GetTopChannel (Tcl_Channel chan)
+ Tcl_Channel Tcl_GetTopChannel(Tcl_Channel chan)
}
declare 397 generic {
- int Tcl_ChannelBuffered (Tcl_Channel chan)
+ int Tcl_ChannelBuffered(Tcl_Channel chan)
}
declare 398 generic {
- char * Tcl_ChannelName(Tcl_ChannelType *chanTypePtr)
+ CONST84_RETURN char * Tcl_ChannelName(Tcl_ChannelType *chanTypePtr)
}
declare 399 generic {
Tcl_ChannelTypeVersion Tcl_ChannelVersion(Tcl_ChannelType *chanTypePtr)
}
declare 400 generic {
- Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc(Tcl_ChannelType \
+ Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc(Tcl_ChannelType
*chanTypePtr)
}
declare 401 generic {
@@ -1396,28 +1433,327 @@ declare 405 generic {
Tcl_DriverSeekProc * Tcl_ChannelSeekProc(Tcl_ChannelType *chanTypePtr)
}
declare 406 generic {
- Tcl_DriverSetOptionProc * Tcl_ChannelSetOptionProc(Tcl_ChannelType \
+ Tcl_DriverSetOptionProc * Tcl_ChannelSetOptionProc(Tcl_ChannelType
*chanTypePtr)
}
declare 407 generic {
- Tcl_DriverGetOptionProc * Tcl_ChannelGetOptionProc(Tcl_ChannelType \
+ Tcl_DriverGetOptionProc * Tcl_ChannelGetOptionProc(Tcl_ChannelType
*chanTypePtr)
}
declare 408 generic {
Tcl_DriverWatchProc * Tcl_ChannelWatchProc(Tcl_ChannelType *chanTypePtr)
}
declare 409 generic {
- Tcl_DriverGetHandleProc * Tcl_ChannelGetHandleProc(Tcl_ChannelType \
+ Tcl_DriverGetHandleProc * Tcl_ChannelGetHandleProc(Tcl_ChannelType
*chanTypePtr)
}
declare 410 generic {
Tcl_DriverFlushProc * Tcl_ChannelFlushProc(Tcl_ChannelType *chanTypePtr)
}
declare 411 generic {
- Tcl_DriverHandlerProc * Tcl_ChannelHandlerProc(Tcl_ChannelType \
+ Tcl_DriverHandlerProc * Tcl_ChannelHandlerProc(Tcl_ChannelType
*chanTypePtr)
}
+# Introduced in 8.4a2
+declare 412 generic {
+ int Tcl_JoinThread(Tcl_ThreadId id, int* result)
+}
+declare 413 generic {
+ int Tcl_IsChannelShared(Tcl_Channel channel)
+}
+declare 414 generic {
+ int Tcl_IsChannelRegistered(Tcl_Interp* interp, Tcl_Channel channel)
+}
+declare 415 generic {
+ void Tcl_CutChannel(Tcl_Channel channel)
+}
+declare 416 generic {
+ void Tcl_SpliceChannel(Tcl_Channel channel)
+}
+declare 417 generic {
+ void Tcl_ClearChannelHandlers(Tcl_Channel channel)
+}
+declare 418 generic {
+ int Tcl_IsChannelExisting(CONST char* channelName)
+}
+
+declare 419 generic {
+ int Tcl_UniCharNcasecmp(CONST Tcl_UniChar *cs, CONST Tcl_UniChar *ct,
+ unsigned long n)
+}
+declare 420 generic {
+ int Tcl_UniCharCaseMatch(CONST Tcl_UniChar *ustr,
+ CONST Tcl_UniChar *pattern, int nocase)
+}
+
+declare 421 generic {
+ Tcl_HashEntry *Tcl_FindHashEntry(Tcl_HashTable *tablePtr, CONST char *key)
+}
+
+declare 422 generic {
+ Tcl_HashEntry *Tcl_CreateHashEntry(Tcl_HashTable *tablePtr,
+ CONST char *key, int *newPtr)
+}
+
+declare 423 generic {
+ void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr, int keyType,
+ Tcl_HashKeyType *typePtr)
+}
+
+declare 424 generic {
+ void Tcl_InitObjHashTable(Tcl_HashTable *tablePtr)
+}
+declare 425 generic {
+ 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,
+ Tcl_CommandTraceProc *proc, ClientData clientData)
+}
+declare 427 generic {
+ 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 429 generic {
+ char * Tcl_AttemptDbCkalloc(unsigned int size, CONST char *file, int line)
+}
+declare 430 generic {
+ 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 432 generic {
+ int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, int length)
+}
+declare 433 generic {
+ Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel)
+}
+# introduced in 8.4a3
+declare 434 generic {
+ Tcl_UniChar * Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr)
+}
+declare 435 generic {
+ 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 437 generic {
+ Tcl_Obj * Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags)
+}
+declare 438 generic {
+ int Tcl_DetachChannel(Tcl_Interp* interp, Tcl_Channel channel)
+}
+declare 439 generic {
+ int Tcl_IsStandardChannel(Tcl_Channel channel)
+}
+# New functions due to TIP#17
+declare 440 generic {
+ int Tcl_FSCopyFile(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr)
+}
+declare 441 generic {
+ int Tcl_FSCopyDirectory(Tcl_Obj *srcPathPtr,
+ Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr)
+}
+declare 442 generic {
+ int Tcl_FSCreateDirectory(Tcl_Obj *pathPtr)
+}
+declare 443 generic {
+ 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,
+ Tcl_FSUnloadFileProc **unloadProcPtr)
+}
+declare 445 generic {
+ int Tcl_FSMatchInDirectory(Tcl_Interp *interp, Tcl_Obj *result,
+ 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 447 generic {
+ int Tcl_FSRemoveDirectory(Tcl_Obj *pathPtr,
+ int recursive, Tcl_Obj **errorPtr)
+}
+declare 448 generic {
+ int Tcl_FSRenameFile(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr)
+}
+declare 449 generic {
+ int Tcl_FSLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf)
+}
+declare 450 generic {
+ int Tcl_FSUtime(Tcl_Obj *pathPtr, struct utimbuf *tval)
+}
+declare 451 generic {
+ int Tcl_FSFileAttrsGet(Tcl_Interp *interp,
+ int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef)
+}
+declare 452 generic {
+ 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 454 generic {
+ int Tcl_FSStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf)
+}
+declare 455 generic {
+ int Tcl_FSAccess(Tcl_Obj *pathPtr, int mode)
+}
+declare 456 generic {
+ Tcl_Channel Tcl_FSOpenFileChannel(Tcl_Interp *interp, Tcl_Obj *pathPtr,
+ CONST char *modeString, int permissions)
+}
+declare 457 generic {
+ Tcl_Obj* Tcl_FSGetCwd(Tcl_Interp *interp)
+}
+declare 458 generic {
+ int Tcl_FSChdir(Tcl_Obj *pathPtr)
+}
+declare 459 generic {
+ int Tcl_FSConvertToPathType(Tcl_Interp *interp, Tcl_Obj *pathPtr)
+}
+declare 460 generic {
+ Tcl_Obj* Tcl_FSJoinPath(Tcl_Obj *listObj, int elements)
+}
+declare 461 generic {
+ Tcl_Obj* Tcl_FSSplitPath(Tcl_Obj* pathPtr, int *lenPtr)
+}
+declare 462 generic {
+ int Tcl_FSEqualPaths(Tcl_Obj* firstPtr, Tcl_Obj* secondPtr)
+}
+declare 463 generic {
+ Tcl_Obj* Tcl_FSGetNormalizedPath(Tcl_Interp *interp, Tcl_Obj* pathObjPtr)
+}
+declare 464 generic {
+ Tcl_Obj* Tcl_FSJoinToPath(Tcl_Obj *basePtr, int objc,
+ Tcl_Obj *CONST objv[])
+}
+declare 465 generic {
+ ClientData Tcl_FSGetInternalRep(Tcl_Obj* pathObjPtr,
+ Tcl_Filesystem *fsPtr)
+}
+declare 466 generic {
+ Tcl_Obj* Tcl_FSGetTranslatedPath(Tcl_Interp *interp, Tcl_Obj* pathPtr)
+}
+declare 467 generic {
+ int Tcl_FSEvalFile(Tcl_Interp *interp, Tcl_Obj *fileName)
+}
+declare 468 generic {
+ Tcl_Obj* Tcl_FSNewNativePath(Tcl_Filesystem* fromFilesystem,
+ ClientData clientData)
+}
+declare 469 generic {
+ CONST char* Tcl_FSGetNativePath(Tcl_Obj* pathObjPtr)
+}
+declare 470 generic {
+ Tcl_Obj* Tcl_FSFileSystemInfo(Tcl_Obj* pathObjPtr)
+}
+declare 471 generic {
+ Tcl_Obj* Tcl_FSPathSeparator(Tcl_Obj* pathObjPtr)
+}
+declare 472 generic {
+ Tcl_Obj* Tcl_FSListVolumes(void)
+}
+declare 473 generic {
+ int Tcl_FSRegister(ClientData clientData, Tcl_Filesystem *fsPtr)
+}
+declare 474 generic {
+ int Tcl_FSUnregister(Tcl_Filesystem *fsPtr)
+}
+declare 475 generic {
+ ClientData Tcl_FSData(Tcl_Filesystem *fsPtr)
+}
+declare 476 generic {
+ CONST char* Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp,
+ Tcl_Obj* pathPtr)
+}
+declare 477 generic {
+ Tcl_Filesystem* Tcl_FSGetFileSystemForPath(Tcl_Obj* pathObjPtr)
+}
+declare 478 generic {
+ Tcl_PathType Tcl_FSGetPathType(Tcl_Obj *pathObjPtr)
+}
+# New function due to TIP#49
+declare 479 generic {
+ int Tcl_OutputBuffered(Tcl_Channel chan)
+}
+declare 480 generic {
+ void Tcl_FSMountsChanged(Tcl_Filesystem *fsPtr)
+}
+# New function due to TIP#56
+declare 481 generic {
+ 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)
+}
+
+# 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)
+}
+declare 484 generic {
+ int Tcl_GetCommandInfoFromToken(Tcl_Command token, Tcl_CmdInfo* infoPtr)
+}
+declare 485 generic {
+ int Tcl_SetCommandInfoFromToken(Tcl_Command token,
+ 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)
+}
+declare 487 generic {
+ int Tcl_GetWideIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ Tcl_WideInt *widePtr)
+}
+declare 488 generic {
+ Tcl_Obj * Tcl_NewWideIntObj(Tcl_WideInt wideValue)
+}
+declare 489 generic {
+ void Tcl_SetWideIntObj(Tcl_Obj *objPtr, Tcl_WideInt wideValue)
+}
+declare 490 generic {
+ Tcl_StatBuf * Tcl_AllocStatBuf(void)
+}
+declare 491 generic {
+ Tcl_WideInt Tcl_Seek(Tcl_Channel chan, Tcl_WideInt offset, int mode)
+}
+declare 492 generic {
+ Tcl_WideInt Tcl_Tell(Tcl_Channel chan)
+}
+
+# New export due to TIP#91
+declare 493 generic {
+ Tcl_DriverWideSeekProc * Tcl_ChannelWideSeekProc(
+ Tcl_ChannelType *chanTypePtr)
+}
+
##############################################################################
# Define the platform specific public Tcl interface. These functions are
@@ -1453,20 +1789,20 @@ declare 1 mac {
char * Tcl_MacConvertTextResource(Handle resource)
}
declare 2 mac {
- int Tcl_MacEvalResource(Tcl_Interp *interp, char *resourceName, \
- int resourceNumber, char *fileName)
+ int Tcl_MacEvalResource(Tcl_Interp *interp, CONST char *resourceName,
+ int resourceNumber, CONST char *fileName)
}
declare 3 mac {
- Handle Tcl_MacFindResource(Tcl_Interp *interp, long resourceType, \
- char *resourceName, int resourceNumber, char *resFileRef, \
- int * releaseIt)
+ Handle Tcl_MacFindResource(Tcl_Interp *interp, long resourceType,
+ CONST char *resourceName, int resourceNumber,
+ CONST char *resFileRef, int * releaseIt)
}
# These routines support the new OSType object type (i.e. the packed 4
# character type and creator codes).
declare 4 mac {
- int Tcl_GetOSTypeFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, \
+ int Tcl_GetOSTypeFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
OSType *osTypePtr)
}
declare 5 mac {
@@ -1477,8 +1813,7 @@ declare 6 mac {
}
# These are not in MSL 2.1.2, so we need to export them from the
-# Tcl shared library. They are found in the compat directory
-# except the panic routine which is found in tclMacPanic.h.
+# Tcl shared library. They are found in the compat directory.
declare 7 mac {
int strncasecmp(CONST char *s1, CONST char *s2, size_t n)
@@ -1487,3 +1822,14 @@ declare 8 mac {
int strcasecmp(CONST char *s1, CONST char *s2)
}
+##################
+# Mac OS X declarations
+#
+
+declare 0 macosx {
+ int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp,
+ CONST char *bundleName,
+ int hasResourceFile,
+ int maxPathLen,
+ char *libraryPath)
+}
diff --git a/tcl/generic/tcl.h b/tcl/generic/tcl.h
index f4574f30d95..c3e4cd6bf9d 100644
--- a/tcl/generic/tcl.h
+++ b/tcl/generic/tcl.h
@@ -8,6 +8,7 @@
* Copyright (c) 1993-1996 Lucent Technologies.
* Copyright (c) 1994-1998 Sun Microsystems, Inc.
* Copyright (c) 1998-2000 by Scriptics Corporation.
+ * Copyright (c) 2002 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.
@@ -43,26 +44,23 @@ extern "C" {
* win/configure.in (as above)
* win/tcl.m4 (not patchlevel)
* win/makefile.vc (not patchlevel) 2 LOC
- * win/pkgIndex.tcl (not patchlevel, for tclregNN.dll)
* README (sections 0 and 2)
* mac/README (2 LOC, not patchlevel)
* win/README.binary (sections 0-4)
* win/README (not patchlevel) (sections 0 and 2)
- * unix/README (not patchlevel) (part (h))
* unix/tcl.spec (2 LOC Major/Minor, 1 LOC patch)
- * tests/basic.test (not patchlevel) (version checks)
+ * tests/basic.test (1 LOC M/M, not patchlevel)
* 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 3
+#define TCL_MINOR_VERSION 4
#define TCL_RELEASE_LEVEL TCL_FINAL_RELEASE
-#define TCL_RELEASE_SERIAL 2
+#define TCL_RELEASE_SERIAL 0
-#define TCL_VERSION "8.3"
-#define TCL_PATCH_LEVEL "8.3.2"
+#define TCL_VERSION "8.4"
+#define TCL_PATCH_LEVEL "8.4.0"
/*
* The following definitions set up the proper options for Windows
@@ -70,34 +68,21 @@ extern "C" {
*/
#ifndef __WIN32__
-# if defined(_WIN32) || defined(WIN32) || \
- defined(__CYGWIN__) || defined(__MINGW32__)
+# if defined(_WIN32) || defined(WIN32) || defined(__CYGWIN__) || defined(__MINGW32__) || defined(__BORLANDC__)
# define __WIN32__
+# ifndef WIN32
+# define WIN32
+# endif
# endif
#endif
+/*
+ * STRICT: See MSDN Article Q83456
+ */
#ifdef __WIN32__
# ifndef STRICT
# define STRICT
# endif
-# ifndef USE_PROTOTYPE
-# define USE_PROTOTYPE 1
-# endif
-# ifndef HAS_STDARG
-# define HAS_STDARG 1
-# endif
-# ifndef USE_PROTOTYPE
-# define USE_PROTOTYPE 1
-# endif
-
-/*
- * Under Windows we need to call Tcl_Alloc in all cases to avoid competing
- * C run-time library issues.
- */
-
-# ifndef USE_TCLALLOC
-# define USE_TCLALLOC 1
-# endif
#endif /* __WIN32__ */
/*
@@ -106,9 +91,7 @@ extern "C" {
*/
#ifdef MAC_TCL
-# ifndef HAS_STDARG
-# define HAS_STDARG 1
-# endif
+#include <ConditionalMacros.h>
# ifndef USE_TCLALLOC
# define USE_TCLALLOC 1
# endif
@@ -118,34 +101,40 @@ extern "C" {
# define INLINE
#endif
+
/*
* Utility macros: STRINGIFY takes an argument and wraps it in "" (double
* quotation marks), JOIN joins two arguments.
*/
-
-#define VERBATIM(x) x
-#ifdef _MSC_VER
-# define STRINGIFY(x) STRINGIFY1(x)
-# define STRINGIFY1(x) #x
-# define JOIN(a,b) JOIN1(a,b)
-# define JOIN1(a,b) a##b
-#else
-# ifdef RESOURCE_INCLUDED
+#ifndef STRINGIFY
# define STRINGIFY(x) STRINGIFY1(x)
# define STRINGIFY1(x) #x
+#endif
+#ifndef JOIN
# define JOIN(a,b) JOIN1(a,b)
# define JOIN1(a,b) a##b
-# else
-# ifdef __STDC__
-# define STRINGIFY(x) #x
-# define JOIN(a,b) a##b
-# else
-# define STRINGIFY(x) "x"
-# define JOIN(a,b) VERBATIM(a)VERBATIM(b)
-# endif
-# endif
#endif
+/*
+ * A special definition used to allow this header file to be included
+ * from windows resource files so that they can obtain version
+ * information. RC_INVOKED is defined by default by the RC tool.
+ * Resource compilers don't like all the C stuff, like typedefs and
+ * procedure declarations, that occur below, so block them out.
+ */
+
+#ifndef RC_INVOKED
+
+/*
+ * A special definition for Macintosh used to allow this header file
+ * to be included in resource files so that they can get obtain
+ * version information from this file. Resource compilers don't like
+ * all the C stuff, like typedefs and procedure declarations, that
+ * occur below.
+*/
+
+#ifndef RESOURCE_INCLUDED
+
/*
* Special macro to define mutexes, that doesn't do anything
* if we are not using threads.
@@ -171,19 +160,12 @@ extern "C" {
#define Tcl_ConditionFinalize(condPtr)
#endif /* TCL_THREADS */
-/*
- * A special definition used to allow this header file to be included
- * in resource files so that they can get obtain version information from
- * this file. Resource compilers don't like all the C stuff, like typedefs
- * and procedure declarations, that occur below.
- */
-
-#ifndef RESOURCE_INCLUDED
#ifndef BUFSIZ
-#include <stdio.h>
+# include <stdio.h>
#endif
+
/*
* Definitions that allow Tcl functions with variable numbers of
* arguments to be used with either varargs.h or stdarg.h. TCL_VARARGS
@@ -193,23 +175,15 @@ extern "C" {
* string for use in the function definition. TCL_VARARGS_START
* initializes the va_list data structure and returns the first argument.
*/
-
-#if defined(__STDC__) || defined(HAS_STDARG)
+#if !defined(NO_STDARG)
# include <stdarg.h>
-
# define TCL_VARARGS(type, name) (type name, ...)
# define TCL_VARARGS_DEF(type, name) (type name, ...)
# define TCL_VARARGS_START(type, name, list) (va_start(list, name), name)
#else
# include <varargs.h>
-
-# ifdef __cplusplus
-# define TCL_VARARGS(type, name) (type name, ...)
-# define TCL_VARARGS_DEF(type, name) (type va_alist, ...)
-# else
-# define TCL_VARARGS(type, name) ()
-# define TCL_VARARGS_DEF(type, name) (va_alist)
-# endif
+# define TCL_VARARGS(type, name) ()
+# define TCL_VARARGS_DEF(type, name) (va_alist)
# define TCL_VARARGS_START(type, name, list) \
(va_start(list), va_arg(list, type))
#endif
@@ -223,16 +197,16 @@ extern "C" {
*/
#ifdef STATIC_BUILD
-# define DLLIMPORT
-# define DLLEXPORT
+# define DLLIMPORT
+# define DLLEXPORT
#else
-# if defined(__WIN32__) && (defined(_MSC_VER) || (defined(__GNUC__) && defined(__declspec)))
-# define DLLIMPORT __declspec(dllimport)
-# define DLLEXPORT __declspec(dllexport)
-# else
-# define DLLIMPORT
-# define DLLEXPORT
-# endif
+# if (defined(__WIN32__) && (defined(_MSC_VER) || (__BORLANDC__ >= 0x0550) || (defined(__GNUC__) && defined(__declspec)))) || (defined(MAC_TCL) && FUNCTION_DECLSPEC)
+# define DLLIMPORT __declspec(dllimport)
+# define DLLEXPORT __declspec(dllexport)
+# else
+# define DLLIMPORT
+# define DLLEXPORT
+# endif
#endif
/*
@@ -248,45 +222,64 @@ extern "C" {
* name of a library we are building, is set on the compile line for sources
* that are to be placed in the library. When this macro is set, the
* storage class will be set to DLLEXPORT. At the end of the header file, the
- * storage class will be reset to DLLIMPORt.
+ * storage class will be reset to DLLIMPORT.
*/
-
#undef TCL_STORAGE_CLASS
#ifdef BUILD_tcl
-# define TCL_STORAGE_CLASS DLLEXPORT
+# define TCL_STORAGE_CLASS DLLEXPORT
#else
-# ifdef USE_TCL_STUBS
-# define TCL_STORAGE_CLASS
-# else
-# define TCL_STORAGE_CLASS DLLIMPORT
-# endif
+# ifdef USE_TCL_STUBS
+# define TCL_STORAGE_CLASS
+# else
+# define TCL_STORAGE_CLASS DLLIMPORT
+# endif
#endif
+
/*
* Definitions that allow this header file to be used either with or
* without ANSI C features like function prototypes.
*/
-
#undef _ANSI_ARGS_
#undef CONST
#ifndef INLINE
# define INLINE
#endif
-#if ((defined(__STDC__) || defined(SABER)) && !defined(NO_PROTOTYPE)) || defined(__cplusplus) || defined(USE_PROTOTYPE)
-# define _USING_PROTOTYPES_ 1
-# define _ANSI_ARGS_(x) x
+#ifndef NO_CONST
# define CONST const
#else
-# define _ANSI_ARGS_(x) ()
# define CONST
#endif
+#ifndef NO_PROTOTYPES
+# define _ANSI_ARGS_(x) x
+#else
+# define _ANSI_ARGS_(x) ()
+#endif
+
+#ifdef USE_NON_CONST
+# ifdef USE_COMPAT_CONST
+# error define at most one of USE_NON_CONST and USE_COMPAT_CONST
+# endif
+# define CONST84
+# define CONST84_RETURN
+#else
+# ifdef USE_COMPAT_CONST
+# define CONST84
+# define CONST84_RETURN CONST
+# else
+# define CONST84 CONST
+# define CONST84_RETURN CONST
+# endif
+#endif
+
+
/*
* Make sure EXTERN isn't defined elsewhere
*/
#ifdef EXTERN
-#undef EXTERN
+# undef EXTERN
#endif /* EXTERN */
#ifdef __cplusplus
@@ -295,23 +288,13 @@ extern "C" {
# define EXTERN extern TCL_STORAGE_CLASS
#endif
+
/*
- * 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 __WIN32__
-#ifndef VOID
-# ifdef __STDC__
-# define VOID void
-# else
-# define VOID char
-# endif
-#endif
-#else /* __WIN32__ */
-/*
- * The following code is copied from winnt.h
+ * 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.
*/
+#ifdef __WIN32__
#ifndef VOID
#define VOID void
typedef char CHAR;
@@ -321,22 +304,130 @@ typedef long LONG;
#endif /* __WIN32__ */
/*
- * Miscellaneous declarations.
+ * 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
+#endif
+
+/*
+ * Miscellaneous declarations.
+ */
#ifndef NULL
-#define NULL 0
+# define NULL 0
#endif
#ifndef _CLIENTDATA
-# if defined(__STDC__) || defined(__cplusplus)
- typedef void *ClientData;
+# ifndef NO_VOID
+ typedef void *ClientData;
# else
- typedef int *ClientData;
-# endif /* __STDC__ */
-#define _CLIENTDATA
+ typedef int *ClientData;
+# endif
+# define _CLIENTDATA
+#endif
+
+/*
+ * 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.)
+ *
+ * At the moment, this only works on Unix systems anyway...
+ *
+ * Also defines the following macros:
+ * TCL_WIDE_INT_IS_LONG - if wide ints are really longs (i.e. we're on
+ * a real 64-bit system.)
+ * Tcl_WideAsLong - forgetful converter from wideInt to long.
+ * Tcl_LongAsWide - sign-extending converter from long to wideInt.
+ * Tcl_WideAsDouble - converter from wideInt to double.
+ * Tcl_DoubleAsWide - converter from double to wideInt.
+ *
+ * The following invariant should hold for any long value 'longVal':
+ * 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, where sprintf(...,"%lld",...) does not work, lltostr().
+ * Although strtoull() is fairly straight-forward, lltostr() is a most
+ * unusual function on Solaris8 (taking its operating buffer
+ * backwards) so any changes you make will need to be done
+ * cautiously...
+ */
+
+#if !defined(TCL_WIDE_INT_TYPE)&&!defined(TCL_WIDE_INT_IS_LONG)
+# ifdef __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__ */
+/*
+ * Don't know what platform it is and configure hasn't discovered what
+ * is going on for us. Try to guess...
+ */
+# ifdef NO_LIMITS_H
+# error please define either TCL_WIDE_INT_TYPE or TCL_WIDE_INT_IS_LONG
+# else /* !NO_LIMITS_H */
+# include <limits.h>
+# if (INT_MAX < LONG_MAX)
+# define TCL_WIDE_INT_IS_LONG 1
+# else
+# define TCL_WIDE_INT_TYPE long long
+# endif
+# endif /* NO_LIMITS_H */
+# endif /* __WIN32__ */
+#endif /* !TCL_WIDE_INT_TYPE & !TCL_WIDE_INT_IS_LONG */
+#ifdef TCL_WIDE_INT_IS_LONG
+# undef TCL_WIDE_INT_TYPE
+# define TCL_WIDE_INT_TYPE long
+#endif /* TCL_WIDE_INT_IS_LONG */
+
+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)))
+#else /* TCL_WIDE_INT_IS_LONG */
+# ifndef __WIN32__
+# 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 /* !__WIN32__ */
+# define Tcl_WideAsLong(val) ((long)((Tcl_WideInt)(val)))
+# define Tcl_LongAsWide(val) ((Tcl_WideInt)((long)(val)))
+# define Tcl_WideAsDouble(val) ((double)((Tcl_WideInt)(val)))
+# 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
#endif
+
/*
* Data structures defined opaquely in this module. The definitions below
* just provide dummy types. A few fields are made visible in Tcl_Interp
@@ -388,6 +479,7 @@ typedef struct Tcl_TimerToken_ *Tcl_TimerToken;
typedef struct Tcl_Trace_ *Tcl_Trace;
typedef struct Tcl_Var_ *Tcl_Var;
typedef struct Tcl_ChannelTypeVersion_ *Tcl_ChannelTypeVersion;
+typedef struct Tcl_LoadHandle_ *Tcl_LoadHandle;
/*
* Definition of the interface to procedures implementing threads.
@@ -395,7 +487,6 @@ typedef struct Tcl_ChannelTypeVersion_ *Tcl_ChannelTypeVersion;
* 'Tcl_CreateThread' and will be called as the main fuction of
* the new thread created by that call.
*/
-
#ifdef MAC_TCL
typedef pascal void *(Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData));
#elif defined __WIN32__
@@ -422,12 +513,10 @@ typedef void (Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData));
#endif
-
/*
* Definition of values for default stacksize and the possible flags to be
* 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 */
@@ -435,7 +524,6 @@ typedef void (Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData));
/*
* Flag values passed to Tcl_GetRegExpFromObj.
*/
-
#define TCL_REG_BASIC 000000 /* BREs (convenience) */
#define TCL_REG_EXTENDED 000001 /* EREs */
#define TCL_REG_ADVF 000002 /* advanced features in EREs */
@@ -455,7 +543,6 @@ typedef void (Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData));
* The following flag is experimental and only intended for use by Expect. It
* will probably go away in a later release.
*/
-
#define TCL_REG_BOSONLY 002000 /* prepend \A to pattern so it only
* matches at the beginning of the
* string. */
@@ -463,7 +550,6 @@ typedef void (Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData));
/*
* Flags values passed to Tcl_RegExpExecObj.
*/
-
#define TCL_REG_NOTBOL 0001 /* Beginning of string does not match ^. */
#define TCL_REG_NOTEOL 0002 /* End of string does not match $. */
@@ -472,7 +558,6 @@ typedef void (Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData));
* relative to the start of the match string, not the beginning of the
* entire string.
*/
-
typedef struct Tcl_RegExpIndices {
long start; /* character offset of first character in match */
long end; /* character offset of first character after the
@@ -493,8 +578,8 @@ typedef struct Tcl_RegExpInfo {
* Picky compilers complain if this typdef doesn't appear before the
* struct's reference in tclDecls.h.
*/
-
-typedef struct stat *Tcl_Stat_;
+typedef Tcl_StatBuf *Tcl_Stat_;
+typedef struct stat *Tcl_OldStat_;
/*
* When a TCL command returns, the interpreter contains a result from the
@@ -516,7 +601,6 @@ typedef struct stat *Tcl_Stat_;
* TCL_CONTINUE Go on to the next iteration of the current loop;
* the interpreter's result is meaningless.
*/
-
#define TCL_OK 0
#define TCL_ERROR 1
#define TCL_RETURN 2
@@ -526,15 +610,31 @@ typedef struct stat *Tcl_Stat_;
#define TCL_RESULT_SIZE 200
/*
- * Argument descriptors for math function callbacks in expressions:
+ * Flags to control what substitutions are performed by Tcl_SubstObj():
*/
+#define TCL_SUBST_COMMANDS 001
+#define TCL_SUBST_VARIABLES 002
+#define TCL_SUBST_BACKSLASHES 004
+#define TCL_SUBST_ALL 007
+
-typedef enum {TCL_INT, TCL_DOUBLE, TCL_EITHER} Tcl_ValueType;
+/*
+ * Argument descriptors for math function callbacks in expressions:
+ */
+typedef enum {
+ TCL_INT, TCL_DOUBLE, TCL_EITHER, TCL_WIDE_INT
+#ifdef TCL_WIDE_INT_IS_LONG
+ = TCL_INT
+#endif
+} Tcl_ValueType;
typedef struct Tcl_Value {
Tcl_ValueType type; /* Indicates intValue or doubleValue is
* valid, or both. */
long intValue; /* Integer value. */
double doubleValue; /* Double-precision floating value. */
+#ifndef TCL_WIDE_INT_IS_LONG
+ Tcl_WideInt wideValue; /* Wide (min. 64-bit) integer value. */
+#endif
} Tcl_Value;
/*
@@ -542,9 +642,9 @@ typedef struct Tcl_Value {
* reference to Tcl_Obj is encountered in the procedure types declared
* below.
*/
-
struct Tcl_Obj;
+
/*
* Procedure types defined by Tcl:
*/
@@ -556,10 +656,14 @@ 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, char *argv[]));
+ 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, char *argv[]));
+ 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,
@@ -586,9 +690,9 @@ 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[]));
+ Tcl_Interp *interp, int objc, struct Tcl_Obj * CONST * objv));
typedef int (Tcl_PackageInitProc) _ANSI_ARGS_((Tcl_Interp *interp));
-typedef void (Tcl_PanicProc) _ANSI_ARGS_(TCL_VARARGS(char *, format));
+typedef void (Tcl_PanicProc) _ANSI_ARGS_(TCL_VARARGS(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));
@@ -596,10 +700,19 @@ 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, char *part1, char *part2, int flags));
+ 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));
+
/*
* The following structure represents a type of object, which is a
@@ -626,6 +739,7 @@ typedef struct Tcl_ObjType {
* failure. */
} Tcl_ObjType;
+
/*
* One of the following structures exists for each object in the Tcl
* system. An object stores a value as either a string, some internal
@@ -655,6 +769,7 @@ typedef struct Tcl_Obj {
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;
@@ -662,6 +777,7 @@ typedef struct Tcl_Obj {
} internalRep;
} Tcl_Obj;
+
/*
* Macros to increment and decrement a Tcl_Obj's reference count, and to
* test whether an object is shared (i.e. has reference count > 1).
@@ -672,7 +788,6 @@ typedef struct Tcl_Obj {
* "obj" twice. This means that you should avoid calling it with an
* expression that is expensive to compute or has side effects.
*/
-
void Tcl_IncrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr));
void Tcl_DecrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr));
int Tcl_IsShared _ANSI_ARGS_((Tcl_Obj *objPtr));
@@ -716,14 +831,16 @@ int Tcl_IsShared _ANSI_ARGS_((Tcl_Obj *objPtr));
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 */
+
/*
* 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.
*/
-
typedef struct Tcl_SavedResult {
char *result;
Tcl_FreeProc *freeProc;
@@ -759,6 +876,7 @@ typedef struct Tcl_Namespace {
* 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
@@ -795,6 +913,7 @@ typedef struct Tcl_CallFrame {
char* dummy10;
} Tcl_CallFrame;
+
/*
* Information about commands that is returned by Tcl_GetCommandInfo and
* passed to Tcl_SetCommandInfo. objProc is an objc/objv object-based
@@ -809,7 +928,7 @@ typedef struct Tcl_CallFrame {
* does string-to-object or object-to-string argument conversions then
* calls the other procedure.
*/
-
+
typedef struct Tcl_CmdInfo {
int isNativeObjectProc; /* 1 if objProc was registered by a call to
* Tcl_CreateObjCommand; 0 otherwise.
@@ -833,10 +952,9 @@ typedef struct Tcl_CmdInfo {
/*
* The structure defined below is used to hold dynamic strings. The only
- * field that clients should use is the string field, and they should
- * never modify it.
+ * field that clients should use is the string field, accessible via the
+ * macro Tcl_DStringValue.
*/
-
#define TCL_DSTRING_STATIC_SIZE 200
typedef struct Tcl_DString {
char *string; /* Points to beginning of string: either
@@ -859,7 +977,6 @@ typedef struct Tcl_DString {
* be specified in the "tcl_precision" variable, and the number of
* bytes of buffer space required by Tcl_PrintDouble.
*/
-
#define TCL_MAX_PREC 17
#define TCL_DOUBLE_SPACE (TCL_MAX_PREC+10)
@@ -868,7 +985,6 @@ typedef struct Tcl_DString {
* string representation of an integer in base 10 (assuming the existence
* of 64-bit integers).
*/
-
#define TCL_INTEGER_SPACE 24
/*
@@ -876,14 +992,12 @@ typedef struct Tcl_DString {
* output braces (careful! if you change this flag be sure to change
* the definitions at the front of tclUtil.c).
*/
-
#define TCL_DONT_USE_BRACES 1
/*
* Flag that may be passed to Tcl_GetIndexFromObj to force it to disallow
* abbreviated strings.
*/
-
#define TCL_EXACT 1
/*
@@ -891,16 +1005,15 @@ typedef struct Tcl_DString {
* WARNING: these bit choices must not conflict with the bit choices
* for evalFlag bits in tclInt.h!!
*/
-
#define TCL_NO_EVAL 0x10000
#define TCL_EVAL_GLOBAL 0x20000
#define TCL_EVAL_DIRECT 0x40000
+#define TCL_EVAL_INVOKE 0x80000
/*
* 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)
@@ -908,7 +1021,6 @@ typedef struct Tcl_DString {
/*
* Flag values passed to variable-related procedures.
*/
-
#define TCL_GLOBAL_ONLY 1
#define TCL_NAMESPACE_ONLY 2
#define TCL_APPEND_VALUE 4
@@ -920,6 +1032,30 @@ typedef struct Tcl_DString {
#define TCL_INTERP_DESTROYED 0x100
#define TCL_LEAVE_ERR_MSG 0x200
#define TCL_TRACE_ARRAY 0x800
+#ifndef TCL_REMOVE_OBSOLETE_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 */
+#define TCL_TRACE_RESULT_DYNAMIC 0x8000
+#define TCL_TRACE_RESULT_OBJECT 0x10000
+
+/*
+ * Flag values passed to command-related procedures.
+ */
+
+#define TCL_TRACE_RENAME 0x2000
+#define TCL_TRACE_DELETE 0x4000
+
+#define TCL_ALLOW_INLINE_COMPILATION 0x20000
+
+/*
+ * Flag values passed to Tcl_CreateObjTrace, and used internally
+ * by command execution traces. Slots 4,8,16 and 32 are
+ * used internally by execution traces (see tclCmdMZ.c)
+ */
+#define TCL_TRACE_ENTER_EXEC 1
+#define TCL_TRACE_LEAVE_EXEC 2
/*
* The TCL_PARSE_PART1 flag is deprecated and has no effect.
@@ -929,28 +1065,45 @@ typedef struct Tcl_DString {
* flag)
*/
#ifndef TCL_NO_DEPRECATED
-#define TCL_PARSE_PART1 0x400
+# define TCL_PARSE_PART1 0x400
#endif
/*
* Types for linked variables:
*/
-
#define TCL_LINK_INT 1
#define TCL_LINK_DOUBLE 2
#define TCL_LINK_BOOLEAN 3
#define TCL_LINK_STRING 4
+#define TCL_LINK_WIDE_INT 5
#define TCL_LINK_READ_ONLY 0x80
+
/*
- * Forward declaration of Tcl_HashTable. Needed by some C++ compilers
- * to prevent errors when the forward reference to Tcl_HashTable is
- * encountered in the Tcl_HashEntry structure.
+ * Forward declarations of Tcl_HashTable and related types.
*/
+typedef struct Tcl_HashKeyType Tcl_HashKeyType;
+typedef struct Tcl_HashTable Tcl_HashTable;
+typedef struct Tcl_HashEntry Tcl_HashEntry;
-#ifdef __cplusplus
-struct Tcl_HashTable;
+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));
+
+/*
+ * This flag controls whether the hash table stores the hash of a key, or
+ * recalculates it. There should be no reason for turning this flag off
+ * as it is completely binary and source compatible unless you directly
+ * access the bucketPtr member of the Tcl_HashTableEntry structure. This
+ * member has been removed and the space used to store the hash value.
+ */
+#ifndef TCL_HASH_KEY_STORE_HASH
+# define TCL_HASH_KEY_STORE_HASH 1
#endif
/*
@@ -959,18 +1112,30 @@ struct Tcl_HashTable;
* defined below.
*/
-typedef struct Tcl_HashEntry {
- struct Tcl_HashEntry *nextPtr; /* Pointer to next entry in this
+struct Tcl_HashEntry {
+ Tcl_HashEntry *nextPtr; /* Pointer to next entry in this
* hash bucket, or NULL for end of
* chain. */
- struct Tcl_HashTable *tablePtr; /* Pointer to table containing entry. */
- struct Tcl_HashEntry **bucketPtr; /* Pointer to bucket that points to
+ 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 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 deleting the entry. */
+#endif
ClientData clientData; /* Application stores something here
* with Tcl_SetHashValue. */
union { /* Key has one of these forms: */
char *oneWordValue; /* One-word value for key. */
+ Tcl_Obj *objPtr; /* Tcl_Obj * key value. */
int words[1]; /* Multiple integer words for key.
* The actual size will be as large
* as necessary for this table's
@@ -979,7 +1144,63 @@ typedef struct Tcl_HashEntry {
* will be as large as needed to hold
* the key. */
} key; /* MUST BE LAST FIELD IN RECORD!! */
-} Tcl_HashEntry;
+};
+
+/*
+ * Flags used in Tcl_HashKeyType.
+ *
+ * TCL_HASH_KEY_RANDOMIZE_HASH:
+ * 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
+ * randomising the bits and then using the upper
+ * N bits as the index into the table.
+ */
+#define TCL_HASH_KEY_RANDOMIZE_HASH 0x1
+
+/*
+ * Structure definition for the methods associated with a hash table
+ * key type.
+ */
+#define TCL_HASH_KEY_TYPE_VERSION 1
+struct Tcl_HashKeyType {
+ int version; /* Version of the table. If this structure is
+ * extended in future then the version can be
+ * used to distinguish between different
+ * structures.
+ */
+
+ int flags; /* Flags, see above for details. */
+
+ /* Calculates a hash value for the key. If this is NULL then the pointer
+ * itself is used as a hash value.
+ */
+ Tcl_HashKeyProc *hashKeyProc;
+
+ /* Compares two keys and returns zero if they do not match, and non-zero
+ * if they do. If this is NULL then the pointers are compared.
+ */
+ Tcl_CompareHashKeysProc *compareKeysProc;
+
+ /* Called to allocate memory for a new entry, i.e. if the key is a
+ * string then this could allocate a single block which contains enough
+ * space for both the entry and the string. Only the key field of the
+ * allocated Tcl_HashEntry structure needs to be filled in. If something
+ * else needs to be done to the key, i.e. incrementing a reference count
+ * then that should be done by this function. 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.
+ */
+ Tcl_AllocHashEntryProc *allocEntryProc;
+
+ /* Called to free memory associated with an entry. If something else needs
+ * to be done to the key, i.e. decrementing a reference count then that
+ * should be done by this function. If this is NULL then Tcl_Free is used
+ * to free the Tcl_HashEntry.
+ */
+ Tcl_FreeHashEntryProc *freeEntryProc;
+};
/*
* Structure definition for a hash table. Must be in tcl.h so clients
@@ -988,7 +1209,7 @@ typedef struct Tcl_HashEntry {
*/
#define TCL_SMALL_HASH_TABLE 4
-typedef struct Tcl_HashTable {
+struct Tcl_HashTable {
Tcl_HashEntry **buckets; /* Pointer to bucket array. Each
* element points to first entry in
* bucket's hash chain, or NULL. */
@@ -1007,16 +1228,20 @@ typedef struct Tcl_HashTable {
int mask; /* Mask value used in hashing
* function. */
int keyType; /* Type of keys used in this table.
- * It's either TCL_STRING_KEYS,
- * TCL_ONE_WORD_KEYS, or an integer
- * giving the number of ints that
- * is the size of the key.
+ * It's either TCL_CUSTOM_KEYS,
+ * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS,
+ * or an integer giving the number of
+ * ints that is the size of the key.
*/
- Tcl_HashEntry *(*findProc) _ANSI_ARGS_((struct Tcl_HashTable *tablePtr,
+#if TCL_PRESERVE_BINARY_COMPATABILITY
+ Tcl_HashEntry *(*findProc) _ANSI_ARGS_((Tcl_HashTable *tablePtr,
CONST char *key));
- Tcl_HashEntry *(*createProc) _ANSI_ARGS_((struct Tcl_HashTable *tablePtr,
+ Tcl_HashEntry *(*createProc) _ANSI_ARGS_((Tcl_HashTable *tablePtr,
CONST char *key, int *newPtr));
-} Tcl_HashTable;
+#endif
+ Tcl_HashKeyType *typePtr; /* Type of the keys used in the
+ * Tcl_HashTable. */
+};
/*
* Structure definition for information used to keep track of searches
@@ -1033,36 +1258,79 @@ typedef struct Tcl_HashSearch {
/*
* Acceptable key types for hash tables:
+ *
+ * TCL_STRING_KEYS: The keys are strings, they are copied into
+ * the entry.
+ * TCL_ONE_WORD_KEYS: The keys are pointers, the pointer is stored
+ * in the entry.
+ * TCL_CUSTOM_TYPE_KEYS: The keys are arbitrary types which are copied
+ * into the entry.
+ * TCL_CUSTOM_PTR_KEYS: The keys are pointers to arbitrary types, the
+ * pointer is stored in the entry.
+ *
+ * While maintaining binary compatability the above have to be distinct
+ * values as they are used to differentiate between old versions of the
+ * hash table which don't have a typePtr and new ones which do. Once binary
+ * compatability is discarded in favour of making more wide spread changes
+ * TCL_STRING_KEYS can be the same as TCL_CUSTOM_TYPE_KEYS, and
+ * TCL_ONE_WORD_KEYS can be the same as TCL_CUSTOM_PTR_KEYS because they
+ * simply determine how the key is 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))
-#define Tcl_GetHashKey(tablePtr, h) \
- ((char *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS) ? (h)->key.oneWordValue \
- : (h)->key.string))
+#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 procedures
* for hash tables:
*/
-#define Tcl_FindHashEntry(tablePtr, key) \
+#if TCL_PRESERVE_BINARY_COMPATABILITY
+# define Tcl_FindHashEntry(tablePtr, key) \
(*((tablePtr)->findProc))(tablePtr, key)
-#define Tcl_CreateHashEntry(tablePtr, key, newPtr) \
+# 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 */
+
/*
* Flag values to pass to Tcl_DoOneEvent to disable searches
* for some kinds of events:
*/
-
#define TCL_DONT_WAIT (1<<1)
#define TCL_WINDOW_EVENTS (1<<2)
#define TCL_FILE_EVENTS (1<<3)
@@ -1079,7 +1347,6 @@ typedef struct Tcl_HashSearch {
* a Tcl_Event header followed by additional information specific to that
* event.
*/
-
struct Tcl_Event {
Tcl_EventProc *proc; /* Procedure to call to service this event. */
struct Tcl_Event *nextPtr; /* Next in list of pending events, or NULL. */
@@ -1088,7 +1355,6 @@ struct Tcl_Event {
/*
* Positions to pass to Tcl_QueueEvent:
*/
-
typedef enum {
TCL_QUEUE_TAIL, TCL_QUEUE_HEAD, TCL_QUEUE_MARK
} Tcl_QueuePosition;
@@ -1097,17 +1363,16 @@ typedef enum {
* Values to pass to Tcl_SetServiceMode to specify the behavior of notifier
* event routines.
*/
-
#define TCL_SERVICE_NONE 0
#define TCL_SERVICE_ALL 1
+
/*
* The following structure keeps is used to hold a time value, either as
* an absolute time (the number of seconds from the epoch) or as an
* elapsed time. On Unix systems the epoch is Midnight Jan 1, 1970 GMT.
* On Macintosh systems the epoch is Midnight Jan 1, 1904 GMT.
*/
-
typedef struct Tcl_Time {
long sec; /* Seconds. */
long usec; /* Microseconds. */
@@ -1116,11 +1381,11 @@ typedef struct Tcl_Time {
typedef void (Tcl_SetTimerProc) _ANSI_ARGS_((Tcl_Time *timePtr));
typedef int (Tcl_WaitForEventProc) _ANSI_ARGS_((Tcl_Time *timePtr));
+
/*
* 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)
@@ -1130,7 +1395,6 @@ typedef int (Tcl_WaitForEventProc) _ANSI_ARGS_((Tcl_Time *timePtr));
* disposition of the stdio handles. TCL_STDIN, TCL_STDOUT, TCL_STDERR,
* are also used in Tcl_GetStdChannel.
*/
-
#define TCL_STDIN (1<<1)
#define TCL_STDOUT (1<<2)
#define TCL_STDERR (1<<3)
@@ -1140,28 +1404,25 @@ typedef int (Tcl_WaitForEventProc) _ANSI_ARGS_((Tcl_Time *timePtr));
* Bits passed to Tcl_DriverClose2Proc to indicate which side of a channel
* should be closed.
*/
-
#define TCL_CLOSE_READ (1<<1)
-#define TCL_CLOSE_WRITE (1<<2)
+#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)
/*
* Channel version tag. This was introduced in 8.3.2/8.4.
*/
-
#define TCL_CHANNEL_VERSION_1 ((Tcl_ChannelTypeVersion) 0x1)
#define TCL_CHANNEL_VERSION_2 ((Tcl_ChannelTypeVersion) 0x2)
+#define TCL_CHANNEL_VERSION_3 ((Tcl_ChannelTypeVersion) 0x3)
/*
* 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,
@@ -1171,15 +1432,15 @@ typedef int (Tcl_DriverClose2Proc) _ANSI_ARGS_((ClientData instanceData,
typedef int (Tcl_DriverInputProc) _ANSI_ARGS_((ClientData instanceData,
char *buf, int toRead, int *errorCodePtr));
typedef int (Tcl_DriverOutputProc) _ANSI_ARGS_((ClientData instanceData,
- char *buf, int toWrite, int *errorCodePtr));
+ 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,
- char *optionName, char *value));
+ CONST char *optionName, CONST char *value));
typedef int (Tcl_DriverGetOptionProc) _ANSI_ARGS_((
ClientData instanceData, Tcl_Interp *interp,
- char *optionName, Tcl_DString *dsPtr));
+ CONST84 char *optionName, Tcl_DString *dsPtr));
typedef void (Tcl_DriverWatchProc) _ANSI_ARGS_((
ClientData instanceData, int mask));
typedef int (Tcl_DriverGetHandleProc) _ANSI_ARGS_((
@@ -1189,19 +1450,23 @@ 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));
+
/*
* The following declarations either map ckalloc and ckfree to
* malloc and free, or they map them to procedures 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 */
/*
@@ -1210,10 +1475,11 @@ typedef int (Tcl_DriverHandlerProc) _ANSI_ARGS_((
* 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)
@@ -1221,17 +1487,6 @@ typedef int (Tcl_DriverHandlerProc) _ANSI_ARGS_((
#endif /* !TCL_MEM_DEBUG */
/*
- * Enum for different end of line translation and recognition modes.
- */
-
-typedef enum Tcl_EolTranslation {
- TCL_TRANSLATE_AUTO, /* Eol == \r, \n and \r\n. */
- TCL_TRANSLATE_CR, /* Eol == \r. */
- TCL_TRANSLATE_LF, /* Eol == \n. */
- TCL_TRANSLATE_CRLF /* Eol == \r\n. */
-} Tcl_EolTranslation;
-
-/*
* struct Tcl_ChannelType:
*
* One such structure exists for each type (kind) of channel.
@@ -1241,11 +1496,10 @@ typedef enum Tcl_EolTranslation {
* It is recommend that the Tcl_Channel* functions are used to access
* elements of this structure, instead of direct accessing.
*/
-
typedef struct Tcl_ChannelType {
char *typeName; /* The name of the channel type in Tcl
- * commands. This storage is owned by
- * channel type. */
+ * commands. This storage is owned by
+ * channel type. */
Tcl_ChannelTypeVersion version; /* Version of the channel type. */
Tcl_DriverCloseProc *closeProc; /* Procedure to call to close the
* channel, or TCL_CLOSE2PROC if the
@@ -1274,13 +1528,22 @@ typedef struct Tcl_ChannelType {
/* Set blocking mode for the
* raw channel. May be NULL. */
/*
- * Only valid in TCL_CHANNEL_VERSION_2 channels
+ * Only valid in TCL_CHANNEL_VERSION_2 channels or later
*/
Tcl_DriverFlushProc *flushProc; /* Procedure to call to flush a
* channel. May be NULL. */
Tcl_DriverHandlerProc *handlerProc; /* Procedure to call to handle a
* channel event. This will be passed
* up the stacked channel chain. */
+ /*
+ * Only valid in TCL_CHANNEL_VERSION_3 channels or later
+ */
+ Tcl_DriverWideSeekProc *wideSeekProc;
+ /* Procedure to call to seek
+ * on the channel which can
+ * handle 64-bit offsets. May be
+ * NULL, and must be NULL if
+ * seekProc is NULL. */
} Tcl_ChannelType;
/*
@@ -1288,38 +1551,346 @@ typedef struct Tcl_ChannelType {
* set the channel into blocking or nonblocking mode. They are passed
* as arguments to the blockModeProc procedure in the above structure.
*/
-
-#define TCL_MODE_BLOCKING 0 /* Put channel into blocking mode. */
-#define TCL_MODE_NONBLOCKING 1 /* Put channel into nonblocking
+#define TCL_MODE_BLOCKING 0 /* Put channel into blocking mode. */
+#define TCL_MODE_NONBLOCKING 1 /* Put channel into nonblocking
* mode. */
/*
* Enum for different types of file paths.
*/
-
typedef enum Tcl_PathType {
TCL_PATH_ABSOLUTE,
TCL_PATH_RELATIVE,
TCL_PATH_VOLUME_RELATIVE
} Tcl_PathType;
+
+/*
+ * The following structure is used to pass glob type data amongst
+ * the various glob routines and Tcl_FSMatchInDirectory.
+ */
+typedef struct Tcl_GlobTypeData {
+ /* Corresponds to bcdpfls as in 'find -t' */
+ int type;
+ /* Corresponds to file permissions */
+ int perm;
+ /* Acceptable mac type */
+ Tcl_Obj* macType;
+ /* Acceptable mac creator */
+ Tcl_Obj* macCreator;
+} Tcl_GlobTypeData;
+
+/*
+ * type and permission definitions for glob command
+ */
+#define TCL_GLOB_TYPE_BLOCK (1<<0)
+#define TCL_GLOB_TYPE_CHAR (1<<1)
+#define TCL_GLOB_TYPE_DIR (1<<2)
+#define TCL_GLOB_TYPE_PIPE (1<<3)
+#define TCL_GLOB_TYPE_FILE (1<<4)
+#define TCL_GLOB_TYPE_LINK (1<<5)
+#define TCL_GLOB_TYPE_SOCK (1<<6)
+
+#define TCL_GLOB_PERM_RONLY (1<<0)
+#define TCL_GLOB_PERM_HIDDEN (1<<1)
+#define TCL_GLOB_PERM_R (1<<2)
+#define TCL_GLOB_PERM_W (1<<3)
+#define TCL_GLOB_PERM_X (1<<4)
+
+
+/*
+ * 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));
+/* 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 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)
+
+/*
+ * struct Tcl_Filesystem:
+ *
+ * One such structure exists for each type (kind) of filesystem.
+ * It collects together in one place all the functions that are
+ * part of the specific filesystem. Tcl always accesses the
+ * filesystem through one of these structures.
+ *
+ * Not all entries need be non-NULL; any which are NULL are simply
+ * ignored. However, a complete filesystem should provide all of
+ * these functions. The explanations in the structure show
+ * the importance of each function.
+ */
+
+typedef struct Tcl_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. */
+ Tcl_FSPathInFilesystemProc *pathInFilesystemProc;
+ /* Function to check whether a path is in
+ * this filesystem. This is the most
+ * important filesystem procedure. */
+ Tcl_FSDupInternalRepProc *dupInternalRepProc;
+ /* Function to duplicate internal fs rep. May
+ * be NULL (but then fs is less efficient). */
+ Tcl_FSFreeInternalRepProc *freeInternalRepProc;
+ /* Function to free internal fs rep. Must
+ * be implemented, if internal representations
+ * need freeing, otherwise it can be NULL. */
+ Tcl_FSInternalToNormalizedProc *internalToNormalizedProc;
+ /* Function to convert internal representation
+ * to a normalized path. Only required if
+ * the fs creates pure path objects with no
+ * string/path representation. */
+ Tcl_FSCreateInternalRepProc *createInternalRepProc;
+ /* Function to create a filesystem-specific
+ * internal representation. May be NULL
+ * if paths have no internal representation,
+ * or if the Tcl_FSPathInFilesystemProc
+ * for this filesystem always immediately
+ * creates an internal representation for
+ * paths it accepts. */
+ Tcl_FSNormalizePathProc *normalizePathProc;
+ /* Function to normalize a path. Should
+ * be implemented for all filesystems
+ * which can have multiple string
+ * representations for the same path
+ * object. */
+ Tcl_FSFilesystemPathTypeProc *filesystemPathTypeProc;
+ /* Function to determine the type of a
+ * path in this filesystem. May be NULL. */
+ Tcl_FSFilesystemSeparatorProc *filesystemSeparatorProc;
+ /* Function to return the separator
+ * character(s) for this filesystem. Must
+ * be implemented. */
+ Tcl_FSStatProc *statProc;
+ /*
+ * Function to process a 'Tcl_FSStat()'
+ * call. Must be implemented for any
+ * reasonable filesystem.
+ */
+ Tcl_FSAccessProc *accessProc;
+ /*
+ * Function to process a 'Tcl_FSAccess()'
+ * call. Must be implemented for any
+ * reasonable filesystem.
+ */
+ Tcl_FSOpenFileChannelProc *openFileChannelProc;
+ /*
+ * Function to process a
+ * 'Tcl_FSOpenFileChannel()' call. Must be
+ * implemented for any reasonable
+ * filesystem.
+ */
+ Tcl_FSMatchInDirectoryProc *matchInDirectoryProc;
+ /* Function to process a
+ * 'Tcl_FSMatchInDirectory()'. If not
+ * implemented, then glob and recursive
+ * copy functionality will be lacking in
+ * the filesystem. */
+ Tcl_FSUtimeProc *utimeProc;
+ /* Function to process a
+ * 'Tcl_FSUtime()' call. Required to
+ * allow setting (not reading) of times
+ * with 'file mtime', 'file atime' and
+ * the open-r/open-w/fcopy implementation
+ * of 'file copy'. */
+ Tcl_FSLinkProc *linkProc;
+ /* Function to process a
+ * 'Tcl_FSLink()' call. Should be
+ * implemented only if the filesystem supports
+ * links (reading or creating). */
+ Tcl_FSListVolumesProc *listVolumesProc;
+ /* Function to list any filesystem volumes
+ * added by this filesystem. Should be
+ * implemented only if the filesystem adds
+ * volumes at the head of the filesystem. */
+ Tcl_FSFileAttrStringsProc *fileAttrStringsProc;
+ /* Function to list all attributes strings
+ * which are valid for this filesystem.
+ * If not implemented the filesystem will
+ * not support the 'file attributes' command.
+ * This allows arbitrary additional information
+ * to be attached to files in the filesystem. */
+ Tcl_FSFileAttrsGetProc *fileAttrsGetProc;
+ /* Function to process a
+ * 'Tcl_FSFileAttrsGet()' call, used by
+ * 'file attributes'. */
+ Tcl_FSFileAttrsSetProc *fileAttrsSetProc;
+ /* Function to process a
+ * 'Tcl_FSFileAttrsSet()' call, used by
+ * 'file attributes'. */
+ Tcl_FSCreateDirectoryProc *createDirectoryProc;
+ /* Function to process a
+ * 'Tcl_FSCreateDirectory()' call. Should
+ * be implemented unless the FS is
+ * read-only. */
+ Tcl_FSRemoveDirectoryProc *removeDirectoryProc;
+ /* Function to process a
+ * 'Tcl_FSRemoveDirectory()' call. Should
+ * be implemented unless the FS is
+ * read-only. */
+ Tcl_FSDeleteFileProc *deleteFileProc;
+ /* Function to process a
+ * 'Tcl_FSDeleteFile()' call. Should
+ * be implemented unless the FS is
+ * read-only. */
+ Tcl_FSCopyFileProc *copyFileProc;
+ /* Function to process a
+ * 'Tcl_FSCopyFile()' call. If not
+ * implemented Tcl will fall back
+ * on open-r, open-w and fcopy as
+ * a copying mechanism, for copying
+ * actions initiated in Tcl (not C). */
+ Tcl_FSRenameFileProc *renameFileProc;
+ /* Function to process a
+ * 'Tcl_FSRenameFile()' call. If not
+ * implemented, Tcl will fall back on
+ * a copy and delete mechanism, for
+ * rename actions initiated in Tcl (not C). */
+ Tcl_FSCopyDirectoryProc *copyDirectoryProc;
+ /* Function to process a
+ * 'Tcl_FSCopyDirectory()' call. If
+ * not implemented, Tcl will fall back
+ * on a recursive create-dir, file copy
+ * mechanism, for copying actions
+ * initiated in Tcl (not C). */
+ Tcl_FSLstatProc *lstatProc;
+ /* Function to process a
+ * 'Tcl_FSLstat()' call. If not implemented,
+ * Tcl will attempt to use the 'statProc'
+ * defined above instead. */
+ Tcl_FSLoadFileProc *loadFileProc;
+ /* Function to process a
+ * 'Tcl_FSLoadFile()' call. If not
+ * implemented, Tcl will fall back on
+ * a copy to native-temp followed by a
+ * Tcl_FSLoadFile on that temporary copy. */
+ Tcl_FSGetCwdProc *getCwdProc;
+ /*
+ * Function to process a 'Tcl_FSGetCwd()'
+ * call. Most filesystems need not
+ * implement this. It will usually only be
+ * called once, if 'getcwd' is called
+ * before 'chdir'. May be NULL.
+ */
+ Tcl_FSChdirProc *chdirProc;
+ /*
+ * Function to process a 'Tcl_FSChdir()'
+ * 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 respond with a positive
+ * return result if the dirName is a valid
+ * directory in their filesystem. They
+ * need not remember the result, since that
+ * will be automatically remembered for use
+ * by GetCwd. Real filesystems should
+ * carry out the correct action (i.e. call
+ * the correct system 'chdir' api). If not
+ * implemented, then 'cd' and 'pwd' will
+ * fail inside the filesystem.
+ */
+} Tcl_Filesystem;
+
+/*
+ * The following definitions are used as values for the 'linkAction' flag
+ * to Tcl_FSLink, or the linkProc of any filesystem. Any combination
+ * of flags can be given. For link creation, the linkProc should create
+ * a link which matches any of the types given.
+ *
+ * TCL_CREATE_SYMBOLIC_LINK: Create a symbolic or soft link.
+ * TCL_CREATE_HARD_LINK: Create a hard link.
+ */
+#define TCL_CREATE_SYMBOLIC_LINK 0x01
+#define TCL_CREATE_HARD_LINK 0x02
+
/*
* The following structure represents the Notifier functions that
* you can override with the Tcl_SetNotifier call.
*/
-
typedef struct Tcl_NotifierProcs {
Tcl_SetTimerProc *setTimerProc;
Tcl_WaitForEventProc *waitForEventProc;
Tcl_CreateFileHandlerProc *createFileHandlerProc;
Tcl_DeleteFileHandlerProc *deleteFileHandlerProc;
+ Tcl_InitNotifierProc *initNotifierProc;
+ Tcl_FinalizeNotifierProc *finalizeNotifierProc;
+ 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
@@ -1373,16 +1944,14 @@ typedef struct Tcl_EncodingType {
* in the destination buffer and then continue
* to sonvert 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. This stuff should all move to tcl.h eventually.
- *----------------------------------------------------------------
+ * The following data structures and declarations are for the new Tcl
+ * parser.
*/
/*
@@ -1390,11 +1959,10 @@ typedef struct Tcl_EncodingType {
* variable reference, one of the following structures is created to
* describe the token.
*/
-
typedef struct Tcl_Token {
int type; /* Type of token, such as TCL_TOKEN_WORD;
* see below for valid types. */
- 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
@@ -1476,7 +2044,6 @@ typedef struct Tcl_Token {
* operator's operands. NumComponents is
* always 0.
*/
-
#define TCL_TOKEN_WORD 1
#define TCL_TOKEN_SIMPLE_WORD 2
#define TCL_TOKEN_TEXT 4
@@ -1491,7 +2058,6 @@ typedef struct Tcl_Token {
* will be stored in the error field of the Tcl_Parse structure
* defined below.
*/
-
#define TCL_PARSE_SUCCESS 0
#define TCL_PARSE_QUOTE_EXTRA 1
#define TCL_PARSE_BRACE_EXTRA 2
@@ -1507,18 +2073,17 @@ typedef struct Tcl_Token {
* A structure of the following type is filled in by Tcl_ParseCommand.
* It describes a single command parsed from an input string.
*/
-
#define NUM_STATIC_TOKENS 20
typedef struct Tcl_Parse {
- char *commentStart; /* Pointer to # that begins the first of
+ 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. */
- char *commandStart; /* First character in first word of command. */
+ 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 terminating newline,
@@ -1542,13 +2107,13 @@ typedef struct Tcl_Parse {
* Tcl_ParseCommand.
*/
- char *string; /* The original command string passed to
+ CONST char *string; /* The original command string passed to
* Tcl_ParseCommand. */
- char *end; /* Points to the character just after the
+ 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. */
- 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
@@ -1597,40 +2162,40 @@ typedef struct Tcl_Parse {
* encoding. This error is reported only if
* 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
+
/*
* The maximum number of bytes that are necessary to represent a single
* Unicode character in UTF-8.
*/
-
#define TCL_UTF_MAX 3
/*
- * This represents a Unicode character.
+ * This represents a Unicode character. Any changes to this should
+ * also be reflected in regcustom.h.
*/
-
typedef unsigned short Tcl_UniChar;
+
/*
* Deprecated Tcl procedures:
*/
-
#ifndef TCL_NO_DEPRECATED
-#define Tcl_EvalObj(interp,objPtr) Tcl_EvalObjEx((interp),(objPtr),0)
-#define Tcl_GlobalEvalObj(interp,objPtr) \
+# define Tcl_EvalObj(interp,objPtr) \
+ Tcl_EvalObjEx((interp),(objPtr),0)
+# define Tcl_GlobalEvalObj(interp,objPtr) \
Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL)
#endif
+
/*
* 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
@@ -1639,6 +2204,7 @@ typedef unsigned short Tcl_UniChar;
#define panic Tcl_Panic
#define panicVA Tcl_PanicVA
+
/*
* The following constant is used to test for older versions of Tcl
* in the stubs tables.
@@ -1647,7 +2213,7 @@ typedef unsigned short Tcl_UniChar;
* value since the stubs tables don't match.
*/
-#define TCL_STUB_MAGIC 0xFCA3BACF
+#define TCL_STUB_MAGIC ((int)0xFCA3BACF)
/*
* The following function is required to be defined in all stubs aware
@@ -1657,8 +2223,8 @@ typedef unsigned short Tcl_UniChar;
* linked into an application.
*/
-EXTERN char * Tcl_InitStubs _ANSI_ARGS_((Tcl_Interp *interp,
- char *version, int exact));
+EXTERN CONST char * Tcl_InitStubs _ANSI_ARGS_((Tcl_Interp *interp,
+ CONST char *version, int exact));
#ifndef USE_TCL_STUBS
@@ -1680,6 +2246,26 @@ EXTERN char * Tcl_InitStubs _ANSI_ARGS_((Tcl_Interp *interp,
#include "tclDecls.h"
/*
+ * Include platform specific public function declarations that are
+ * accessible via the stubs table.
+ */
+
+/*
+ * tclPlatDecls.h can't be included here on the Mac, as we need
+ * Mac specific headers to define the Mac types used in this file,
+ * but these Mac haders conflict with a number of tk types
+ * and thus can't be included in the globally read tcl.h
+ * This header was originally added here as a fix for bug 5241
+ * (stub link error for symbols in TclPlatStubs table), as a work-
+ * around for the bug on the mac, tclMac.h is included immediately
+ * after tcl.h in the tcl precompiled header (with DLLEXPORT set).
+ */
+
+#if !defined(MAC_TCL)
+#include "tclPlatDecls.h"
+#endif
+
+/*
* Public functions that are not accessible via the stubs table.
*/
@@ -1691,24 +2277,23 @@ EXTERN void Tcl_Main _ANSI_ARGS_((int argc, char **argv,
* 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));
-#endif /* RESOURCE_INCLUDED */
+#endif /* RC_INVOKED */
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT
+#endif /* RESOURCE_INCLUDED */
+
/*
* end block for C++
*/
-
#ifdef __cplusplus
}
#endif
-
-#endif /* _TCL */
+#endif /* _TCL */
diff --git a/tcl/generic/tclAlloc.c b/tcl/generic/tclAlloc.c
index 44c4e94b2c2..b510fb95bca 100644
--- a/tcl/generic/tclAlloc.c
+++ b/tcl/generic/tclAlloc.c
@@ -18,6 +18,13 @@
* RCS: @(#) $Id$
*/
+/*
+ * Windows and Unix use an alternative allocator when building with threads
+ * that has significantly reduced lock contention.
+ */
+
+#if !defined(TCL_THREADS) || !defined(USE_THREAD_ALLOC)
+
#include "tclInt.h"
#include "tclPort.h"
@@ -30,12 +37,10 @@
#endif
/*
- * With gcc this will already be defined. This should really
- * make use of AC_CHECK_TYPE(caddr_t) but that can wait
- * until we use config.h properly.
+ * We should really make use of AC_CHECK_TYPE(caddr_t)
+ * here, but it can wait until Tcl uses config.h properly.
*/
-
-#if defined(MAC_TCL) || defined(_MSC_VER) || defined(__MINGW32__)
+#if defined(MAC_TCL) || defined(_MSC_VER) || defined(__MINGW32__) || defined(__BORLANDC__)
typedef unsigned long caddr_t;
#endif
@@ -723,4 +728,4 @@ TclpRealloc(cp, nbytes)
}
#endif /* !USE_TCLALLOC */
-
+#endif /* !TCL_THREADS */
diff --git a/tcl/generic/tclAsync.c b/tcl/generic/tclAsync.c
index 6ec8ca9934b..cf689dee2cc 100644
--- a/tcl/generic/tclAsync.c
+++ b/tcl/generic/tclAsync.c
@@ -18,6 +18,9 @@
#include "tclInt.h"
#include "tclPort.h"
+/* Forward declaration */
+struct ThreadSpecificData;
+
/*
* One of the following structures exists for each asynchronous
* handler:
@@ -33,34 +36,74 @@ typedef struct AsyncHandler {
* is invoked. */
ClientData clientData; /* Value to pass to handler when it
* is invoked. */
+ struct ThreadSpecificData *originTsd;
+ /* Used in Tcl_AsyncMark to modify thread-
+ * specific data from outside the thread
+ * it is associated to. */
+ Tcl_ThreadId originThrdId; /* Origin thread where this token was
+ * created and where it will be
+ * yielded. */
} AsyncHandler;
-/*
- * The variables below maintain a list of all existing handlers.
- */
-static AsyncHandler *firstHandler; /* First handler defined for process,
- * or NULL if none. */
-static AsyncHandler *lastHandler; /* Last handler or NULL. */
+typedef struct ThreadSpecificData {
+ /*
+ * The variables below maintain a list of all existing handlers
+ * specific to the calling thread.
+ */
+ AsyncHandler *firstHandler; /* First handler defined for process,
+ * or NULL if none. */
+ AsyncHandler *lastHandler; /* Last handler or NULL. */
-TCL_DECLARE_MUTEX(asyncMutex) /* Process-wide async handler lock */
+ /*
+ * The variable below is set to 1 whenever a handler becomes ready and
+ * it is cleared to zero whenever Tcl_AsyncInvoke is called. It can be
+ * checked elsewhere in the application by calling Tcl_AsyncReady to see
+ * if Tcl_AsyncInvoke should be invoked.
+ */
-/*
- * The variable below is set to 1 whenever a handler becomes ready and
- * it is cleared to zero whenever 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 asyncReady;
+
+ /*
+ * The variable below indicates whether Tcl_AsyncInvoke is currently
+ * working. If so then we won't set asyncReady again until
+ * Tcl_AsyncInvoke returns.
+ */
-static int asyncReady = 0;
+ int asyncActive;
+ Tcl_Mutex asyncMutex; /* Thread-specific AsyncHandler linked-list lock */
+
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+
/*
- * The variable below indicates whether Tcl_AsyncInvoke is currently
- * working. If so then we won't set asyncReady again until
- * Tcl_AsyncInvoke returns.
+ *----------------------------------------------------------------------
+ *
+ * TclFinalizeAsync --
+ *
+ * Finalizes the mutex in the thread local data structure for the
+ * async subsystem.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Forgets knowledge of the mutex should it have been created.
+ *
+ *----------------------------------------------------------------------
*/
-static int asyncActive = 0;
+void
+TclFinalizeAsync()
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if (tsdPtr->asyncMutex != NULL) {
+ Tcl_MutexFinalize(&tsdPtr->asyncMutex);
+ }
+}
/*
*----------------------------------------------------------------------
@@ -88,20 +131,24 @@ Tcl_AsyncCreate(proc, clientData)
ClientData clientData; /* Argument to pass to handler. */
{
AsyncHandler *asyncPtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
asyncPtr = (AsyncHandler *) ckalloc(sizeof(AsyncHandler));
asyncPtr->ready = 0;
asyncPtr->nextPtr = NULL;
asyncPtr->proc = proc;
asyncPtr->clientData = clientData;
- Tcl_MutexLock(&asyncMutex);
- if (firstHandler == NULL) {
- firstHandler = asyncPtr;
+ asyncPtr->originTsd = tsdPtr;
+ asyncPtr->originThrdId = Tcl_GetCurrentThread();
+
+ Tcl_MutexLock(&tsdPtr->asyncMutex);
+ if (tsdPtr->firstHandler == NULL) {
+ tsdPtr->firstHandler = asyncPtr;
} else {
- lastHandler->nextPtr = asyncPtr;
+ tsdPtr->lastHandler->nextPtr = asyncPtr;
}
- lastHandler = asyncPtr;
- Tcl_MutexUnlock(&asyncMutex);
+ tsdPtr->lastHandler = asyncPtr;
+ Tcl_MutexUnlock(&tsdPtr->asyncMutex);
return (Tcl_AsyncHandler) asyncPtr;
}
@@ -128,13 +175,15 @@ void
Tcl_AsyncMark(async)
Tcl_AsyncHandler async; /* Token for handler. */
{
- Tcl_MutexLock(&asyncMutex);
- ((AsyncHandler *) async)->ready = 1;
- if (!asyncActive) {
- asyncReady = 1;
- TclpAsyncMark(async);
+ AsyncHandler *token = (AsyncHandler *) async;
+
+ Tcl_MutexLock(&token->originTsd->asyncMutex);
+ token->ready = 1;
+ if (!token->originTsd->asyncActive) {
+ token->originTsd->asyncReady = 1;
+ Tcl_ThreadAlert(token->originThrdId);
}
- Tcl_MutexUnlock(&asyncMutex);
+ Tcl_MutexUnlock(&token->originTsd->asyncMutex);
}
/*
@@ -167,14 +216,16 @@ Tcl_AsyncInvoke(interp, code)
* just completed. */
{
AsyncHandler *asyncPtr;
- Tcl_MutexLock(&asyncMutex);
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ Tcl_MutexLock(&tsdPtr->asyncMutex);
- if (asyncReady == 0) {
- Tcl_MutexUnlock(&asyncMutex);
+ if (tsdPtr->asyncReady == 0) {
+ Tcl_MutexUnlock(&tsdPtr->asyncMutex);
return code;
}
- asyncReady = 0;
- asyncActive = 1;
+ tsdPtr->asyncReady = 0;
+ tsdPtr->asyncActive = 1;
if (interp == NULL) {
code = 0;
}
@@ -191,7 +242,7 @@ Tcl_AsyncInvoke(interp, code)
*/
while (1) {
- for (asyncPtr = firstHandler; asyncPtr != NULL;
+ for (asyncPtr = tsdPtr->firstHandler; asyncPtr != NULL;
asyncPtr = asyncPtr->nextPtr) {
if (asyncPtr->ready) {
break;
@@ -201,12 +252,12 @@ Tcl_AsyncInvoke(interp, code)
break;
}
asyncPtr->ready = 0;
- Tcl_MutexUnlock(&asyncMutex);
+ Tcl_MutexUnlock(&tsdPtr->asyncMutex);
code = (*asyncPtr->proc)(asyncPtr->clientData, interp, code);
- Tcl_MutexLock(&asyncMutex);
+ Tcl_MutexLock(&tsdPtr->asyncMutex);
}
- asyncActive = 0;
- Tcl_MutexUnlock(&asyncMutex);
+ tsdPtr->asyncActive = 0;
+ Tcl_MutexUnlock(&tsdPtr->asyncMutex);
return code;
}
@@ -231,26 +282,27 @@ void
Tcl_AsyncDelete(async)
Tcl_AsyncHandler async; /* Token for handler to delete. */
{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
AsyncHandler *asyncPtr = (AsyncHandler *) async;
AsyncHandler *prevPtr;
- Tcl_MutexLock(&asyncMutex);
- if (firstHandler == asyncPtr) {
- firstHandler = asyncPtr->nextPtr;
- if (firstHandler == NULL) {
- lastHandler = NULL;
+ Tcl_MutexLock(&tsdPtr->asyncMutex);
+ if (tsdPtr->firstHandler == asyncPtr) {
+ tsdPtr->firstHandler = asyncPtr->nextPtr;
+ if (tsdPtr->firstHandler == NULL) {
+ tsdPtr->lastHandler = NULL;
}
} else {
- prevPtr = firstHandler;
+ prevPtr = tsdPtr->firstHandler;
while (prevPtr->nextPtr != asyncPtr) {
prevPtr = prevPtr->nextPtr;
}
prevPtr->nextPtr = asyncPtr->nextPtr;
- if (lastHandler == asyncPtr) {
- lastHandler = prevPtr;
+ if (tsdPtr->lastHandler == asyncPtr) {
+ tsdPtr->lastHandler = prevPtr;
}
}
- Tcl_MutexUnlock(&asyncMutex);
+ Tcl_MutexUnlock(&tsdPtr->asyncMutex);
ckfree((char *) asyncPtr);
}
@@ -261,7 +313,7 @@ Tcl_AsyncDelete(async)
*
* This procedure can be used to tell whether Tcl_AsyncInvoke
* needs to be called. This procedure is the external interface
- * for checking the internal asyncReady variable.
+ * for checking the thread-specific asyncReady variable.
*
* Results:
* The return value is 1 whenever a handler is ready and is 0
@@ -276,5 +328,6 @@ Tcl_AsyncDelete(async)
int
Tcl_AsyncReady()
{
- return asyncReady;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ return tsdPtr->asyncReady;
}
diff --git a/tcl/generic/tclBasic.c b/tcl/generic/tclBasic.c
index 8c6a19de4ef..1fe5f109c56 100644
--- a/tcl/generic/tclBasic.c
+++ b/tcl/generic/tclBasic.c
@@ -3,11 +3,12 @@
*
* Contains the basic facilities for TCL command interpretation,
* including interpreter creation and deletion, command creation
- * and deletion, and command parsing and execution.
+ * and deletion, and command/script execution.
*
* 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, 2002 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.
@@ -25,12 +26,20 @@
* Static procedures in this file:
*/
+static char * CallCommandTraces _ANSI_ARGS_((Interp *iPtr,
+ Command *cmdPtr, CONST char *oldName,
+ CONST char* newName, int flags));
static void DeleteInterpProc _ANSI_ARGS_((Tcl_Interp *interp));
static void ProcessUnexpectedResult _ANSI_ARGS_((
Tcl_Interp *interp, int returnCode));
-static void RecordTracebackInfo _ANSI_ARGS_((
- Tcl_Interp *interp, Tcl_Obj *objPtr,
- int numSrcBytes));
+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));
extern TclStubs tclStubs;
@@ -62,7 +71,7 @@ static CmdInfo builtInCmds[] = {
*/
{"append", (Tcl_CmdProc *) NULL, Tcl_AppendObjCmd,
- (CompileProc *) NULL, 1},
+ TclCompileAppendCmd, 1},
{"array", (Tcl_CmdProc *) NULL, Tcl_ArrayObjCmd,
(CompileProc *) NULL, 1},
{"binary", (Tcl_CmdProc *) NULL, Tcl_BinaryObjCmd,
@@ -110,15 +119,15 @@ static CmdInfo builtInCmds[] = {
{"join", (Tcl_CmdProc *) NULL, Tcl_JoinObjCmd,
(CompileProc *) NULL, 1},
{"lappend", (Tcl_CmdProc *) NULL, Tcl_LappendObjCmd,
- (CompileProc *) NULL, 1},
+ TclCompileLappendCmd, 1},
{"lindex", (Tcl_CmdProc *) NULL, Tcl_LindexObjCmd,
- (CompileProc *) NULL, 1},
+ TclCompileLindexCmd, 1},
{"linsert", (Tcl_CmdProc *) NULL, Tcl_LinsertObjCmd,
(CompileProc *) NULL, 1},
{"list", (Tcl_CmdProc *) NULL, Tcl_ListObjCmd,
- (CompileProc *) NULL, 1},
+ TclCompileListCmd, 1},
{"llength", (Tcl_CmdProc *) NULL, Tcl_LlengthObjCmd,
- (CompileProc *) NULL, 1},
+ TclCompileLlengthCmd, 1},
{"load", (Tcl_CmdProc *) NULL, Tcl_LoadObjCmd,
(CompileProc *) NULL, 0},
{"lrange", (Tcl_CmdProc *) NULL, Tcl_LrangeObjCmd,
@@ -127,6 +136,8 @@ static CmdInfo builtInCmds[] = {
(CompileProc *) NULL, 1},
{"lsearch", (Tcl_CmdProc *) NULL, Tcl_LsearchObjCmd,
(CompileProc *) NULL, 1},
+ {"lset", (Tcl_CmdProc *) NULL, Tcl_LsetObjCmd,
+ TclCompileLsetCmd, 1},
{"lsort", (Tcl_CmdProc *) NULL, Tcl_LsortObjCmd,
(CompileProc *) NULL, 1},
{"namespace", (Tcl_CmdProc *) NULL, Tcl_NamespaceObjCmd,
@@ -136,13 +147,13 @@ static CmdInfo builtInCmds[] = {
{"proc", (Tcl_CmdProc *) NULL, Tcl_ProcObjCmd,
(CompileProc *) NULL, 1},
{"regexp", (Tcl_CmdProc *) NULL, Tcl_RegexpObjCmd,
- (CompileProc *) NULL, 1},
+ TclCompileRegexpCmd, 1},
{"regsub", (Tcl_CmdProc *) NULL, Tcl_RegsubObjCmd,
(CompileProc *) NULL, 1},
{"rename", (Tcl_CmdProc *) NULL, Tcl_RenameObjCmd,
(CompileProc *) NULL, 1},
{"return", (Tcl_CmdProc *) NULL, Tcl_ReturnObjCmd,
- (CompileProc *) NULL, 1},
+ TclCompileReturnCmd, 1},
{"scan", (Tcl_CmdProc *) NULL, Tcl_ScanObjCmd,
(CompileProc *) NULL, 1},
{"set", (Tcl_CmdProc *) NULL, Tcl_SetObjCmd,
@@ -150,7 +161,7 @@ static CmdInfo builtInCmds[] = {
{"split", (Tcl_CmdProc *) NULL, Tcl_SplitObjCmd,
(CompileProc *) NULL, 1},
{"string", (Tcl_CmdProc *) NULL, Tcl_StringObjCmd,
- (CompileProc *) NULL, 1},
+ TclCompileStringCmd, 1},
{"subst", (Tcl_CmdProc *) NULL, Tcl_SubstObjCmd,
(CompileProc *) NULL, 1},
{"switch", (Tcl_CmdProc *) NULL, Tcl_SwitchObjCmd,
@@ -239,6 +250,15 @@ static CmdInfo builtInCmds[] = {
(CompileProc *) NULL, 0}
};
+/*
+ * The following structure holds the client data for string-based
+ * trace procs
+ */
+
+typedef struct StringTraceData {
+ ClientData clientData; /* Client data from Tcl_CreateTrace */
+ Tcl_CmdTraceProc* proc; /* Trace procedure from Tcl_CreateTrace */
+} StringTraceData;
/*
*----------------------------------------------------------------------
@@ -253,8 +273,8 @@ static CmdInfo builtInCmds[] = {
* Tcl_DeleteInterp.
*
* Side effects:
- * The command interpreter is initialized with an empty variable
- * table and the built-in commands.
+ * The command interpreter is initialized with the built-in commands
+ * and with the variables documented in tclvars(n).
*
*----------------------------------------------------------------------
*/
@@ -311,10 +331,10 @@ Tcl_CreateInterp()
Tcl_InitHashTable(&iPtr->mathFuncTable, TCL_STRING_KEYS);
iPtr->numLevels = 0;
- iPtr->maxNestingDepth = 1000;
+ iPtr->maxNestingDepth = MAX_NESTING_DEPTH;
iPtr->framePtr = NULL;
iPtr->varFramePtr = NULL;
- iPtr->activeTracePtr = NULL;
+ iPtr->activeVarTracePtr = NULL;
iPtr->returnCode = TCL_OK;
iPtr->errorInfo = NULL;
iPtr->errorCode = NULL;
@@ -335,6 +355,9 @@ Tcl_CreateInterp()
iPtr->scriptFile = NULL;
iPtr->flags = 0;
iPtr->tracePtr = NULL;
+ 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 */
@@ -447,8 +470,9 @@ Tcl_CreateInterp()
}
cmdPtr->deleteProc = NULL;
cmdPtr->deleteData = (ClientData) NULL;
- cmdPtr->deleted = 0;
+ cmdPtr->flags = 0;
cmdPtr->importRefPtr = NULL;
+ cmdPtr->tracePtr = NULL;
Tcl_SetHashValue(hPtr, cmdPtr);
}
}
@@ -458,7 +482,7 @@ Tcl_CreateInterp()
*/
i = 0;
- for (builtinFuncPtr = builtinFuncTable; builtinFuncPtr->name != NULL;
+ for (builtinFuncPtr = tclBuiltinFuncTable; builtinFuncPtr->name != NULL;
builtinFuncPtr++) {
Tcl_CreateMathFunc((Tcl_Interp *) iPtr, builtinFuncPtr->name,
builtinFuncPtr->numArgs, builtinFuncPtr->argTypes,
@@ -518,6 +542,9 @@ Tcl_CreateInterp()
((order.c[0] == 1) ? "littleEndian" : "bigEndian"),
TCL_GLOBAL_ONLY);
+ Tcl_SetVar2Ex(interp, "tcl_platform", "wordSize",
+ Tcl_NewLongObj((long) sizeof(long)), TCL_GLOBAL_ONLY);
+
/*
* Set up other variables such as tcl_version and tcl_library
*/
@@ -715,7 +742,7 @@ Tcl_DontCallWhenDeleted(interp, proc, clientData)
void
Tcl_SetAssocData(interp, name, proc, clientData)
Tcl_Interp *interp; /* Interpreter to associate with. */
- char *name; /* Name for association. */
+ 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. */
@@ -761,7 +788,7 @@ Tcl_SetAssocData(interp, name, proc, clientData)
void
Tcl_DeleteAssocData(interp, name)
Tcl_Interp *interp; /* Interpreter to associate with. */
- char *name; /* Name of association. */
+ CONST char *name; /* Name of association. */
{
Interp *iPtr = (Interp *) interp;
AssocData *dPtr;
@@ -803,7 +830,7 @@ Tcl_DeleteAssocData(interp, name)
ClientData
Tcl_GetAssocData(interp, name, procPtr)
Tcl_Interp *interp; /* Interpreter associated with. */
- char *name; /* Name of association. */
+ CONST char *name; /* Name of association. */
Tcl_InterpDeleteProc **procPtr; /* Pointer to place to store address
* of current deletion callback. */
{
@@ -1048,10 +1075,7 @@ DeleteInterpProc(interp)
}
TclFreePackageInfo(iPtr);
while (iPtr->tracePtr != NULL) {
- Trace *nextPtr = iPtr->tracePtr->nextPtr;
-
- ckfree((char *) iPtr->tracePtr);
- iPtr->tracePtr = nextPtr;
+ Tcl_DeleteTrace( (Tcl_Interp*) iPtr, (Tcl_Trace) iPtr->tracePtr );
}
if (iPtr->execEnvPtr != NULL) {
TclDeleteExecEnv(iPtr->execEnvPtr);
@@ -1098,8 +1122,8 @@ DeleteInterpProc(interp)
int
Tcl_HideCommand(interp, cmdName, hiddenCmdToken)
Tcl_Interp *interp; /* Interpreter in which to hide command. */
- char *cmdName; /* Name of command to hide. */
- char *hiddenCmdToken; /* Token name of the to-be-hidden 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;
@@ -1261,8 +1285,8 @@ int
Tcl_ExposeCommand(interp, hiddenCmdToken, cmdName)
Tcl_Interp *interp; /* Interpreter in which to make command
* callable. */
- char *hiddenCmdToken; /* Name of hidden command. */
- 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;
@@ -1415,7 +1439,7 @@ Tcl_Command
Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc)
Tcl_Interp *interp; /* Token for command interpreter returned by
* a previous call to Tcl_CreateInterp. */
- 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. */
@@ -1430,7 +1454,7 @@ Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc)
Namespace *nsPtr, *dummy1, *dummy2;
Command *cmdPtr, *refCmdPtr;
Tcl_HashEntry *hPtr;
- char *tail;
+ CONST char *tail;
int new;
ImportedCmdData *dataPtr;
@@ -1498,8 +1522,9 @@ Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc)
cmdPtr->clientData = clientData;
cmdPtr->deleteProc = deleteProc;
cmdPtr->deleteData = clientData;
- cmdPtr->deleted = 0;
+ cmdPtr->flags = 0;
cmdPtr->importRefPtr = NULL;
+ cmdPtr->tracePtr = NULL;
/*
* Plug in any existing import references found above. Be sure
@@ -1559,7 +1584,7 @@ Tcl_Command
Tcl_CreateObjCommand(interp, cmdName, proc, clientData, deleteProc)
Tcl_Interp *interp; /* Token for command interpreter (returned
* by previous call to Tcl_CreateInterp). */
- 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. */
@@ -1576,7 +1601,7 @@ Tcl_CreateObjCommand(interp, cmdName, proc, clientData, deleteProc)
Namespace *nsPtr, *dummy1, *dummy2;
Command *cmdPtr, *refCmdPtr;
Tcl_HashEntry *hPtr;
- char *tail;
+ CONST char *tail;
int new;
ImportedCmdData *dataPtr;
@@ -1659,8 +1684,9 @@ Tcl_CreateObjCommand(interp, cmdName, proc, clientData, deleteProc)
cmdPtr->clientData = (ClientData) cmdPtr;
cmdPtr->deleteProc = deleteProc;
cmdPtr->deleteData = clientData;
- cmdPtr->deleted = 0;
+ cmdPtr->flags = 0;
cmdPtr->importRefPtr = NULL;
+ cmdPtr->tracePtr = NULL;
/*
* Plug in any existing import references found above. Be sure
@@ -1727,8 +1753,8 @@ TclInvokeStringCommand(clientData, interp, objc, objv)
*/
#define NUM_ARGS 20
- char *(argStorage[NUM_ARGS]);
- char **argv = argStorage;
+ CONST char *(argStorage[NUM_ARGS]);
+ CONST char **argv = argStorage;
/*
* Create the string argument array "argv". Make sure argv is large
@@ -1737,7 +1763,7 @@ TclInvokeStringCommand(clientData, interp, objc, objv)
*/
if ((objc + 1) > NUM_ARGS) {
- argv = (char **) ckalloc((unsigned)(objc + 1) * sizeof(char *));
+ argv = (CONST char **) ckalloc((unsigned)(objc + 1) * sizeof(char *));
}
for (i = 0; i < objc; i++) {
@@ -1788,7 +1814,7 @@ TclInvokeObjectCommand(clientData, interp, argc, argv)
ClientData clientData; /* Points to command's Command structure. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- register char **argv; /* Argument strings. */
+ register CONST char **argv; /* Argument strings. */
{
Command *cmdPtr = (Command *) clientData;
register Tcl_Obj *objPtr;
@@ -1886,7 +1912,7 @@ TclRenameCommand(interp, oldName, newName)
char *newName; /* New command name. */
{
Interp *iPtr = (Interp *) interp;
- char *newTail;
+ CONST char *newTail;
Namespace *cmdNsPtr, *newNsPtr, *dummy1, *dummy2;
Tcl_Command cmd;
Command *cmdPtr;
@@ -1976,6 +2002,15 @@ TclRenameCommand(interp, oldName, newName)
}
/*
+ * 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.
+ */
+ cmdPtr->refCount++;
+ CallCommandTraces(iPtr,cmdPtr,oldName,newName,TCL_TRACE_RENAME);
+
+ /*
* The new command name is okay, so remove the command from its
* current namespace. This is like deleting the command, so bump
* the cmdEpoch to invalidate any cached references to the command.
@@ -1995,6 +2030,12 @@ TclRenameCommand(interp, oldName, newName)
iPtr->compileEpoch++;
}
+ /*
+ * Now free the Command structure, if the "oldName" command has
+ * been deleted by invocation of rename traces.
+ */
+ TclCleanupCommand(cmdPtr);
+
return TCL_OK;
}
@@ -2024,15 +2065,48 @@ int
Tcl_SetCommandInfo(interp, cmdName, infoPtr)
Tcl_Interp *interp; /* Interpreter in which to look
* for command. */
- char *cmdName; /* Name of desired command. */
- Tcl_CmdInfo *infoPtr; /* Where to find information
+ CONST char *cmdName; /* Name of desired command. */
+ CONST Tcl_CmdInfo *infoPtr; /* Where to find information
* to store in the command. */
{
Tcl_Command cmd;
- Command *cmdPtr;
cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL,
/*flags*/ 0);
+
+ return Tcl_SetCommandInfoFromToken( cmd, infoPtr );
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetCommandInfoFromToken --
+ *
+ * Modifies various information about a Tcl command. Note that
+ * this procedure will not change a command's namespace; use
+ * Tcl_RenameCommand to do that. Also, the isNativeObjectProc
+ * member of *infoPtr is ignored.
+ *
+ * Results:
+ * If cmdName exists in interp, then the information at *infoPtr
+ * is stored with the command in place of the current information
+ * and 1 is returned. If the command doesn't exist then 0 is
+ * returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_SetCommandInfoFromToken( cmd, infoPtr )
+ Tcl_Command cmd;
+ CONST Tcl_CmdInfo* infoPtr;
+{
+ Command* cmdPtr; /* Internal representation of the command */
+
if (cmd == (Tcl_Command) NULL) {
return 0;
}
@@ -2079,16 +2153,46 @@ int
Tcl_GetCommandInfo(interp, cmdName, infoPtr)
Tcl_Interp *interp; /* Interpreter in which to look
* for command. */
- char *cmdName; /* Name of desired command. */
+ CONST char *cmdName; /* Name of desired command. */
Tcl_CmdInfo *infoPtr; /* Where to store information about
* command. */
{
Tcl_Command cmd;
- Command *cmdPtr;
cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL,
/*flags*/ 0);
- if (cmd == (Tcl_Command) NULL) {
+
+ return Tcl_GetCommandInfoFromToken( cmd, infoPtr );
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetCommandInfoFromToken --
+ *
+ * Returns various information about a Tcl command.
+ *
+ * Results:
+ * Copies information from the command identified by 'cmd' into
+ * a caller-supplied structure and returns 1. If the 'cmd' is
+ * NULL, leaves the structure untouched and returns 0.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetCommandInfoFromToken( cmd, infoPtr )
+ Tcl_Command cmd;
+ Tcl_CmdInfo* infoPtr;
+{
+
+ Command* cmdPtr; /* Internal representation of the command */
+
+ if ( cmd == (Tcl_Command) NULL ) {
return 0;
}
@@ -2107,7 +2211,9 @@ Tcl_GetCommandInfo(interp, cmdName, infoPtr)
infoPtr->deleteProc = cmdPtr->deleteProc;
infoPtr->deleteData = cmdPtr->deleteData;
infoPtr->namespacePtr = (Tcl_Namespace *) cmdPtr->nsPtr;
+
return 1;
+
}
/*
@@ -2128,7 +2234,7 @@ Tcl_GetCommandInfo(interp, cmdName, infoPtr)
*----------------------------------------------------------------------
*/
-char *
+CONST char *
Tcl_GetCommandName(interp, command)
Tcl_Interp *interp; /* Interpreter containing the command. */
Tcl_Command command; /* Token for command returned by a previous
@@ -2225,7 +2331,7 @@ int
Tcl_DeleteCommand(interp, cmdName)
Tcl_Interp *interp; /* Token for command interpreter (returned
* by a previous Tcl_CreateInterp call). */
- char *cmdName; /* Name of command to remove. */
+ CONST char *cmdName; /* Name of command to remove. */
{
Tcl_Command cmd;
@@ -2281,7 +2387,7 @@ Tcl_DeleteCommandFromToken(interp, cmd)
* flag allows us to detect these cases and skip nested deletes.
*/
- if (cmdPtr->deleted) {
+ if (cmdPtr->flags & CMD_IS_DELETED) {
/*
* Another deletion is already in progress. Remove the hash
* table entry now, but don't invoke a callback or free the
@@ -2293,6 +2399,33 @@ Tcl_DeleteCommandFromToken(interp, cmd)
return 0;
}
+ /*
+ * We must delete this command, even though both traces and
+ * delete procs may try to avoid this (renaming the command etc).
+ * Also traces and delete procs may try to delete the command
+ * themsevles. This flag declares that a delete is in progress
+ * and that recursive deletes should be ignored.
+ */
+ cmdPtr->flags |= CMD_IS_DELETED;
+
+ /*
+ * Call trace procedures for the command being deleted. Then delete
+ * its traces.
+ */
+
+ if (cmdPtr->tracePtr != NULL) {
+ CommandTrace *tracePtr;
+ CallCommandTraces(iPtr,cmdPtr,NULL,NULL,TCL_TRACE_DELETE);
+ /* Now delete these traces */
+ tracePtr = cmdPtr->tracePtr;
+ while (tracePtr != NULL) {
+ CommandTrace *nextPtr = tracePtr->nextPtr;
+ Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC);
+ tracePtr = nextPtr;
+ }
+ cmdPtr->tracePtr = NULL;
+ }
+
/*
* If the command being deleted has a compile procedure, increment the
* interpreter's compileEpoch to invalidate its compiled code. This
@@ -2306,7 +2439,6 @@ Tcl_DeleteCommandFromToken(interp, cmd)
iPtr->compileEpoch++;
}
- cmdPtr->deleted = 1;
if (cmdPtr->deleteProc != NULL) {
/*
* Delete the command's client data. If this was an imported command
@@ -2381,6 +2513,98 @@ Tcl_DeleteCommandFromToken(interp, cmd)
TclCleanupCommand(cmdPtr);
return 0;
}
+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 the name from cmdPtr */
+ CONST char *newName; /* Command's new name, or NULL if
+ * the command is not being renamed */
+ int flags; /* Flags passed to trace procedures:
+ * indicates what's happening to command,
+ * plus other stuff like TCL_GLOBAL_ONLY,
+ * TCL_NAMESPACE_ONLY, and
+ * TCL_INTERP_DESTROYED. */
+{
+ register CommandTrace *tracePtr;
+ ActiveCommandTrace active;
+ char *result;
+ Tcl_Obj *oldNamePtr = NULL;
+
+ if (cmdPtr->flags & CMD_TRACE_ACTIVE) {
+ /*
+ * While a rename trace is active, we will not process any more
+ * rename traces; while a delete trace is active we will never
+ * reach here -- because Tcl_DeleteCommandFromToken checks for the
+ * condition (cmdPtr->flags & CMD_IS_DELETED) and returns immediately
+ * when a command deletion is in progress. For all other traces,
+ * delete traces will not be invoked but a call to TraceCommandProc
+ * will ensure that tracePtr->clientData is freed whenever the
+ * command "oldName" is deleted.
+ */
+ if (cmdPtr->flags & TCL_TRACE_RENAME) {
+ flags &= ~TCL_TRACE_RENAME;
+ }
+ if (flags == 0) {
+ return NULL;
+ }
+ }
+ cmdPtr->flags |= CMD_TRACE_ACTIVE;
+ cmdPtr->refCount++;
+
+ result = NULL;
+ active.nextPtr = iPtr->activeCmdTracePtr;
+ iPtr->activeCmdTracePtr = &active;
+
+ if (flags & TCL_TRACE_DELETE) {
+ flags |= TCL_TRACE_DESTROYED;
+ }
+ active.cmdPtr = cmdPtr;
+ Tcl_Preserve((ClientData) iPtr);
+ for (tracePtr = cmdPtr->tracePtr; tracePtr != NULL;
+ tracePtr = active.nextTracePtr) {
+ active.nextTracePtr = tracePtr->nextPtr;
+ if (!(tracePtr->flags & flags)) {
+ continue;
+ }
+ cmdPtr->flags |= tracePtr->flags;
+ if (oldName == NULL) {
+ TclNewObj(oldNamePtr);
+ Tcl_IncrRefCount(oldNamePtr);
+ Tcl_GetCommandFullName((Tcl_Interp *) iPtr,
+ (Tcl_Command) cmdPtr, oldNamePtr);
+ oldName = TclGetString(oldNamePtr);
+ }
+ Tcl_Preserve((ClientData) tracePtr);
+ (*tracePtr->traceProc)(tracePtr->clientData,
+ (Tcl_Interp *) iPtr, oldName, newName, flags);
+ cmdPtr->flags &= ~tracePtr->flags;
+ Tcl_Release((ClientData) tracePtr);
+ }
+
+ /*
+ * If a new object was created to hold the full oldName,
+ * free it now.
+ */
+
+ if (oldNamePtr != NULL) {
+ TclDecrRefCount(oldNamePtr);
+ }
+
+ /*
+ * Restore the variable's flags, remove the record of our active
+ * traces, and then return.
+ */
+
+ cmdPtr->flags &= ~CMD_TRACE_ACTIVE;
+ cmdPtr->refCount--;
+ iPtr->activeCmdTracePtr = active.nextPtr;
+ Tcl_Release((ClientData) iPtr);
+ return result;
+}
+
/*
*----------------------------------------------------------------------
@@ -2441,7 +2665,7 @@ void
Tcl_CreateMathFunc(interp, name, numArgs, argTypes, proc, clientData)
Tcl_Interp *interp; /* Interpreter in which function is
* to be available. */
- char *name; /* Name of function (e.g. "sin"). */
+ 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
@@ -2502,294 +2726,1254 @@ Tcl_CreateMathFunc(interp, name, numArgs, argTypes, proc, clientData)
/*
*----------------------------------------------------------------------
*
- * Tcl_EvalObjEx --
+ * Tcl_GetMathFuncInfo --
*
- * Execute Tcl commands stored in a Tcl object. These commands are
- * compiled into bytecodes if necessary, unless TCL_EVAL_DIRECT
- * is specified.
+ * Discovers how a particular math function was created in a given
+ * interpreter.
*
* 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 the return code.
+ * TCL_OK if it succeeds, TCL_ERROR else (leaving an error message
+ * in the interpreter result if that happens.)
*
* Side effects:
- * The object is converted, if necessary, to a ByteCode object that
- * holds the bytecode instructions for the commands. Executing the
- * commands will almost certainly have side effects that depend
- * on those commands.
- *
- * Just as in Tcl_Eval, interp->termOffset is set to the offset of the
- * last character executed in the objPtr's string.
+ * If this function succeeds, the variables pointed to by the
+ * numArgsPtr and argTypePtr arguments will be updated to detail the
+ * arguments allowed by the function. The variable pointed to by the
+ * procPtr argument will be set to NULL if the function is a builtin
+ * function, and will be set to the address of the C function used to
+ * implement the math function otherwise (in which case the variable
+ * pointed to by the clientDataPtr argument will also be updated.)
*
*----------------------------------------------------------------------
*/
int
-Tcl_EvalObjEx(interp, objPtr, flags)
- 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. */
+Tcl_GetMathFuncInfo(interp, name, numArgsPtr, argTypesPtr, procPtr,
+ clientDataPtr)
+ Tcl_Interp *interp;
+ CONST char *name;
+ int *numArgsPtr;
+ Tcl_ValueType **argTypesPtr;
+ Tcl_MathProc **procPtr;
+ ClientData *clientDataPtr;
{
- register Interp *iPtr = (Interp *) interp;
- int evalFlags; /* Interp->evalFlags value when the
- * procedure was called. */
- register ByteCode* codePtr; /* Tcl Internal type of bytecode. */
- int oldCount = iPtr->cmdCount; /* Used to tell whether any commands
- * at all were executed. */
- int numSrcBytes;
- int result;
- CallFrame *savedVarFramePtr; /* Saves old copy of iPtr->varFramePtr
- * in case TCL_EVAL_GLOBAL was set. */
- Namespace *namespacePtr;
+ Interp *iPtr = (Interp *) interp;
+ Tcl_HashEntry *hPtr;
+ MathFunc *mathFuncPtr;
+ Tcl_ValueType *argTypes;
+ int i,numArgs;
- Tcl_IncrRefCount(objPtr);
+ hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, name);
+ if (hPtr == NULL) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "math function \"", name, "\" not known in this interpreter",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
- if ((iPtr->flags & USE_EVAL_DIRECT) || (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 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.
- *
- * USE_EVAL_DIRECT is a special flag used for testing purpose only
- * (ensure we go into the TCL_EVAL_DIRECT path, avoiding opt)
- */
- if (!(iPtr->flags & USE_EVAL_DIRECT) &&
- (objPtr->typePtr == &tclListType) && /* is a list... */
- (objPtr->bytes == NULL) /* ...without a string rep */) {
- register List *listRepPtr =
- (List *) objPtr->internalRep.otherValuePtr;
- result = Tcl_EvalObjv(interp, listRepPtr->elemCount,
- listRepPtr->elements, flags);
- } else {
- register char *p;
- p = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
- result = Tcl_EvalEx(interp, p, numSrcBytes, flags);
- }
- Tcl_DecrRefCount(objPtr);
- return result;
+ *numArgsPtr = numArgs = mathFuncPtr->numArgs;
+ if (numArgs == 0) {
+ /* Avoid doing zero-sized allocs... */
+ numArgs = 1;
+ }
+ *argTypesPtr = argTypes =
+ (Tcl_ValueType *)ckalloc(numArgs * sizeof(Tcl_ValueType));
+ for (i = 0; i < mathFuncPtr->numArgs; i++) {
+ argTypes[i] = mathFuncPtr->argTypes[i];
}
- /*
- * Prevent the object from being deleted as a side effect of evaling it.
- */
+ if (mathFuncPtr->builtinFuncIndex == -1) {
+ *procPtr = (Tcl_MathProc *) NULL;
+ } else {
+ *procPtr = mathFuncPtr->proc;
+ *clientDataPtr = mathFuncPtr->clientData;
+ }
- savedVarFramePtr = iPtr->varFramePtr;
- if (flags & TCL_EVAL_GLOBAL) {
- iPtr->varFramePtr = NULL;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ListMathFuncs --
+ *
+ * Produces a list of all the math functions defined in a given
+ * interpreter.
+ *
+ * Results:
+ * A pointer to a Tcl_Obj structure with a reference count of zero,
+ * or NULL in the case of an error (in which case a suitable error
+ * message will be left in the interpreter result.)
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_ListMathFuncs(interp, pattern)
+ Tcl_Interp *interp;
+ CONST char *pattern;
+{
+ Interp *iPtr = (Interp *) interp;
+ Tcl_Obj *resultList = Tcl_NewObj();
+ register Tcl_HashEntry *hPtr;
+ Tcl_HashSearch hSearch;
+ CONST char *name;
+
+ for (hPtr = Tcl_FirstHashEntry(&iPtr->mathFuncTable, &hSearch);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
+ name = Tcl_GetHashKey(&iPtr->mathFuncTable, hPtr);
+ if ((pattern == NULL || Tcl_StringMatch(name, pattern)) &&
+ /* I don't expect this to fail, but... */
+ Tcl_ListObjAppendElement(interp, resultList,
+ Tcl_NewStringObj(name,-1)) != TCL_OK) {
+ Tcl_DecrRefCount(resultList);
+ return NULL;
+ }
}
+ return resultList;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInterpReady --
+ *
+ * Check if an interpreter is ready to eval commands or scripts,
+ * i.e., if it was not deleted and if the nesting level is not
+ * too high.
+ *
+ * Results:
+ * The return value is TCL_OK if it the interpreter is ready,
+ * TCL_ERROR otherwise.
+ *
+ * Side effects:
+ * The interpreters object and string results are cleared.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclInterpReady(interp)
+ Tcl_Interp *interp;
+{
+ register Interp *iPtr = (Interp *) interp;
/*
- * Reset both the interpreter's string and object results and clear out
- * any error information. This makes sure that we return an empty
- * result if there are no commands in the command string.
+ * Reset both the interpreter's string and object results and clear
+ * out any previous error information.
*/
Tcl_ResetResult(interp);
/*
+ * If the interpreter has been deleted, return an error.
+ */
+
+ if (iPtr->flags & DELETED) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ "attempt to call eval in deleted interpreter", -1);
+ Tcl_SetErrorCode(interp, "CORE", "IDELETE",
+ "attempt to call eval in deleted interpreter",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
* Check depth of nested calls to Tcl_Eval: if this gets too large,
* it's probably because of an infinite loop somewhere.
*/
- iPtr->numLevels++;
- if (iPtr->numLevels > iPtr->maxNestingDepth) {
+ if (((iPtr->numLevels) >= iPtr->maxNestingDepth)
+ || (TclpCheckStackSpace() == 0)) {
Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "too many nested calls to Tcl_EvalObj (infinite loop?)", -1);
- result = TCL_ERROR;
- goto done;
+ "too many nested evaluations (infinite loop?)", -1);
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclEvalObjvInternal --
+ *
+ * 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 checking that the interpreter is ready to
+ * evaluate (by calling TclInterpReady), and also to manage the
+ * iPtr->numLevels.
+ *
+ * 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.
+ *
+ * Side effects:
+ * Depends on the command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+
+{
+ 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;
+
+ if (objc == 0) {
+ return TCL_OK;
}
/*
- * On the Mac, we will never reach the default recursion limit before
- * blowing the stack. So we need to do a check here.
+ * If any execution traces rename or delete the current command,
+ * we may need (at most) two passes here.
*/
+ while (1) {
- if (TclpCheckStackSpace() == 0) {
- /*NOTREACHED*/
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "too many nested calls to Tcl_EvalObj (infinite loop?)", -1);
- result = TCL_ERROR;
- goto done;
+ /*
+ * 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.
+ */
+
+ savedVarFramePtr = iPtr->varFramePtr;
+ if (flags & TCL_EVAL_INVOKE) {
+ 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_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "invalid command name \"", Tcl_GetString(objv[0]), "\"",
+ (char *) NULL);
+ code = TCL_ERROR;
+ } else if (TclInterpReady(interp) == TCL_ERROR) {
+ 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;
+ }
+
+ /*
+ * Call trace procedures if needed.
+ */
+ 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.
+ */
+ 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 */
+ checkTraces = 0;
+ continue;
+ }
+ }
+ break;
}
/*
- * If the interpreter has been deleted, return an error.
+ * Finally, invoke the command's Tcl_ObjCmdProc.
*/
-
- if (iPtr->flags & DELETED) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "attempt to call eval in deleted interpreter", -1);
- Tcl_SetErrorCode(interp, "CORE", "IDELETE",
- "attempt to call eval in deleted interpreter",
- (char *) NULL);
- result = TCL_ERROR;
- goto done;
+ cmdPtr->refCount++;
+ iPtr->cmdCount++;
+ if ( code == TCL_OK && traceCode == TCL_OK) {
+ savedVarFramePtr = iPtr->varFramePtr;
+ if (flags & TCL_EVAL_GLOBAL) {
+ iPtr->varFramePtr = NULL;
+ }
+ code = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
+ iPtr->varFramePtr = savedVarFramePtr;
+ }
+ if (Tcl_AsyncReady()) {
+ code = Tcl_AsyncInvoke(interp, code);
}
/*
- * 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,
- * or for a different namespace, or for the same namespace but
- * with different name resolution rules, we recompile it.
- *
- * 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 #def'ed out because [info body] was changed to never
- * return a bytecode type object, which should obviate us from
- * the extra checks here.
+ * Call 'leave' command traces
*/
+ 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);
+ }
+ }
+ TclCleanupCommand(cmdPtr);
- if (iPtr->varFramePtr != NULL) {
- namespacePtr = iPtr->varFramePtr->nsPtr;
- } else {
- namespacePtr = iPtr->globalNsPtr;
+ /*
+ * 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.
+ */
+
+ if (traceCode != TCL_OK) {
+ code = traceCode;
+ }
+
+ /*
+ * 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.
+ */
+
+ if (*(iPtr->result) != 0) {
+ (void) Tcl_GetObjResult(interp);
}
- if (objPtr->typePtr == &tclByteCodeType) {
- codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
-
- 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) {
- panic("Tcl_EvalObj: compiled script jumped interps");
- }
- codePtr->compileEpoch = iPtr->compileEpoch;
- } else {
- tclByteCodeType.freeIntRepProc(objPtr);
- }
+ done:
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_EvalObjv --
+ *
+ * This procedure evaluates a Tcl command that has already been
+ * parsed into words, with one Tcl_Obj holding each word.
+ *
+ * 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 command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_EvalObjv(interp, objc, objv, 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. */
+ 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. */
+{
+ 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);
+
+ 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.
+ */
+
+ 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;
}
}
- if (objPtr->typePtr != &tclByteCodeType) {
- iPtr->errorLine = 1;
- result = tclByteCodeType.setFromAnyProc(interp, objPtr);
- if (result != TCL_OK) {
- goto done;
+
+ code = TclInterpReady(interp);
+ if (code == TCL_OK) {
+ iPtr->numLevels++;
+ code = TclEvalObjvInternal(interp, objc, objv, cmdString, cmdLen,
+ flags);
+ iPtr->numLevels--;
+ }
+
+ /*
+ * If we are again at the top level, process any unusual
+ * return code returned by the evaluated code.
+ */
+
+ if (iPtr->numLevels == 0) {
+ if (code == TCL_RETURN) {
+ code = TclUpdateReturnInfo(iPtr);
}
- } else {
- codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
- if (((Interp *) *codePtr->interpHandle != iPtr)
- || (codePtr->compileEpoch != iPtr->compileEpoch)) {
- (*tclByteCodeType.freeIntRepProc)(objPtr);
- iPtr->errorLine = 1;
- result = (*tclByteCodeType.setFromAnyProc)(interp, objPtr);
- if (result != TCL_OK) {
- iPtr->numLevels--;
- return result;
+ if ((code != TCL_OK) && (code != TCL_ERROR)
+ && !allowExceptions) {
+ ProcessUnexpectedResult(interp, code);
+ code = TCL_ERROR;
+ }
+ }
+
+ if ((code == TCL_ERROR) && !(flags & TCL_EVAL_INVOKE)) {
+
+ /*
+ * If there was an error, a command string will be needed for the
+ * error log: generate it now if it was not done previously.
+ */
+
+ if (cmdLen == 0) {
+ Tcl_DStringInit(&cmdBuf);
+ for (i = 0; i < objc; i++) {
+ Tcl_DStringAppendElement(&cmdBuf, Tcl_GetString(objv[i]));
}
+ cmdString = Tcl_DStringValue(&cmdBuf);
+ cmdLen = Tcl_DStringLength(&cmdBuf);
}
+ Tcl_LogCommandInfo(interp, cmdString, cmdString, cmdLen);
+ }
+
+ if (cmdLen != 0) {
+ Tcl_DStringFree(&cmdBuf);
+ }
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LogCommandInfo --
+ *
+ * This procedure is invoked after an error occurs in an interpreter.
+ * It adds information to the "errorInfo" variable to describe the
+ * command that was being executed when the error occurred.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information about the command is added to errorInfo and the
+ * line number stored internally in the interpreter is set. If this
+ * is the first call to this procedure or Tcl_AddObjErrorInfo since
+ * an error occurred, then old information in errorInfo is
+ * deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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). */
+{
+ char buffer[200];
+ register CONST char *p;
+ char *ellipsis = "";
+ Interp *iPtr = (Interp *) interp;
+
+ if (iPtr->flags & ERR_ALREADY_LOGGED) {
+ /*
+ * Someone else has already logged error information for this
+ * command; we shouldn't add anything more.
+ */
+
+ return;
}
- codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
/*
- * Extract then reset the compilation flags in the interpreter.
- * Resetting the flags must be done after any compilation.
+ * Compute the line number where the error occurred.
*/
- evalFlags = iPtr->evalFlags;
- iPtr->evalFlags = 0;
+ iPtr->errorLine = 1;
+ for (p = script; p != command; p++) {
+ if (*p == '\n') {
+ iPtr->errorLine++;
+ }
+ }
+
+ /*
+ * Create an error message to add to errorInfo, including up to a
+ * maximum number of characters of the command.
+ */
+
+ if (length < 0) {
+ length = strlen(command);
+ }
+ if (length > 150) {
+ length = 150;
+ ellipsis = "...";
+ }
+ if (!(iPtr->flags & ERR_IN_PROGRESS)) {
+ sprintf(buffer, "\n while executing\n\"%.*s%s\"",
+ length, command, ellipsis);
+ } else {
+ sprintf(buffer, "\n invoked from within\n\"%.*s%s\"",
+ length, command, ellipsis);
+ }
+ Tcl_AddObjErrorInfo(interp, buffer, -1);
+ iPtr->flags &= ~ERR_ALREADY_LOGGED;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 evaluates the tokens and concatenates their
+ * values to form a single result value.
+ *
+ * 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 array of tokens being evaled.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_EvalTokensStandard(interp, tokenPtr, count)
+ 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 evaluate and concatenate. */
+ int count; /* Number of tokens to consider at tokenPtr.
+ * Must be at least 1. */
+{
+ Tcl_Obj *resultPtr, *indexPtr, *valuePtr;
+ char buffer[TCL_UTF_MAX];
+#ifdef TCL_MEM_DEBUG
+# define MAX_VAR_CHARS 5
+#else
+# define MAX_VAR_CHARS 30
+#endif
+ char nameBuffer[MAX_VAR_CHARS+1];
+ char *varName, *index;
+ CONST char *p = NULL; /* Initialized to avoid compiler warning. */
+ int length, code;
/*
- * Execute the commands. If the code was compiled from an empty string,
- * don't bother executing the code.
+ * The only tricky thing about this procedure is that it attempts to
+ * avoid object creation and string copying whenever possible. For
+ * example, if the value is just a nested command, then use the
+ * command's result object directly.
*/
- numSrcBytes = codePtr->numSrcBytes;
- if ((numSrcBytes > 0) || (codePtr->flags & TCL_BYTECODE_PRECOMPILED)) {
+ code = TCL_OK;
+ resultPtr = NULL;
+ Tcl_ResetResult(interp);
+ for ( ; count > 0; count--, tokenPtr++) {
+ valuePtr = NULL;
+
/*
- * Increment the code's ref count while it is being executed. If
- * afterwards no references to it remain, free the code.
+ * The switch statement below computes the next value to be
+ * concat to the result, as either a range of text or an
+ * object.
*/
-
- codePtr->refCount++;
- result = TclExecuteByteCode(interp, codePtr);
- codePtr->refCount--;
- if (codePtr->refCount <= 0) {
- TclCleanupByteCode(codePtr);
+
+ switch (tokenPtr->type) {
+ case TCL_TOKEN_TEXT:
+ p = tokenPtr->start;
+ length = tokenPtr->size;
+ break;
+
+ case TCL_TOKEN_BS:
+ length = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL,
+ buffer);
+ p = buffer;
+ break;
+
+ case TCL_TOKEN_COMMAND:
+ code = Tcl_EvalEx(interp, tokenPtr->start+1, tokenPtr->size-2,
+ 0);
+ if (code != TCL_OK) {
+ goto done;
+ }
+ valuePtr = Tcl_GetObjResult(interp);
+ break;
+
+ case TCL_TOKEN_VARIABLE:
+ if (tokenPtr->numComponents == 1) {
+ indexPtr = NULL;
+ index = NULL;
+ } else {
+ code = Tcl_EvalTokensStandard(interp, tokenPtr+2,
+ tokenPtr->numComponents - 1);
+ if (code != TCL_OK) {
+ goto done;
+ }
+ indexPtr = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(indexPtr);
+ index = Tcl_GetString(indexPtr);
+ }
+
+ /*
+ * We have to make a copy of the variable name in order
+ * to have a null-terminated string. We can't make a
+ * temporary modification to the script to null-terminate
+ * the name, because a trace callback might potentially
+ * reuse the script and be affected by the null character.
+ */
+
+ if (tokenPtr[1].size <= MAX_VAR_CHARS) {
+ varName = nameBuffer;
+ } else {
+ varName = ckalloc((unsigned) (tokenPtr[1].size + 1));
+ }
+ strncpy(varName, tokenPtr[1].start, (size_t) tokenPtr[1].size);
+ varName[tokenPtr[1].size] = 0;
+ valuePtr = Tcl_GetVar2Ex(interp, varName, index,
+ TCL_LEAVE_ERR_MSG);
+ if (varName != nameBuffer) {
+ ckfree(varName);
+ }
+ if (indexPtr != NULL) {
+ Tcl_DecrRefCount(indexPtr);
+ }
+ if (valuePtr == NULL) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ count -= tokenPtr->numComponents;
+ tokenPtr += tokenPtr->numComponents;
+ break;
+
+ default:
+ panic("unexpected token type in Tcl_EvalTokensStandard");
}
+
+ /*
+ * If valuePtr isn't NULL, the next piece of text comes from that
+ * object; otherwise, take length bytes starting at p.
+ */
+
+ if (resultPtr == NULL) {
+ if (valuePtr != NULL) {
+ resultPtr = valuePtr;
+ } else {
+ resultPtr = Tcl_NewStringObj(p, length);
+ }
+ Tcl_IncrRefCount(resultPtr);
+ } else {
+ if (Tcl_IsShared(resultPtr)) {
+ Tcl_DecrRefCount(resultPtr);
+ resultPtr = Tcl_DuplicateObj(resultPtr);
+ Tcl_IncrRefCount(resultPtr);
+ }
+ if (valuePtr != NULL) {
+ p = Tcl_GetStringFromObj(valuePtr, &length);
+ }
+ Tcl_AppendToObj(resultPtr, p, length);
+ }
+ }
+ if (resultPtr != NULL) {
+ Tcl_SetObjResult(interp, resultPtr);
} else {
- result = TCL_OK;
+ code = TCL_ERROR;
+ }
+
+ done:
+ if (resultPtr != NULL) {
+ Tcl_DecrRefCount(resultPtr);
}
+ return code;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 evaluates the tokens and concatenates their
+ * values to form a single result value.
+ *
+ * Results:
+ * The return value is a pointer to a newly allocated Tcl_Obj
+ * containing the value of the array of tokens. The reference
+ * count of the returned object has been incremented. If an error
+ * occurs in evaluating the tokens then a NULL value is returned
+ * and an error message is left in interp's result.
+ *
+ * Side effects:
+ * A new object is allocated to hold the result.
+ *
+ *----------------------------------------------------------------------
+ *
+ * This uses a non-standard return convention; its use is now deprecated.
+ * It is a wrapper for the new function Tcl_EvalTokensStandard, and is not
+ * used in the core any longer. It is only kept for backward compatibility.
+ */
+
+Tcl_Obj *
+Tcl_EvalTokens(interp, tokenPtr, count)
+ 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 evaluate and concatenate. */
+ 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 {
+ return NULL;
+ }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_EvalEx --
+ *
+ * This procedure 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.
+ *
+ * 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 script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_EvalEx(interp, script, numBytes, flags)
+ 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 null character. */
+ int flags; /* Collection of OR-ed bits that control
+ * the evaluation of the script. Only
+ * TCL_EVAL_GLOBAL is currently
+ * supported. */
+{
+ Interp *iPtr = (Interp *) interp;
+ CONST char *p, *next;
+ Tcl_Parse parse;
+#define NUM_STATIC_OBJS 20
+ Tcl_Obj *staticObjArray[NUM_STATIC_OBJS], **objv;
+ Tcl_Token *tokenPtr;
+ int i, code, commandLength, bytesLeft, nested;
+ CallFrame *savedVarFramePtr; /* Saves old copy of iPtr->varFramePtr
+ * in case TCL_EVAL_GLOBAL was set. */
+ int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
+
+ /* For nested scripts, this variable will be set to point to the first
+ * char after the end of the script - needed only to compare pointers,
+ * nothing will be read nor written there.
+ */
+
+ CONST char *onePast = NULL;
/*
- * If no commands at all were executed, check for asynchronous
- * handlers so that they at least get one change to execute.
- * This is needed to handle event loops written in Tcl with
- * empty bodies.
+ * 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.
*/
- if ((oldCount == iPtr->cmdCount) && Tcl_AsyncReady()) {
- result = Tcl_AsyncInvoke(interp, result);
+ int gotParse = 0, objectsUsed = 0;
+
+ if (numBytes < 0) {
+ numBytes = strlen(script);
+ }
+ Tcl_ResetResult(interp);
+
+ savedVarFramePtr = iPtr->varFramePtr;
+ if (flags & TCL_EVAL_GLOBAL) {
+ iPtr->varFramePtr = NULL;
}
/*
- * Update the interpreter's evaluation level count. If we are again at
- * the top level, process any unusual return code returned by the
- * evaluated code.
+ * Each iteration through the following loop parses the next
+ * command from the script and then executes it.
*/
- if (iPtr->numLevels == 1) {
- if (result == TCL_RETURN) {
- result = TclUpdateReturnInfo(iPtr);
+ objv = staticObjArray;
+ p = script;
+ bytesLeft = numBytes;
+ if (iPtr->evalFlags & TCL_BRACKET_TERM) {
+ nested = 1;
+ onePast = script + numBytes;
+ } else {
+ nested = 0;
+ }
+ iPtr->evalFlags = 0;
+ do {
+ if (Tcl_ParseCommand(interp, p, bytesLeft, nested, &parse)
+ != TCL_OK) {
+ code = TCL_ERROR;
+ goto error;
}
- if ((result != TCL_OK) && (result != TCL_ERROR)
- && ((evalFlags & TCL_ALLOW_EXCEPTIONS) == 0)) {
- ProcessUnexpectedResult(interp, result);
- result = TCL_ERROR;
+ gotParse = 1;
+
+ /*
+ * A nested script can only terminate in ']'. If the script is not
+ * nested, onePast is NULL and the second test is not performed.
+ */
+
+ next = parse.commandStart + parse.commandSize;
+ if ((next == onePast) && (onePast[-1] != ']')) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("missing close-bracket", -1));
+ code = TCL_ERROR;
+ goto error;
}
- }
+ if (parse.numWords > 0) {
+ /*
+ * Generate an array of objects for the words of the command.
+ */
+
+ if (parse.numWords <= NUM_STATIC_OBJS) {
+ objv = staticObjArray;
+ } else {
+ objv = (Tcl_Obj **) ckalloc((unsigned)
+ (parse.numWords * sizeof (Tcl_Obj *)));
+ }
+ for (objectsUsed = 0, tokenPtr = parse.tokenPtr;
+ objectsUsed < parse.numWords;
+ objectsUsed++, tokenPtr += (tokenPtr->numComponents + 1)) {
+ code = Tcl_EvalTokensStandard(interp, tokenPtr+1,
+ tokenPtr->numComponents);
+ if (code == TCL_OK) {
+ objv[objectsUsed] = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(objv[objectsUsed]);
+ } else {
+ goto error;
+ }
+ }
+
+ /*
+ * Execute the command and free the objects for its words.
+ */
+
+ if (TclInterpReady(interp) == TCL_ERROR) {
+ code = TCL_ERROR;
+ } else {
+ iPtr->numLevels++;
+ code = TclEvalObjvInternal(interp, objectsUsed, objv, p,
+ parse.commandStart + parse.commandSize - p, 0);
+ iPtr->numLevels--;
+ }
+ if (code != TCL_OK) {
+ 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;
+ }
+ }
+ goto error;
+ }
+ for (i = 0; i < objectsUsed; i++) {
+ Tcl_DecrRefCount(objv[i]);
+ }
+ objectsUsed = 0;
+ if (objv != staticObjArray) {
+ ckfree((char *) objv);
+ objv = staticObjArray;
+ }
+ }
+
+ /*
+ * Advance to the next command in the script.
+ */
+
+ bytesLeft -= next - p;
+ p = next;
+ Tcl_FreeParse(&parse);
+ gotParse = 0;
+ if ((nested != 0) && (p > script) && (p[-1] == ']')) {
+ /*
+ * We get here in the special case where the TCL_BRACKET_TERM
+ * flag was set in the interpreter and we reached a close
+ * bracket in the script. Return immediately.
+ */
+
+ iPtr->termOffset = (p - 1) - script;
+ iPtr->varFramePtr = savedVarFramePtr;
+ return TCL_OK;
+ }
+ } while (bytesLeft > 0);
+ iPtr->termOffset = p - script;
+ iPtr->varFramePtr = savedVarFramePtr;
+ return TCL_OK;
+
+ error:
/*
- * If an error occurred, record information about what was being
- * executed when the error occurred.
+ * Generate various pieces of error information, such as the line
+ * number where the error occurred and information to add to the
+ * errorInfo variable. Then free resources that had been allocated
+ * to the command.
*/
- if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
- RecordTracebackInfo(interp, objPtr, numSrcBytes);
+ if ((code == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
+ commandLength = parse.commandSize;
+ if ((parse.commandStart + commandLength) != (script + numBytes)) {
+ /*
+ * The command where the error occurred didn't end at the end
+ * of the script (i.e. it ended at a terminator character such
+ * as ";". Reduce the length by one so that the error message
+ * doesn't include the terminator character.
+ */
+
+ commandLength -= 1;
+ }
+ Tcl_LogCommandInfo(interp, script, parse.commandStart, commandLength);
+ }
+
+ for (i = 0; i < objectsUsed; i++) {
+ Tcl_DecrRefCount(objv[i]);
}
+ if (gotParse) {
+ next = parse.commandStart + parse.commandSize;
+ bytesLeft -= next - p;
+ p = next;
+ Tcl_FreeParse(&parse);
+
+ if ((nested != 0) && (p > script)) {
+ CONST char *nextCmd = NULL; /* pointer to start of next command */
+
+ /*
+ * We get here in the special case where the TCL_BRACKET_TERM
+ * flag was set in the interpreter.
+ *
+ * At this point, we want to find the end of the script
+ * (either end of script or the closing ']').
+ */
+
+ while ((p[-1] != ']') && bytesLeft) {
+ if (Tcl_ParseCommand(NULL, p, bytesLeft, nested, &parse)
+ != TCL_OK) {
+ /*
+ * We were looking for the ']' to close the script.
+ * But if we find a syntax error, it is ok to quit
+ * early since in that case we no longer need to know
+ * where the ']' is (if there was one). We reset the
+ * pointer to the start of the command that after the
+ * one causing the return. -- hobbs
+ */
+
+ p = (nextCmd == NULL) ? parse.commandStart : nextCmd;
+ break;
+ }
+
+ if (nextCmd == NULL) {
+ nextCmd = parse.commandStart;
+ }
+
+ /*
+ * Advance to the next command in the script.
+ */
+
+ next = parse.commandStart + parse.commandSize;
+ bytesLeft -= next - p;
+ p = next;
+ Tcl_FreeParse(&parse);
+ }
+ iPtr->termOffset = (p - 1) - script;
+ } else {
+ iPtr->termOffset = p - script;
+ }
+ }
+ if (objv != staticObjArray) {
+ ckfree((char *) objv);
+ }
+ iPtr->varFramePtr = savedVarFramePtr;
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Eval --
+ *
+ * Execute a Tcl command in a string. This procedure 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 for executing Tcl commands, but nowadays
+ * it isn't used much.
+ *
+ * Results:
+ * The return value is one of the return codes defined in tcl.h
+ * (such as TCL_OK), and interp's result contains a value
+ * to supplement the return code. The value of the result
+ * will persist only until the next call to Tcl_Eval or Tcl_EvalObj:
+ * you must copy it or lose it!
+ *
+ * Side effects:
+ * Can be almost arbitrary, depending on the commands in the script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_Eval(interp, string)
+ Tcl_Interp *interp; /* Token for command interpreter (returned
+ * by previous call to Tcl_CreateInterp). */
+ CONST char *string; /* Pointer to TCL command to execute. */
+{
+ int code = Tcl_EvalEx(interp, string, -1, 0);
/*
- * Set the interpreter's termOffset member to the offset of the
- * character just after the last one executed. We approximate the offset
- * of the last character executed by using the number of characters
- * compiled.
+ * For backwards compatibility with old C code that predates the
+ * object system in Tcl 8.0, we have to mirror the object result
+ * back into the string result (some callers may expect it there).
*/
- iPtr->termOffset = numSrcBytes;
- iPtr->flags &= ~ERR_ALREADY_LOGGED;
+ Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
+ TCL_VOLATILE);
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_EvalObj, Tcl_GlobalEvalObj --
+ *
+ * These functions are deprecated but we keep them around for backwards
+ * compatibility reasons.
+ *
+ * Results:
+ * See the functions they call.
+ *
+ * Side effects:
+ * See the functions they call.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#undef Tcl_EvalObj
+int
+Tcl_EvalObj(interp, objPtr)
+ 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;
+{
+ return Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_EvalObjEx --
+ *
+ * Execute Tcl commands stored in a Tcl object. These commands are
+ * compiled into bytecodes if necessary, unless TCL_EVAL_DIRECT
+ * is specified.
+ *
+ * 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 the return code.
+ *
+ * Side effects:
+ * The object is converted, if necessary, to a ByteCode object that
+ * holds the bytecode instructions for the commands. Executing the
+ * commands will almost certainly have side effects that depend
+ * on those commands.
+ *
+ * Just as in Tcl_Eval, interp->termOffset is set to the offset of the
+ * last character executed in the objPtr's string.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_EvalObjEx(interp, objPtr, flags)
+ 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. */
+{
+ register Interp *iPtr = (Interp *) interp;
+ char *script;
+ int numSrcBytes;
+ 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);
+
+ if ((iPtr->flags & USE_EVAL_DIRECT) || (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 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.
+ *
+ * USE_EVAL_DIRECT is a special flag used for testing purpose only
+ * (ensure we go into the TCL_EVAL_DIRECT path, avoiding opt)
+ */
+ if (!(iPtr->flags & USE_EVAL_DIRECT) &&
+ (objPtr->typePtr == &tclListType) && /* is a list... */
+ (objPtr->bytes == NULL) /* ...without a string rep */) {
+ register List *listRepPtr =
+ (List *) objPtr->internalRep.twoPtrValue.ptr1;
+ result = Tcl_EvalObjv(interp, listRepPtr->elemCount,
+ listRepPtr->elements, flags);
+ } else {
+ script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
+ result = Tcl_EvalEx(interp, script, numSrcBytes, flags);
+ }
+ } else {
+ /*
+ * Let the compiler/engine subsystem do the evaluation.
+ */
+
+ savedVarFramePtr = iPtr->varFramePtr;
+ if (flags & TCL_EVAL_GLOBAL) {
+ iPtr->varFramePtr = NULL;
+ }
+
+ result = TclCompEvalObj(interp, objPtr);
+
+ /*
+ * If we are again at the top level, process any unusual
+ * return code returned by the evaluated code.
+ */
+
+ 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;
+
+ /*
+ * If an error was created here, record information about
+ * what was being executed when the error occurred.
+ */
+
+ if (!(iPtr->flags & ERR_ALREADY_LOGGED)) {
+ script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
+ Tcl_LogCommandInfo(interp, script, script, numSrcBytes);
+ iPtr->flags &= ~ERR_ALREADY_LOGGED;
+ }
+ }
+ }
+ iPtr->evalFlags = 0;
+ iPtr->varFramePtr = savedVarFramePtr;
+ }
- done:
TclDecrRefCount(objPtr);
- iPtr->varFramePtr = savedVarFramePtr;
- iPtr->numLevels--;
return result;
}
@@ -2835,61 +4019,6 @@ ProcessUnexpectedResult(interp, returnCode)
}
/*
- *----------------------------------------------------------------------
- *
- * RecordTracebackInfo --
- *
- * Procedure called by Tcl_EvalObj to record information about what was
- * being executed when the error occurred.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Appends information about the script being evaluated to the
- * interpreter's "errorInfo" variable.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-RecordTracebackInfo(interp, objPtr, numSrcBytes)
- Tcl_Interp *interp; /* The interpreter in which the error
- * occurred. */
- Tcl_Obj *objPtr; /* Points to object containing script whose
- * evaluation resulted in an error. */
- int numSrcBytes; /* Number of bytes compiled in script. */
-{
- Interp *iPtr = (Interp *) interp;
- char buf[200];
- char *ellipsis, *bytes;
- int length;
-
- /*
- * Decide how much of the command to print in the error message
- * (up to a certain number of bytes).
- */
-
- bytes = Tcl_GetStringFromObj(objPtr, &length);
- length = TclMin(numSrcBytes, length);
-
- ellipsis = "";
- if (length > 150) {
- length = 150;
- ellipsis = " ...";
- }
-
- if (!(iPtr->flags & ERR_IN_PROGRESS)) {
- sprintf(buf, "\n while executing\n\"%.*s%s\"",
- length, bytes, ellipsis);
- } else {
- sprintf(buf, "\n invoked from within\n\"%.*s%s\"",
- length, bytes, ellipsis);
- }
- Tcl_AddObjErrorInfo(interp, buf, -1);
-}
-
-/*
*---------------------------------------------------------------------------
*
* Tcl_ExprLong, Tcl_ExprDouble, Tcl_ExprBoolean --
@@ -2914,7 +4043,7 @@ int
Tcl_ExprLong(interp, string, ptr)
Tcl_Interp *interp; /* Context in which to evaluate the
* expression. */
- char *string; /* Expression to evaluate. */
+ CONST char *string; /* Expression to evaluate. */
long *ptr; /* Where to store result. */
{
register Tcl_Obj *exprPtr;
@@ -2965,7 +4094,7 @@ int
Tcl_ExprDouble(interp, string, ptr)
Tcl_Interp *interp; /* Context in which to evaluate the
* expression. */
- char *string; /* Expression to evaluate. */
+ CONST char *string; /* Expression to evaluate. */
double *ptr; /* Where to store result. */
{
register Tcl_Obj *exprPtr;
@@ -3016,7 +4145,7 @@ int
Tcl_ExprBoolean(interp, string, ptr)
Tcl_Interp *interp; /* Context in which to evaluate the
* expression. */
- char *string; /* Expression to evaluate. */
+ CONST char *string; /* Expression to evaluate. */
int *ptr; /* Where to store 0/1 result. */
{
register Tcl_Obj *exprPtr;
@@ -3185,7 +4314,7 @@ int
TclInvoke(interp, argc, argv, flags)
Tcl_Interp *interp; /* Where to invoke the command. */
int argc; /* Count of args. */
- register char **argv; /* The arg strings; argv[0] is the name of
+ register CONST char **argv; /* The arg strings; argv[0] is the name of
* the command to invoke. */
int flags; /* Combination of flags controlling the
* call: TCL_INVOKE_HIDDEN and
@@ -3282,7 +4411,7 @@ int
TclGlobalInvoke(interp, argc, argv, flags)
Tcl_Interp *interp; /* Where to invoke the command. */
int argc; /* Count of args. */
- register char **argv; /* The arg strings; argv[0] is the name of
+ register CONST char **argv; /* The arg strings; argv[0] is the name of
* the command to invoke. */
int flags; /* Combination of flags controlling the
* call: TCL_INVOKE_HIDDEN and
@@ -3537,7 +4666,7 @@ int
Tcl_ExprString(interp, string)
Tcl_Interp *interp; /* Context in which to evaluate the
* expression. */
- char *string; /* Expression to evaluate. */
+ CONST char *string; /* Expression to evaluate. */
{
register Tcl_Obj *exprPtr;
Tcl_Obj *resultPtr;
@@ -3593,214 +4722,112 @@ Tcl_ExprString(interp, string)
}
/*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*
- * Tcl_ExprObj --
+ * Tcl_CreateObjTrace --
*
- * Evaluate an expression in a Tcl_Obj.
+ * Arrange for a procedure to be called to trace command execution.
*
* Results:
- * A standard Tcl object result. If the result is other than TCL_OK,
- * then the interpreter's result contains an error message. If the
- * result is TCL_OK, then a pointer to the expression's result value
- * object is stored in resultPtrPtr. In that case, the object's ref
- * count is incremented to reflect the reference returned to the
- * caller; the caller is then responsible for the resulting object
- * and must, for example, decrement the ref count when it is finished
- * with the object.
+ * The return value is a token for the trace, which may be passed
+ * to Tcl_DeleteTrace to eliminate the trace.
*
* Side effects:
- * Any side effects caused by subcommands in the expression, if any.
- * The interpreter result is not modified unless there is an error.
+ * From now on, proc will be called just before a command procedure
+ * is called to execute a Tcl command. Calls to proc will have the
+ * following form:
*
- *--------------------------------------------------------------
+ * void proc( ClientData clientData,
+ * Tcl_Interp* interp,
+ * int level,
+ * CONST char* command,
+ * Tcl_Command commandInfo,
+ * int objc,
+ * 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 nesting depth of command interpretation within
+ * the interpreter. The 'command' argument is the ASCII text of
+ * the command being evaluated -- before any substitutions are
+ * performed. The 'commandInfo' argument gives a handle to the
+ * command procedure that will be evaluated. The 'objc' and 'objv'
+ * parameters give the parameter vector that will be passed to the
+ * command procedure. proc does not return a value.
+ *
+ * It is permissible for 'proc' to call Tcl_SetCommandTokenInfo
+ * to change the command procedure or client data for the command
+ * being evaluated, and these changes will take effect with the
+ * current evaluation.
+ *
+ * The 'level' argument specifies the maximum nesting level of calls
+ * to be traced. If the execution depth of the interpreter exceeds
+ * 'level', the trace callback is not executed.
+ *
+ * The 'flags' argument is either zero or the value,
+ * TCL_ALLOW_INLINE_COMPILATION. If the TCL_ALLOW_INLINE_COMPILATION
+ * flag is not present, the bytecode compiler will not generate inline
+ * code for Tcl's built-in commands. This behavior will have a significant
+ * impact on performance, but will ensure that all command evaluations are
+ * traced. If the TCL_ALLOW_INLINE_COMPILATION flag is present, the
+ * bytecode compiler will have its normal behavior of compiling in-line
+ * code for some of Tcl's built-in commands. In this case, the tracing
+ * will be imprecise -- in-line code will not be traced -- but run-time
+ * performance will be improved. The latter behavior is desired for
+ * many applications such as profiling of run time.
+ *
+ * When the trace is deleted, the 'delProc' procedure will be invoked,
+ * passing it the original client data.
+ *
+ *----------------------------------------------------------------------
*/
-int
-Tcl_ExprObj(interp, objPtr, resultPtrPtr)
- Tcl_Interp *interp; /* Context in which to evaluate the
- * expression. */
- register Tcl_Obj *objPtr; /* Points to Tcl object containing
- * expression to evaluate. */
- Tcl_Obj **resultPtrPtr; /* Where the Tcl_Obj* that is the expression
- * result is stored if no errors occur. */
+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;
+ /* Procedure to call when trace is deleted */
{
- 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 to avoid compiler warning. */
- AuxData *auxDataPtr;
- LiteralEntry *entryPtr;
- Tcl_Obj *saveObjPtr;
- char *string;
- int length, i, result;
-
- /*
- * First handle some common expressions specially.
- */
-
- string = Tcl_GetStringFromObj(objPtr, &length);
- if (length == 1) {
- if (*string == '0') {
- *resultPtrPtr = Tcl_NewLongObj(0);
- Tcl_IncrRefCount(*resultPtrPtr);
- return TCL_OK;
- } else if (*string == '1') {
- *resultPtrPtr = Tcl_NewLongObj(1);
- Tcl_IncrRefCount(*resultPtrPtr);
- return TCL_OK;
- }
- } else if ((length == 2) && (*string == '!')) {
- if (*(string+1) == '0') {
- *resultPtrPtr = Tcl_NewLongObj(1);
- Tcl_IncrRefCount(*resultPtrPtr);
- return TCL_OK;
- } else if (*(string+1) == '1') {
- *resultPtrPtr = Tcl_NewLongObj(0);
- Tcl_IncrRefCount(*resultPtrPtr);
- return TCL_OK;
- }
- }
+ register Trace *tracePtr;
+ register Interp *iPtr = (Interp *) interp;
- /*
- * 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.
- *
- */
+ /* Test if this trace allows inline compilation of commands */
- if (objPtr->typePtr == &tclByteCodeType) {
- codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
- if (((Interp *) *codePtr->interpHandle != iPtr)
- || (codePtr->compileEpoch != iPtr->compileEpoch)) {
- if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
- if ((Interp *) *codePtr->interpHandle != iPtr) {
- panic("Tcl_ExprObj: compiled expression jumped interps");
- }
- codePtr->compileEpoch = iPtr->compileEpoch;
- } else {
- (*tclByteCodeType.freeIntRepProc)(objPtr);
- objPtr->typePtr = (Tcl_ObjType *) NULL;
- }
- }
- }
- if (objPtr->typePtr != &tclByteCodeType) {
- TclInitCompileEnv(interp, &compEnv, string, length);
- result = TclCompileExpr(interp, string, length, &compEnv);
+ if ( ! ( flags & TCL_ALLOW_INLINE_COMPILATION ) ) {
- /*
- * Free the compilation environment's literal table bucket array if
- * it was dynamically allocated.
- */
+ if ( iPtr->tracesForbiddingInline == 0 ) {
- if (localTablePtr->buckets != localTablePtr->staticBuckets) {
- ckfree((char *) localTablePtr->buckets);
- }
-
- if (result != TCL_OK) {
/*
- * Compilation errors. Free storage allocated for compilation.
+ * When the first trace forbidding inline compilation is
+ * created, invalidate existing compiled code for this
+ * interpreter and arrange (by setting the
+ * DONT_COMPILE_CMDS_INLINE flag) that when compiling new
+ * code, no commands will be compiled inline (i.e., into
+ * an inline sequence of instructions). We do this because
+ * commands that were compiled inline will never result in
+ * a command trace being called.
*/
-#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*/
-
- 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;
- }
-
- /*
- * Successful compilation. If the expression yielded no
- * instructions, push an zero object as the expression's result.
- */
-
- if (compEnv.codeNext == compEnv.codeStart) {
- TclEmitPush(TclRegisterLiteral(&compEnv, "0", 1, /*onHeap*/ 0),
- &compEnv);
- }
-
- /*
- * 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.
- */
-
- compEnv.numSrcBytes = iPtr->termOffset;
- TclEmitOpcode(INST_DONE, &compEnv);
- TclInitByteCodeObj(objPtr, &compEnv);
- TclFreeCompileEnv(&compEnv);
- codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
-#ifdef TCL_COMPILE_DEBUG
- if (tclTraceCompile == 2) {
- TclPrintByteCodeObj(interp, objPtr);
+ iPtr->compileEpoch++;
+ iPtr->flags |= DONT_COMPILE_CMDS_INLINE;
}
-#endif /* TCL_COMPILE_DEBUG */
+ ++ iPtr->tracesForbiddingInline;
}
-
- /*
- * Execute the expression after first saving the interpreter's result.
- */
- saveObjPtr = Tcl_GetObjResult(interp);
- Tcl_IncrRefCount(saveObjPtr);
- Tcl_ResetResult(interp);
+ tracePtr = (Trace *) ckalloc(sizeof(Trace));
+ tracePtr->level = level;
+ tracePtr->proc = proc;
+ tracePtr->clientData = clientData;
+ tracePtr->delProc = delProc;
+ tracePtr->nextPtr = iPtr->tracePtr;
+ tracePtr->flags = flags;
+ iPtr->tracePtr = tracePtr;
- /*
- * Increment the code's ref count while it is being executed. If
- * afterwards no references to it remain, free the code.
- */
-
- codePtr->refCount++;
- result = TclExecuteByteCode(interp, codePtr);
- 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);
- }
- Tcl_DecrRefCount(saveObjPtr);
- return result;
+ return (Tcl_Trace) tracePtr;
}
/*
@@ -3855,28 +4882,95 @@ Tcl_CreateTrace(interp, level, proc, clientData)
* command. */
ClientData clientData; /* Arbitrary value word to pass to proc. */
{
- register Trace *tracePtr;
- register Interp *iPtr = (Interp *) interp;
+ StringTraceData* data;
+ data = (StringTraceData*) ckalloc( sizeof( *data ));
+ data->clientData = clientData;
+ data->proc = proc;
+ return Tcl_CreateObjTrace( interp, level, 0, StringTraceProc,
+ (ClientData) data, StringTraceDeleteProc );
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringTraceProc --
+ *
+ * Invoke a string-based trace procedure from an object-based
+ * callback.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Whatever the string-based trace procedure does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+{
+ StringTraceData* data = (StringTraceData*) clientData;
+ Command* cmdPtr = (Command*) commandInfo;
+
+ CONST char** argv; /* Args to pass to string trace proc */
+
+ int i;
/*
- * Invalidate existing compiled code for this interpreter and arrange
- * (by setting the DONT_COMPILE_CMDS_INLINE flag) that when compiling
- * new code, no commands will be compiled inline (i.e., into an inline
- * sequence of instructions). We do this because commands that were
- * compiled inline will never result in a command trace being called.
+ * This is a bit messy because we have to emulate the old trace
+ * interface, which uses strings for everything.
*/
+
+ argv = (CONST char **) ckalloc((unsigned) ( (objc + 1)
+ * sizeof(CONST char *) ));
+ for (i = 0; i < objc; i++) {
+ argv[i] = Tcl_GetString(objv[i]);
+ }
+ argv[objc] = 0;
- iPtr->compileEpoch++;
- iPtr->flags |= DONT_COMPILE_CMDS_INLINE;
+ /*
+ * Invoke the command procedure. Note that we cast away const-ness
+ * on two parameters for compatibility with legacy code; the code
+ * MUST NOT modify either command or argv.
+ */
+
+ ( data->proc )( data->clientData, interp, level,
+ (char*) command, cmdPtr->proc, cmdPtr->clientData,
+ objc, argv );
+ ckfree( (char*) argv );
- tracePtr = (Trace *) ckalloc(sizeof(Trace));
- tracePtr->level = level;
- tracePtr->proc = proc;
- tracePtr->clientData = clientData;
- tracePtr->nextPtr = iPtr->tracePtr;
- iPtr->tracePtr = tracePtr;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringTraceDeleteProc --
+ *
+ * Clean up memory when a string-based trace is deleted.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Allocated memory is returned to the system.
+ *
+ *----------------------------------------------------------------------
+ */
- return (Tcl_Trace) tracePtr;
+static void
+StringTraceDeleteProc( clientData )
+ ClientData clientData;
+{
+ ckfree( (char*) clientData );
}
/*
@@ -3902,31 +4996,49 @@ Tcl_DeleteTrace(interp, trace)
Tcl_Trace trace; /* Token for trace (returned previously by
* Tcl_CreateTrace). */
{
- register Interp *iPtr = (Interp *) interp;
- register Trace *tracePtr = (Trace *) trace;
- register Trace *tracePtr2;
+ Interp *iPtr = (Interp *) interp;
+ Trace *tracePtr = (Trace *) trace;
+ register Trace **tracePtr2 = &( iPtr->tracePtr );
- if (iPtr->tracePtr == tracePtr) {
- iPtr->tracePtr = tracePtr->nextPtr;
- ckfree((char *) tracePtr);
- } else {
- for (tracePtr2 = iPtr->tracePtr; tracePtr2 != NULL;
- tracePtr2 = tracePtr2->nextPtr) {
- if (tracePtr2->nextPtr == tracePtr) {
- tracePtr2->nextPtr = tracePtr->nextPtr;
- ckfree((char *) tracePtr);
- break;
- }
+ /*
+ * Locate the trace entry in the interpreter's trace list,
+ * and remove it from the list.
+ */
+
+ while ( (*tracePtr2) != NULL && (*tracePtr2) != tracePtr ) {
+ tracePtr2 = &((*tracePtr2)->nextPtr);
+ }
+ if ( *tracePtr2 == NULL ) {
+ return;
+ }
+ (*tracePtr2) = (*tracePtr2)->nextPtr;
+
+ /*
+ * If the trace forbids bytecode compilation, change the interpreter's
+ * state. If bytecode compilation is now permitted, flag the fact and
+ * advance the compilation epoch so that procs will be recompiled to
+ * take advantage of it.
+ */
+
+ if ( ! (tracePtr->flags & TCL_ALLOW_INLINE_COMPILATION ) ) {
+ -- iPtr->tracesForbiddingInline;
+ if ( iPtr->tracesForbiddingInline == 0 ) {
+ iPtr->flags &= ~DONT_COMPILE_CMDS_INLINE;
+ ++ iPtr->compileEpoch;
}
}
- if (iPtr->tracePtr == NULL) {
- /*
- * When compiling new code, allow commands to be compiled inline.
- */
+ /*
+ * Execute any delete callback.
+ */
- iPtr->flags &= ~DONT_COMPILE_CMDS_INLINE;
+ if ( tracePtr->delProc != NULL ) {
+ ( tracePtr->delProc )( tracePtr->clientData );
}
+
+ /* Delete the trace object */
+
+ Tcl_EventuallyFree( (char*) tracePtr, TCL_DYNAMIC);
}
/*
@@ -4004,11 +5116,11 @@ Tcl_AddObjErrorInfo(interp, message, length)
iPtr->flags |= ERR_IN_PROGRESS;
if (iPtr->result[0] == 0) {
- (void) Tcl_SetVar2Ex(interp, "errorInfo", NULL, iPtr->objResultPtr,
- TCL_GLOBAL_ONLY);
+ Tcl_ObjSetVar2(interp, iPtr->execEnvPtr->errorInfo, NULL,
+ iPtr->objResultPtr, TCL_GLOBAL_ONLY);
} else { /* use the string result */
- Tcl_SetVar2(interp, "errorInfo", (char *) NULL, interp->result,
- TCL_GLOBAL_ONLY);
+ Tcl_ObjSetVar2(interp, iPtr->execEnvPtr->errorInfo, NULL,
+ Tcl_NewStringObj(interp->result, -1), TCL_GLOBAL_ONLY);
}
/*
@@ -4017,8 +5129,8 @@ Tcl_AddObjErrorInfo(interp, message, length)
*/
if (!(iPtr->flags & ERROR_CODE_SET)) {
- (void) Tcl_SetVar2(interp, "errorCode", (char *) NULL, "NONE",
- TCL_GLOBAL_ONLY);
+ Tcl_ObjSetVar2(interp, iPtr->execEnvPtr->errorCode, NULL,
+ Tcl_NewStringObj("NONE", -1), TCL_GLOBAL_ONLY);
}
}
@@ -4029,8 +5141,8 @@ Tcl_AddObjErrorInfo(interp, message, length)
if (length != 0) {
messagePtr = Tcl_NewStringObj(message, length);
Tcl_IncrRefCount(messagePtr);
- Tcl_SetVar2Ex(interp, "errorInfo", NULL, messagePtr,
- (TCL_GLOBAL_ONLY | TCL_APPEND_VALUE));
+ Tcl_ObjSetVar2(interp, iPtr->execEnvPtr->errorInfo, NULL,
+ messagePtr, (TCL_GLOBAL_ONLY | TCL_APPEND_VALUE));
Tcl_DecrRefCount(messagePtr); /* free msg object appended above */
}
}
@@ -4138,7 +5250,7 @@ Tcl_VarEval TCL_VARARGS_DEF(Tcl_Interp *,arg1)
int
Tcl_GlobalEval(interp, command)
Tcl_Interp *interp; /* Interpreter in which to evaluate command. */
- char *command; /* Command to evaluate. */
+ CONST char *command; /* Command to evaluate. */
{
register Interp *iPtr = (Interp *) interp;
int result;
@@ -4232,7 +5344,8 @@ Tcl_AllowExceptions(interp)
*----------------------------------------------------------------------
*/
-void Tcl_GetVersion(majorV, minorV, patchLevelV, type)
+void
+Tcl_GetVersion(majorV, minorV, patchLevelV, type)
int *majorV;
int *minorV;
int *patchLevelV;
@@ -4252,4 +5365,3 @@ void Tcl_GetVersion(majorV, minorV, patchLevelV, type)
}
}
-
diff --git a/tcl/generic/tclBinary.c b/tcl/generic/tclBinary.c
index 199109637a5..6065d018d5a 100644
--- a/tcl/generic/tclBinary.c
+++ b/tcl/generic/tclBinary.c
@@ -13,9 +13,9 @@
* RCS: @(#) $Id$
*/
-#include <math.h>
#include "tclInt.h"
#include "tclPort.h"
+#include <math.h>
/*
* The following constants are used by GetFormatSpec to indicate various
@@ -26,6 +26,26 @@
#define BINARY_NOCOUNT -2 /* No count was specified in format. */
/*
+ * 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 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
+ * 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 bytes.) - DKF
+ */
+
+#define BINARY_SCAN_MAX_CACHE 260
+
+/*
* Prototypes for local procedures defined in this file:
*/
@@ -36,7 +56,8 @@ static int FormatNumber _ANSI_ARGS_((Tcl_Interp *interp, int type,
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));
+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));
@@ -125,7 +146,7 @@ typedef struct ByteArray {
Tcl_Obj *
Tcl_NewByteArrayObj(bytes, length)
- unsigned char *bytes; /* The array of bytes used to initialize
+ 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. */
@@ -137,7 +158,7 @@ Tcl_NewByteArrayObj(bytes, length)
Tcl_Obj *
Tcl_NewByteArrayObj(bytes, length)
- unsigned char *bytes; /* The array of bytes used to initialize
+ 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. */
@@ -159,8 +180,8 @@ Tcl_NewByteArrayObj(bytes, length)
* TCL_MEM_DEBUG is defined. It is the same as the Tcl_NewByteArrayObj
* above except that it calls Tcl_DbCkalloc directly with the file name
* and line number from its caller. This simplifies debugging since then
- * the checkmem command will report the correct file name and line number
- * when reporting objects that haven't been freed.
+ * 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
* result of calling Tcl_NewByteArrayObj.
@@ -180,11 +201,11 @@ Tcl_NewByteArrayObj(bytes, length)
Tcl_Obj *
Tcl_DbNewByteArrayObj(bytes, length, file, line)
- unsigned char *bytes; /* The array of bytes used to initialize
+ 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. */
- 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 debugging. */
@@ -200,11 +221,11 @@ Tcl_DbNewByteArrayObj(bytes, length, file, line)
Tcl_Obj *
Tcl_DbNewByteArrayObj(bytes, length, file, line)
- unsigned char *bytes; /* The array of bytes used to initialize
+ 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. */
- 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 debugging. */
@@ -234,7 +255,7 @@ Tcl_DbNewByteArrayObj(bytes, length, file, line)
void
Tcl_SetByteArrayObj(objPtr, bytes, length)
Tcl_Obj *objPtr; /* Object to initialize as a ByteArray. */
- unsigned char *bytes; /* The array of bytes to use as the new
+ 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. */
@@ -561,7 +582,7 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
* cursor has visited.*/
char *errorString, *errorValue, *str;
int offset, size, length, index;
- static char *options[] = {
+ static CONST char *options[] = {
"format", "scan", NULL
};
enum options {
@@ -644,6 +665,11 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
size = 4;
goto doNumbers;
}
+ case 'w':
+ case 'W': {
+ size = 8;
+ goto doNumbers;
+ }
case 'f': {
size = sizeof(float);
goto doNumbers;
@@ -924,6 +950,8 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
case 'S':
case 'i':
case 'I':
+ case 'w':
+ case 'W':
case 'd':
case 'f': {
int listc, i;
@@ -996,12 +1024,16 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
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;
}
+ numberCachePtr = &numberCacheHash;
+ Tcl_InitHashTable(numberCachePtr, TCL_ONE_WORD_KEYS);
buffer = Tcl_GetByteArrayFromObj(objv[2], &length);
format = Tcl_GetString(objv[3]);
cursor = buffer;
@@ -1018,6 +1050,9 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
unsigned char *src;
if (arg >= objc) {
+ if (numberCachePtr != NULL) {
+ Tcl_DeleteHashTable(numberCachePtr);
+ }
goto badIndex;
}
if (count == BINARY_ALL) {
@@ -1051,6 +1086,9 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
NULL, valuePtr, TCL_LEAVE_ERR_MSG);
arg++;
if (resultPtr == NULL) {
+ if (numberCachePtr != NULL) {
+ Tcl_DeleteHashTable(numberCachePtr);
+ }
Tcl_DecrRefCount(valuePtr); /* unneeded */
return TCL_ERROR;
}
@@ -1063,6 +1101,9 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
char *dest;
if (arg >= objc) {
+ if (numberCachePtr != NULL) {
+ Tcl_DeleteHashTable(numberCachePtr);
+ }
goto badIndex;
}
if (count == BINARY_ALL) {
@@ -1104,6 +1145,9 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
NULL, valuePtr, TCL_LEAVE_ERR_MSG);
arg++;
if (resultPtr == NULL) {
+ if (numberCachePtr != NULL) {
+ Tcl_DeleteHashTable(numberCachePtr);
+ }
Tcl_DecrRefCount(valuePtr); /* unneeded */
return TCL_ERROR;
}
@@ -1118,6 +1162,9 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
static char hexdigit[] = "0123456789abcdef";
if (arg >= objc) {
+ if (numberCachePtr != NULL) {
+ Tcl_DeleteHashTable(numberCachePtr);
+ }
goto badIndex;
}
if (count == BINARY_ALL) {
@@ -1159,6 +1206,9 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
NULL, valuePtr, TCL_LEAVE_ERR_MSG);
arg++;
if (resultPtr == NULL) {
+ if (numberCachePtr != NULL) {
+ Tcl_DeleteHashTable(numberCachePtr);
+ }
Tcl_DecrRefCount(valuePtr); /* unneeded */
return TCL_ERROR;
}
@@ -1179,6 +1229,11 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
size = 4;
goto scanNumber;
}
+ case 'w':
+ case 'W': {
+ size = 8;
+ goto scanNumber;
+ }
case 'f': {
size = sizeof(float);
goto scanNumber;
@@ -1191,13 +1246,17 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
scanNumber:
if (arg >= objc) {
+ if (numberCachePtr != NULL) {
+ Tcl_DeleteHashTable(numberCachePtr);
+ }
goto badIndex;
}
if (count == BINARY_NOCOUNT) {
if ((length - offset) < size) {
goto done;
}
- valuePtr = ScanNumber(buffer+offset, cmd);
+ valuePtr = ScanNumber(buffer+offset, cmd,
+ &numberCachePtr);
offset += size;
} else {
if (count == BINARY_ALL) {
@@ -1209,7 +1268,8 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
valuePtr = Tcl_NewObj();
src = buffer+offset;
for (i = 0; i < count; i++) {
- elementPtr = ScanNumber(src, cmd);
+ elementPtr = ScanNumber(src, cmd,
+ &numberCachePtr);
src += size;
Tcl_ListObjAppendElement(NULL, valuePtr,
elementPtr);
@@ -1221,6 +1281,9 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
NULL, valuePtr, TCL_LEAVE_ERR_MSG);
arg++;
if (resultPtr == NULL) {
+ if (numberCachePtr != NULL) {
+ Tcl_DeleteHashTable(numberCachePtr);
+ }
Tcl_DecrRefCount(valuePtr); /* unneeded */
return TCL_ERROR;
}
@@ -1251,6 +1314,9 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
}
case '@': {
if (count == BINARY_NOCOUNT) {
+ if (numberCachePtr != NULL) {
+ Tcl_DeleteHashTable(numberCachePtr);
+ }
goto badCount;
}
if ((count == BINARY_ALL) || (count > length)) {
@@ -1261,6 +1327,9 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
break;
}
default: {
+ if (numberCachePtr != NULL) {
+ Tcl_DeleteHashTable(numberCachePtr);
+ }
errorString = str;
goto badfield;
}
@@ -1274,6 +1343,9 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
done:
Tcl_ResetResult(interp);
Tcl_SetLongObj(Tcl_GetObjResult(interp), arg - 4);
+ if (numberCachePtr != NULL) {
+ Tcl_DeleteHashTable(numberCachePtr);
+ }
break;
}
}
@@ -1393,10 +1465,13 @@ FormatNumber(interp, type, src, cursorPtr)
Tcl_Obj *src; /* Number to format. */
unsigned char **cursorPtr; /* Pointer to index into destination buffer. */
{
- int value;
+ long value;
double dvalue;
+ Tcl_WideInt wvalue;
- if ((type == 'd') || (type == 'f')) {
+ switch (type) {
+ case 'd':
+ case 'f':
/*
* For floating point types, we need to copy the data using
* memcpy to avoid alignment issues.
@@ -1425,8 +1500,39 @@ FormatNumber(interp, type, src, cursorPtr)
memcpy((VOID *) *cursorPtr, (VOID *) &fvalue, sizeof(float));
*cursorPtr += sizeof(float);
}
- } else {
- if (Tcl_GetIntFromObj(interp, src, &value) != TCL_OK) {
+ return TCL_OK;
+
+ /*
+ * Next cases separate from other integer cases because we
+ * need a different API to get a wide.
+ */
+ case 'w':
+ case 'W':
+ if (Tcl_GetWideIntFromObj(interp, src, &wvalue) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (type == 'w') {
+ *(*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);
+ } 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;
+ }
+ return TCL_OK;
+ default:
+ if (Tcl_GetLongFromObj(interp, src, &value) != TCL_OK) {
return TCL_ERROR;
}
if (type == 'c') {
@@ -1448,8 +1554,8 @@ FormatNumber(interp, type, src, cursorPtr)
*(*cursorPtr)++ = (unsigned char) (value >> 8);
*(*cursorPtr)++ = (unsigned char) value;
}
+ return TCL_OK;
}
- return TCL_OK;
}
/*
@@ -1465,17 +1571,24 @@ FormatNumber(interp, type, src, cursorPtr)
* This object has a ref count of zero.
*
* Side effects:
- * None.
+ * 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)
+ScanNumber(buffer, type, numberCachePtrPtr)
unsigned char *buffer; /* Buffer to scan number from. */
int type; /* Format character from "binary scan" */
+ Tcl_HashTable **numberCachePtrPtr;
+ /* Place to look for cache of scanned
+ * value objects, or NULL if too many
+ * different numbers have been scanned. */
{
long value;
+ Tcl_WideInt wvalue;
/*
* We cannot rely on the compiler to properly sign extend integer values
@@ -1486,7 +1599,7 @@ ScanNumber(buffer, type)
*/
switch (type) {
- case 'c': {
+ case 'c':
/*
* Characters need special handling. We want to produce a
* signed result, but on some platforms (such as AIX) chars
@@ -1498,28 +1611,26 @@ ScanNumber(buffer, type)
if (value & 0x80) {
value |= -0x100;
}
- return Tcl_NewLongObj((long)value);
- }
- case 's': {
+ goto returnNumericObject;
+
+ case 's':
value = (long) (buffer[0] + (buffer[1] << 8));
goto shortValue;
- }
- case 'S': {
+ case 'S':
value = (long) (buffer[1] + (buffer[0] << 8));
shortValue:
if (value & 0x8000) {
value |= -0x10000;
}
- return Tcl_NewLongObj(value);
- }
- case 'i': {
+ goto returnNumericObject;
+
+ case 'i':
value = (long) (buffer[0]
+ (buffer[1] << 8)
+ (buffer[2] << 16)
+ (buffer[3] << 24));
goto intValue;
- }
- case 'I': {
+ case 'I':
value = (long) (buffer[3]
+ (buffer[2] << 8)
+ (buffer[1] << 16)
@@ -1534,8 +1645,58 @@ ScanNumber(buffer, type)
value -= (((unsigned int)1)<<31);
value -= (((unsigned int)1)<<31);
}
- return Tcl_NewLongObj(value);
- }
+ returnNumericObject:
+ if (*numberCachePtrPtr == NULL) {
+ return Tcl_NewLongObj(value);
+ } else {
+ register Tcl_HashTable *tablePtr = *numberCachePtrPtr;
+ register Tcl_HashEntry *hPtr;
+ int isNew;
+
+ hPtr = Tcl_CreateHashEntry(tablePtr, (char *)value, &isNew);
+ if (!isNew) {
+ return (Tcl_Obj *) 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.
+ */
+ Tcl_DeleteHashTable(tablePtr);
+ *numberCachePtrPtr = NULL;
+ return Tcl_NewLongObj(value);
+ } else {
+ register Tcl_Obj *objPtr = Tcl_NewLongObj(value);
+ /* Don't need to fiddle with refcount... */
+ Tcl_SetHashValue(hPtr, (ClientData) objPtr);
+ return objPtr;
+ }
+ }
+ case 'w':
+ value = (long) (buffer[4]
+ | (buffer[5] << 8)
+ | (buffer[6] << 16)
+ | (buffer[7] << 24));
+ wvalue = ((Tcl_WideInt) value) << 32 | (buffer[0]
+ | (buffer[1] << 8)
+ | (buffer[2] << 16)
+ | (buffer[3] << 24));
+ return Tcl_NewWideIntObj(wvalue);
+ case 'W':
+ value = (long) (buffer[3]
+ | (buffer[2] << 8)
+ | (buffer[1] << 16)
+ | (buffer[0] << 24));
+ wvalue = ((Tcl_WideInt) value) << 32 | (buffer[7]
+ | (buffer[6] << 8)
+ | (buffer[5] << 16)
+ | (buffer[4] << 24));
+ return Tcl_NewWideIntObj(wvalue);
case 'f': {
float fvalue;
memcpy((VOID *) &fvalue, (VOID *) buffer, sizeof(float));
diff --git a/tcl/generic/tclCkalloc.c b/tcl/generic/tclCkalloc.c
index 1eb906d2af8..ff0917972ca 100644
--- a/tcl/generic/tclCkalloc.c
+++ b/tcl/generic/tclCkalloc.c
@@ -54,7 +54,7 @@ struct mem_header {
struct mem_header *blink;
MemTag *tagPtr; /* Tag from "memory tag" command; may be
* NULL. */
- char *file;
+ CONST char *file;
long length;
int line;
unsigned char low_guard[LOW_GUARD_SIZE];
@@ -111,6 +111,7 @@ static int init_malloced_bodies = TRUE;
char *tclMemDumpFileName = NULL;
+static char *onExitMemDumpFileName = NULL;
static char dumpFile[100]; /* Records where to dump memory allocation
* information. */
@@ -127,11 +128,11 @@ static int ckallocInit = 0;
*/
static int CheckmemCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char *argv[]));
+ Tcl_Interp *interp, int argc, CONST char *argv[]));
static int MemoryCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static void ValidateMemory _ANSI_ARGS_((
- struct mem_header *memHeaderP, char *file,
+ struct mem_header *memHeaderP, CONST char *file,
int line, int nukeGuards));
/*
@@ -200,7 +201,7 @@ TclDumpMemoryInfo(outFile)
static void
ValidateMemory(memHeaderP, file, line, nukeGuards)
struct mem_header *memHeaderP; /* Memory chunk to validate */
- char *file; /* File containing the call to
+ CONST char *file; /* File containing the call to
* Tcl_ValidateAllMemory */
int line; /* Line number of call to
* Tcl_ValidateAllMemory */
@@ -280,8 +281,8 @@ ValidateMemory(memHeaderP, file, line, nukeGuards)
*/
void
Tcl_ValidateAllMemory (file, line)
- char *file; /* File from which Tcl_ValidateAllMemory was called */
- int line; /* Line number of call to Tcl_ValidateAllMemory */
+ CONST char *file; /* File from which Tcl_ValidateAllMemory was called */
+ int line; /* Line number of call to Tcl_ValidateAllMemory */
{
struct mem_header *memScanP;
@@ -304,13 +305,13 @@ Tcl_ValidateAllMemory (file, line)
* information will be written to stderr.
*
* Results:
- * Return TCL_ERROR if an error accessing the file occures, `errno'
+ * Return TCL_ERROR if an error accessing the file occurs, `errno'
* will have the file error number left in it.
*----------------------------------------------------------------------
*/
int
Tcl_DumpActiveMemory (fileName)
- char *fileName; /* Name of the file to write info to */
+ CONST char *fileName; /* Name of the file to write info to */
{
FILE *fileP;
struct mem_header *memScanP;
@@ -364,7 +365,7 @@ Tcl_DumpActiveMemory (fileName)
char *
Tcl_DbCkalloc(size, file, line)
unsigned int size;
- char *file;
+ CONST char *file;
int line;
{
struct mem_header *result;
@@ -377,7 +378,7 @@ Tcl_DbCkalloc(size, file, line)
if (result == NULL) {
fflush(stdout);
TclDumpMemoryInfo(stderr);
- panic("unable to alloc %d bytes, %s line %d", size, file, line);
+ panic("unable to alloc %ud bytes, %s line %d", size, file, line);
}
/*
@@ -421,7 +422,7 @@ Tcl_DbCkalloc(size, file, line)
}
if (alloc_tracing)
- fprintf(stderr,"ckalloc %lx %d %s %d\n",
+ fprintf(stderr,"ckalloc %lx %ud %s %d\n",
(long unsigned int) result->body, size, file, line);
if (break_on_malloc && (total_mallocs >= break_on_malloc)) {
@@ -445,6 +446,92 @@ Tcl_DbCkalloc(size, file, line)
return result->body;
}
+
+char *
+Tcl_AttemptDbCkalloc(size, file, line)
+ unsigned int size;
+ CONST char *file;
+ int line;
+{
+ struct mem_header *result;
+
+ if (validate_memory)
+ Tcl_ValidateAllMemory (file, line);
+
+ result = (struct mem_header *) TclpAlloc((unsigned)size +
+ sizeof(struct mem_header) + HIGH_GUARD_SIZE);
+ if (result == NULL) {
+ fflush(stdout);
+ TclDumpMemoryInfo(stderr);
+ return NULL;
+ }
+
+ /*
+ * Fill in guard zones and size. Also initialize the contents of
+ * the block with bogus bytes to detect uses of initialized data.
+ * Link into allocated list.
+ */
+ if (init_malloced_bodies) {
+ memset ((VOID *) result, GUARD_VALUE,
+ size + sizeof(struct mem_header) + HIGH_GUARD_SIZE);
+ } else {
+ memset ((char *) result->low_guard, GUARD_VALUE, LOW_GUARD_SIZE);
+ memset (result->body + size, GUARD_VALUE, HIGH_GUARD_SIZE);
+ }
+ if (!ckallocInit) {
+ TclInitDbCkalloc();
+ }
+ Tcl_MutexLock(ckallocMutexPtr);
+ result->length = size;
+ result->tagPtr = curTagPtr;
+ if (curTagPtr != NULL) {
+ curTagPtr->refCount++;
+ }
+ result->file = file;
+ result->line = line;
+ result->flink = allocHead;
+ result->blink = NULL;
+
+ if (allocHead != NULL)
+ allocHead->blink = result;
+ allocHead = result;
+
+ total_mallocs++;
+ if (trace_on_at_malloc && (total_mallocs >= trace_on_at_malloc)) {
+ (void) fflush(stdout);
+ fprintf(stderr, "reached malloc trace enable point (%d)\n",
+ total_mallocs);
+ fflush(stderr);
+ alloc_tracing = TRUE;
+ trace_on_at_malloc = 0;
+ }
+
+ if (alloc_tracing)
+ fprintf(stderr,"ckalloc %lx %ud %s %d\n",
+ (long unsigned int) result->body, 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();
+ }
+
+ current_malloc_packets++;
+ if (current_malloc_packets > maximum_malloc_packets)
+ maximum_malloc_packets = current_malloc_packets;
+ current_bytes_malloced += size;
+ if (current_bytes_malloced > maximum_bytes_malloced)
+ maximum_bytes_malloced = current_bytes_malloced;
+
+ Tcl_MutexUnlock(ckallocMutexPtr);
+
+ return result->body;
+}
+
/*
*----------------------------------------------------------------------
@@ -467,9 +554,9 @@ Tcl_DbCkalloc(size, file, line)
int
Tcl_DbCkfree(ptr, file, line)
- char *ptr;
- char *file;
- int line;
+ char *ptr;
+ CONST char *file;
+ int line;
{
struct mem_header *memp;
@@ -542,10 +629,10 @@ Tcl_DbCkfree(ptr, file, line)
*/
char *
Tcl_DbCkrealloc(ptr, size, file, line)
- char *ptr;
+ char *ptr;
unsigned int size;
- char *file;
- int line;
+ CONST char *file;
+ int line;
{
char *new;
unsigned int copySize;
@@ -572,6 +659,41 @@ Tcl_DbCkrealloc(ptr, size, file, line)
return new;
}
+char *
+Tcl_AttemptDbCkrealloc(ptr, size, file, line)
+ char *ptr;
+ unsigned int size;
+ CONST char *file;
+ int line;
+{
+ char *new;
+ unsigned int copySize;
+ struct mem_header *memp;
+
+ if (ptr == NULL) {
+ return Tcl_AttemptDbCkalloc(size, file, line);
+ }
+
+ /*
+ * See comment from Tcl_DbCkfree before you change the following
+ * line.
+ */
+
+ memp = (struct mem_header *) (((unsigned long) ptr) - BODY_OFFSET);
+
+ copySize = size;
+ if (copySize > (unsigned int) memp->length) {
+ copySize = memp->length;
+ }
+ new = Tcl_AttemptDbCkalloc(size, file, line);
+ if (new == NULL) {
+ return NULL;
+ }
+ memcpy((VOID *) new, (VOID *) ptr, (size_t) copySize);
+ Tcl_DbCkfree(ptr, file, line);
+ return new;
+}
+
/*
*----------------------------------------------------------------------
@@ -593,6 +715,8 @@ Tcl_DbCkrealloc(ptr, size, file, line)
#undef Tcl_Alloc
#undef Tcl_Free
#undef Tcl_Realloc
+#undef Tcl_AttemptAlloc
+#undef Tcl_AttemptRealloc
char *
Tcl_Alloc(size)
@@ -601,6 +725,13 @@ Tcl_Alloc(size)
return Tcl_DbCkalloc(size, "unknown", 0);
}
+char *
+Tcl_AttemptAlloc(size)
+ unsigned int size;
+{
+ return Tcl_AttemptDbCkalloc(size, "unknown", 0);
+}
+
void
Tcl_Free(ptr)
char *ptr;
@@ -615,6 +746,13 @@ Tcl_Realloc(ptr, size)
{
return Tcl_DbCkrealloc(ptr, size, "unknown", 0);
}
+char *
+Tcl_AttemptRealloc(ptr, size)
+ char *ptr;
+ unsigned int size;
+{
+ return Tcl_AttemptDbCkrealloc(ptr, size, "unknown", 0);
+}
/*
*----------------------------------------------------------------------
@@ -622,11 +760,14 @@ Tcl_Realloc(ptr, size)
* MemoryCmd --
* Implements the Tcl "memory" command, which provides Tcl-level
* control of Tcl memory debugging information.
+ * memory active $file
+ * memory break_on_malloc $count
* memory info
- * memory display
- * memory break_on_malloc count
- * memory trace_on_at_malloc count
+ * memory init on|off
+ * memory onexit $file
+ * memory tag $string
* memory trace on|off
+ * memory trace_on_at_malloc $count
* memory validate on|off
*
* Results:
@@ -640,9 +781,9 @@ MemoryCmd (clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
- char **argv;
+ CONST char **argv;
{
- char *fileName;
+ CONST char *fileName;
Tcl_DString buffer;
int result;
@@ -652,10 +793,10 @@ MemoryCmd (clientData, interp, argc, argv)
return TCL_ERROR;
}
- if (strcmp(argv[1],"active") == 0) {
+ if ((strcmp(argv[1],"active") == 0) || (strcmp(argv[1],"display") == 0)) {
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " active file\"", (char *) NULL);
+ argv[0], " ", argv[1], " file\"", (char *) NULL);
return TCL_ERROR;
}
fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
@@ -681,14 +822,14 @@ MemoryCmd (clientData, interp, argc, argv)
return TCL_OK;
}
if (strcmp(argv[1],"info") == 0) {
- char buffer[400];
- sprintf(buffer, "%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n",
+ char buf[400];
+ sprintf(buf, "%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n",
"total mallocs", total_mallocs, "total frees", total_frees,
"current packets allocated", current_malloc_packets,
"current bytes allocated", current_bytes_malloced,
"maximum packets allocated", maximum_malloc_packets,
"maximum bytes allocated", maximum_bytes_malloced);
- Tcl_SetResult(interp, buffer, TCL_VOLATILE);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
return TCL_OK;
}
if (strcmp(argv[1],"init") == 0) {
@@ -698,6 +839,21 @@ MemoryCmd (clientData, interp, argc, argv)
init_malloced_bodies = (strcmp(argv[2],"on") == 0);
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);
+ return TCL_ERROR;
+ }
+ fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
+ if (fileName == NULL) {
+ return TCL_ERROR;
+ }
+ onExitMemDumpFileName = dumpFile;
+ strcpy(onExitMemDumpFileName,fileName);
+ Tcl_DStringFree(&buffer);
+ return TCL_OK;
+ }
if (strcmp(argv[1],"tag") == 0) {
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
@@ -738,7 +894,7 @@ MemoryCmd (clientData, interp, argc, argv)
}
Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": should be active, break_on_malloc, info, init, ",
+ "\": should be active, break_on_malloc, info, init, onexit, ",
"tag, trace, trace_on_at_malloc, or validate", (char *) NULL);
return TCL_ERROR;
@@ -777,7 +933,7 @@ CheckmemCmd(clientData, interp, argc, argv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Interpreter for evaluation. */
int argc; /* Number of arguments. */
- char *argv[]; /* String values of arguments. */
+ CONST char *argv[]; /* String values of arguments. */
{
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
@@ -854,7 +1010,7 @@ Tcl_Alloc (size)
* a special pointer on failure, but we only check for NULL
*/
if ((result == NULL) && size) {
- panic("unable to alloc %d bytes", size);
+ panic("unable to alloc %ud bytes", size);
}
return result;
}
@@ -862,7 +1018,7 @@ Tcl_Alloc (size)
char *
Tcl_DbCkalloc(size, file, line)
unsigned int size;
- char *file;
+ CONST char *file;
int line;
{
char *result;
@@ -871,10 +1027,42 @@ Tcl_DbCkalloc(size, file, line)
if ((result == NULL) && size) {
fflush(stdout);
- panic("unable to alloc %d bytes, %s line %d", size, file, line);
+ panic("unable to alloc %ud bytes, %s line %d", size, file, line);
}
return result;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AttemptAlloc --
+ * Interface to TclpAlloc when TCL_MEM_DEBUG is disabled. It does not
+ * check that memory was actually allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_AttemptAlloc (size)
+ unsigned int size;
+{
+ char *result;
+
+ result = TclpAlloc(size);
+ return result;
+}
+
+char *
+Tcl_AttemptDbCkalloc(size, file, line)
+ unsigned int size;
+ CONST char *file;
+ int line;
+{
+ char *result;
+
+ result = (char *) TclpAlloc(size);
+ return result;
+}
/*
@@ -897,17 +1085,17 @@ Tcl_Realloc(ptr, size)
result = TclpRealloc(ptr, size);
if ((result == NULL) && size) {
- panic("unable to realloc %d bytes", size);
+ panic("unable to realloc %ud bytes", size);
}
return result;
}
char *
Tcl_DbCkrealloc(ptr, size, file, line)
- char *ptr;
+ char *ptr;
unsigned int size;
- char *file;
- int line;
+ CONST char *file;
+ int line;
{
char *result;
@@ -915,7 +1103,7 @@ Tcl_DbCkrealloc(ptr, size, file, line)
if ((result == NULL) && size) {
fflush(stdout);
- panic("unable to realloc %d bytes, %s line %d", size, file, line);
+ panic("unable to realloc %ud bytes, %s line %d", size, file, line);
}
return result;
}
@@ -923,6 +1111,40 @@ Tcl_DbCkrealloc(ptr, size, file, line)
/*
*----------------------------------------------------------------------
*
+ * Tcl_AttemptRealloc --
+ * Interface to TclpRealloc when TCL_MEM_DEBUG is disabled. It does
+ * not check that memory was actually allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_AttemptRealloc(ptr, size)
+ char *ptr;
+ unsigned int size;
+{
+ char *result;
+
+ result = TclpRealloc(ptr, size);
+ return result;
+}
+
+char *
+Tcl_AttemptDbCkrealloc(ptr, size, file, line)
+ char *ptr;
+ unsigned int size;
+ CONST char *file;
+ int line;
+{
+ char *result;
+
+ result = (char *) TclpRealloc(ptr, size);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_Free --
* Interface to TclpFree when TCL_MEM_DEBUG is disabled. Done here
* rather in the macro to keep some modules from being compiled with
@@ -940,9 +1162,9 @@ Tcl_Free (ptr)
int
Tcl_DbCkfree(ptr, file, line)
- char *ptr;
- char *file;
- int line;
+ char *ptr;
+ CONST char *file;
+ int line;
{
TclpFree(ptr);
return 0;
@@ -966,15 +1188,15 @@ Tcl_InitMemory(interp)
int
Tcl_DumpActiveMemory(fileName)
- char *fileName;
+ CONST char *fileName;
{
return TCL_OK;
}
void
Tcl_ValidateAllMemory(file, line)
- char *file;
- int line;
+ CONST char *file;
+ int line;
{
}
@@ -1010,12 +1232,15 @@ void
TclFinalizeMemorySubsystem()
{
#ifdef TCL_MEM_DEBUG
- Tcl_MutexLock(ckallocMutexPtr);
if (tclMemDumpFileName != NULL) {
Tcl_DumpActiveMemory(tclMemDumpFileName);
+ } else if (onExitMemDumpFileName != NULL) {
+ Tcl_DumpActiveMemory(onExitMemDumpFileName);
}
+ Tcl_MutexLock(ckallocMutexPtr);
if (curTagPtr != NULL) {
TclpFree((char *) curTagPtr);
+ curTagPtr = NULL;
}
allocHead = NULL;
Tcl_MutexUnlock(ckallocMutexPtr);
@@ -1025,4 +1250,3 @@ TclFinalizeMemorySubsystem()
TclFinalizeAllocSubsystem();
#endif
}
-
diff --git a/tcl/generic/tclClock.c b/tcl/generic/tclClock.c
index ed79949feaa..f68ca6a26a5 100644
--- a/tcl/generic/tclClock.c
+++ b/tcl/generic/tclClock.c
@@ -67,13 +67,13 @@ Tcl_ClockObjCmd (client, interp, objc, objv)
Tcl_Obj *baseObjPtr = NULL;
char *scanStr;
- static char *switches[] =
+ static CONST char *switches[] =
{"clicks", "format", "scan", "seconds", (char *) NULL};
enum command { COMMAND_CLICKS, COMMAND_FORMAT, COMMAND_SCAN,
COMMAND_SECONDS
};
- static char *formatSwitches[] = {"-format", "-gmt", (char *) NULL};
- static char *scanSwitches[] = {"-base", "-gmt", (char *) NULL};
+ static CONST char *formatSwitches[] = {"-format", "-gmt", (char *) NULL};
+ static CONST char *scanSwitches[] = {"-base", "-gmt", (char *) NULL};
resultPtr = Tcl_GetObjResult(interp);
if (objc < 2) {
@@ -109,7 +109,7 @@ Tcl_ClockObjCmd (client, interp, objc, objv)
* We can enforce at least millisecond granularity
*/
Tcl_Time time;
- TclpGetTime(&time);
+ Tcl_GetTime(&time);
Tcl_SetLongObj(resultPtr,
(long) (time.sec*1000 + time.usec/1000));
} else {
@@ -289,7 +289,7 @@ FormatClock(interp, clockVal, useGMT, format)
return TCL_OK;
}
-#ifndef HAVE_TM_ZONE
+#if !defined(HAVE_TM_ZONE) && !defined(WIN32)
/*
* This is a kludge for systems not having the timezone string in
* struct tm. No matter what was specified, they use the local
@@ -297,7 +297,7 @@ FormatClock(interp, clockVal, useGMT, format)
*/
if (useGMT) {
- char *varValue;
+ CONST char *varValue;
varValue = Tcl_GetVar2(interp, "env", "TZ", TCL_GLOBAL_ONLY);
if (varValue != NULL) {
@@ -327,15 +327,18 @@ FormatClock(interp, clockVal, useGMT, format)
bufSize++;
}
}
+ Tcl_DStringInit(&uniBuffer);
+ Tcl_UtfToExternalDString(NULL, format, -1, &uniBuffer);
Tcl_DStringInit(&buffer);
Tcl_DStringSetLength(&buffer, bufSize);
Tcl_MutexLock(&clockMutex);
- result = TclpStrftime(buffer.string, (unsigned int) bufSize, format,
- timeDataPtr);
+ result = TclpStrftime(buffer.string, (unsigned int) bufSize,
+ Tcl_DStringValue(&uniBuffer), timeDataPtr, useGMT);
Tcl_MutexUnlock(&clockMutex);
+ Tcl_DStringFree(&uniBuffer);
-#ifndef HAVE_TM_ZONE
+#if !defined(HAVE_TM_ZONE) && !defined(WIN32)
if (useGMT) {
if (savedTZEnv != NULL) {
Tcl_SetVar2(interp, "env", "TZ", savedTZEnv, TCL_GLOBAL_ONLY);
@@ -361,8 +364,7 @@ FormatClock(interp, clockVal, useGMT, format)
}
/*
- * Convert the time to external encoding, in case we asked for
- * a localized return value. [Bug: 3345]
+ * Convert the time to UTF from external encoding [Bug: 3345]
*/
Tcl_DStringInit(&uniBuffer);
Tcl_ExternalToUtfDString(NULL, buffer.string, -1, &uniBuffer);
@@ -374,4 +376,3 @@ FormatClock(interp, clockVal, useGMT, format)
return TCL_OK;
}
-
diff --git a/tcl/generic/tclCmdAH.c b/tcl/generic/tclCmdAH.c
index 7788917ef99..e82dee2b03c 100644
--- a/tcl/generic/tclCmdAH.c
+++ b/tcl/generic/tclCmdAH.c
@@ -18,8 +18,6 @@
#include "tclPort.h"
#include <locale.h>
-typedef int (StatProc)_ANSI_ARGS_((CONST char *path, struct stat *buf));
-
/*
* Prototypes for local procedures defined in this file:
*/
@@ -27,15 +25,11 @@ typedef int (StatProc)_ANSI_ARGS_((CONST char *path, struct stat *buf));
static int CheckAccess _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Obj *objPtr, int mode));
static int GetStatBuf _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr, StatProc *statProc,
- struct stat *statPtr));
+ Tcl_Obj *objPtr, Tcl_FSStatProc *statProc,
+ Tcl_StatBuf *statPtr));
static char * GetTypeFromMode _ANSI_ARGS_((int mode));
-static int SplitPath _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr, int *argcPtr, char ***argvPtr));
static int StoreStatData _ANSI_ARGS_((Tcl_Interp *interp,
- char *varName, struct stat *statPtr));
-static char ** StringifyObjects _ANSI_ARGS_((int objc,
- Tcl_Obj *CONST objv[]));
+ char *varName, Tcl_StatBuf *statPtr));
/*
*----------------------------------------------------------------------
@@ -99,9 +93,8 @@ Tcl_CaseObjCmd(dummy, interp, objc, objv)
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
register int i;
- int body, result;
+ int body, result, caseObjc;
char *string, *arg;
- int caseObjc;
Tcl_Obj *CONST *caseObjv;
Tcl_Obj *armPtr;
@@ -137,7 +130,7 @@ Tcl_CaseObjCmd(dummy, interp, objc, objv)
for (i = 0; i < caseObjc; i += 2) {
int patObjc, j;
- char **patObjv;
+ CONST char **patObjv;
char *pat;
unsigned char *p;
@@ -307,8 +300,7 @@ Tcl_CdObjCmd(dummy, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- char *dirName;
- Tcl_DString ds;
+ Tcl_Obj *dir;
int result;
if (objc > 2) {
@@ -317,23 +309,25 @@ Tcl_CdObjCmd(dummy, interp, objc, objv)
}
if (objc == 2) {
- dirName = Tcl_GetString(objv[1]);
+ dir = objv[1];
} else {
- dirName = "~";
+ dir = Tcl_NewStringObj("~",1);
+ Tcl_IncrRefCount(dir);
}
- if (Tcl_TranslateFileName(interp, dirName, &ds) == NULL) {
- return TCL_ERROR;
+ if (Tcl_FSConvertToPathType(interp, dir) != TCL_OK) {
+ result = TCL_ERROR;
+ } else {
+ result = Tcl_FSChdir(dir);
+ if (result != TCL_OK) {
+ Tcl_AppendResult(interp, "couldn't change working directory to \"",
+ Tcl_GetString(dir), "\": ", Tcl_PosixError(interp), (char *) NULL);
+ result = TCL_ERROR;
+ }
}
-
- result = Tcl_Chdir(Tcl_DStringValue(&ds));
- Tcl_DStringFree(&ds);
-
- if (result != 0) {
- Tcl_AppendResult(interp, "couldn't change working directory to \"",
- dirName, "\": ", Tcl_PosixError(interp), (char *) NULL);
- return TCL_ERROR;
+ if (objc != 2) {
+ Tcl_DecrRefCount(dir);
}
- return TCL_OK;
+ return result;
}
/*
@@ -432,7 +426,7 @@ Tcl_EncodingObjCmd(dummy, interp, objc, objv)
Tcl_DString ds;
Tcl_Obj *resultPtr;
- static char *optionStrings[] = {
+ static CONST char *optionStrings[] = {
"convertfrom", "convertto", "names", "system",
NULL
};
@@ -517,7 +511,8 @@ Tcl_EncodingObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
if (objc == 2) {
- Tcl_SetResult(interp, Tcl_GetEncodingName(NULL), TCL_STATIC);
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ Tcl_GetEncodingName(NULL), -1);
} else {
return Tcl_SetSystemEncoding(interp,
Tcl_GetStringFromObj(objv[2], NULL));
@@ -729,6 +724,7 @@ Tcl_ExprObjCmd(dummy, interp, objc, objv)
* Create a new object holding the concatenated argument strings.
*/
+ /*** QUESTION: Do we need to copy the slow way? ***/
bytes = Tcl_GetStringFromObj(objv[1], &length);
objPtr = Tcl_NewStringObj(bytes, length);
Tcl_IncrRefCount(objPtr);
@@ -765,7 +761,9 @@ Tcl_ExprObjCmd(dummy, interp, objc, objv)
* See the user documentation for details on what it does.
* PLEASE NOTE THAT THIS FAILS WITH FILENAMES AND PATHS WITH
* EMBEDDED NULLS, WHICH COULD THEORETICALLY HAPPEN ON A MAC.
- *
+ * 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.
*
@@ -783,21 +781,22 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- Tcl_Obj *resultPtr;
int index;
/*
* This list of constants should match the fileOption string array below.
*/
- static char *fileOptions[] = {
+ static CONST char *fileOptions[] = {
"atime", "attributes", "channels", "copy",
"delete",
"dirname", "executable", "exists", "extension",
- "isdirectory", "isfile", "join", "lstat",
- "mtime", "mkdir", "nativename", "owned",
+ "isdirectory", "isfile", "join", "link",
+ "lstat", "mtime", "mkdir", "nativename",
+ "normalize", "owned",
"pathtype", "readable", "readlink", "rename",
- "rootname", "size", "split", "stat",
+ "rootname", "separator", "size", "split",
+ "stat", "system",
"tail", "type", "volumes", "writable",
(char *) NULL
};
@@ -805,10 +804,12 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
FILE_ATIME, FILE_ATTRIBUTES, FILE_CHANNELS, FILE_COPY,
FILE_DELETE,
FILE_DIRNAME, FILE_EXECUTABLE, FILE_EXISTS, FILE_EXTENSION,
- FILE_ISDIRECTORY, FILE_ISFILE, FILE_JOIN, FILE_LSTAT,
- FILE_MTIME, FILE_MKDIR, FILE_NATIVENAME, FILE_OWNED,
+ FILE_ISDIRECTORY, FILE_ISFILE, FILE_JOIN, FILE_LINK,
+ FILE_LSTAT, FILE_MTIME, FILE_MKDIR, FILE_NATIVENAME,
+ FILE_NORMALIZE, FILE_OWNED,
FILE_PATHTYPE, FILE_READABLE, FILE_READLINK, FILE_RENAME,
- FILE_ROOTNAME, FILE_SIZE, FILE_SPLIT, FILE_STAT,
+ FILE_ROOTNAME, FILE_SEPARATOR, FILE_SIZE, FILE_SPLIT,
+ FILE_STAT, FILE_SYSTEM,
FILE_TAIL, FILE_TYPE, FILE_VOLUMES, FILE_WRITABLE
};
@@ -821,18 +822,16 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
- resultPtr = Tcl_GetObjResult(interp);
switch ((enum options) index) {
case FILE_ATIME: {
- struct stat buf;
- char *fileName;
+ Tcl_StatBuf buf;
struct utimbuf tval;
if ((objc < 3) || (objc > 4)) {
Tcl_WrongNumArgs(interp, 2, objv, "name ?time?");
return TCL_ERROR;
}
- if (GetStatBuf(interp, objv[2], TclStat, &buf) != TCL_OK) {
+ if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
return TCL_ERROR;
}
if (objc == 4) {
@@ -842,11 +841,10 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
}
tval.actime = buf.st_atime;
tval.modtime = buf.st_mtime;
- fileName = Tcl_GetString(objv[2]);
- if (utime(fileName, &tval) != 0) {
- Tcl_AppendStringsToObj(resultPtr,
+ if (Tcl_FSUtime(objv[2], &tval) != 0) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"could not set access time for file \"",
- fileName, "\": ",
+ Tcl_GetString(objv[2]), "\": ",
Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
@@ -856,11 +854,11 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
* one we sent in. However, fs's like FAT don't
* even know what atime is.
*/
- if (GetStatBuf(interp, objv[2], TclStat, &buf) != TCL_OK) {
+ if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
return TCL_ERROR;
}
}
- Tcl_SetLongObj(resultPtr, (long) buf.st_atime);
+ Tcl_SetLongObj(Tcl_GetObjResult(interp), (long) buf.st_atime);
return TCL_OK;
}
case FILE_ATTRIBUTES: {
@@ -875,57 +873,24 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
((objc == 2) ? NULL : Tcl_GetString(objv[2])));
}
case FILE_COPY: {
- int result;
- char **argv;
-
- argv = StringifyObjects(objc, objv);
- result = TclFileCopyCmd(interp, objc, argv);
- ckfree((char *) argv);
- return result;
+ return TclFileCopyCmd(interp, objc, objv);
}
case FILE_DELETE: {
- int result;
- char **argv;
-
- argv = StringifyObjects(objc, objv);
- result = TclFileDeleteCmd(interp, objc, argv);
- ckfree((char *) argv);
- return result;
+ return TclFileDeleteCmd(interp, objc, objv);
}
case FILE_DIRNAME: {
- int argc;
- char **argv;
-
+ Tcl_Obj *dirPtr;
if (objc != 3) {
goto only3Args;
}
- if (SplitPath(interp, objv[2], &argc, &argv) != TCL_OK) {
- return TCL_ERROR;
- }
-
- /*
- * Return all but the last component. If there is only one
- * component, return it if the path was non-relative, otherwise
- * return the current directory.
- */
-
- if (argc > 1) {
- Tcl_DString ds;
-
- Tcl_DStringInit(&ds);
- Tcl_JoinPath(argc - 1, argv, &ds);
- Tcl_SetStringObj(resultPtr, Tcl_DStringValue(&ds),
- Tcl_DStringLength(&ds));
- Tcl_DStringFree(&ds);
- } else if ((argc == 0)
- || (Tcl_GetPathType(argv[0]) == TCL_PATH_RELATIVE)) {
- Tcl_SetStringObj(resultPtr,
- ((tclPlatform == TCL_PLATFORM_MAC) ? ":" : "."), 1);
+ dirPtr = TclFileDirname(interp, objv[2]);
+ if (dirPtr == NULL) {
+ return TCL_ERROR;
} else {
- Tcl_SetStringObj(resultPtr, argv[0], -1);
+ Tcl_SetObjResult(interp, dirPtr);
+ Tcl_DecrRefCount(dirPtr);
+ return TCL_OK;
}
- ckfree((char *) argv);
- return TCL_OK;
}
case FILE_EXECUTABLE: {
if (objc != 3) {
@@ -947,79 +912,162 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
fileName = Tcl_GetString(objv[2]);
extension = TclGetExtension(fileName);
if (extension != NULL) {
- Tcl_SetStringObj(resultPtr, extension, -1);
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), extension, -1);
}
return TCL_OK;
}
case FILE_ISDIRECTORY: {
int value;
- struct stat buf;
+ Tcl_StatBuf buf;
if (objc != 3) {
goto only3Args;
}
value = 0;
- if (GetStatBuf(NULL, objv[2], TclStat, &buf) == TCL_OK) {
+ if (GetStatBuf(NULL, objv[2], Tcl_FSStat, &buf) == TCL_OK) {
value = S_ISDIR(buf.st_mode);
}
- Tcl_SetBooleanObj(resultPtr, value);
+ Tcl_SetBooleanObj(Tcl_GetObjResult(interp), value);
return TCL_OK;
}
case FILE_ISFILE: {
int value;
- struct stat buf;
+ Tcl_StatBuf buf;
if (objc != 3) {
goto only3Args;
}
value = 0;
- if (GetStatBuf(NULL, objv[2], TclStat, &buf) == TCL_OK) {
+ if (GetStatBuf(NULL, objv[2], Tcl_FSStat, &buf) == TCL_OK) {
value = S_ISREG(buf.st_mode);
}
- Tcl_SetBooleanObj(resultPtr, value);
+ Tcl_SetBooleanObj(Tcl_GetObjResult(interp), value);
return TCL_OK;
}
case FILE_JOIN: {
- char **argv;
- Tcl_DString ds;
+ Tcl_Obj *resObj;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 2, objv, "name ?name ...?");
return TCL_ERROR;
}
- argv = StringifyObjects(objc - 2, objv + 2);
- Tcl_DStringInit(&ds);
- Tcl_JoinPath(objc - 2, argv, &ds);
- Tcl_SetStringObj(resultPtr, Tcl_DStringValue(&ds),
- Tcl_DStringLength(&ds));
- Tcl_DStringFree(&ds);
- ckfree((char *) argv);
+ resObj = Tcl_FSJoinToPath(NULL, objc - 2, objv + 2);
+ Tcl_SetObjResult(interp, resObj);
+ return TCL_OK;
+ }
+ case FILE_LINK: {
+ Tcl_Obj *contents;
+ int index;
+
+ if (objc < 3 || objc > 5) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "?-linktype? linkname ?target?");
+ return TCL_ERROR;
+ }
+
+ /* Index of the 'source' argument */
+ if (objc == 5) {
+ index = 3;
+ } else {
+ index = 2;
+ }
+
+ 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;
+ }
+ /* Create link from source to target */
+ contents = Tcl_FSLink(objv[index], objv[index+1], linkAction);
+ if (contents == NULL) {
+ /*
+ * We handle two 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 \"",
+ Tcl_GetString(objv[index]),
+ "\": that path already exists", (char *) NULL);
+ } else if (errno == ENOENT) {
+ Tcl_AppendResult(interp, "could not create new link \"",
+ Tcl_GetString(objv[index]),
+ "\" since target \"",
+ Tcl_GetString(objv[index+1]),
+ "\" doesn't exist",
+ (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp, "could not create new link \"",
+ Tcl_GetString(objv[index]), "\" pointing to \"",
+ Tcl_GetString(objv[index+1]), "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
+ }
+ 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_AppendResult(interp, "could not read link \"",
+ Tcl_GetString(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.
+ */
+ Tcl_DecrRefCount(contents);
+ }
return TCL_OK;
}
case FILE_LSTAT: {
char *varName;
- struct stat buf;
+ Tcl_StatBuf buf;
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "name varName");
return TCL_ERROR;
}
- if (GetStatBuf(interp, objv[2], TclpLstat, &buf) != TCL_OK) {
+ if (GetStatBuf(interp, objv[2], Tcl_FSLstat, &buf) != TCL_OK) {
return TCL_ERROR;
}
varName = Tcl_GetString(objv[3]);
return StoreStatData(interp, varName, &buf);
}
case FILE_MTIME: {
- struct stat buf;
- char *fileName;
+ Tcl_StatBuf buf;
struct utimbuf tval;
if ((objc < 3) || (objc > 4)) {
Tcl_WrongNumArgs(interp, 2, objv, "name ?time?");
return TCL_ERROR;
}
- if (GetStatBuf(interp, objv[2], TclStat, &buf) != TCL_OK) {
+ if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
return TCL_ERROR;
}
if (objc == 4) {
@@ -1029,11 +1077,10 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
}
tval.actime = buf.st_atime;
tval.modtime = buf.st_mtime;
- fileName = Tcl_GetString(objv[2]);
- if (utime(fileName, &tval) != 0) {
- Tcl_AppendStringsToObj(resultPtr,
+ if (Tcl_FSUtime(objv[2], &tval) != 0) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"could not set modification time for file \"",
- fileName, "\": ",
+ Tcl_GetString(objv[2]), "\": ",
Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
@@ -1043,28 +1090,22 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
* one we sent in. However, fs's like FAT don't
* even know what atime is.
*/
- if (GetStatBuf(interp, objv[2], TclStat, &buf) != TCL_OK) {
+ if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
return TCL_ERROR;
}
}
- Tcl_SetLongObj(resultPtr, (long) buf.st_mtime);
+ Tcl_SetLongObj(Tcl_GetObjResult(interp), (long) buf.st_mtime);
return TCL_OK;
}
case FILE_MKDIR: {
- char **argv;
- int result;
-
if (objc < 3) {
Tcl_WrongNumArgs(interp, 2, objv, "name ?name ...?");
return TCL_ERROR;
}
- argv = StringifyObjects(objc, objv);
- result = TclFileMakeDirsCmd(interp, objc, argv);
- ckfree((char *) argv);
- return result;
+ return TclFileMakeDirsCmd(interp, objc, objv);
}
case FILE_NATIVENAME: {
- char *fileName;
+ CONST char *fileName;
Tcl_DString ds;
if (objc != 3) {
@@ -1075,19 +1116,32 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
if (fileName == NULL) {
return TCL_ERROR;
}
- Tcl_SetStringObj(resultPtr, fileName, Tcl_DStringLength(&ds));
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), fileName,
+ Tcl_DStringLength(&ds));
Tcl_DStringFree(&ds);
return TCL_OK;
}
+ case FILE_NORMALIZE: {
+ Tcl_Obj *fileName;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "filename");
+ return TCL_ERROR;
+ }
+
+ fileName = Tcl_FSGetNormalizedPath(interp, objv[2]);
+ Tcl_SetObjResult(interp, fileName);
+ return TCL_OK;
+ }
case FILE_OWNED: {
int value;
- struct stat buf;
+ Tcl_StatBuf buf;
if (objc != 3) {
goto only3Args;
}
value = 0;
- if (GetStatBuf(NULL, objv[2], TclStat, &buf) == TCL_OK) {
+ if (GetStatBuf(NULL, objv[2], Tcl_FSStat, &buf) == TCL_OK) {
/*
* For Windows and Macintosh, there are no user ids
* associated with a file, so we always return 1.
@@ -1099,25 +1153,23 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
value = (geteuid() == buf.st_uid);
#endif
}
- Tcl_SetBooleanObj(resultPtr, value);
+ Tcl_SetBooleanObj(Tcl_GetObjResult(interp), value);
return TCL_OK;
}
case FILE_PATHTYPE: {
- char *fileName;
-
if (objc != 3) {
goto only3Args;
}
- fileName = Tcl_GetString(objv[2]);
- switch (Tcl_GetPathType(fileName)) {
+ switch (Tcl_FSGetPathType(objv[2])) {
case TCL_PATH_ABSOLUTE:
- Tcl_SetStringObj(resultPtr, "absolute", -1);
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), "absolute", -1);
break;
case TCL_PATH_RELATIVE:
- Tcl_SetStringObj(resultPtr, "relative", -1);
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), "relative", -1);
break;
case TCL_PATH_VOLUME_RELATIVE:
- Tcl_SetStringObj(resultPtr, "volumerelative", -1);
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ "volumerelative", -1);
break;
}
return TCL_OK;
@@ -1129,52 +1181,30 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
return CheckAccess(interp, objv[2], R_OK);
}
case FILE_READLINK: {
- char *fileName, *contents;
- Tcl_DString name, link;
+ Tcl_Obj *contents;
if (objc != 3) {
goto only3Args;
}
- fileName = Tcl_GetString(objv[2]);
- fileName = Tcl_TranslateFileName(interp, fileName, &name);
- if (fileName == NULL) {
+ if (Tcl_FSConvertToPathType(interp, objv[2]) != TCL_OK) {
return TCL_ERROR;
}
- /*
- * 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.
- */
-
-#ifndef S_IFLNK
- contents = NULL;
- errno = EINVAL;
-#else
- contents = TclpReadlink(fileName, &link);
-#endif /* S_IFLNK */
+ contents = Tcl_FSLink(objv[2], NULL, 0);
- Tcl_DStringFree(&name);
if (contents == NULL) {
Tcl_AppendResult(interp, "could not readlink \"",
Tcl_GetString(objv[2]), "\": ",
Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
- Tcl_DStringResult(interp, &link);
+ Tcl_SetObjResult(interp, contents);
+ Tcl_DecrRefCount(contents);
return TCL_OK;
}
case FILE_RENAME: {
- int result;
- char **argv;
-
- argv = StringifyObjects(objc, objv);
- result = TclFileRenameCmd(interp, objc, argv);
- ckfree((char *) argv);
- return result;
+ return TclFileRenameCmd(interp, objc, objv);
}
case FILE_ROOTNAME: {
int length;
@@ -1188,64 +1218,113 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
if (extension == NULL) {
Tcl_SetObjResult(interp, objv[2]);
} else {
- Tcl_SetStringObj(resultPtr, fileName,
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), fileName,
(int) (length - strlen(extension)));
}
return TCL_OK;
}
+ case FILE_SEPARATOR: {
+ if ((objc < 2) || (objc > 3)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?name?");
+ return TCL_ERROR;
+ }
+ if (objc == 2) {
+ char *separator = NULL; /* lint */
+ switch (tclPlatform) {
+ case TCL_PLATFORM_UNIX:
+ separator = "/";
+ break;
+ case TCL_PLATFORM_WINDOWS:
+ separator = "\\";
+ break;
+ case TCL_PLATFORM_MAC:
+ 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 FILE_SIZE: {
- struct stat buf;
+ Tcl_StatBuf buf;
if (objc != 3) {
goto only3Args;
}
- if (GetStatBuf(interp, objv[2], TclStat, &buf) != TCL_OK) {
+ if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
return TCL_ERROR;
}
- Tcl_SetLongObj(resultPtr, (long) buf.st_size);
+ Tcl_SetWideIntObj(Tcl_GetObjResult(interp),
+ (Tcl_WideInt) buf.st_size);
return TCL_OK;
}
case FILE_SPLIT: {
- int i, argc;
- char **argv;
- char *fileName;
- Tcl_Obj *objPtr;
-
if (objc != 3) {
goto only3Args;
}
- fileName = Tcl_GetString(objv[2]);
- Tcl_SplitPath(fileName, &argc, &argv);
- for (i = 0; i < argc; i++) {
- objPtr = Tcl_NewStringObj(argv[i], -1);
- Tcl_ListObjAppendElement(NULL, resultPtr, objPtr);
- }
- ckfree((char *) argv);
+ Tcl_SetObjResult(interp, Tcl_FSSplitPath(objv[2], NULL));
return TCL_OK;
}
case FILE_STAT: {
char *varName;
- struct stat buf;
+ Tcl_StatBuf buf;
if (objc != 4) {
Tcl_WrongNumArgs(interp, 1, objv, "stat name varName");
return TCL_ERROR;
}
- if (GetStatBuf(interp, objv[2], TclStat, &buf) != TCL_OK) {
+ if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
return TCL_ERROR;
}
varName = Tcl_GetString(objv[3]);
return StoreStatData(interp, varName, &buf);
}
+ case FILE_SYSTEM: {
+ Tcl_Obj* fsInfo;
+ 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;
+ }
+ }
case FILE_TAIL: {
- int argc;
- char **argv;
+ int splitElements;
+ Tcl_Obj *splitPtr;
if (objc != 3) {
goto only3Args;
}
- if (SplitPath(interp, objv[2], &argc, &argv) != TCL_OK) {
- return TCL_ERROR;
+ /*
+ * The behaviour we want here is slightly different to
+ * the standard Tcl_FSSplitPath in the handling of home
+ * directories; Tcl_FSSplitPath preserves the "~" while
+ * this code computes the actual full path name, if we
+ * had just a single component.
+ */
+ splitPtr = Tcl_FSSplitPath(objv[2], &splitElements);
+ if ((splitElements == 1) && (Tcl_GetString(objv[2])[0] == '~')) {
+ Tcl_DecrRefCount(splitPtr);
+ splitPtr = Tcl_FSGetNormalizedPath(interp, objv[2]);
+ if (splitPtr == NULL) {
+ return TCL_ERROR;
+ }
+ splitPtr = Tcl_FSSplitPath(splitPtr, &splitElements);
}
/*
@@ -1253,25 +1332,28 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
* and it is the root of an absolute path.
*/
- if (argc > 0) {
- if ((argc > 1)
- || (Tcl_GetPathType(argv[0]) == TCL_PATH_RELATIVE)) {
- Tcl_SetStringObj(resultPtr, argv[argc - 1], -1);
+ if (splitElements > 0) {
+ if ((splitElements > 1)
+ || (Tcl_FSGetPathType(objv[2]) == TCL_PATH_RELATIVE)) {
+
+ Tcl_Obj *tail = NULL;
+ Tcl_ListObjIndex(NULL, splitPtr, splitElements-1, &tail);
+ Tcl_SetObjResult(interp, tail);
}
}
- ckfree((char *) argv);
+ Tcl_DecrRefCount(splitPtr);
return TCL_OK;
}
case FILE_TYPE: {
- struct stat buf;
+ Tcl_StatBuf buf;
if (objc != 3) {
goto only3Args;
}
- if (GetStatBuf(interp, objv[2], TclpLstat, &buf) != TCL_OK) {
+ if (GetStatBuf(interp, objv[2], Tcl_FSLstat, &buf) != TCL_OK) {
return TCL_ERROR;
}
- Tcl_SetStringObj(resultPtr,
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
GetTypeFromMode((unsigned short) buf.st_mode), -1);
return TCL_OK;
}
@@ -1280,7 +1362,8 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
- return TclpListVolumes(interp);
+ Tcl_SetObjResult(interp, Tcl_FSListVolumes());
+ return TCL_OK;
}
case FILE_WRITABLE: {
if (objc != 3) {
@@ -1298,63 +1381,6 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
/*
*---------------------------------------------------------------------------
*
- * SplitPath --
- *
- * Utility procedure used by Tcl_FileObjCmd() to split a path.
- * Differs from standard Tcl_SplitPath in its handling of home
- * directories; Tcl_SplitPath preserves the "~" while this
- * procedure computes the actual full path name.
- *
- * Results:
- * The return value is TCL_OK if the path could be split, TCL_ERROR
- * otherwise. If TCL_ERROR was returned, an error message is left
- * in interp. If TCL_OK was returned, *argvPtr is set to a newly
- * allocated array of strings that represent the individual
- * directories in the specified path, and *argcPtr is filled with
- * the length of that array.
- *
- * Side effects:
- * Memory allocated. The caller must eventually free this memory
- * by calling ckfree() on *argvPtr.
- *
- *---------------------------------------------------------------------------
- */
-
-static int
-SplitPath(interp, objPtr, argcPtr, argvPtr)
- Tcl_Interp *interp; /* Interp for error return. May be NULL. */
- Tcl_Obj *objPtr; /* Path to be split. */
- int *argcPtr; /* Filled with length of following array. */
- char ***argvPtr; /* Filled with array of strings representing
- * the elements of the specified path. */
-{
- char *fileName;
-
- fileName = Tcl_GetString(objPtr);
-
- /*
- * If there is only one element, and it starts with a tilde,
- * perform tilde substitution and resplit the path.
- */
-
- Tcl_SplitPath(fileName, argcPtr, argvPtr);
- if ((*argcPtr == 1) && (fileName[0] == '~')) {
- Tcl_DString ds;
-
- ckfree((char *) *argvPtr);
- fileName = Tcl_TranslateFileName(interp, fileName, &ds);
- if (fileName == NULL) {
- return TCL_ERROR;
- }
- Tcl_SplitPath(fileName, argcPtr, argvPtr);
- Tcl_DStringFree(&ds);
- }
- return TCL_OK;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
* CheckAccess --
*
* Utility procedure used by Tcl_FileObjCmd() to query file
@@ -1379,16 +1405,11 @@ CheckAccess(interp, objPtr, mode)
* access(). */
{
int value;
- char *fileName;
- Tcl_DString ds;
- fileName = Tcl_GetString(objPtr);
- fileName = Tcl_TranslateFileName(interp, fileName, &ds);
- if (fileName == NULL) {
+ if (Tcl_FSConvertToPathType(interp, objPtr) != TCL_OK) {
value = 0;
} else {
- value = (TclAccess(fileName, mode) == 0);
- Tcl_DStringFree(&ds);
+ value = (Tcl_FSAccess(objPtr, mode) == 0);
}
Tcl_SetBooleanObj(Tcl_GetObjResult(interp), value);
@@ -1419,23 +1440,18 @@ static int
GetStatBuf(interp, objPtr, statProc, statPtr)
Tcl_Interp *interp; /* Interp for error return. May be NULL. */
Tcl_Obj *objPtr; /* Path name to examine. */
- StatProc *statProc; /* Either stat() or lstat() depending on
+ Tcl_FSStatProc *statProc; /* Either stat() or lstat() depending on
* desired behavior. */
- struct stat *statPtr; /* Filled with info about file obtained by
+ Tcl_StatBuf *statPtr; /* Filled with info about file obtained by
* calling (*statProc)(). */
{
- char *fileName;
- Tcl_DString ds;
int status;
- fileName = Tcl_GetString(objPtr);
- fileName = Tcl_TranslateFileName(interp, fileName, &ds);
- if (fileName == NULL) {
+ if (Tcl_FSConvertToPathType(interp, objPtr) != TCL_OK) {
return TCL_ERROR;
}
- status = (*statProc)(Tcl_DStringValue(&ds), statPtr);
- Tcl_DStringFree(&ds);
+ status = (*statProc)(objPtr, statPtr);
if (status < 0) {
if (interp != NULL) {
@@ -1472,66 +1488,52 @@ StoreStatData(interp, varName, statPtr)
Tcl_Interp *interp; /* Interpreter for error reports. */
char *varName; /* Name of associative array variable
* in which to store stat results. */
- struct stat *statPtr; /* Pointer to buffer containing
+ Tcl_StatBuf *statPtr; /* Pointer to buffer containing
* stat data to store in varName. */
{
- char string[TCL_INTEGER_SPACE];
+ Tcl_Obj *var = Tcl_NewStringObj(varName, -1);
+ Tcl_Obj *field = Tcl_NewObj();
+ Tcl_Obj *value;
+ register unsigned short mode;
- TclFormatInt(string, (long) statPtr->st_dev);
- if (Tcl_SetVar2(interp, varName, "dev", string, TCL_LEAVE_ERR_MSG)
- == NULL) {
- return TCL_ERROR;
- }
- TclFormatInt(string, (long) statPtr->st_ino);
- if (Tcl_SetVar2(interp, varName, "ino", string, TCL_LEAVE_ERR_MSG)
- == NULL) {
- return TCL_ERROR;
- }
- TclFormatInt(string, (unsigned short) statPtr->st_mode);
- if (Tcl_SetVar2(interp, varName, "mode", string, TCL_LEAVE_ERR_MSG)
- == NULL) {
- return TCL_ERROR;
- }
- TclFormatInt(string, (long) statPtr->st_nlink);
- if (Tcl_SetVar2(interp, varName, "nlink", string, TCL_LEAVE_ERR_MSG)
- == NULL) {
- return TCL_ERROR;
- }
- TclFormatInt(string, (long) statPtr->st_uid);
- if (Tcl_SetVar2(interp, varName, "uid", string, TCL_LEAVE_ERR_MSG)
- == NULL) {
- return TCL_ERROR;
- }
- TclFormatInt(string, (long) statPtr->st_gid);
- if (Tcl_SetVar2(interp, varName, "gid", string, TCL_LEAVE_ERR_MSG)
- == NULL) {
- return TCL_ERROR;
- }
- sprintf(string, "%lu", (unsigned long) statPtr->st_size);
- if (Tcl_SetVar2(interp, varName, "size", string, TCL_LEAVE_ERR_MSG)
- == NULL) {
- return TCL_ERROR;
- }
- TclFormatInt(string, (long) statPtr->st_atime);
- if (Tcl_SetVar2(interp, varName, "atime", string, TCL_LEAVE_ERR_MSG)
- == NULL) {
- return TCL_ERROR;
- }
- TclFormatInt(string, (long) statPtr->st_mtime);
- if (Tcl_SetVar2(interp, varName, "mtime", string, TCL_LEAVE_ERR_MSG)
- == NULL) {
- return TCL_ERROR;
- }
- TclFormatInt(string, (long) statPtr->st_ctime);
- if (Tcl_SetVar2(interp, varName, "ctime", string, TCL_LEAVE_ERR_MSG)
- == NULL) {
- return TCL_ERROR;
- }
- if (Tcl_SetVar2(interp, varName, "type",
- GetTypeFromMode((unsigned short) statPtr->st_mode),
- TCL_LEAVE_ERR_MSG) == NULL) {
- return TCL_ERROR;
- }
+ /*
+ * Assume Tcl_ObjSetVar2() does not keep a copy of the field name!
+ */
+#define STORE_ARY(fieldName, object) \
+ Tcl_SetStringObj(field, (fieldName), -1); \
+ value = (object); \
+ if (Tcl_ObjSetVar2(interp,var,field,value,TCL_LEAVE_ERR_MSG) == NULL) { \
+ Tcl_DecrRefCount(var); \
+ Tcl_DecrRefCount(field); \
+ Tcl_DecrRefCount(value); \
+ return TCL_ERROR; \
+ }
+
+ Tcl_IncrRefCount(var);
+ Tcl_IncrRefCount(field);
+ STORE_ARY("dev", Tcl_NewLongObj((long)statPtr->st_dev));
+ /*
+ * 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...
+ */
+ STORE_ARY("ino", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_ino));
+ STORE_ARY("nlink", Tcl_NewLongObj((long)statPtr->st_nlink));
+ 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
+ STORE_ARY("blocks",Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_blocks));
+#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));
+ mode = (unsigned short) statPtr->st_mode;
+ STORE_ARY("mode", Tcl_NewIntObj(mode));
+ STORE_ARY("type", Tcl_NewStringObj(GetTypeFromMode(mode), -1));
+#undef STORE_ARY
+ Tcl_DecrRefCount(var);
+ Tcl_DecrRefCount(field);
return TCL_OK;
}
@@ -1710,17 +1712,17 @@ Tcl_ForeachObjCmd(dummy, interp, objc, objv)
Tcl_Obj **argObjv = argObjStorage;
#define STATIC_LIST_SIZE 4
- int indexArray[STATIC_LIST_SIZE]; /* Array of value list indices */
- int varcListArray[STATIC_LIST_SIZE]; /* # loop variables per list */
- Tcl_Obj **varvListArray[STATIC_LIST_SIZE]; /* Array of var name lists */
- int argcListArray[STATIC_LIST_SIZE]; /* Array of value list sizes */
- Tcl_Obj **argvListArray[STATIC_LIST_SIZE]; /* Array of value lists */
-
- int *index = indexArray;
- int *varcList = varcListArray;
- Tcl_Obj ***varvList = varvListArray;
- int *argcList = argcListArray;
- Tcl_Obj ***argvList = argvListArray;
+ 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 *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 */
if (objc < 4 || (objc%2 != 0)) {
Tcl_WrongNumArgs(interp, 1, objv,
@@ -1806,24 +1808,23 @@ Tcl_ForeachObjCmd(dummy, interp, objc, objv)
for (j = 0; j < maxj; j++) {
for (i = 0; i < numLists; i++) {
/*
- * If a variable or value list object has been converted to
- * another kind of Tcl object, convert it back to a list object
- * and refetch the pointer to its element array.
+ * 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...)
*/
- if (argObjv[1+i*2]->typePtr != &tclListType) {
- result = Tcl_ListObjGetElements(interp, argObjv[1+i*2],
- &varcList[i], &varvList[i]);
- if (result != TCL_OK) {
- panic("Tcl_ForeachObjCmd: could not reconvert variable list %d to a list object\n", i);
- }
+ result = Tcl_ListObjGetElements(interp, argObjv[1+i*2],
+ &varcList[i], &varvList[i]);
+ if (result != TCL_OK) {
+ panic("Tcl_ForeachObjCmd: could not reconvert variable list %d to a list object\n", i);
}
- if (argObjv[2+i*2]->typePtr != &tclListType) {
- result = Tcl_ListObjGetElements(interp, argObjv[2+i*2],
- &argcList[i], &argvList[i]);
- if (result != TCL_OK) {
- panic("Tcl_ForeachObjCmd: could not reconvert value list %d to a list object\n", i);
- }
+ result = Tcl_ListObjGetElements(interp, argObjv[2+i*2],
+ &argcList[i], &argvList[i]);
+ if (result != TCL_OK) {
+ panic("Tcl_ForeachObjCmd: could not reconvert value list %d to a list object\n", i);
}
for (v = 0; v < varcList[i]; v++) {
@@ -1920,9 +1921,9 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
{
char *format; /* Used to read characters from the format
* string. */
- int formatLen; /* The length of the format string */
+ int formatLen; /* The length of the format string */
char *endPtr; /* Points to the last char in format array */
- char newFormat[40]; /* A new format specifier is generated here. */
+ 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
@@ -1930,12 +1931,16 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
int size; /* Number of bytes needed for result of
* conversion, based on type of conversion
* ("e", "s", etc.), width, and precision. */
- int intValue; /* Used to hold value to pass to sprintf, if
+ 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. */
+#ifndef TCL_WIDE_INT_IS_LONG
+ Tcl_WideInt wideValue; /* Used to hold value to pass to sprintf if
+ * it's a 'long long' value. */
+#endif /* TCL_WIDE_INT_IS_LONG */
int whichValue; /* Indicates which of intValue, ptrValue,
* or doubleValue has the value to pass to
* sprintf, according to the following
@@ -1945,8 +1950,9 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
# define PTR_VALUE 2
# define DOUBLE_VALUE 3
# define STRING_VALUE 4
+# define WIDE_VALUE 5
# define MAX_FLOAT_SIZE 320
-
+
Tcl_Obj *resultPtr; /* Where result is stored finally. */
char staticBuf[MAX_FLOAT_SIZE + 1];
/* A static buffer to copy the format results
@@ -1973,6 +1979,9 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
* been set for the current field. */
int gotZero; /* Non-zero indicates that a zero flag has
* been seen in the current field. */
+#ifndef TCL_WIDE_INT_IS_LONG
+ int useWide; /* Value to be printed is Tcl_WideInt. */
+#endif /* TCL_WIDE_INT_IS_LONG */
/*
* This procedure is a bit nasty. The goal is to use sprintf to
@@ -1982,7 +1991,8 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
* 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).
+ * 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.
*/
@@ -1992,7 +2002,7 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
- format = (char *) Tcl_GetStringFromObj(objv[1], &formatLen);
+ format = Tcl_GetStringFromObj(objv[1], &formatLen);
endPtr = format + formatLen;
resultPtr = Tcl_NewObj();
objIndex = 2;
@@ -2002,6 +2012,9 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
width = precision = noPercent = useShort = 0;
gotZero = gotMinus = gotPrecision = 0;
+#ifndef TCL_WIDE_INT_IS_LONG
+ useWide = 0;
+#endif /* TCL_WIDE_INT_IS_LONG */
whichValue = PTR_VALUE;
/*
@@ -2081,7 +2094,7 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
newPtr++;
format++;
}
- if (isdigit(UCHAR(*format))) { /* INTL: Tcl source. */
+ if (isdigit(UCHAR(*format))) { /* INTL: Tcl source. */
width = strtoul(format, &end, 10); /* INTL: Tcl source. */
format = end;
} else if (*format == '*') {
@@ -2124,7 +2137,7 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
format++;
gotPrecision = 1;
}
- if (isdigit(UCHAR(*format))) { /* INTL: Tcl source. */
+ if (isdigit(UCHAR(*format))) { /* INTL: Tcl source. */
precision = strtoul(format, &end, 10); /* INTL: "C" locale. */
format = end;
} else if (*format == '*') {
@@ -2145,6 +2158,11 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
}
}
if (*format == 'l') {
+#ifndef TCL_WIDE_INT_IS_LONG
+ useWide = 1;
+ strcpy(newPtr, TCL_LL_MODIFIER);
+ newPtr += TCL_LL_MODIFIER_SIZE;
+#endif /* TCL_WIDE_INT_IS_LONG */
format++;
} else if (*format == 'h') {
useShort = 1;
@@ -2166,10 +2184,32 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
case 'u':
case 'x':
case 'X':
- if (Tcl_GetIntFromObj(interp, /* INTL: Tcl source. */
+#ifndef TCL_WIDE_INT_IS_LONG
+ if (useWide) {
+ if (Tcl_GetWideIntFromObj(interp, /* INTL: Tcl source. */
+ objv[objIndex], &wideValue) != TCL_OK) {
+ goto fmtError;
+ }
+ whichValue = WIDE_VALUE;
+ size = 40 + precision;
+ break;
+ }
+#endif /* TCL_WIDE_INT_IS_LONG */
+ if (Tcl_GetLongFromObj(interp, /* INTL: Tcl source. */
objv[objIndex], &intValue) != TCL_OK) {
goto fmtError;
}
+#if (LONG_MAX > INT_MAX)
+ /*
+ * 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.
+ */
+ newPtr++;
+ *newPtr = 0;
+ newPtr[-1] = newPtr[-2];
+ newPtr[-2] = 'l';
+#endif /* LONG_MAX > INT_MAX */
whichValue = INT_VALUE;
size = 40 + precision;
break;
@@ -2193,7 +2233,7 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
}
break;
case 'c':
- if (Tcl_GetIntFromObj(interp, /* INTL: Tcl source. */
+ if (Tcl_GetLongFromObj(interp, /* INTL: Tcl source. */
objv[objIndex], &intValue) != TCL_OK) {
goto fmtError;
}
@@ -2254,6 +2294,12 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
sprintf(dst, newFormat, doubleValue); /* INTL: user locale. */
break;
}
+#ifndef TCL_WIDE_INT_IS_LONG
+ case WIDE_VALUE: {
+ sprintf(dst, newFormat, wideValue);
+ break;
+ }
+#endif /* TCL_WIDE_INT_IS_LONG */
case INT_VALUE: {
if (useShort) {
sprintf(dst, newFormat, (short) intValue);
@@ -2345,43 +2391,3 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
Tcl_DecrRefCount(resultPtr);
return TCL_ERROR;
}
-
-/*
- *---------------------------------------------------------------------------
- *
- * StringifyObjects --
- *
- * Helper function to bridge the gap between an object-based procedure
- * and an older string-based procedure.
- *
- * Given an array of objects, allocate an array that consists of the
- * string representations of those objects.
- *
- * Results:
- * The return value is a pointer to the newly allocated array of
- * strings. Elements 0 to (objc-1) of the string array point to the
- * string representation of the corresponding element in the source
- * object array; element objc of the string array is NULL.
- *
- * Side effects:
- * Memory allocated. The caller must eventually free this memory
- * by calling ckfree() on the return value.
- *
- *---------------------------------------------------------------------------
- */
-
-static char **
-StringifyObjects(objc, objv)
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
-{
- int i;
- char **argv;
-
- argv = (char **) ckalloc((objc + 1) * sizeof(char *));
- for (i = 0; i < objc; i++) {
- argv[i] = Tcl_GetString(objv[i]);
- }
- argv[i] = NULL;
- return argv;
-}
diff --git a/tcl/generic/tclCmdIL.c b/tcl/generic/tclCmdIL.c
index 54ed56fa0e8..dae26d8f10a 100644
--- a/tcl/generic/tclCmdIL.c
+++ b/tcl/generic/tclCmdIL.c
@@ -10,6 +10,7 @@
* 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.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -19,7 +20,6 @@
#include "tclInt.h"
#include "tclPort.h"
-#include "tclCompile.h"
#include "tclRegexp.h"
/*
@@ -73,11 +73,18 @@ typedef struct SortInfo {
#define SORTMODE_DICTIONARY 4
/*
+ * Magic values for the index field of the SortInfo structure.
+ * Note that the index "end-1" will be translated to SORTIDX_END-1, etc.
+ */
+#define SORTIDX_NONE -1 /* Not indexed; use whole value. */
+#define SORTIDX_END -2 /* Indexed from end. */
+
+/*
* Forward declarations for procedures defined in this file:
*/
static void AppendLocals _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *listPtr, char *pattern,
+ Tcl_Obj *listPtr, CONST char *pattern,
int includeLinks));
static int DictionaryCompare _ANSI_ARGS_((char *left,
char *right));
@@ -102,6 +109,9 @@ static int InfoDefaultCmd _ANSI_ARGS_((ClientData dummy,
static int InfoExistsCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]));
+static int InfoFunctionsCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
static int InfoGlobalsCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]));
@@ -313,10 +323,36 @@ Tcl_IncrObjCmd(dummy, interp, objc, objv)
if (objc == 2) {
incrAmount = 1;
} else {
+#ifdef TCL_WIDE_INT_IS_LONG
if (Tcl_GetLongFromObj(interp, objv[2], &incrAmount) != TCL_OK) {
Tcl_AddErrorInfo(interp, "\n (reading increment)");
return TCL_ERROR;
}
+#else
+ /*
+ * 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;
+ } else if (objv[2]->typePtr == &tclWideIntType) {
+ incrAmount = Tcl_WideAsLong(objv[2]->internalRep.wideValue);
+ } else {
+ Tcl_WideInt wide;
+
+ if (Tcl_GetWideIntFromObj(interp, objv[2], &wide) != TCL_OK) {
+ Tcl_AddErrorInfo(interp, "\n (reading increment)");
+ return TCL_ERROR;
+ }
+ incrAmount = Tcl_WideAsLong(wide);
+ if ((wide <= Tcl_LongAsWide(LONG_MAX))
+ && (wide >= Tcl_LongAsWide(LONG_MIN))) {
+ objv[2]->typePtr = &tclIntType;
+ objv[2]->internalRep.longValue = incrAmount;
+ }
+ }
+#endif
}
/*
@@ -363,16 +399,16 @@ Tcl_InfoObjCmd(clientData, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- static char *subCmds[] = {
+ static CONST char *subCmds[] = {
"args", "body", "cmdcount", "commands",
- "complete", "default", "exists", "globals",
+ "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, IGlobalsIdx,
+ ICompleteIdx, IDefaultIdx, IExistsIdx, IFunctionsIdx, IGlobalsIdx,
IHostnameIdx, ILevelIdx, ILibraryIdx, ILoadedIdx,
ILocalsIdx, INameOfExecutableIdx, IPatchLevelIdx, IProcsIdx,
IScriptIdx, ISharedLibExtensionIdx, ITclVersionIdx, IVarsIdx
@@ -412,6 +448,9 @@ Tcl_InfoObjCmd(clientData, interp, objc, objv)
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;
@@ -562,23 +601,24 @@ InfoBodyCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
- /*
- * We should not return a bytecompiled body. If it is precompiled,
- * then the bodyPtr's string representation is bogus, since sources
- * are not available. If it was just a bytecompiled body, then it
- * is likely to not be of any use to the caller, as it was compiled
- * for a separate procedure context [Bug: 3412], and noone else can
- * reasonably use it.
- * In order to make sure that later manipulations of the object do not
- * invalidate the internal representation, we make a copy of the string
- * representation and return that one, instead.
+ /*
+ * Here we used to return procPtr->bodyPtr, except when the body was
+ * bytecompiled - in that case, the return was a copy of the body's
+ * string rep. In order to better isolate the implementation details
+ * of the compiler/engine subsystem, we now always return a copy of
+ * the string rep. It is important to return a copy so that later
+ * manipulations of the object do not invalidate the internal rep.
*/
bodyPtr = procPtr->bodyPtr;
- resultPtr = bodyPtr;
- if (bodyPtr->typePtr == &tclByteCodeType) {
- resultPtr = Tcl_NewStringObj(bodyPtr->bytes, bodyPtr->length);
+ if (bodyPtr->bytes == NULL) {
+ /*
+ * The string rep might not be valid if the procedure has
+ * never been run before. [Bug #545644]
+ */
+ (void) Tcl_GetString(bodyPtr);
}
+ resultPtr = Tcl_NewStringObj(bodyPtr->bytes, bodyPtr->length);
Tcl_SetObjResult(interp, resultPtr);
return TCL_OK;
@@ -654,7 +694,8 @@ InfoCommandsCmd(dummy, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- char *cmdName, *pattern, *simplePattern;
+ char *cmdName, *pattern;
+ CONST char *simplePattern;
register Tcl_HashEntry *entryPtr;
Tcl_HashSearch search;
Namespace *nsPtr;
@@ -927,6 +968,54 @@ InfoExistsCmd(dummy, interp, objc, objv)
/*
*----------------------------------------------------------------------
*
+ * 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(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 *pattern;
+ Tcl_Obj *listPtr;
+
+ if (objc == 2) {
+ pattern = NULL;
+ } else if (objc == 3) {
+ pattern = Tcl_GetString(objv[2]);
+ } else {
+ Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
+ return TCL_ERROR;
+ }
+
+ listPtr = Tcl_ListMathFuncs(interp, pattern);
+ if (listPtr == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, listPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* InfoGlobalsCmd --
*
* Called to implement the "info globals" command that returns the list
@@ -1018,7 +1107,7 @@ InfoHostnameCmd(dummy, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- char *name;
+ CONST char *name;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
@@ -1136,7 +1225,7 @@ InfoLibraryCmd(dummy, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- char *libDirName;
+ CONST char *libDirName;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
@@ -1276,7 +1365,7 @@ static void
AppendLocals(interp, listPtr, pattern, includeLinks)
Tcl_Interp *interp; /* Current interpreter. */
Tcl_Obj *listPtr; /* List object to append names to. */
- char *pattern; /* Pattern to match against. */
+ CONST char *pattern; /* Pattern to match against. */
int includeLinks; /* 1 if upvars should be included, else 0. */
{
Interp *iPtr = (Interp *) interp;
@@ -1298,7 +1387,8 @@ AppendLocals(interp, listPtr, pattern, includeLinks)
* Skip nameless (temporary) variables and undefined variables
*/
- if (!TclIsVarTemporary(localPtr) && !TclIsVarUndefined(varPtr)) {
+ if (!TclIsVarTemporary(localPtr) && !TclIsVarUndefined(varPtr)
+ && (includeLinks || !TclIsVarLink(varPtr))) {
varName = varPtr->name;
if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
Tcl_ListObjAppendElement(interp, listPtr,
@@ -1365,7 +1455,7 @@ InfoNameOfExecutableCmd(dummy, interp, objc, objv)
nameOfExecutable = Tcl_GetNameOfExecutable();
if (nameOfExecutable != NULL) {
- Tcl_SetStringObj(Tcl_GetObjResult(interp), (char *)nameOfExecutable, -1);
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), nameOfExecutable, -1);
}
return TCL_OK;
}
@@ -1398,7 +1488,7 @@ InfoPatchLevelCmd(dummy, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- char *patchlevel;
+ CONST char *patchlevel;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
@@ -1445,7 +1535,8 @@ InfoProcsCmd(dummy, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- char *cmdName, *pattern, *simplePattern;
+ char *cmdName, *pattern;
+ CONST char *simplePattern;
Namespace *nsPtr;
#ifdef INFO_PROCS_SEARCH_GLOBAL_NS
Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
@@ -1506,19 +1597,19 @@ InfoProcsCmd(dummy, interp, objc, objv)
|| Tcl_StringMatch(cmdName, simplePattern)) {
cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
- if (specificNsInPattern) {
- elemObjPtr = Tcl_NewObj();
- Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr,
- elemObjPtr);
- } else {
- elemObjPtr = Tcl_NewStringObj(cmdName, -1);
- }
-
realCmdPtr = (Command *)
TclGetOriginalCommand((Tcl_Command) cmdPtr);
if (TclIsProc(cmdPtr)
|| ((realCmdPtr != NULL) && TclIsProc(realCmdPtr))) {
+ if (specificNsInPattern) {
+ elemObjPtr = Tcl_NewObj();
+ Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr,
+ elemObjPtr);
+ } else {
+ elemObjPtr = Tcl_NewStringObj(cmdName, -1);
+ }
+
Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
}
}
@@ -1578,14 +1669,17 @@ InfoProcsCmd(dummy, interp, objc, objv)
* script file that is currently being evaluated. Handles the
* following syntax:
*
- * info script
+ * info script ?newName?
+ *
+ * If newName is specified, it will set that as the internal name.
*
* 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.
+ * an error, the result is an error message. It may change the
+ * internal script filename.
*
*----------------------------------------------------------------------
*/
@@ -1598,13 +1692,20 @@ InfoScriptCmd(dummy, interp, objc, objv)
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
- if (objc != 2) {
- Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ if ((objc != 2) && (objc != 3)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?filename?");
return TCL_ERROR;
}
+ if (objc == 3) {
+ if (iPtr->scriptFile != NULL) {
+ Tcl_DecrRefCount(iPtr->scriptFile);
+ }
+ iPtr->scriptFile = objv[2];
+ Tcl_IncrRefCount(iPtr->scriptFile);
+ }
if (iPtr->scriptFile != NULL) {
- Tcl_SetStringObj(Tcl_GetObjResult(interp), iPtr->scriptFile, -1);
+ Tcl_SetObjResult(interp, iPtr->scriptFile);
}
return TCL_OK;
}
@@ -1675,7 +1776,7 @@ InfoTclVersionCmd(dummy, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- char *version;
+ CONST char *version;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
@@ -1723,7 +1824,8 @@ InfoVarsCmd(dummy, interp, objc, objv)
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
- char *varName, *pattern, *simplePattern;
+ char *varName, *pattern;
+ CONST char *simplePattern;
register Tcl_HashEntry *entryPtr;
Tcl_HashSearch search;
Var *varPtr;
@@ -1936,61 +2038,334 @@ Tcl_LindexObjCmd(dummy, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- Tcl_Obj *listPtr;
- Tcl_Obj **elemPtrs;
- int listLen, index, result;
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 1, objv, "list index");
+ Tcl_Obj *elemPtr; /* Pointer to the element being extracted */
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "list ?index...?");
return TCL_ERROR;
}
/*
- * Convert the first argument to a list if necessary.
+ * If objc == 3, then objv[ 2 ] may be either a single index or
+ * a list of indices: go to TclLindexList to determine which.
+ * If objc >= 4, or objc == 2, then objv[ 2 .. objc-2 ] are all
+ * single indices and processed as such in TclLindexFlat.
*/
- listPtr = objv[1];
- result = Tcl_ListObjGetElements(interp, listPtr, &listLen, &elemPtrs);
- if (result != TCL_OK) {
- return result;
- }
+ if ( objc == 3 ) {
+
+ elemPtr = TclLindexList( interp, objv[ 1 ], objv[ 2 ] );
+
+ } else {
+ elemPtr = TclLindexFlat( interp, objv[ 1 ], objc-2, objv+2 );
+
+ }
+
/*
- * Get the index from objv[2].
+ * Set the interpreter's object result to the last element extracted
*/
- result = TclGetIntForIndex(interp, objv[2], /*endValue*/ (listLen - 1),
- &index);
- if (result != TCL_OK) {
- return result;
+ if ( elemPtr == NULL ) {
+ return TCL_ERROR;
+ } else {
+ Tcl_SetObjResult(interp, elemPtr);
+ Tcl_DecrRefCount( elemPtr );
+ return TCL_OK;
}
- if ((index < 0) || (index >= listLen)) {
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ * 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 );
+
+ } else if ( Tcl_ListObjGetElements( NULL, argPtr, &indexCount, &indices )
+ != TCL_OK ) {
+
/*
- * The index is out of range: the result is an empty string object.
+ * argPtr designates something that is neither an index nor a
+ * well-formed list. Report the error via TclLindexFlat.
*/
- return TCL_OK;
+ return TclLindexFlat( interp, listPtr, 1, &argPtr );
}
/*
- * Make sure listPtr still refers to a list object. It might have been
- * converted to an int above if the argument objects were shared.
+ * Record the reference to the list that we are maintaining in
+ * the activation record.
*/
- if (listPtr->typePtr != &tclListType) {
- result = Tcl_ListObjGetElements(interp, listPtr, &listLen,
- &elemPtrs);
+ 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) {
- return result;
+ 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;
+ }
+
+ } /* end for */
/*
- * Set the interpreter's object result to the index-th list element.
+ * Return the last object extracted. Its reference count will include
+ * the reference being returned.
*/
- Tcl_SetObjResult(interp, elemPtrs[index]);
- return TCL_OK;
+ 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.
+ *
+ * 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;
+
}
/*
@@ -2019,77 +2394,58 @@ Tcl_LinsertObjCmd(dummy, interp, objc, objv)
register int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- Tcl_Obj *listPtr, *resultPtr;
- Tcl_ObjType *typePtr;
+ Tcl_Obj *listPtr;
int index, isDuplicate, len, result;
-
+
if (objc < 4) {
Tcl_WrongNumArgs(interp, 1, objv, "list index element ?element ...?");
return TCL_ERROR;
}
- /*
- * Get the index first since, if a conversion to int is needed, it
- * will invalidate the list's internal representation.
- */
-
result = Tcl_ListObjLength(interp, objv[1], &len);
if (result != TCL_OK) {
return result;
}
- result = TclGetIntForIndex(interp, objv[2], /*endValue*/ len, &index);
+ /*
+ * Get the index. "end" is interpreted to be the index after the last
+ * element, such that using it will cause any inserted elements to be
+ * appended to the list.
+ */
+
+ result = TclGetIntForIndex(interp, objv[2], /*end*/ len, &index);
if (result != TCL_OK) {
return result;
}
+ if (index > len) {
+ index = len;
+ }
/*
* If the list object is unshared we can modify it directly. Otherwise
- * we create a copy to modify: this is "copy on write". We create the
- * duplicate directly in the interpreter's object result.
+ * we create a copy to modify: this is "copy on write".
*/
-
+
listPtr = objv[1];
isDuplicate = 0;
if (Tcl_IsShared(listPtr)) {
- /*
- * The following code must reflect the logic in Tcl_DuplicateObj()
- * except that it must duplicate the list object directly into the
- * interpreter's result.
- */
-
- Tcl_ResetResult(interp);
- resultPtr = Tcl_GetObjResult(interp);
- typePtr = listPtr->typePtr;
- if (listPtr->bytes == NULL) {
- resultPtr->bytes = NULL;
- } else if (listPtr->bytes != tclEmptyStringRep) {
- len = listPtr->length;
- TclInitStringRep(resultPtr, listPtr->bytes, len);
- }
- if (typePtr != NULL) {
- if (typePtr->dupIntRepProc == NULL) {
- resultPtr->internalRep = listPtr->internalRep;
- resultPtr->typePtr = typePtr;
- } else {
- (*typePtr->dupIntRepProc)(listPtr, resultPtr);
- }
- }
- listPtr = resultPtr;
+ listPtr = Tcl_DuplicateObj(listPtr);
isDuplicate = 1;
}
-
- if ((objc == 4) && (index == INT_MAX)) {
+
+ if ((objc == 4) && (index == len)) {
/*
* 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;
}
@@ -2097,9 +2453,7 @@ Tcl_LinsertObjCmd(dummy, interp, objc, objv)
* Set the interpreter's object result.
*/
- if (!isDuplicate) {
- Tcl_SetObjResult(interp, listPtr);
- }
+ Tcl_SetObjResult(interp, listPtr);
return TCL_OK;
}
@@ -2306,9 +2660,7 @@ Tcl_LreplaceObjCmd(dummy, interp, objc, objv)
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
register Tcl_Obj *listPtr;
- int createdNewObj, first, last, listLen, numToDelete;
- int firstArgLen, result;
- char *firstArg;
+ int isDuplicate, first, last, listLen, numToDelete, result;
if (objc < 4) {
Tcl_WrongNumArgs(interp, 1, objv,
@@ -2316,53 +2668,43 @@ Tcl_LreplaceObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
- /*
- * If the list object is unshared we can modify it directly, otherwise
- * we create a copy to modify: this is "copy on write".
- */
-
- listPtr = objv[1];
- createdNewObj = 0;
- if (Tcl_IsShared(listPtr)) {
- listPtr = Tcl_DuplicateObj(listPtr);
- createdNewObj = 1;
- }
- result = Tcl_ListObjLength(interp, listPtr, &listLen);
+ result = Tcl_ListObjLength(interp, objv[1], &listLen);
if (result != TCL_OK) {
- errorReturn:
- if (createdNewObj) {
- Tcl_DecrRefCount(listPtr); /* free unneeded obj */
- }
return result;
}
/*
- * Get the first and last indexes.
+ * Get the first and last indexes. "end" is interpreted to be the index
+ * for the last element, such that using it will cause that element to
+ * be included for deletion.
*/
- result = TclGetIntForIndex(interp, objv[2], /*endValue*/ (listLen - 1),
- &first);
+ result = TclGetIntForIndex(interp, objv[2], /*end*/ (listLen - 1), &first);
if (result != TCL_OK) {
- goto errorReturn;
+ return result;
}
- firstArg = Tcl_GetStringFromObj(objv[2], &firstArgLen);
- result = TclGetIntForIndex(interp, objv[3], /*endValue*/ (listLen - 1),
- &last);
+ result = TclGetIntForIndex(interp, objv[3], /*end*/ (listLen - 1), &last);
if (result != TCL_OK) {
- goto errorReturn;
+ return result;
}
if (first < 0) {
first = 0;
}
- if ((first >= listLen) && (listLen > 0)
- && (strncmp(firstArg, "end", (unsigned) firstArgLen) != 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
+ * be properly constrained by TclGetIntForIndex because we use listLen-1
+ * (to allow for replacing the last elem).
+ */
+
+ if ((first >= listLen) && (listLen > 0)) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"list doesn't contain element ",
Tcl_GetString(objv[2]), (int *) NULL);
- result = TCL_ERROR;
- goto errorReturn;
+ return TCL_ERROR;
}
if (last >= listLen) {
last = (listLen - 1);
@@ -2373,6 +2715,17 @@ Tcl_LreplaceObjCmd(dummy, interp, objc, objv)
numToDelete = 0;
}
+ /*
+ * If the list object is unshared we can modify it directly, otherwise
+ * we create a copy to modify: this is "copy on write".
+ */
+
+ 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]));
@@ -2381,7 +2734,10 @@ Tcl_LreplaceObjCmd(dummy, interp, objc, objv)
0, NULL);
}
if (result != TCL_OK) {
- goto errorReturn;
+ if (isDuplicate) {
+ Tcl_DecrRefCount(listPtr); /* free unneeded obj */
+ }
+ return result;
}
/*
@@ -2418,23 +2774,120 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
{
char *bytes, *patternBytes;
int i, match, mode, index, result, listc, length, elemLen;
- Tcl_Obj *patObj, **listv;
- static char *options[] = {
- "-exact", "-glob", "-regexp", NULL
+ int dataType, isIncreasing, lower, upper, patInt, objInt;
+ int offset, allMatches, inlineReturn, negatedMatch;
+ double patDouble, objDouble;
+ Tcl_Obj *patObj, **listv, *listPtr, *startPtr;
+ static CONST char *options[] = {
+ "-all", "-ascii", "-decreasing", "-dictionary",
+ "-exact", "-glob", "-increasing", "-inline",
+ "-integer", "-not", "-real", "-regexp",
+ "-sorted", "-start", NULL
};
enum options {
- LSEARCH_EXACT, LSEARCH_GLOB, LSEARCH_REGEXP
+ LSEARCH_ALL, LSEARCH_ASCII, LSEARCH_DECREASING, LSEARCH_DICTIONARY,
+ LSEARCH_EXACT, LSEARCH_GLOB, LSEARCH_INCREASING, LSEARCH_INLINE,
+ LSEARCH_INTEGER, LSEARCH_NOT, LSEARCH_REAL, LSEARCH_REGEXP,
+ LSEARCH_SORTED, LSEARCH_START
};
+ enum datatypes {
+ ASCII, DICTIONARY, INTEGER, REAL
+ };
+ enum modes {
+ EXACT, GLOB, REGEXP, SORTED
+ };
+
+ mode = GLOB;
+ dataType = ASCII;
+ isIncreasing = 1;
+ allMatches = 0;
+ inlineReturn = 0;
+ negatedMatch = 0;
+ listPtr = NULL;
+ startPtr = NULL;
+ offset = 0;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?options? list pattern");
+ return TCL_ERROR;
+ }
- mode = LSEARCH_GLOB;
- if (objc == 4) {
- if (Tcl_GetIndexFromObj(interp, objv[1], options, "search mode", 0,
- &mode) != TCL_OK) {
+ for (i = 1; i < objc-2; i++) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index)
+ != TCL_OK) {
+ if (startPtr) {
+ Tcl_DecrRefCount(startPtr);
+ }
return TCL_ERROR;
}
- } else if (objc != 3) {
- Tcl_WrongNumArgs(interp, 1, objv, "?mode? list pattern");
- return TCL_ERROR;
+ switch ((enum options) index) {
+ case LSEARCH_ALL: /* -all */
+ allMatches = 1;
+ break;
+ case LSEARCH_ASCII: /* -ascii */
+ dataType = ASCII;
+ break;
+ case LSEARCH_DECREASING: /* -decreasing */
+ isIncreasing = 0;
+ break;
+ case LSEARCH_DICTIONARY: /* -dictionary */
+ dataType = DICTIONARY;
+ break;
+ case LSEARCH_EXACT: /* -increasing */
+ mode = EXACT;
+ break;
+ case LSEARCH_GLOB: /* -glob */
+ mode = GLOB;
+ break;
+ case LSEARCH_INCREASING: /* -increasing */
+ isIncreasing = 1;
+ break;
+ case LSEARCH_INLINE: /* -inline */
+ inlineReturn = 1;
+ break;
+ case LSEARCH_INTEGER: /* -integer */
+ dataType = INTEGER;
+ break;
+ case LSEARCH_NOT: /* -not */
+ negatedMatch = 1;
+ break;
+ case LSEARCH_REAL: /* -real */
+ dataType = REAL;
+ break;
+ case LSEARCH_REGEXP: /* -regexp */
+ mode = REGEXP;
+ break;
+ case LSEARCH_SORTED: /* -sorted */
+ mode = SORTED;
+ break;
+ case LSEARCH_START: /* -start */
+ /*
+ * If there was a previous -start option, release its saved
+ * index because it will either be replaced or there will be
+ * an error.
+ */
+ if (startPtr) {
+ Tcl_DecrRefCount(startPtr);
+ }
+ if (i > objc-4) {
+ Tcl_AppendResult(interp, "missing starting index", NULL);
+ return TCL_ERROR;
+ }
+ 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.
+ */
+ startPtr = Tcl_DuplicateObj(objv[i]);
+ } else {
+ startPtr = objv[i];
+ Tcl_IncrRefCount(startPtr);
+ }
+ }
}
/*
@@ -2444,48 +2897,328 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
result = Tcl_ListObjGetElements(interp, objv[objc - 2], &listc, &listv);
if (result != TCL_OK) {
+ if (startPtr) {
+ Tcl_DecrRefCount(startPtr);
+ }
return result;
}
+ /*
+ * Get the user-specified start offset.
+ */
+ if (startPtr) {
+ result = TclGetIntForIndex(interp, startPtr, listc-1, &offset);
+ Tcl_DecrRefCount(startPtr);
+ if (result != TCL_OK) {
+ return result;
+ }
+ if (offset < 0) {
+ offset = 0;
+ } else if (offset > listc-1) {
+ offset = listc-1;
+ }
+ }
+
patObj = objv[objc - 1];
- patternBytes = Tcl_GetStringFromObj(patObj, &length);
+ patternBytes = NULL;
+ if ((enum modes) mode == EXACT || (enum modes) mode == SORTED) {
+ switch ((enum datatypes) dataType) {
+ case ASCII:
+ case DICTIONARY:
+ patternBytes = Tcl_GetStringFromObj(patObj, &length);
+ break;
+ case INTEGER:
+ result = Tcl_GetIntFromObj(interp, patObj, &patInt);
+ if (result != TCL_OK) {
+ return result;
+ }
+ break;
+ case REAL:
+ result = Tcl_GetDoubleFromObj(interp, patObj, &patDouble);
+ if (result != TCL_OK) {
+ return result;
+ }
+ break;
+ }
+ } else {
+ patternBytes = Tcl_GetStringFromObj(patObj, &length);
+ }
+ /*
+ * Set default index value to -1, indicating failure; if we find the
+ * item in the course of our search, index will be set to the correct
+ * value.
+ */
index = -1;
- for (i = 0; i < listc; i++) {
- match = 0;
- switch ((enum options) mode) {
- case LSEARCH_EXACT: {
- bytes = Tcl_GetStringFromObj(listv[i], &elemLen);
- if (length == elemLen) {
- match = (memcmp(bytes, patternBytes,
- (size_t) length) == 0);
+ match = 0;
+
+ if ((enum modes) 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 that case, we have to look at all items anyway,
+ * and there is no sense in doing this when the match sense is
+ * inverted.
+ */
+ lower = offset - 1;
+ upper = listc;
+ while (lower + 1 != upper) {
+ i = (lower + upper)/2;
+ switch ((enum datatypes) dataType) {
+ case ASCII:
+ bytes = Tcl_GetString(listv[i]);
+ match = strcmp(patternBytes, bytes);
+ break;
+ case DICTIONARY:
+ bytes = Tcl_GetString(listv[i]);
+ match = DictionaryCompare(patternBytes, bytes);
+ break;
+ case INTEGER:
+ result = Tcl_GetIntFromObj(interp, listv[i], &objInt);
+ if (result != TCL_OK) {
+ return result;
+ }
+ if (patInt == objInt) {
+ match = 0;
+ } else if (patInt < objInt) {
+ match = -1;
+ } else {
+ match = 1;
}
break;
- }
- case LSEARCH_GLOB: {
- match = Tcl_StringMatch(Tcl_GetString(listv[i]), patternBytes);
+ case REAL:
+ result = Tcl_GetDoubleFromObj(interp, listv[i], &objDouble);
+ if (result != TCL_OK) {
+ return result;
+ }
+ if (patDouble == objDouble) {
+ match = 0;
+ } else if (patDouble < objDouble) {
+ match = -1;
+ } else {
+ match = 1;
+ }
break;
}
- case LSEARCH_REGEXP: {
+ if (match == 0) {
+ /*
+ * Normally, binary search is written to stop when it
+ * finds a match. If there are duplicates of an element in
+ * the list, our first match might not be the first occurance.
+ * Consider: 0 0 0 1 1 1 2 2 2
+ * To maintain consistancy with standard lsearch semantics,
+ * we must find the leftmost occurance of the pattern in the
+ * list. Thus we don't just stop searching here. This
+ * variation means that a search always makes log n
+ * comparisons (normal binary search might "get lucky" with
+ * an early comparison).
+ */
+ index = i;
+ upper = i;
+ } else if (match > 0) {
+ if (isIncreasing) {
+ lower = i;
+ } else {
+ upper = i;
+ }
+ } else {
+ if (isIncreasing) {
+ upper = i;
+ } else {
+ lower = i;
+ }
+ }
+ }
+
+ } else {
+ /*
+ * We need to do a linear search, because (at least one) of:
+ * - our matcher can only tell equal vs. not equal
+ * - our matching sense is negated
+ * - we're building a list of all matched items
+ */
+ if (allMatches) {
+ listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ }
+ for (i = offset; i < listc; i++) {
+ match = 0;
+ switch ((enum modes) mode) {
+ case SORTED:
+ case EXACT:
+ switch ((enum datatypes) dataType) {
+ case ASCII:
+ bytes = Tcl_GetStringFromObj(listv[i], &elemLen);
+ if (length == elemLen) {
+ match = (memcmp(bytes, patternBytes,
+ (size_t) length) == 0);
+ }
+ break;
+ case DICTIONARY:
+ bytes = Tcl_GetString(listv[i]);
+ match = (DictionaryCompare(bytes, patternBytes) == 0);
+ break;
+ case INTEGER:
+ result = Tcl_GetIntFromObj(interp, listv[i], &objInt);
+ if (result != TCL_OK) {
+ if (listPtr) {
+ Tcl_DecrRefCount(listPtr);
+ }
+ return result;
+ }
+ match = (objInt == patInt);
+ break;
+ case REAL:
+ result = Tcl_GetDoubleFromObj(interp, listv[i],
+ &objDouble);
+ if (result != TCL_OK) {
+ if (listPtr) {
+ Tcl_DecrRefCount(listPtr);
+ }
+ return result;
+ }
+ match = (objDouble == patDouble);
+ break;
+ }
+ break;
+ case GLOB:
+ match = Tcl_StringMatch(Tcl_GetString(listv[i]),
+ patternBytes);
+ break;
+ case REGEXP:
match = Tcl_RegExpMatchObj(interp, listv[i], patObj);
if (match < 0) {
+ if (listPtr) {
+ Tcl_DecrRefCount(listPtr);
+ }
return TCL_ERROR;
}
break;
}
+ /*
+ * Invert match condition for -not
+ */
+ if (negatedMatch) {
+ match = !match;
+ }
+ if (match != 0) {
+ if (!allMatches) {
+ index = i;
+ break;
+ } else if (inlineReturn) {
+ /*
+ * Note that these appends are not expected to fail.
+ */
+ Tcl_ListObjAppendElement(interp, listPtr, listv[i]);
+ } else {
+ Tcl_ListObjAppendElement(interp, listPtr,
+ Tcl_NewIntObj(i));
+ }
+ }
}
- if (match != 0) {
- index = i;
- break;
- }
}
- Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
+
+ /*
+ * Return everything or a single value.
+ */
+ if (allMatches) {
+ Tcl_SetObjResult(interp, listPtr);
+ } else if (!inlineReturn) {
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
+ } else if (index < 0) {
+ /*
+ * Is this superfluous? The result should be a blank object
+ * by default...
+ */
+ Tcl_SetObjResult(interp, Tcl_NewObj());
+ } else {
+ Tcl_SetObjResult(interp, listv[index]);
+ }
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
+ * Tcl_LsetObjCmd --
+ *
+ * This procedure is invoked to process the "lset" 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_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_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" );
+ return TCL_ERROR;
+ }
+
+ /* Look up the list variable's value */
+
+ listPtr = Tcl_ObjGetVar2( interp, objv[ 1 ], (Tcl_Obj*) NULL,
+ TCL_LEAVE_ERR_MSG );
+ if ( listPtr == NULL ) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Substitute the value in the value. Return either the value or
+ * else an unshared copy of it.
+ */
+
+ if ( objc == 4 ) {
+ finalValuePtr = TclLsetList( interp, listPtr,
+ objv[ 2 ], objv[ 3 ] );
+ } else {
+ finalValuePtr = TclLsetFlat( interp, listPtr,
+ objc-3, objv+2, objv[ objc-1 ] );
+ }
+
+ /*
+ * If substitution has failed, bail out.
+ */
+
+ if ( finalValuePtr == NULL ) {
+ return TCL_ERROR;
+ }
+
+ /* Finally, update the variable so that traces fire. */
+
+ listPtr = Tcl_ObjSetVar2( interp, objv[1], NULL, finalValuePtr,
+ TCL_LEAVE_ERR_MSG );
+ Tcl_DecrRefCount( finalValuePtr );
+ if ( listPtr == NULL ) {
+ return TCL_ERROR;
+ }
+
+ /* Return the new value of the variable as the interpreter result. */
+
+ Tcl_SetObjResult( interp, listPtr );
+ return TCL_OK;
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_LsortObjCmd --
*
* This procedure is invoked to process the "lsort" Tcl command.
@@ -2516,7 +3249,7 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
SortInfo sortInfo; /* Information about this sort that
* needs to be passed to the
* comparison function */
- static char *switches[] = {
+ static CONST char *switches[] = {
"-ascii", "-command", "-decreasing", "-dictionary", "-increasing",
"-index", "-integer", "-real", "-unique", (char *) NULL
};
@@ -2533,7 +3266,7 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
sortInfo.isIncreasing = 1;
sortInfo.sortMode = SORTMODE_ASCII;
- sortInfo.index = -1;
+ sortInfo.index = SORTIDX_NONE;
sortInfo.interp = interp;
sortInfo.resultCode = TCL_OK;
cmdPtr = NULL;
@@ -2574,11 +3307,10 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
-1);
return TCL_ERROR;
}
- if (TclGetIntForIndex(interp, objv[i+1], -2, &sortInfo.index)
- != TCL_OK) {
+ if (TclGetIntForIndex(interp, objv[i+1], SORTIDX_END,
+ &sortInfo.index) != TCL_OK) {
return TCL_ERROR;
}
- cmdPtr = objv[i+1];
i++;
break;
case 6: /* -integer */
@@ -2616,12 +3348,9 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
sortInfo.resultCode = Tcl_ListObjGetElements(interp, objv[objc-1],
&length, &listObjPtrs);
- if (sortInfo.resultCode != TCL_OK) {
+ if (sortInfo.resultCode != TCL_OK || length <= 0) {
goto done;
}
- if (length <= 0) {
- return TCL_OK;
- }
elementArray = (SortElement *) ckalloc(length * sizeof(SortElement));
for (i=0; i < length; i++){
elementArray[i].objPtr = listObjPtrs[i];
@@ -2832,20 +3561,20 @@ SortCompare(objPtr1, objPtr2, infoPtr)
return order;
}
- if (infoPtr->index != -1) {
+ if (infoPtr->index != SORTIDX_NONE) {
/*
* The "-index" option was specified. Treat each object as a
* list, extract the requested element from each list, and
- * compare the elements, not the lists. The special index "end"
- * is signaled here with a large negative index.
+ * compare the elements, not the lists. "end"-relative indices
+ * are signaled here with large negative values.
*/
if (Tcl_ListObjLength(infoPtr->interp, objPtr1, &listLen) != TCL_OK) {
infoPtr->resultCode = TCL_ERROR;
return order;
}
- if (infoPtr->index < -1) {
- index = listLen - 1;
+ if (infoPtr->index < SORTIDX_NONE) {
+ index = listLen + infoPtr->index + 1;
} else {
index = infoPtr->index;
}
@@ -2871,8 +3600,8 @@ SortCompare(objPtr1, objPtr2, infoPtr)
infoPtr->resultCode = TCL_ERROR;
return order;
}
- if (infoPtr->index < -1) {
- index = listLen - 1;
+ if (infoPtr->index < SORTIDX_NONE) {
+ index = listLen + infoPtr->index + 1;
} else {
index = infoPtr->index;
}
@@ -3097,4 +3826,3 @@ DictionaryCompare(left, right)
}
return diff;
}
-
diff --git a/tcl/generic/tclCmdMZ.c b/tcl/generic/tclCmdMZ.c
index abc7a30d822..d13bc8e5914 100644
--- a/tcl/generic/tclCmdMZ.c
+++ b/tcl/generic/tclCmdMZ.c
@@ -8,7 +8,8 @@
*
* Copyright (c) 1987-1993 The Regents of the University of California.
* Copyright (c) 1994-1997 Sun Microsystems, Inc.
- * Copyright (c) 1998-1999 by Scriptics Corporation.
+ * Copyright (c) 1998-2000 Scriptics Corporation.
+ * Copyright (c) 2002 ActiveState Corporation.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -18,50 +19,110 @@
#include "tclInt.h"
#include "tclPort.h"
-#include "tclCompile.h"
#include "tclRegexp.h"
/*
- * Flag values used by Tcl_ScanObjCmd.
+ * Structure used to hold information about variable traces:
*/
-#define SCAN_NOSKIP 0x1 /* Don't skip blanks. */
-#define SCAN_SUPPRESS 0x2 /* Suppress assignment. */
-#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. */
+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 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. */
+} TraceVarInfo;
/*
- * Structure used to hold information about variable traces:
+ * Structure used to hold information about command traces:
*/
typedef struct {
int flags; /* Operations for which Tcl command is
* to be invoked. */
- char *errMsg; /* Error message returned from Tcl command,
- * or NULL. Malloc'ed. */
size_t length; /* Number of non-NULL chars. in command. */
+ Tcl_Trace stepTrace; /* Used for execution traces, when tracing
+ * inside the given command */
+ int startLevel; /* Used for bookkeeping with execution traces */
+ int curFlags; /* Trace flags for the current command */
+ int curCode; /* Return code for the current command */
char command[4]; /* 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. */
-} TraceVarInfo;
+} TraceCommandInfo;
+
+/*
+ * Used by command execution traces. Note that we assume in the code
+ * that the first two defines are exactly 4 times the
+ * 'TCL_TRACE_ENTER_EXEC' and 'TCL_TRACE_LEAVE_EXEC' constants.
+ *
+ * TCL_TRACE_ENTER_DURING_EXEC - Trace each command inside the command
+ * currently being traced, before execution.
+ * TCL_TRACE_LEAVE_DURING_EXEC - Trace each command inside the command
+ * currently being traced, after execution.
+ * TCL_TRACE_ANY_EXEC - OR'd combination of all EXEC flags.
+ * TCL_TRACE_EXEC_IN_PROGRESS - The callback procedure on this trace
+ * is currently executing. Therefore we
+ * don't let further traces execute.
+ * TCL_TRACE_EXEC_DIRECT - This execution trace is triggered directly
+ * by the command being traced, not because
+ * of an internal trace.
+ * The flags 'TCL_TRACE_DESTROYED' and 'TCL_INTERP_DESTROYED' may also
+ * be used in command execution traces.
+ */
+#define TCL_TRACE_ENTER_DURING_EXEC 4
+#define TCL_TRACE_LEAVE_DURING_EXEC 8
+#define TCL_TRACE_ANY_EXEC 15
+#define TCL_TRACE_EXEC_IN_PROGRESS 0x10
+#define TCL_TRACE_EXEC_DIRECT 0x20
/*
* Forward declarations for procedures defined in this file:
*/
+typedef int (Tcl_TraceTypeObjCmd) _ANSI_ARGS_((Tcl_Interp *interp,
+ int optionIndex, int objc, Tcl_Obj *CONST objv[]));
+
+Tcl_TraceTypeObjCmd TclTraceVariableObjCmd;
+Tcl_TraceTypeObjCmd TclTraceCommandObjCmd;
+Tcl_TraceTypeObjCmd TclTraceExecutionObjCmd;
+
+/*
+ * Each subcommand has a number of 'types' to which it can apply.
+ * Currently 'execution', 'command' and 'variable' are the only
+ * types supported. These three arrays MUST be kept in sync!
+ * In the future we may provide an API to add to the list of
+ * supported trace types.
+ */
+static CONST char *traceTypeOptions[] = {
+ "execution", "command", "variable", (char*) NULL
+};
+static Tcl_TraceTypeObjCmd* traceSubCmds[] = {
+ TclTraceExecutionObjCmd,
+ TclTraceCommandObjCmd,
+ TclTraceVariableObjCmd,
+};
+
+/*
+ * Declarations for local procedures to this file:
+ */
+static int CallTraceProcedure _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, char *name1, char *name2,
- int flags));
-
+ 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 Tcl_CmdObjTraceProc TraceExecutionProc;
+
/*
*----------------------------------------------------------------------
*
@@ -87,17 +148,19 @@ Tcl_PwdObjCmd(dummy, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- Tcl_DString ds;
+ Tcl_Obj *retVal;
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
- if (Tcl_GetCwd(interp, &ds) == NULL) {
+ retVal = Tcl_FSGetCwd(interp);
+ if (retVal == NULL) {
return TCL_ERROR;
}
- Tcl_DStringResult(interp, &ds);
+ Tcl_SetObjResult(interp, retVal);
+ Tcl_DecrRefCount(retVal);
return TCL_OK;
}
@@ -131,7 +194,7 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv)
Tcl_RegExp regExpr;
Tcl_Obj *objPtr, *resultPtr;
Tcl_RegExpInfo info;
- static char *options[] = {
+ static CONST char *options[] = {
"-all", "-about", "-indices", "-inline",
"-expanded", "-line", "-linestop", "-lineanchor",
"-nocase", "-start", "--", (char *) NULL
@@ -235,19 +298,30 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
- regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags);
- if (regExpr == NULL) {
- return TCL_ERROR;
- }
- objPtr = objv[1];
-
+ /*
+ * Handle the odd about case separately.
+ */
if (about) {
- if (TclRegAbout(interp, regExpr) < 0) {
+ regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags);
+ if ((regExpr == NULL) || (TclRegAbout(interp, regExpr) < 0)) {
return TCL_ERROR;
}
return TCL_OK;
}
+ /*
+ * Get the length of the string that we are matching against so
+ * we can do the termination test for -all matches. Do this before
+ * getting the regexp to avoid shimmering problems.
+ */
+ objPtr = objv[1];
+ stringLength = Tcl_GetCharLength(objPtr);
+
+ regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags);
+ if (regExpr == NULL) {
+ return TCL_ERROR;
+ }
+
if (offset > 0) {
/*
* Add flag if using offset (string is part of a larger string),
@@ -275,12 +349,6 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv)
}
/*
- * Get the length of the string that we are matching against so
- * we can do the termination test for -all matches.
- */
- stringLength = Tcl_GetCharLength(objPtr);
-
- /*
* The following loop is to handle multiple matches within the
* same source string; each iteration handles one match. If "-all"
* hasn't been specified then the loop body only gets executed once.
@@ -337,7 +405,11 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv)
int start, end;
Tcl_Obj *objs[2];
- if (i <= info.nsubs) {
+ /*
+ * Only adjust the match area if there was a match for
+ * that area. (Scriptics Bug 4391/SF Bug #219232)
+ */
+ if (i <= info.nsubs && info.matches[i].start >= 0) {
start = offset + info.matches[i].start;
end = offset + info.matches[i].end;
@@ -402,6 +474,7 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv)
}
offset += info.matches[0].end;
all++;
+ eflags |= TCL_REG_NOTBOL;
if (offset >= stringLength) {
break;
}
@@ -411,9 +484,12 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv)
* Set the interpreter's object result to an integer object
* with value 1 if -all wasn't specified, otherwise it's all-1
* (the number of times through the while - 1).
+ * Get the resultPtr again as the Tcl_ObjSetVar2 above may have
+ * cause the result to change. [Patch #558324] (watson).
*/
if (!doinline) {
+ resultPtr = Tcl_GetObjResult(interp);
Tcl_SetIntObj(resultPtr, (all ? all-1 : 1));
}
return TCL_OK;
@@ -444,13 +520,14 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- int i, result, cflags, all, wlen, numMatches, offset;
+ int idx, result, cflags, all, wlen, wsublen, numMatches, offset;
+ int start, end, subStart, subEnd, match;
Tcl_RegExp regExpr;
- Tcl_Obj *resultPtr, *varPtr, *objPtr;
- Tcl_UniChar *wstring;
- char *subspec;
+ Tcl_RegExpInfo info;
+ Tcl_Obj *resultPtr, *subPtr, *objPtr;
+ Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec, *wend;
- static char *options[] = {
+ static CONST char *options[] = {
"-all", "-nocase", "-expanded",
"-line", "-linestop", "-lineanchor", "-start",
"--", NULL
@@ -464,17 +541,18 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
cflags = TCL_REG_ADVANCED;
all = 0;
offset = 0;
+ resultPtr = NULL;
- for (i = 1; i < objc; i++) {
+ for (idx = 1; idx < objc; idx++) {
char *name;
int index;
- name = Tcl_GetString(objv[i]);
+ name = Tcl_GetString(objv[idx]);
if (name[0] != '-') {
break;
}
- if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", TCL_EXACT,
- &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObj(interp, objv[idx], options, "switch",
+ TCL_EXACT, &index) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum options) index) {
@@ -503,10 +581,10 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
break;
}
case REGSUB_START: {
- if (++i >= objc) {
+ if (++idx >= objc) {
goto endOfForLoop;
}
- if (Tcl_GetIntFromObj(interp, objv[i], &offset) != TCL_OK) {
+ if (Tcl_GetIntFromObj(interp, objv[idx], &offset) != TCL_OK) {
return TCL_ERROR;
}
if (offset < 0) {
@@ -515,34 +593,117 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
break;
}
case REGSUB_LAST: {
- i++;
+ idx++;
goto endOfForLoop;
}
}
}
endOfForLoop:
- if (objc - i != 4) {
+ if (objc-idx < 3 || objc-idx > 4) {
Tcl_WrongNumArgs(interp, 1, objv,
- "?switches? exp string subSpec varName");
+ "?switches? exp string subSpec ?varName?");
return TCL_ERROR;
}
- objv += i;
+ objc -= idx;
+ objv += idx;
+
+ if (all && (offset == 0)
+ && (strpbrk(Tcl_GetString(objv[2]), "&\\") == NULL)
+ && (strpbrk(Tcl_GetString(objv[0]), "*+?{}()[].\\|^$") == NULL)) {
+ /*
+ * This is a simple one pair string map situation. We make use of
+ * a slightly modified version of the one pair STR_MAP code.
+ */
+ int slen, nocase;
+ int (*strCmpFn)_ANSI_ARGS_((CONST Tcl_UniChar *, CONST Tcl_UniChar *,
+ unsigned long));
+ Tcl_UniChar *p, wsrclc;
+
+ numMatches = 0;
+ nocase = (cflags & TCL_REG_NOCASE);
+ strCmpFn = nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp;
+
+ wsrc = Tcl_GetUnicodeFromObj(objv[0], &slen);
+ wstring = Tcl_GetUnicodeFromObj(objv[1], &wlen);
+ wsubspec = Tcl_GetUnicodeFromObj(objv[2], &wsublen);
+ wend = wstring + wlen - (slen ? slen - 1 : 0);
+ result = TCL_OK;
+
+ if (slen == 0) {
+ /*
+ * regsub behavior for "" matches between each character.
+ * 'string map' skips the "" case.
+ */
+ if (wstring < wend) {
+ resultPtr = Tcl_NewUnicodeObj(wstring, 0);
+ Tcl_IncrRefCount(resultPtr);
+ for (; wstring < wend; wstring++) {
+ Tcl_AppendUnicodeToObj(resultPtr, wsubspec, wsublen);
+ Tcl_AppendUnicodeToObj(resultPtr, wstring, 1);
+ numMatches++;
+ }
+ wlen = 0;
+ }
+ } else {
+ wsrclc = Tcl_UniCharToLower(*wsrc);
+ for (p = wfirstChar = wstring; wstring < wend; wstring++) {
+ if (((*wstring == *wsrc) ||
+ (nocase && (Tcl_UniCharToLower(*wstring) ==
+ wsrclc))) &&
+ ((slen == 1) || (strCmpFn(wstring, wsrc,
+ (unsigned long) slen) == 0))) {
+ if (numMatches == 0) {
+ resultPtr = Tcl_NewUnicodeObj(wstring, 0);
+ Tcl_IncrRefCount(resultPtr);
+ }
+ if (p != wstring) {
+ Tcl_AppendUnicodeToObj(resultPtr, p, wstring - p);
+ p = wstring + slen;
+ } else {
+ p += slen;
+ }
+ wstring = p - 1;
+
+ Tcl_AppendUnicodeToObj(resultPtr, wsubspec, wsublen);
+ numMatches++;
+ }
+ }
+ if (numMatches) {
+ wlen = wfirstChar + wlen - p;
+ wstring = p;
+ }
+ }
+ objPtr = NULL;
+ subPtr = NULL;
+ goto regsubDone;
+ }
regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags);
if (regExpr == NULL) {
return TCL_ERROR;
}
- result = TCL_OK;
- resultPtr = Tcl_NewObj();
- Tcl_IncrRefCount(resultPtr);
+ /*
+ * Make sure to avoid problems where the objects are shared. This
+ * can cause RegExpObj <> UnicodeObj shimmering that causes data
+ * corruption. [Bug #461322]
+ */
- objPtr = objv[1];
- wlen = Tcl_GetCharLength(objPtr);
- wstring = Tcl_GetUnicode(objPtr);
- subspec = Tcl_GetString(objv[2]);
- varPtr = objv[3];
+ if (objv[1] == objv[0]) {
+ objPtr = Tcl_DuplicateObj(objv[1]);
+ } else {
+ objPtr = objv[1];
+ }
+ wstring = Tcl_GetUnicodeFromObj(objPtr, &wlen);
+ if (objv[2] == objv[0]) {
+ subPtr = Tcl_DuplicateObj(objv[2]);
+ } else {
+ subPtr = objv[2];
+ }
+ wsubspec = Tcl_GetUnicodeFromObj(subPtr, &wsublen);
+
+ result = TCL_OK;
/*
* The following loop is to handle multiple matches within the
@@ -553,10 +714,6 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
numMatches = 0;
for ( ; offset < wlen; ) {
- int start, end, subStart, subEnd, match;
- char *src, *firstChar;
- char c;
- Tcl_RegExpInfo info;
/*
* The flags argument is set if string is part of a larger string,
@@ -573,11 +730,16 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
if (match == 0) {
break;
}
- if ((numMatches == 0) && (offset > 0)) {
- /* Copy the initial portion of the string in if an offset
- * was specified.
- */
- Tcl_AppendUnicodeToObj(resultPtr, wstring, offset);
+ if (numMatches == 0) {
+ resultPtr = Tcl_NewUnicodeObj(wstring, 0);
+ Tcl_IncrRefCount(resultPtr);
+ if (offset > 0) {
+ /*
+ * Copy the initial portion of the string in if an offset
+ * was specified.
+ */
+ Tcl_AppendUnicodeToObj(resultPtr, wstring, offset);
+ }
}
numMatches++;
@@ -598,22 +760,22 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
* subSpec to reduce the number of calls to Tcl_SetVar.
*/
- src = subspec;
- firstChar = subspec;
- for (c = *src; c != '\0'; src++, c = *src) {
- int index;
-
- if (c == '&') {
- index = 0;
- } else if (c == '\\') {
- c = src[1];
- if ((c >= '0') && (c <= '9')) {
- index = c - '0';
- } else if ((c == '\\') || (c == '&')) {
- Tcl_AppendToObj(resultPtr, firstChar, src - firstChar);
- Tcl_AppendToObj(resultPtr, &c, 1);
- firstChar = src + 2;
- src++;
+ wsrc = wfirstChar = wsubspec;
+ wend = wsubspec + wsublen;
+ for (ch = *wsrc; wsrc != wend; wsrc++, ch = *wsrc) {
+ if (ch == '&') {
+ idx = 0;
+ } else if (ch == '\\') {
+ ch = wsrc[1];
+ if ((ch >= '0') && (ch <= '9')) {
+ idx = ch - '0';
+ } else if ((ch == '\\') || (ch == '&')) {
+ *wsrc = ch;
+ Tcl_AppendUnicodeToObj(resultPtr, wfirstChar,
+ wsrc - wfirstChar + 1);
+ *wsrc = '\\';
+ wfirstChar = wsrc + 2;
+ wsrc++;
continue;
} else {
continue;
@@ -621,24 +783,25 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
} else {
continue;
}
- if (firstChar != src) {
- Tcl_AppendToObj(resultPtr, firstChar, src - firstChar);
+ if (wfirstChar != wsrc) {
+ Tcl_AppendUnicodeToObj(resultPtr, wfirstChar,
+ wsrc - wfirstChar);
}
- if (index <= info.nsubs) {
- subStart = info.matches[index].start;
- subEnd = info.matches[index].end;
+ if (idx <= info.nsubs) {
+ subStart = info.matches[idx].start;
+ subEnd = info.matches[idx].end;
if ((subStart >= 0) && (subEnd >= 0)) {
Tcl_AppendUnicodeToObj(resultPtr,
wstring + offset + subStart, subEnd - subStart);
}
}
- if (*src == '\\') {
- src++;
+ if (*wsrc == '\\') {
+ wsrc++;
}
- firstChar = src + 1;
+ wfirstChar = wsrc + 1;
}
- if (firstChar != src) {
- Tcl_AppendToObj(resultPtr, firstChar, src - firstChar);
+ if (wfirstChar != wsrc) {
+ Tcl_AppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar);
}
if (end == 0) {
/*
@@ -648,8 +811,9 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1);
offset++;
+ } else {
+ offset += end;
}
- offset += end;
if (!all) {
break;
}
@@ -659,31 +823,41 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
* Copy the portion of the source string after the last match to the
* result variable.
*/
-
+ regsubDone:
if (numMatches == 0) {
/*
* On zero matches, just ignore the offset, since it shouldn't
* matter to us in this case, and the user may have skewed it.
*/
- Tcl_AppendUnicodeToObj(resultPtr, wstring, wlen);
+ resultPtr = objv[1];
+ Tcl_IncrRefCount(resultPtr);
} else if (offset < wlen) {
Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, wlen - offset);
}
- if (Tcl_ObjSetVar2(interp, varPtr, NULL, resultPtr, 0) == NULL) {
- Tcl_AppendResult(interp, "couldn't set variable \"",
- Tcl_GetString(varPtr), "\"", (char *) NULL);
- result = TCL_ERROR;
+ if (objc == 4) {
+ if (Tcl_ObjSetVar2(interp, objv[3], NULL, resultPtr, 0) == NULL) {
+ Tcl_AppendResult(interp, "couldn't set variable \"",
+ Tcl_GetString(objv[3]), "\"", (char *) NULL);
+ result = TCL_ERROR;
+ } else {
+ /*
+ * Set the interpreter's object result to an integer object
+ * holding the number of matches.
+ */
+
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), numMatches);
+ }
} else {
/*
- * Set the interpreter's object result to an integer object holding the
- * number of matches.
+ * No varname supplied, so just return the modified string.
*/
-
- Tcl_SetIntObj(Tcl_GetObjResult(interp), numMatches);
+ Tcl_SetObjResult(interp, resultPtr);
}
done:
- Tcl_DecrRefCount(resultPtr);
+ if (objPtr && (objv[1] == objv[0])) { Tcl_DecrRefCount(objPtr); }
+ if (subPtr && (objv[2] == objv[0])) { Tcl_DecrRefCount(subPtr); }
+ if (resultPtr) { Tcl_DecrRefCount(resultPtr); }
return result;
}
@@ -845,17 +1019,12 @@ Tcl_SourceObjCmd(dummy, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- char *bytes;
- int result;
-
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "fileName");
return TCL_ERROR;
}
- bytes = Tcl_GetString(objv[1]);
- result = Tcl_EvalFile(interp, bytes);
- return result;
+ return Tcl_FSEvalFile(interp, objv[1]);
}
/*
@@ -908,15 +1077,34 @@ Tcl_SplitObjCmd(dummy, interp, objc, objv)
* Do nothing.
*/
} else if (splitCharLen == 0) {
+ Tcl_HashTable charReuseTable;
+ Tcl_HashEntry *hPtr;
+ int isNew;
+
/*
* Handle the special case of splitting on every character.
+ *
+ * Uses a hash table to ensure that each kind of character has
+ * only one Tcl_Obj instance (multiply-referenced) in the
+ * final list. This is a *major* win when splitting on a long
+ * string (especially in the megabyte range!) - DKF
*/
+ Tcl_InitHashTable(&charReuseTable, TCL_ONE_WORD_KEYS);
for ( ; string < end; string += len) {
len = Tcl_UtfToUniChar(string, &ch);
- objPtr = Tcl_NewStringObj(string, len);
+ /* Assume Tcl_UniChar is an integral type... */
+ hPtr = Tcl_CreateHashEntry(&charReuseTable, (char*)0 + ch, &isNew);
+ if (isNew) {
+ objPtr = Tcl_NewStringObj(string, len);
+ /* Don't need to fiddle with refcount... */
+ Tcl_SetHashValue(hPtr, (ClientData) objPtr);
+ } else {
+ objPtr = (Tcl_Obj*) Tcl_GetHashValue(hPtr);
+ }
Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
}
+ Tcl_DeleteHashTable(&charReuseTable);
} else {
char *element, *p, *splitEnd;
int splitLen;
@@ -957,6 +1145,11 @@ Tcl_SplitObjCmd(dummy, interp, objc, objv)
* that this command only functions correctly on properly formed
* Tcl UTF strings.
*
+ * 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.
*
@@ -978,7 +1171,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
Tcl_Obj *resultPtr;
char *string1, *string2;
int length1, length2;
- static char *options[] = {
+ static CONST char *options[] = {
"bytelength", "compare", "equal", "first",
"index", "is", "last", "length",
"map", "match", "range", "repeat",
@@ -1009,7 +1202,14 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
switch ((enum options) index) {
case STR_EQUAL:
case STR_COMPARE: {
+ /*
+ * 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/...).
+ */
int i, match, length, nocase = 0, reqlength = -1;
+ int (*strCmpFn)();
if (objc < 4 || objc > 7) {
str_cmp_args:
@@ -1021,10 +1221,10 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
for (i = 2; i < objc-2; i++) {
string2 = Tcl_GetStringFromObj(objv[i], &length2);
if ((length2 > 1)
- && strncmp(string2, "-nocase", (size_t) length2) == 0) {
+ && strncmp(string2, "-nocase", (size_t)length2) == 0) {
nocase = 1;
} else if ((length2 > 1)
- && strncmp(string2, "-length", (size_t) length2) == 0) {
+ && strncmp(string2, "-length", (size_t)length2) == 0) {
if (i+1 >= objc-2) {
goto str_cmp_args;
}
@@ -1040,58 +1240,80 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
}
}
- string1 = Tcl_GetStringFromObj(objv[objc-2], &length1);
- string2 = Tcl_GetStringFromObj(objv[objc-1], &length2);
/*
- * This is the min length IN BYTES of the two strings
+ * From now on, we only access the two objects at the end
+ * of the argument array.
*/
- length = (length1 < length2) ? length1 : length2;
+ objv += objc-2;
- if (reqlength == 0) {
+ if ((reqlength == 0) || (objv[0] == objv[1])) {
/*
- * Anything matches at 0 chars, right?
+ * Alway match at 0 chars of if it is the same obj.
*/
- match = 0;
- } else if (nocase || ((reqlength > 0) && (reqlength <= length))) {
+ Tcl_SetBooleanObj(resultPtr,
+ ((enum options) index == STR_EQUAL));
+ break;
+ } else if (!nocase && objv[0]->typePtr == &tclByteArrayType &&
+ objv[1]->typePtr == &tclByteArrayType) {
/*
- * with -nocase or -length we have to check true char length
- * as it could be smaller than expected
+ * 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... :^)
*/
-
- length1 = Tcl_NumUtfChars(string1, length1);
- length2 = Tcl_NumUtfChars(string2, length2);
- length = (length1 < length2) ? length1 : length2;
-
+ string1 = (char*) Tcl_GetByteArrayFromObj(objv[0], &length1);
+ string2 = (char*) Tcl_GetByteArrayFromObj(objv[1], &length2);
+ strCmpFn = memcmp;
+ } else if ((objv[0]->typePtr == &tclStringType)
+ && (objv[1]->typePtr == &tclStringType)) {
/*
- * Do the reqlength check again, against 0 as well for
- * the benfit of nocase
+ * 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 = 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
+ * 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.
+ */
+ string1 = (char*) Tcl_GetStringFromObj(objv[0], &length1);
+ string2 = (char*) Tcl_GetStringFromObj(objv[1], &length2);
+ if ((reqlength < 0) && !nocase) {
+ strCmpFn = TclpUtfNcmp2;
+ } else {
+ length1 = Tcl_NumUtfChars(string1, length1);
+ length2 = Tcl_NumUtfChars(string2, length2);
+ strCmpFn = nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp;
+ }
+ }
- if ((reqlength > 0) && (reqlength < length)) {
+ 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 the longer of the two lengths.
+ * setting it to length + 1 so we correct the match var.
*/
-
- reqlength = (length1 > length2) ? length1 : length2;
- }
- if (nocase) {
- match = Tcl_UtfNcasecmp(string1, string2,
- (unsigned) length);
- } else {
- match = Tcl_UtfNcmp(string1, string2, (unsigned) length);
+ reqlength = length + 1;
}
+ match = strCmpFn(string1, string2, (unsigned) length);
if ((match == 0) && (reqlength > length)) {
match = length1 - length2;
}
- } else {
- match = memcmp(string1, string2, (unsigned) length);
- if (match == 0) {
- match = length1 - length2;
- }
}
if ((enum options) index == STR_EQUAL) {
@@ -1103,91 +1325,79 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
break;
}
case STR_FIRST: {
- register char *p, *end;
- int match, utflen, start;
+ Tcl_UniChar *ustring1, *ustring2;
+ int match, start;
if (objc < 4 || objc > 5) {
Tcl_WrongNumArgs(interp, 2, objv,
- "string1 string2 ?startIndex?");
+ "subString string ?startIndex?");
return TCL_ERROR;
}
/*
- * This algorithm fails on improperly formed UTF strings.
* We are searching string2 for the sequence string1.
*/
match = -1;
start = 0;
- utflen = -1;
- string1 = Tcl_GetStringFromObj(objv[2], &length1);
- string2 = Tcl_GetStringFromObj(objv[3], &length2);
+ length2 = -1;
+
+ ustring1 = Tcl_GetUnicodeFromObj(objv[2], &length1);
+ ustring2 = Tcl_GetUnicodeFromObj(objv[3], &length2);
if (objc == 5) {
/*
- * If a startIndex is specified, we will need to fast forward
- * to that point in the string before we think about a match
+ * If a startIndex is specified, we will need to fast
+ * forward to that point in the string before we think
+ * about a match
*/
- utflen = Tcl_NumUtfChars(string2, length2);
- if (TclGetIntForIndex(interp, objv[4], utflen-1,
- &start) != TCL_OK) {
+ if (TclGetIntForIndex(interp, objv[4], length2 - 1,
+ &start) != TCL_OK) {
return TCL_ERROR;
}
- if (start >= utflen) {
+ if (start >= length2) {
goto str_first_done;
} else if (start > 0) {
- if (length2 == utflen) {
- /* no unicode chars */
- string2 += start;
- length2 -= start;
- } else {
- char *s = Tcl_UtfAtIndex(string2, start);
- length2 -= s - string2;
- string2 = s;
- }
+ ustring2 += start;
+ length2 -= start;
+ } else if (start < 0) {
+ /*
+ * Invalid start index mapped to string start;
+ * Bug #423581
+ */
+ start = 0;
}
}
if (length1 > 0) {
- end = string2 + length2 - length1 + 1;
- for (p = string2; p < end; p++) {
+ register Tcl_UniChar *p, *end;
+
+ end = ustring2 + length2 - length1 + 1;
+ for (p = ustring2; p < end; p++) {
/*
* Scan forward to find the first character.
*/
-
- p = memchr(p, *string1, (unsigned) (end - p));
- if (p == NULL) {
- break;
- }
- if (memcmp(string1, p, (unsigned) length1) == 0) {
- match = p - string2;
+ if ((*p == *ustring1) &&
+ (TclUniCharNcmp(ustring1, p,
+ (unsigned long) length1) == 0)) {
+ match = p - ustring2;
break;
}
}
}
-
/*
* Compute the character index of the matching string by
* counting the number of characters before the match.
*/
- str_first_done:
- if (match != -1) {
- if (objc == 4) {
- match = Tcl_NumUtfChars(string2, match);
- } else if (length2 == utflen) {
- /* no unicode chars */
- match += start;
- } else {
- match = start + Tcl_NumUtfChars(string2, match);
- }
+ if ((match != -1) && (objc == 5)) {
+ match += start;
}
+
+ str_first_done:
Tcl_SetIntObj(resultPtr, match);
break;
}
case STR_INDEX: {
- char buf[TCL_UTF_MAX];
- Tcl_UniChar unichar;
-
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "string charIndex");
return TCL_ERROR;
@@ -1201,33 +1411,33 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
*/
if (objv[2]->typePtr == &tclByteArrayType) {
-
- string1 = (char *)Tcl_GetByteArrayFromObj(objv[2], &length1);
+ string1 = (char *) Tcl_GetByteArrayFromObj(objv[2], &length1);
if (TclGetIntForIndex(interp, objv[3], length1 - 1,
&index) != TCL_OK) {
return TCL_ERROR;
}
- Tcl_SetByteArrayObj(resultPtr,
- (unsigned char *)(&string1[index]), 1);
+ if ((index >= 0) && (index < length1)) {
+ Tcl_SetByteArrayObj(resultPtr,
+ (unsigned char *)(&string1[index]), 1);
+ }
} else {
- string1 = Tcl_GetStringFromObj(objv[2], &length1);
-
/*
- * convert to Unicode internal rep to calulate what
- * 'end' really means.
+ * Get Unicode char length to calulate what 'end' means.
*/
+ length1 = Tcl_GetCharLength(objv[2]);
- length2 = Tcl_GetCharLength(objv[2]);
-
- if (TclGetIntForIndex(interp, objv[3], length2 - 1,
+ if (TclGetIntForIndex(interp, objv[3], length1 - 1,
&index) != TCL_OK) {
return TCL_ERROR;
}
- if ((index >= 0) && (index < length2)) {
- unichar = Tcl_GetUniChar(objv[2], index);
- length2 = Tcl_UniCharToUtf((int)unichar, buf);
- Tcl_SetStringObj(resultPtr, buf, length2);
+ 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_SetStringObj(resultPtr, buf, length1);
}
}
break;
@@ -1244,7 +1454,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
int i, failat = 0, result = 1, strict = 0;
Tcl_Obj *objPtr, *failVarObj = NULL;
- static char *isOptions[] = {
+ static CONST char *isOptions[] = {
"alnum", "alpha", "ascii", "control",
"boolean", "digit", "double", "false",
"graph", "integer", "lower", "print",
@@ -1275,7 +1485,8 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
strncmp(string2, "-strict", (size_t) length2) == 0) {
strict = 1;
} else if ((length2 > 1) &&
- strncmp(string2, "-failindex", (size_t) length2) == 0) {
+ strncmp(string2, "-failindex",
+ (size_t) length2) == 0) {
if (i+1 >= objc-1) {
Tcl_WrongNumArgs(interp, 3, objv,
"?-strict? ?-failindex var? str");
@@ -1375,7 +1586,11 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
*/
if (TclLooksLikeInt(string1, length1)) {
errno = 0;
- strtoul(string1, &stop, 0);
+#ifdef TCL_WIDE_INT_IS_LONG
+ strtoul(string1, &stop, 0); /* INTL: Tcl source. */
+#else
+ strtoull(string1, &stop, 0); /* INTL: Tcl source. */
+#endif
if (stop == end) {
if (errno == ERANGE) {
result = 0;
@@ -1429,7 +1644,11 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
*/
result = 0;
errno = 0;
+#ifdef TCL_WIDE_INT_IS_LONG
strtoul(string1, &stop, 0); /* INTL: Tcl source. */
+#else
+ strtoull(string1, &stop, 0); /* INTL: Tcl source. */
+#endif
if (errno == ERANGE) {
/*
* if (errno == ERANGE), then it was an over/underflow
@@ -1508,78 +1727,61 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
break;
}
case STR_LAST: {
- register char *p;
- int match, utflen, start;
+ Tcl_UniChar *ustring1, *ustring2, *p;
+ int match, start;
if (objc < 4 || objc > 5) {
Tcl_WrongNumArgs(interp, 2, objv,
- "string1 string2 ?startIndex?");
+ "subString string ?startIndex?");
return TCL_ERROR;
}
/*
- * This algorithm fails on improperly formed UTF strings.
+ * We are searching string2 for the sequence string1.
*/
match = -1;
start = 0;
- utflen = -1;
- string1 = Tcl_GetStringFromObj(objv[2], &length1);
- string2 = Tcl_GetStringFromObj(objv[3], &length2);
+ length2 = -1;
+
+ ustring1 = Tcl_GetUnicodeFromObj(objv[2], &length1);
+ ustring2 = Tcl_GetUnicodeFromObj(objv[3], &length2);
if (objc == 5) {
/*
* If a startIndex is specified, we will need to restrict
* the string range to that char index in the string
*/
- utflen = Tcl_NumUtfChars(string2, length2);
- if (TclGetIntForIndex(interp, objv[4], utflen-1,
- &start) != TCL_OK) {
+ if (TclGetIntForIndex(interp, objv[4], length2 - 1,
+ &start) != TCL_OK) {
return TCL_ERROR;
}
if (start < 0) {
goto str_last_done;
- } else if (start < utflen) {
- if (length2 == utflen) {
- /* no unicode chars */
- p = string2 + start + 1 - length1;
- } else {
- p = Tcl_UtfAtIndex(string2, start+1) - length1;
- }
+ } else if (start < length2) {
+ p = ustring2 + start + 1 - length1;
} else {
- p = string2 + length2 - length1;
+ p = ustring2 + length2 - length1;
}
} else {
- p = string2 + length2 - length1;
+ p = ustring2 + length2 - length1;
}
if (length1 > 0) {
- for (; p >= string2; p--) {
+ for (; p >= ustring2; p--) {
/*
* Scan backwards to find the first character.
*/
-
- while ((p != string2) && (*p != *string1)) {
- p--;
- }
- if (memcmp(string1, p, (unsigned) length1) == 0) {
- match = p - string2;
+ if ((*p == *ustring1) &&
+ (memcmp((char *) ustring1, (char *) p, (size_t)
+ (length1 * sizeof(Tcl_UniChar))) == 0)) {
+ match = p - ustring2;
break;
}
}
}
- /*
- * Compute the character index of the matching string by counting
- * the number of characters before the match.
- */
- str_last_done:
- if (match != -1) {
- if ((objc == 4) || (length2 != utflen)) {
- /* only check when we've got unicode chars */
- match = Tcl_NumUtfChars(string2, match);
- }
- }
+ str_last_done:
Tcl_SetIntObj(resultPtr, match);
break;
}
@@ -1592,7 +1794,6 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
if ((enum options) index == STR_BYTELENGTH) {
(void) Tcl_GetStringFromObj(objv[2], &length1);
- Tcl_SetIntObj(resultPtr, length1);
} else {
/*
* If we have a ByteArray object, avoid recomputing the
@@ -1603,20 +1804,19 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
if (objv[2]->typePtr == &tclByteArrayType) {
(void) Tcl_GetByteArrayFromObj(objv[2], &length1);
- Tcl_SetIntObj(resultPtr, length1);
} else {
- Tcl_SetIntObj(resultPtr,
- Tcl_GetCharLength(objv[2]));
+ length1 = Tcl_GetCharLength(objv[2]);
}
}
+ Tcl_SetIntObj(resultPtr, length1);
break;
}
case STR_MAP: {
- int uselen, mapElemc, len, nocase = 0;
+ int mapElemc, nocase = 0;
Tcl_Obj **mapElemv;
- char *end;
- Tcl_UniChar ch;
- int (*str_comp_fn)();
+ Tcl_UniChar *ustring1, *ustring2, *p, *end;
+ int (*strCmpFn)_ANSI_ARGS_((CONST Tcl_UniChar*,
+ CONST Tcl_UniChar*, unsigned long));
if (objc < 4 || objc > 5) {
Tcl_WrongNumArgs(interp, 2, objv, "?-nocase? charMap string");
@@ -1645,6 +1845,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
* 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
@@ -1652,63 +1853,131 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
Tcl_SetStringObj(resultPtr, "char map list unbalanced", -1);
return TCL_ERROR;
}
- string1 = Tcl_GetStringFromObj(objv[objc-1], &length1);
+ objc--;
+
+ ustring1 = Tcl_GetUnicodeFromObj(objv[objc], &length1);
if (length1 == 0) {
+ /*
+ * Empty input string, just stop now
+ */
break;
}
- end = string1 + length1;
+ end = ustring1 + length1;
- if (nocase) {
- length1 = Tcl_NumUtfChars(string1, length1);
- str_comp_fn = Tcl_UtfNcasecmp;
- } else {
- str_comp_fn = memcmp;
- }
+ strCmpFn = nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp;
- for ( ; string1 < end; string1 += len) {
- len = Tcl_UtfToUniChar(string1, &ch);
- for (index = 0; index < mapElemc; index +=2) {
- /*
- * Get the key string to match on
- */
- string2 = Tcl_GetStringFromObj(mapElemv[index],
- &length2);
- if (nocase) {
- uselen = Tcl_NumUtfChars(string2, length2);
- } else {
- uselen = length2;
+ /*
+ * Force result to be Unicode
+ */
+ Tcl_SetUnicodeObj(resultPtr, 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.
+ */
+ int mapLen;
+ Tcl_UniChar *mapString, u2lc;
+
+ ustring2 = Tcl_GetUnicodeFromObj(mapElemv[0], &length2);
+ p = ustring1;
+ if (length2 == 0) {
+ 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;
+
+ Tcl_AppendUnicodeToObj(resultPtr, mapString,
+ mapLen);
+ }
}
- if ((uselen > 0) && (uselen <= length1) &&
- (str_comp_fn(string2, string1, uselen) == 0)) {
- /*
- * Adjust len to be full length of matched string
- * it has to be the BYTE length
- */
- len = length2;
+ }
+ } else {
+ Tcl_UniChar **mapStrings, *u2lc = NULL;
+ int *mapLens;
+ /*
+ * 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.
+ */
+ 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) {
/*
- * Change string2 and length2 to the map value
+ * Get the key string to match on.
*/
- string2 = Tcl_GetStringFromObj(mapElemv[index+1],
- &length2);
- Tcl_AppendToObj(resultPtr, string2, length2);
- break;
+ ustring2 = mapStrings[index];
+ length2 = mapLens[index];
+ if ((length2 > 0) && ((*ustring1 == *ustring2) ||
+ (nocase && (Tcl_UniCharToLower(*ustring1) ==
+ u2lc[index/2]))) &&
+ ((length2 == 1) || strCmpFn(ustring2, ustring1,
+ (unsigned long) length2) == 0)) {
+ 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 (index == mapElemc) {
- /*
- * No match was found, put the char onto result
- */
- Tcl_AppendToObj(resultPtr, string1, len);
+ ckfree((char *) mapStrings);
+ ckfree((char *) mapLens);
+ if (nocase) {
+ ckfree((char *) u2lc);
}
+ }
+ if (p != ustring1) {
/*
- * in nocase, length1 is in chars
- * otherwise it is in bytes
+ * Put the rest of the unmapped chars onto result
*/
- if (nocase) {
- length1--;
- } else {
- length1 -= len;
- }
+ Tcl_AppendUnicodeToObj(resultPtr, p, ustring1 - p);
}
break;
}
@@ -1734,9 +2003,8 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
}
Tcl_SetBooleanObj(resultPtr,
- Tcl_StringCaseMatch(Tcl_GetString(objv[objc-1]),
- Tcl_GetString(objv[objc-2]),
- nocase));
+ Tcl_UniCharCaseMatch(Tcl_GetUnicode(objv[objc-1]),
+ Tcl_GetUnicode(objv[objc-2]), nocase));
break;
}
case STR_RANGE: {
@@ -1748,64 +2016,24 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
}
/*
- * 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.
+ * Get the length in actual characters.
*/
+ length1 = Tcl_GetCharLength(objv[2]) - 1;
- if (objv[2]->typePtr == &tclByteArrayType) {
-
- string1 = (char *)Tcl_GetByteArrayFromObj(objv[2], &length1);
-
- if (TclGetIntForIndex(interp, objv[3], length1 - 1,
- &first) != TCL_OK) {
- return TCL_ERROR;
- }
- if (TclGetIntForIndex(interp, objv[4], length1 - 1,
- &last) != TCL_OK) {
- return TCL_ERROR;
- }
- if (first < 0) {
- first = 0;
- }
- if (last >= length1 - 1) {
- last = length1 - 1;
- }
- if (last >= first) {
- int numBytes = last - first + 1;
- resultPtr = Tcl_NewByteArrayObj(
- (unsigned char *) &string1[first], numBytes);
- Tcl_SetObjResult(interp, resultPtr);
- }
- } else {
- string1 = Tcl_GetStringFromObj(objv[2], &length1);
-
- /*
- * Convert to Unicode internal rep to calulate length and
- * create a result object.
- */
+ if ((TclGetIntForIndex(interp, objv[3], length1, &first) != TCL_OK)
+ || (TclGetIntForIndex(interp, objv[4], length1,
+ &last) != TCL_OK)) {
+ return TCL_ERROR;
+ }
- length2 = Tcl_GetCharLength(objv[2]) - 1;
-
- if (TclGetIntForIndex(interp, objv[3], length2,
- &first) != TCL_OK) {
- return TCL_ERROR;
- }
- if (TclGetIntForIndex(interp, objv[4], length2,
- &last) != TCL_OK) {
- return TCL_ERROR;
- }
- if (first < 0) {
- first = 0;
- }
- if (last >= length2) {
- last = length2;
- }
- if (last >= first) {
- resultPtr = Tcl_GetRange(objv[2], first, last);
- Tcl_SetObjResult(interp, resultPtr);
- }
+ if (first < 0) {
+ first = 0;
+ }
+ if (last >= length1) {
+ last = length1;
+ }
+ if (last >= first) {
+ Tcl_SetObjResult(interp, Tcl_GetRange(objv[2], first, last));
}
break;
}
@@ -1821,15 +2049,41 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
- string1 = Tcl_GetStringFromObj(objv[2], &length1);
- if (length1 > 0) {
- for (index = 0; index < count; index++) {
- Tcl_AppendToObj(resultPtr, string1, length1);
+ 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.
+ */
+ length2 = length1 * count;
+ /*
+ * Include space for the NULL
+ */
+ string2 = (char *) ckalloc((size_t) length2+1);
+ 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.
+ */
+ resultPtr = Tcl_NewObj();
+ resultPtr->bytes = string2;
+ resultPtr->length = length2;
+ Tcl_SetObjResult(interp, resultPtr);
}
}
break;
}
case STR_REPLACE: {
+ Tcl_UniChar *ustring1;
int first, last;
if (objc < 5 || objc > 6) {
@@ -1838,33 +2092,29 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
- string1 = Tcl_GetStringFromObj(objv[2], &length1);
- length1 = Tcl_NumUtfChars(string1, length1) - 1;
- if (TclGetIntForIndex(interp, objv[3], length1,
- &first) != TCL_OK) {
- return TCL_ERROR;
- }
- if (TclGetIntForIndex(interp, objv[4], length1,
- &last) != TCL_OK) {
+ ustring1 = Tcl_GetUnicodeFromObj(objv[2], &length1);
+ length1--;
+
+ if ((TclGetIntForIndex(interp, objv[3], length1, &first) != TCL_OK)
+ || (TclGetIntForIndex(interp, objv[4], length1,
+ &last) != TCL_OK)) {
return TCL_ERROR;
}
- if ((last < first) || (first > length1) || (last < 0)) {
+
+ if ((last < first) || (last < 0) || (first > length1)) {
Tcl_SetObjResult(interp, objv[2]);
} else {
- char *start, *end;
-
if (first < 0) {
first = 0;
}
- start = Tcl_UtfAtIndex(string1, first);
- end = Tcl_UtfAtIndex(start, ((last > length1) ? length1 : last)
- - first + 1);
- Tcl_SetStringObj(resultPtr, string1, start - string1);
+
+ Tcl_SetUnicodeObj(resultPtr, ustring1, first);
if (objc == 6) {
Tcl_AppendObjToObj(resultPtr, objv[5]);
}
if (last < length1) {
- Tcl_AppendToObj(resultPtr, end, -1);
+ Tcl_AppendUnicodeToObj(resultPtr, ustring1 + last + 1,
+ length1 - last);
}
}
break;
@@ -1898,7 +2148,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
Tcl_SetObjLength(resultPtr, length1);
} else {
int first, last;
- char *start, *end;
+ CONST char *start, *end;
length1 = Tcl_NumUtfChars(string1, length1) - 1;
if (TclGetIntForIndex(interp, objv[3], length1,
@@ -1942,7 +2192,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
case STR_TRIM: {
Tcl_UniChar ch, trim;
- register char *p, *end;
+ register CONST char *p, *end;
char *check, *checkEnd;
int offset;
@@ -2031,7 +2281,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
case STR_WORDEND: {
int cur;
Tcl_UniChar ch;
- char *p, *end;
+ CONST char *p, *end;
int numChars;
if (objc != 4) {
@@ -2069,7 +2319,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
case STR_WORDSTART: {
int cur;
Tcl_UniChar ch;
- char *p;
+ CONST char *p;
int numChars;
if (objc != 4) {
@@ -2114,8 +2364,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
*
* This procedure is invoked to process the "subst" Tcl command.
* See the user documentation for details on what it does. This
- * command is an almost direct copy of an implementation by
- * Andrew Payne.
+ * command relies on Tcl_SubstObj() for its implementation.
*
* Results:
* A standard Tcl result.
@@ -2134,27 +2383,21 @@ Tcl_SubstObjCmd(dummy, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- static char *substOptions[] = {
+ static CONST char *substOptions[] = {
"-nobackslashes", "-nocommands", "-novariables", (char *) NULL
};
enum substOptions {
SUBST_NOBACKSLASHES, SUBST_NOCOMMANDS, SUBST_NOVARS
};
- Interp *iPtr = (Interp *) interp;
- Tcl_DString result;
- char *p, *old, *value;
- int optionIndex, code, count, doVars, doCmds, doBackslashes, i;
+ Tcl_Obj *resultPtr;
+ int optionIndex, flags, i;
/*
* Parse command-line options.
*/
- doVars = doCmds = doBackslashes = 1;
+ flags = TCL_SUBST_ALL;
for (i = 1; i < (objc-1); i++) {
- p = Tcl_GetString(objv[i]);
- if (*p != '-') {
- break;
- }
if (Tcl_GetIndexFromObj(interp, objv[i], substOptions,
"switch", 0, &optionIndex) != TCL_OK) {
@@ -2162,15 +2405,15 @@ Tcl_SubstObjCmd(dummy, interp, objc, objv)
}
switch (optionIndex) {
case SUBST_NOBACKSLASHES: {
- doBackslashes = 0;
+ flags &= ~TCL_SUBST_BACKSLASHES;
break;
}
case SUBST_NOCOMMANDS: {
- doCmds = 0;
+ flags &= ~TCL_SUBST_COMMANDS;
break;
}
case SUBST_NOVARS: {
- doVars = 0;
+ flags &= ~TCL_SUBST_VARIABLES;
break;
}
default: {
@@ -2185,76 +2428,168 @@ Tcl_SubstObjCmd(dummy, interp, objc, objv)
}
/*
- * Scan through the string one character at a time, performing
- * command, variable, and backslash substitutions.
+ * Perform the substitution.
*/
+ resultPtr = Tcl_SubstObj(interp, objv[i], flags);
- Tcl_DStringInit(&result);
- old = p = Tcl_GetString(objv[i]);
- while (*p != 0) {
+ if (resultPtr == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, resultPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SubstObj --
+ *
+ * This function performs the substitutions specified on the
+ * given string as described in the user documentation for the
+ * "subst" Tcl command. This code is heavily based on an
+ * implementation by Andrew Payne. Note that if a command
+ * substitution returns TCL_CONTINUE or TCL_RETURN from its
+ * evaluation and is not completely well-formed, the results are
+ * not defined (or at least hard to characterise.) This fault
+ * will be fixed at some point, but the cost of the only sane
+ * fix (well-formedness check first) is such that you need to
+ * "precompile and cache" to stop everyone from being hit with
+ * the consequences every time through. Note that the current
+ * behaviour is not a security hole; it just restarts parsing
+ * the string following the substitution in a mildly surprising
+ * place, and it is a very bad idea to count on this remaining
+ * the same in future...
+ *
+ * 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(interp, objPtr, flags)
+ Tcl_Interp *interp;
+ Tcl_Obj *objPtr;
+ int flags;
+{
+ Tcl_Obj *resultObj;
+ char *p, *old;
+
+ old = p = Tcl_GetString(objPtr);
+ resultObj = Tcl_NewStringObj("", 0);
+ while (1) {
switch (*p) {
- case '\\':
- if (doBackslashes) {
- char buf[TCL_UTF_MAX];
+ case 0:
+ if (p != old) {
+ Tcl_AppendToObj(resultObj, old, p-old);
+ }
+ return resultObj;
- if (p != old) {
- Tcl_DStringAppend(&result, old, p-old);
- }
- Tcl_DStringAppend(&result, buf,
- Tcl_UtfBackslash(p, &count, buf));
- p += count;
- old = p;
- } else {
- p++;
+ case '\\':
+ if (flags & TCL_SUBST_BACKSLASHES) {
+ char buf[TCL_UTF_MAX];
+ int count;
+
+ if (p != old) {
+ Tcl_AppendToObj(resultObj, old, p-old);
}
- break;
+ Tcl_AppendToObj(resultObj, buf,
+ Tcl_UtfBackslash(p, &count, buf));
+ p += count;
+ old = p;
+ } else {
+ p++;
+ }
+ break;
- case '$':
- if (doVars) {
- if (p != old) {
- Tcl_DStringAppend(&result, old, p-old);
- }
- value = Tcl_ParseVar(interp, p, &p);
- if (value == NULL) {
- Tcl_DStringFree(&result);
- return TCL_ERROR;
- }
- Tcl_DStringAppend(&result, value, -1);
- old = p;
- } else {
+ case '$':
+ if (flags & TCL_SUBST_VARIABLES) {
+ Tcl_Parse parse;
+ int code;
+
+ /*
+ * Code is simpler overall if we (effectively) inline
+ * Tcl_ParseVar, particularly as that allows us to use
+ * a non-string interface when we come to appending
+ * the variable contents to the result object. There
+ * are a few other optimisations that doing this
+ * enables (like being able to continue the run of
+ * unsubstituted characters straight through if a '$'
+ * does not precede a variable name.)
+ */
+ if (Tcl_ParseVarName(interp, p, -1, &parse, 0) != TCL_OK) {
+ goto errorResult;
+ }
+ if (parse.numTokens == 1) {
+ /*
+ * There isn't a variable name after all: the $ is
+ * just a $.
+ */
p++;
+ break;
}
- break;
-
- case '[':
- if (doCmds) {
- if (p != old) {
- Tcl_DStringAppend(&result, old, p-old);
- }
- iPtr->evalFlags = TCL_BRACKET_TERM;
- code = Tcl_Eval(interp, p+1);
- if (code == TCL_ERROR) {
- Tcl_DStringFree(&result);
- return code;
- }
- old = p = (p+1 + iPtr->termOffset+1);
- Tcl_DStringAppend(&result, iPtr->result, -1);
+ if (p != old) {
+ Tcl_AppendToObj(resultObj, old, p-old);
+ }
+ p += parse.tokenPtr->size;
+ code = Tcl_EvalTokensStandard(interp, parse.tokenPtr,
+ parse.numTokens);
+ if (code == TCL_ERROR) {
+ goto errorResult;
+ }
+ if (code == TCL_BREAK) {
Tcl_ResetResult(interp);
- } else {
- p++;
+ return resultObj;
}
- break;
+ if (code != TCL_CONTINUE) {
+ Tcl_AppendObjToObj(resultObj, Tcl_GetObjResult(interp));
+ }
+ Tcl_ResetResult(interp);
+ old = p;
+ } else {
+ p++;
+ }
+ break;
+
+ case '[':
+ if (flags & TCL_SUBST_COMMANDS) {
+ Interp *iPtr = (Interp *) interp;
+ int code;
- default:
+ if (p != old) {
+ Tcl_AppendToObj(resultObj, old, p-old);
+ }
+ iPtr->evalFlags = TCL_BRACKET_TERM;
+ code = Tcl_EvalEx(interp, p+1, -1, 0);
+ switch (code) {
+ case TCL_ERROR:
+ goto errorResult;
+ case TCL_BREAK:
+ Tcl_ResetResult(interp);
+ return resultObj;
+ default:
+ Tcl_AppendObjToObj(resultObj, Tcl_GetObjResult(interp));
+ case TCL_CONTINUE:
+ Tcl_ResetResult(interp);
+ old = p = (p+1 + iPtr->termOffset + 1);
+ }
+ } else {
p++;
- break;
+ }
+ break;
+ default:
+ p++;
+ break;
}
}
- if (p != old) {
- Tcl_DStringAppend(&result, old, p-old);
- }
- Tcl_DStringResult(interp, &result);
- return TCL_OK;
+
+ errorResult:
+ Tcl_DecrRefCount(resultObj);
+ return NULL;
}
/*
@@ -2282,10 +2617,11 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- int i, j, index, mode, matched, result, splitObjs, seenComment;
+ int i, j, index, mode, matched, result, splitObjs;
char *string, *pattern;
Tcl_Obj *stringObj;
- static char *options[] = {
+ Tcl_Obj *CONST *savedObjv = objv;
+ static CONST char *options[] = {
"-exact", "-glob", "-regexp", "--",
NULL
};
@@ -2332,46 +2668,72 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
if (Tcl_ListObjGetElements(interp, objv[0], &objc, &listv) != TCL_OK) {
return TCL_ERROR;
}
- objv = listv;
- splitObjs = 1;
- }
- seenComment = 0;
- for (i = 0; i < objc; i += 2) {
- if (i == objc - 1) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "extra switch pattern with no body", -1);
-
- /*
- * Check if this can be due to a badly placed comment
- * in the switch block
- */
-
- if (splitObjs && seenComment) {
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- ", this may be due to a comment incorrectly placed outside of a switch body - see the \"switch\" documentation", -1);
- }
+ /*
+ * Ensure that the list is non-empty.
+ */
+ if (objc < 1) {
+ Tcl_WrongNumArgs(interp, 1, savedObjv,
+ "?switches? string {pattern body ... ?default body?}");
return TCL_ERROR;
}
+ objv = listv;
+ splitObjs = 1;
+ }
- /*
- * See if the pattern matches the string.
- */
+ /*
+ * Complain if there is an odd number of words in the list of
+ * patterns and bodies.
+ */
- pattern = Tcl_GetString(objv[i]);
+ if (objc % 2) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "extra switch pattern with no body", NULL);
/*
+ * Check if this can be due to a badly placed comment
+ * in the switch block.
+ *
* The following is an heuristic to detect the infamous
* "comment in switch" error: just check if a pattern
* begins with '#'.
*/
- if (splitObjs && *pattern == '#') {
- seenComment = 1;
+ if (splitObjs) {
+ for (i=0 ; i<objc ; i+=2) {
+ if (Tcl_GetString(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);
+ break;
+ }
+ }
}
+ return TCL_ERROR;
+ }
+
+ /*
+ * Complain if the last body is a continuation. Note that this
+ * check assumes that the list is non-empty!
+ */
+
+ if (strcmp(Tcl_GetString(objv[objc-1]), "-") == 0) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "no body specified for pattern \"",
+ Tcl_GetString(objv[objc-2]), "\"", NULL);
+ return TCL_ERROR;
+ }
+
+ for (i = 0; i < objc; i += 2) {
+ /*
+ * See if the pattern matches the string.
+ */
+
+ pattern = Tcl_GetString(objv[i]);
+
matched = 0;
if ((i == objc - 2)
&& (*pattern == 'd')
@@ -2405,10 +2767,11 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
for (j = i + 1; ; j += 2) {
if (j >= objc) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "no body specified for pattern \"", pattern,
- "\"", (char *) NULL);
- return TCL_ERROR;
+ /*
+ * This shouldn't happen since we've checked that the
+ * last body is not a continuation...
+ */
+ panic("fall-out when searching for body to match pattern");
}
if (strcmp(Tcl_GetString(objv[j]), "-") != 0) {
break;
@@ -2473,17 +2836,17 @@ Tcl_TimeObjCmd(dummy, interp, objc, objv)
objPtr = objv[1];
i = count;
- TclpGetTime(&start);
+ Tcl_GetTime(&start);
while (i-- > 0) {
result = Tcl_EvalObjEx(interp, objPtr, 0);
if (result != TCL_OK) {
return result;
}
}
- TclpGetTime(&stop);
+ Tcl_GetTime(&stop);
- totalMicroSec =
- (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
+ totalMicroSec = ( ( (double) ( stop.sec - start.sec ) ) * 1.0e6
+ + ( stop.usec - start.usec ) );
sprintf(buf, "%.0f microseconds per iteration",
((count <= 0) ? 0 : totalMicroSec/count));
Tcl_ResetResult(interp);
@@ -2498,13 +2861,17 @@ Tcl_TimeObjCmd(dummy, interp, objc, objv)
*
* This procedure is invoked to process the "trace" Tcl command.
* See the user documentation for details on what it does.
+ *
+ * Standard syntax as of Tcl 8.4 is
+ *
+ * trace {add|info|remove} {command|variable} name ops cmd
+ *
*
* Results:
* A standard Tcl result.
*
* Side effects:
* See the user documentation.
- *
*----------------------------------------------------------------------
*/
@@ -2517,17 +2884,26 @@ Tcl_TraceObjCmd(dummy, interp, objc, objv)
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
int optionIndex, commandLength;
- char *name, *rwuOps, *command, *p;
+ char *name, *flagOps, *command, *p;
size_t length;
- static char *traceOptions[] = {
- "variable", "vdelete", "vinfo", (char *) NULL
+ /* Main sub commands to 'trace' */
+ static CONST char *traceOptions[] = {
+ "add", "info", "remove",
+#ifndef TCL_REMOVE_OBSOLETE_TRACES
+ "variable", "vdelete", "vinfo",
+#endif
+ (char *) NULL
};
+ /* 'OLD' options are pre-Tcl-8.4 style */
enum traceOptions {
- TRACE_VARIABLE, TRACE_VDELETE, TRACE_VINFO
+ TRACE_ADD, TRACE_INFO, TRACE_REMOVE,
+#ifndef TCL_REMOVE_OBSOLETE_TRACES
+ TRACE_OLD_VARIABLE, TRACE_OLD_VDELETE, TRACE_OLD_VINFO
+#endif
};
if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "option [arg arg ...]");
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
return TCL_ERROR;
}
@@ -2536,162 +2912,1497 @@ Tcl_TraceObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
switch ((enum traceOptions) optionIndex) {
- case TRACE_VARIABLE: {
- int flags;
- TraceVarInfo *tvarPtr;
- if (objc != 5) {
- Tcl_WrongNumArgs(interp, 2, objv, "name ops command");
+ case TRACE_ADD:
+ case TRACE_REMOVE:
+ case TRACE_INFO: {
+ /*
+ * All sub commands of trace add/remove must take at least
+ * one more argument. Beyond that we let the subcommand itself
+ * control the argument structure.
+ */
+ int typeIndex;
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "type ?arg 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);
+ break;
+ }
+#ifndef TCL_REMOVE_OBSOLETE_TRACES
+ case TRACE_OLD_VARIABLE: {
+ int flags;
+ TraceVarInfo *tvarPtr;
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "name ops command");
+ return TCL_ERROR;
+ }
+
+ flags = 0;
+ flagOps = Tcl_GetString(objv[3]);
+ for (p = flagOps; *p != 0; p++) {
+ if (*p == 'r') {
+ flags |= TCL_TRACE_READS;
+ } else if (*p == 'w') {
+ flags |= TCL_TRACE_WRITES;
+ } else if (*p == 'u') {
+ flags |= TCL_TRACE_UNSETS;
+ } else if (*p == 'a') {
+ flags |= TCL_TRACE_ARRAY;
+ } else {
+ goto badVarOps;
+ }
+ }
+ if (flags == 0) {
+ goto badVarOps;
+ }
+ flags |= TCL_TRACE_OLD_STYLE;
+
+ command = Tcl_GetStringFromObj(objv[4], &commandLength);
+ length = (size_t) commandLength;
+ tvarPtr = (TraceVarInfo *) ckalloc((unsigned)
+ (sizeof(TraceVarInfo) - sizeof(tvarPtr->command)
+ + length + 1));
+ tvarPtr->flags = flags;
+ tvarPtr->length = length;
+ flags |= TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT;
+ strcpy(tvarPtr->command, command);
+ name = Tcl_GetString(objv[2]);
+ if (Tcl_TraceVar(interp, name, flags, TraceVarProc,
+ (ClientData) tvarPtr) != TCL_OK) {
+ ckfree((char *) tvarPtr);
+ return TCL_ERROR;
+ }
+ break;
+ }
+ case TRACE_OLD_VDELETE: {
+ int flags;
+ TraceVarInfo *tvarPtr;
+ ClientData clientData;
+
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "name ops command");
+ return TCL_ERROR;
+ }
+
+ flags = 0;
+ flagOps = Tcl_GetString(objv[3]);
+ for (p = flagOps; *p != 0; p++) {
+ if (*p == 'r') {
+ flags |= TCL_TRACE_READS;
+ } else if (*p == 'w') {
+ flags |= TCL_TRACE_WRITES;
+ } else if (*p == 'u') {
+ flags |= TCL_TRACE_UNSETS;
+ } else if (*p == 'a') {
+ flags |= TCL_TRACE_ARRAY;
+ } else {
+ goto badVarOps;
+ }
+ }
+ if (flags == 0) {
+ goto badVarOps;
+ }
+ flags |= TCL_TRACE_OLD_STYLE;
+
+ /*
+ * Search through all of our traces on this variable to
+ * see if there's one with the given command. If so, then
+ * delete the first one that matches.
+ */
+
+ command = Tcl_GetStringFromObj(objv[4], &commandLength);
+ length = (size_t) commandLength;
+ clientData = 0;
+ name = Tcl_GetString(objv[2]);
+ while ((clientData = Tcl_VarTraceInfo(interp, name, 0,
+ TraceVarProc, clientData)) != 0) {
+ tvarPtr = (TraceVarInfo *) clientData;
+ if ((tvarPtr->length == length) && (tvarPtr->flags == flags)
+ && (strncmp(command, tvarPtr->command,
+ (size_t) length) == 0)) {
+ Tcl_UntraceVar2(interp, name, NULL,
+ flags | TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT,
+ TraceVarProc, clientData);
+ Tcl_EventuallyFree((ClientData) tvarPtr, TCL_DYNAMIC);
+ break;
+ }
+ }
+ break;
+ }
+ case TRACE_OLD_VINFO: {
+ ClientData clientData;
+ char ops[5];
+ Tcl_Obj *resultListPtr, *pairObjPtr, *elemObjPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "name");
+ return TCL_ERROR;
+ }
+ resultListPtr = Tcl_GetObjResult(interp);
+ clientData = 0;
+ name = Tcl_GetString(objv[2]);
+ while ((clientData = Tcl_VarTraceInfo(interp, name, 0,
+ TraceVarProc, clientData)) != 0) {
+
+ TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
+
+ pairObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ p = ops;
+ if (tvarPtr->flags & TCL_TRACE_READS) {
+ *p = 'r';
+ p++;
+ }
+ if (tvarPtr->flags & TCL_TRACE_WRITES) {
+ *p = 'w';
+ p++;
+ }
+ if (tvarPtr->flags & TCL_TRACE_UNSETS) {
+ *p = 'u';
+ p++;
+ }
+ if (tvarPtr->flags & TCL_TRACE_ARRAY) {
+ *p = 'a';
+ p++;
+ }
+ *p = '\0';
+
+ /*
+ * Build a pair (2-item list) with the ops string as
+ * the first obj element and the tvarPtr->command string
+ * as the second obj element. Append the pair (as an
+ * element) to the end of the result object list.
+ */
+
+ elemObjPtr = Tcl_NewStringObj(ops, -1);
+ Tcl_ListObjAppendElement(NULL, pairObjPtr, elemObjPtr);
+ elemObjPtr = Tcl_NewStringObj(tvarPtr->command, -1);
+ Tcl_ListObjAppendElement(NULL, pairObjPtr, elemObjPtr);
+ Tcl_ListObjAppendElement(interp, resultListPtr, pairObjPtr);
+ }
+ Tcl_SetObjResult(interp, resultListPtr);
+ break;
+ }
+#endif /* TCL_REMOVE_OBSOLETE_TRACES */
+ }
+ return TCL_OK;
+
+ badVarOps:
+ Tcl_AppendResult(interp, "bad operations \"", flagOps,
+ "\": should be one or more of rwua", (char *) NULL);
+ return TCL_ERROR;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclTraceExecutionObjCmd --
+ *
+ * Helper function for Tcl_TraceObjCmd; implements the
+ * [trace {add|remove|info} execution ...] subcommands.
+ * See the user documentation for details on what these do.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * Depends on the operation (add, remove, or info) being performed;
+ * may add or remove command traces on a command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+{
+ int commandLength, index;
+ char *name, *command;
+ size_t length;
+ enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE };
+ static CONST char *opStrings[] = { "enter", "leave",
+ "enterstep", "leavestep", (char *) NULL };
+ enum operations { TRACE_EXEC_ENTER, TRACE_EXEC_LEAVE,
+ TRACE_EXEC_ENTER_STEP, TRACE_EXEC_LEAVE_STEP };
+
+ switch ((enum traceOptions) optionIndex) {
+ case TRACE_ADD:
+ case TRACE_REMOVE: {
+ int flags = 0;
+ int i, listLen, result;
+ Tcl_Obj **elemPtrs;
+ if (objc != 6) {
+ Tcl_WrongNumArgs(interp, 3, objv, "name opList execution");
+ return TCL_ERROR;
+ }
+ /*
+ * Make sure the ops argument is a list object; get its length and
+ * a pointer to its array of element pointers.
+ */
+
+ result = Tcl_ListObjGetElements(interp, objv[4], &listLen,
+ &elemPtrs);
+ if (result != TCL_OK) {
+ return result;
+ }
+ if (listLen == 0) {
+ Tcl_SetResult(interp, "bad operation list \"\": must be "
+ "one or more of enter, leave, enterstep, or leavestep", TCL_STATIC);
+ return TCL_ERROR;
+ }
+ for (i = 0; i < listLen; i++) {
+ if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings,
+ "operation", TCL_EXACT, &index) != TCL_OK) {
return TCL_ERROR;
}
+ switch ((enum operations) index) {
+ case TRACE_EXEC_ENTER:
+ flags |= TCL_TRACE_ENTER_EXEC;
+ break;
+ case TRACE_EXEC_LEAVE:
+ flags |= TCL_TRACE_LEAVE_EXEC;
+ break;
+ case TRACE_EXEC_ENTER_STEP:
+ flags |= TCL_TRACE_ENTER_DURING_EXEC;
+ break;
+ case TRACE_EXEC_LEAVE_STEP:
+ flags |= TCL_TRACE_LEAVE_DURING_EXEC;
+ break;
+ }
+ }
+ command = Tcl_GetStringFromObj(objv[5], &commandLength);
+ length = (size_t) commandLength;
+ if ((enum traceOptions) optionIndex == TRACE_ADD) {
+ TraceCommandInfo *tcmdPtr;
+ tcmdPtr = (TraceCommandInfo *) ckalloc((unsigned)
+ (sizeof(TraceCommandInfo) - sizeof(tcmdPtr->command)
+ + length + 1));
+ tcmdPtr->flags = flags;
+ tcmdPtr->stepTrace = NULL;
+ tcmdPtr->startLevel = 0;
+ tcmdPtr->length = length;
+ flags |= TCL_TRACE_DELETE;
+ if (flags & (TRACE_EXEC_ENTER_STEP | TRACE_EXEC_LEAVE_STEP)) {
+ flags |= (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC);
+ }
+ strcpy(tcmdPtr->command, command);
+ name = Tcl_GetString(objv[3]);
+ if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc,
+ (ClientData) tcmdPtr) != TCL_OK) {
+ ckfree((char *) tcmdPtr);
+ return TCL_ERROR;
+ }
+ } else {
+ /*
+ * Search through all of our traces on this command to
+ * see if there's one with the given command. If so, then
+ * delete the first one that matches.
+ */
+
+ TraceCommandInfo *tcmdPtr;
+ ClientData clientData;
+ clientData = 0;
+ name = Tcl_GetString(objv[3]);
+ while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
+ TraceCommandProc, clientData)) != 0) {
+ tcmdPtr = (TraceCommandInfo *) clientData;
+ /*
+ * In checking the 'flags' field we must remove any extraneous
+ * flags which may have been temporarily added by various pieces
+ * of the trace mechanism.
+ */
+ if ((tcmdPtr->length == length)
+ && ((tcmdPtr->flags & (TCL_TRACE_ANY_EXEC | TCL_TRACE_RENAME |
+ TCL_TRACE_DELETE)) == flags)
+ && (strncmp(command, tcmdPtr->command,
+ (size_t) length) == 0)) {
+ flags |= TCL_TRACE_DELETE;
+ if (flags & (TRACE_EXEC_ENTER_STEP | TRACE_EXEC_LEAVE_STEP)) {
+ flags |= (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC);
+ }
+ Tcl_UntraceCommand(interp, name,
+ flags, TraceCommandProc, clientData);
+ if (tcmdPtr->stepTrace != NULL) {
+ /*
+ * We need to remove the interpreter-wide trace
+ * which we created to allow 'step' traces.
+ */
+ Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
+ tcmdPtr->stepTrace = NULL;
+ }
+ /* Postpone deletion */
+ if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
+ tcmdPtr->flags = 0;
+ } else {
+ Tcl_EventuallyFree((ClientData) tcmdPtr, TCL_DYNAMIC);
+ }
+ break;
+ }
+ }
+ }
+ break;
+ }
+ case TRACE_INFO: {
+ ClientData clientData;
+ Tcl_Obj *resultListPtr, *eachTraceObjPtr, *elemObjPtr;
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "name");
+ return TCL_ERROR;
+ }
- flags = 0;
- rwuOps = Tcl_GetString(objv[3]);
- for (p = rwuOps; *p != 0; p++) {
- if (*p == 'r') {
- flags |= TCL_TRACE_READS;
- } else if (*p == 'w') {
- flags |= TCL_TRACE_WRITES;
- } else if (*p == 'u') {
- flags |= TCL_TRACE_UNSETS;
- } else {
- goto badOps;
+ resultListPtr = Tcl_GetObjResult(interp);
+ clientData = 0;
+ name = Tcl_GetString(objv[3]);
+ while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
+ TraceCommandProc, clientData)) != 0) {
+
+ TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
+
+ eachTraceObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+
+ /*
+ * Build a list with the ops list as the first obj
+ * element and the tcmdPtr->command string as the
+ * second obj element. Append this list (as an
+ * element) to the end of the result object list.
+ */
+
+ elemObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ if (tcmdPtr->flags & TCL_TRACE_ENTER_EXEC) {
+ Tcl_ListObjAppendElement(NULL, elemObjPtr,
+ Tcl_NewStringObj("enter",6));
+ }
+ if (tcmdPtr->flags & TCL_TRACE_LEAVE_EXEC) {
+ Tcl_ListObjAppendElement(NULL, elemObjPtr,
+ Tcl_NewStringObj("leave",5));
+ }
+ if (tcmdPtr->flags & TCL_TRACE_ENTER_DURING_EXEC) {
+ Tcl_ListObjAppendElement(NULL, elemObjPtr,
+ Tcl_NewStringObj("enterstep",9));
+ }
+ if (tcmdPtr->flags & TCL_TRACE_LEAVE_DURING_EXEC) {
+ Tcl_ListObjAppendElement(NULL, elemObjPtr,
+ Tcl_NewStringObj("leavestep",10));
+ }
+ Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
+
+ elemObjPtr = Tcl_NewStringObj(tcmdPtr->command, -1);
+ Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
+ Tcl_ListObjAppendElement(interp, resultListPtr,
+ eachTraceObjPtr);
+ }
+ Tcl_SetObjResult(interp, resultListPtr);
+ break;
+ }
+ }
+ return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclTraceCommandObjCmd --
+ *
+ * Helper function for Tcl_TraceObjCmd; implements the
+ * [trace {add|info|remove} command ...] subcommands.
+ * See the user documentation for details on what these do.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * Depends on the operation (add, remove, or info) being performed;
+ * may add or remove command traces on a command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+{
+ int commandLength, index;
+ char *name, *command;
+ size_t length;
+ enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE };
+ static CONST char *opStrings[] = { "delete", "rename", (char *) NULL };
+ enum operations { TRACE_CMD_DELETE, TRACE_CMD_RENAME };
+
+ switch ((enum traceOptions) optionIndex) {
+ case TRACE_ADD:
+ case TRACE_REMOVE: {
+ int flags = 0;
+ int i, listLen, result;
+ Tcl_Obj **elemPtrs;
+ if (objc != 6) {
+ Tcl_WrongNumArgs(interp, 3, objv, "name opList command");
+ return TCL_ERROR;
+ }
+ /*
+ * Make sure the ops argument is a list object; get its length and
+ * a pointer to its array of element pointers.
+ */
+
+ result = Tcl_ListObjGetElements(interp, objv[4], &listLen,
+ &elemPtrs);
+ if (result != TCL_OK) {
+ return result;
+ }
+ if (listLen == 0) {
+ Tcl_SetResult(interp, "bad operation list \"\": must be "
+ "one or more of delete or rename", TCL_STATIC);
+ return TCL_ERROR;
+ }
+ for (i = 0; i < listLen; i++) {
+ if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings,
+ "operation", TCL_EXACT, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch ((enum operations) index) {
+ case TRACE_CMD_RENAME:
+ flags |= TCL_TRACE_RENAME;
+ break;
+ case TRACE_CMD_DELETE:
+ flags |= TCL_TRACE_DELETE;
+ break;
+ }
+ }
+ command = Tcl_GetStringFromObj(objv[5], &commandLength);
+ length = (size_t) commandLength;
+ if ((enum traceOptions) optionIndex == TRACE_ADD) {
+ TraceCommandInfo *tcmdPtr;
+ tcmdPtr = (TraceCommandInfo *) ckalloc((unsigned)
+ (sizeof(TraceCommandInfo) - sizeof(tcmdPtr->command)
+ + length + 1));
+ tcmdPtr->flags = flags;
+ tcmdPtr->stepTrace = NULL;
+ tcmdPtr->startLevel = 0;
+ tcmdPtr->length = length;
+ flags |= TCL_TRACE_DELETE;
+ strcpy(tcmdPtr->command, command);
+ name = Tcl_GetString(objv[3]);
+ if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc,
+ (ClientData) tcmdPtr) != TCL_OK) {
+ ckfree((char *) tcmdPtr);
+ return TCL_ERROR;
+ }
+ } else {
+ /*
+ * Search through all of our traces on this command to
+ * see if there's one with the given command. If so, then
+ * delete the first one that matches.
+ */
+
+ TraceCommandInfo *tcmdPtr;
+ ClientData clientData;
+ clientData = 0;
+ name = Tcl_GetString(objv[3]);
+ while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
+ TraceCommandProc, clientData)) != 0) {
+ tcmdPtr = (TraceCommandInfo *) 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);
+ ckfree((char *) tcmdPtr);
+ break;
}
}
- if (flags == 0) {
- goto badOps;
+ }
+ break;
+ }
+ case TRACE_INFO: {
+ ClientData clientData;
+ Tcl_Obj *resultListPtr, *eachTraceObjPtr, *elemObjPtr;
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "name");
+ return TCL_ERROR;
+ }
+
+ resultListPtr = Tcl_GetObjResult(interp);
+ clientData = 0;
+ name = Tcl_GetString(objv[3]);
+ while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
+ TraceCommandProc, clientData)) != 0) {
+
+ TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
+
+ eachTraceObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+
+ /*
+ * Build a list with the ops list as
+ * the first obj element and the tcmdPtr->command string
+ * as the second obj element. Append this list (as an
+ * element) to the end of the result object list.
+ */
+
+ elemObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ if (tcmdPtr->flags & TCL_TRACE_RENAME) {
+ Tcl_ListObjAppendElement(NULL, elemObjPtr,
+ Tcl_NewStringObj("rename",6));
+ }
+ if (tcmdPtr->flags & TCL_TRACE_DELETE) {
+ Tcl_ListObjAppendElement(NULL, elemObjPtr,
+ Tcl_NewStringObj("delete",6));
}
+ Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
+
+ elemObjPtr = Tcl_NewStringObj(tcmdPtr->command, -1);
+ Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
+ Tcl_ListObjAppendElement(interp, resultListPtr,
+ eachTraceObjPtr);
+ }
+ Tcl_SetObjResult(interp, resultListPtr);
+ break;
+ }
+ }
+ return TCL_OK;
+}
- command = Tcl_GetStringFromObj(objv[4], &commandLength);
- length = (size_t) commandLength;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclTraceVariableObjCmd --
+ *
+ * Helper function for Tcl_TraceObjCmd; implements the
+ * [trace {add|info|remove} variable ...] subcommands.
+ * See the user documentation for details on what these do.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * Depends on the operation (add, remove, or info) being performed;
+ * may add or remove variable traces on a variable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+{
+ int commandLength, index;
+ char *name, *command;
+ size_t length;
+ enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE };
+ static CONST char *opStrings[] = { "array", "read", "unset", "write",
+ (char *) NULL };
+ enum operations { TRACE_VAR_ARRAY, TRACE_VAR_READ, TRACE_VAR_UNSET,
+ TRACE_VAR_WRITE };
+
+ switch ((enum traceOptions) optionIndex) {
+ case TRACE_ADD:
+ case TRACE_REMOVE: {
+ int flags = 0;
+ int i, listLen, result;
+ Tcl_Obj **elemPtrs;
+ if (objc != 6) {
+ Tcl_WrongNumArgs(interp, 3, objv, "name opList command");
+ return TCL_ERROR;
+ }
+ /*
+ * Make sure the ops argument is a list object; get its length and
+ * a pointer to its array of element pointers.
+ */
+
+ result = Tcl_ListObjGetElements(interp, objv[4], &listLen,
+ &elemPtrs);
+ if (result != TCL_OK) {
+ return result;
+ }
+ if (listLen == 0) {
+ Tcl_SetResult(interp, "bad operation list \"\": must be "
+ "one or more of array, read, unset, or write",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+ for (i = 0; i < listLen ; i++) {
+ if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings,
+ "operation", TCL_EXACT, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch ((enum operations) index) {
+ case TRACE_VAR_ARRAY:
+ flags |= TCL_TRACE_ARRAY;
+ break;
+ case TRACE_VAR_READ:
+ flags |= TCL_TRACE_READS;
+ break;
+ case TRACE_VAR_UNSET:
+ flags |= TCL_TRACE_UNSETS;
+ break;
+ case TRACE_VAR_WRITE:
+ flags |= TCL_TRACE_WRITES;
+ break;
+ }
+ }
+ 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;
- tvarPtr->errMsg = NULL;
tvarPtr->length = length;
- flags |= TCL_TRACE_UNSETS;
+ flags |= TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT;
strcpy(tvarPtr->command, command);
- name = Tcl_GetString(objv[2]);
+ name = Tcl_GetString(objv[3]);
if (Tcl_TraceVar(interp, name, flags, TraceVarProc,
(ClientData) tvarPtr) != TCL_OK) {
ckfree((char *) tvarPtr);
return TCL_ERROR;
}
- break;
- }
- case TRACE_VDELETE: {
- int flags;
- TraceVarInfo *tvarPtr;
- ClientData clientData;
-
- if (objc != 5) {
- Tcl_WrongNumArgs(interp, 2, objv, "name ops command");
- return TCL_ERROR;
- }
-
- flags = 0;
- rwuOps = Tcl_GetString(objv[3]);
- for (p = rwuOps; *p != 0; p++) {
- if (*p == 'r') {
- flags |= TCL_TRACE_READS;
- } else if (*p == 'w') {
- flags |= TCL_TRACE_WRITES;
- } else if (*p == 'u') {
- flags |= TCL_TRACE_UNSETS;
- } else {
- goto badOps;
- }
- }
- if (flags == 0) {
- goto badOps;
- }
-
+ } else {
/*
* Search through all of our traces on this variable to
* see if there's one with the given command. If so, then
* delete the first one that matches.
*/
- command = Tcl_GetStringFromObj(objv[4], &commandLength);
- length = (size_t) commandLength;
- clientData = 0;
- name = Tcl_GetString(objv[2]);
+ TraceVarInfo *tvarPtr;
+ ClientData clientData = 0;
+ name = Tcl_GetString(objv[3]);
while ((clientData = Tcl_VarTraceInfo(interp, name, 0,
TraceVarProc, clientData)) != 0) {
tvarPtr = (TraceVarInfo *) clientData;
- if ((tvarPtr->length == length) && (tvarPtr->flags == flags)
+ if ((tvarPtr->length == length)
+ && (tvarPtr->flags == flags)
&& (strncmp(command, tvarPtr->command,
(size_t) length) == 0)) {
- Tcl_UntraceVar(interp, name, flags | TCL_TRACE_UNSETS,
+ Tcl_UntraceVar2(interp, name, NULL,
+ flags | TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT,
TraceVarProc, clientData);
- if (tvarPtr->errMsg != NULL) {
- ckfree(tvarPtr->errMsg);
- }
- ckfree((char *) tvarPtr);
+ Tcl_EventuallyFree((ClientData) tvarPtr, TCL_DYNAMIC);
break;
}
}
- break;
}
- case TRACE_VINFO: {
- ClientData clientData;
- char ops[4];
- Tcl_Obj *resultListPtr, *pairObjPtr, *elemObjPtr;
+ break;
+ }
+ case TRACE_INFO: {
+ ClientData clientData;
+ Tcl_Obj *resultListPtr, *eachTraceObjPtr, *elemObjPtr;
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "name");
+ return TCL_ERROR;
+ }
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "name");
- return TCL_ERROR;
+ resultListPtr = Tcl_GetObjResult(interp);
+ clientData = 0;
+ name = Tcl_GetString(objv[3]);
+ while ((clientData = Tcl_VarTraceInfo(interp, name, 0,
+ TraceVarProc, clientData)) != 0) {
+
+ TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
+
+ eachTraceObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ /*
+ * Build a list with the ops list as
+ * the first obj element and the tcmdPtr->command string
+ * as the second obj element. Append this list (as an
+ * element) to the end of the result object list.
+ */
+
+ elemObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ if (tvarPtr->flags & TCL_TRACE_ARRAY) {
+ Tcl_ListObjAppendElement(NULL, elemObjPtr,
+ Tcl_NewStringObj("array", 5));
}
- resultListPtr = Tcl_GetObjResult(interp);
- clientData = 0;
- name = Tcl_GetString(objv[2]);
- while ((clientData = Tcl_VarTraceInfo(interp, name, 0,
- TraceVarProc, clientData)) != 0) {
+ if (tvarPtr->flags & TCL_TRACE_READS) {
+ Tcl_ListObjAppendElement(NULL, elemObjPtr,
+ Tcl_NewStringObj("read", 4));
+ }
+ if (tvarPtr->flags & TCL_TRACE_WRITES) {
+ Tcl_ListObjAppendElement(NULL, elemObjPtr,
+ Tcl_NewStringObj("write", 5));
+ }
+ if (tvarPtr->flags & TCL_TRACE_UNSETS) {
+ Tcl_ListObjAppendElement(NULL, elemObjPtr,
+ Tcl_NewStringObj("unset", 5));
+ }
+ Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
+
+ elemObjPtr = Tcl_NewStringObj(tvarPtr->command, -1);
+ Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
+ Tcl_ListObjAppendElement(interp, resultListPtr,
+ eachTraceObjPtr);
+ }
+ Tcl_SetObjResult(interp, resultListPtr);
+ break;
+ }
+ }
+ return TCL_OK;
+}
- TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CommandTraceInfo --
+ *
+ * Return the clientData value associated with a trace on a
+ * command. This procedure can also be used to step through
+ * all of the traces on a particular command that have the
+ * same trace procedure.
+ *
+ * Results:
+ * The return value is the clientData value associated with
+ * a trace on the given command. Information will only be
+ * returned for a trace with proc as trace procedure. If
+ * the clientData argument is NULL then the first such trace is
+ * returned; otherwise, the next relevant one after the one
+ * given by clientData will be returned. If the command
+ * doesn't exist, or if there are no (more) traces for it,
+ * then NULL is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
- pairObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
- p = ops;
- if (tvarPtr->flags & TCL_TRACE_READS) {
- *p = 'r';
- p++;
- }
- if (tvarPtr->flags & TCL_TRACE_WRITES) {
- *p = 'w';
- p++;
- }
- if (tvarPtr->flags & TCL_TRACE_UNSETS) {
- *p = 'u';
- p++;
- }
- *p = '\0';
+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_NAMESPACE_ONLY (can be 0). */
+ Tcl_CommandTraceProc *proc; /* Procedure assocated with trace. */
+ ClientData prevClientData; /* If non-NULL, gives last value returned
+ * by this procedure, so this call will
+ * return the next trace after that one.
+ * If NULL, this call will return the
+ * first trace. */
+{
+ Command *cmdPtr;
+ register CommandTrace *tracePtr;
- /*
- * Build a pair (2-item list) with the ops string as
- * the first obj element and the tvarPtr->command string
- * as the second obj element. Append the pair (as an
- * element) to the end of the result object list.
- */
+ cmdPtr = (Command*)Tcl_FindCommand(interp, cmdName,
+ NULL, TCL_LEAVE_ERR_MSG);
+ if (cmdPtr == NULL) {
+ return NULL;
+ }
- elemObjPtr = Tcl_NewStringObj(ops, -1);
- Tcl_ListObjAppendElement(NULL, pairObjPtr, elemObjPtr);
- elemObjPtr = Tcl_NewStringObj(tvarPtr->command, -1);
- Tcl_ListObjAppendElement(NULL, pairObjPtr, elemObjPtr);
- Tcl_ListObjAppendElement(interp, resultListPtr, pairObjPtr);
- }
- Tcl_SetObjResult(interp, resultListPtr);
+ /*
+ * Find the relevant trace, if any, and return its clientData.
+ */
+
+ tracePtr = cmdPtr->tracePtr;
+ if (prevClientData != NULL) {
+ for ( ; tracePtr != NULL; tracePtr = tracePtr->nextPtr) {
+ if ((tracePtr->clientData == prevClientData)
+ && (tracePtr->traceProc == proc)) {
+ tracePtr = tracePtr->nextPtr;
break;
}
- default: {
- panic("Tcl_TraceObjCmd: bad option index to TraceOptions");
- }
+ }
+ }
+ for ( ; tracePtr != NULL; tracePtr = tracePtr->nextPtr) {
+ if (tracePtr->traceProc == proc) {
+ return tracePtr->clientData;
+ }
+ }
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_TraceCommand --
+ *
+ * Arrange for rename/deletes to a command to cause a
+ * procedure to be invoked, which can monitor the operations.
+ *
+ * Also optionally arrange for execution of that command
+ * to cause a procedure to be invoked.
+ *
+ * Results:
+ * A standard Tcl return value.
+ *
+ * Side effects:
+ * A trace is set up on the command given by cmdName, such that
+ * future changes to the command will be intermediated by
+ * proc. See the manual entry for complete details on the calling
+ * sequence for proc.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_TraceCommand(interp, cmdName, flags, proc, clientData)
+ 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 TCL_TRACE_RENAME, TCL_TRACE_DELETE,
+ * and any of the TRACE_*_EXEC flags */
+ Tcl_CommandTraceProc *proc; /* Procedure to call when specified ops are
+ * invoked upon varName. */
+ ClientData clientData; /* Arbitrary argument to pass to proc. */
+{
+ Command *cmdPtr;
+ register CommandTrace *tracePtr;
+
+ cmdPtr = (Command*)Tcl_FindCommand(interp, cmdName,
+ NULL, TCL_LEAVE_ERR_MSG);
+ if (cmdPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Set up trace information.
+ */
+
+ tracePtr = (CommandTrace *) ckalloc(sizeof(CommandTrace));
+ tracePtr->traceProc = proc;
+ tracePtr->clientData = clientData;
+ tracePtr->flags = flags & (TCL_TRACE_RENAME | TCL_TRACE_DELETE
+ | TCL_TRACE_ANY_EXEC);
+ tracePtr->nextPtr = cmdPtr->tracePtr;
+ cmdPtr->tracePtr = tracePtr;
+ if (tracePtr->flags & TCL_TRACE_ANY_EXEC) {
+ cmdPtr->flags |= CMD_HAS_EXEC_TRACES;
}
return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UntraceCommand --
+ *
+ * Remove a previously-created trace for a command.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If there exists a trace for the command given by cmdName
+ * with the given flags, proc, and clientData, then that trace
+ * is removed.
+ *
+ *----------------------------------------------------------------------
+ */
- badOps:
- Tcl_AppendResult(interp, "bad operations \"", rwuOps,
- "\": should be one or more of rwu", (char *) NULL);
- return TCL_ERROR;
+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_TRACE_RENAME, TCL_TRACE_DELETE,
+ * and any of the TRACE_*_EXEC flags */
+ Tcl_CommandTraceProc *proc; /* Procedure assocated with trace. */
+ ClientData clientData; /* Arbitrary argument to pass to proc. */
+{
+ register CommandTrace *tracePtr;
+ CommandTrace *prevPtr;
+ Command *cmdPtr;
+ Interp *iPtr = (Interp *) interp;
+ ActiveCommandTrace *activePtr;
+ int hasExecTraces = 0;
+
+ cmdPtr = (Command*)Tcl_FindCommand(interp, cmdName,
+ NULL, TCL_LEAVE_ERR_MSG);
+ if (cmdPtr == NULL) {
+ return;
+ }
+
+ flags &= (TCL_TRACE_RENAME | TCL_TRACE_DELETE | TCL_TRACE_ANY_EXEC);
+
+ for (tracePtr = cmdPtr->tracePtr, prevPtr = NULL; ;
+ prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
+ if (tracePtr == NULL) {
+ return;
+ }
+ if ((tracePtr->traceProc == proc) && ((tracePtr->flags & (TCL_TRACE_RENAME | TCL_TRACE_DELETE | TCL_TRACE_ANY_EXEC)) == flags)
+ && (tracePtr->clientData == clientData)) {
+ if (tracePtr->flags & TCL_TRACE_ANY_EXEC) {
+ hasExecTraces = 1;
+ }
+ break;
+ }
+ }
+
+ /*
+ * 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 CallCommandTraces.
+ */
+
+ for (activePtr = iPtr->activeCmdTracePtr; activePtr != NULL;
+ activePtr = activePtr->nextPtr) {
+ if (activePtr->nextTracePtr == tracePtr) {
+ activePtr->nextTracePtr = tracePtr->nextPtr;
+ }
+ }
+ if (prevPtr == NULL) {
+ cmdPtr->tracePtr = tracePtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = tracePtr->nextPtr;
+ }
+ tracePtr->flags = 0;
+ Tcl_EventuallyFree((int*)tracePtr, TCL_DYNAMIC);
+
+ if (hasExecTraces) {
+ for (tracePtr = cmdPtr->tracePtr, prevPtr = NULL; tracePtr != NULL ;
+ prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
+ if (tracePtr->flags & TCL_TRACE_ANY_EXEC) {
+ return;
+ }
+ }
+ /*
+ * None of the remaining traces on this command are execution
+ * traces. We therefore remove this flag:
+ */
+ cmdPtr->flags &= ~CMD_HAS_EXEC_TRACES;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TraceCommandProc --
+ *
+ * This procedure is called to handle command changes that have
+ * been traced using the "trace" command, when using the
+ * 'rename' or 'delete' options.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on the command associated with the trace.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* 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 means command is being deleted
+ * (renamed to ""). */
+ int flags; /* OR-ed bits giving operation and other
+ * information. */
+{
+ Tcl_SavedResult state;
+ TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
+ int code;
+ Tcl_DString cmd;
+
+ Tcl_Preserve((ClientData) tcmdPtr);
+
+ if ((tcmdPtr->flags & flags) && !(flags & TCL_INTERP_DESTROYED)) {
+ /*
+ * Generate a command to execute by appending list elements
+ * for the old and new command name and the operation.
+ */
+
+ Tcl_DStringInit(&cmd);
+ Tcl_DStringAppend(&cmd, tcmdPtr->command, (int) tcmdPtr->length);
+ Tcl_DStringAppendElement(&cmd, oldName);
+ Tcl_DStringAppendElement(&cmd, (newName ? newName : ""));
+ if (flags & TCL_TRACE_RENAME) {
+ Tcl_DStringAppend(&cmd, " rename", 7);
+ } else if (flags & TCL_TRACE_DELETE) {
+ Tcl_DStringAppend(&cmd, " delete", 7);
+ }
+
+ /*
+ * Execute the command. Save the interp's result used for
+ * the command. We discard any object result the command returns.
+ *
+ * Add the TCL_TRACE_DESTROYED flag to tcmdPtr to indicate to
+ * other areas that this will be destroyed by us, otherwise a
+ * double-free might occur depending on what the eval does.
+ */
+
+ Tcl_SaveResult(interp, &state);
+ if (flags & TCL_TRACE_DESTROYED) {
+ tcmdPtr->flags |= TCL_TRACE_DESTROYED;
+ }
+
+ code = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd),
+ Tcl_DStringLength(&cmd), 0);
+ if (code != TCL_OK) {
+ /* We ignore errors in these traced commands */
+ }
+
+ Tcl_RestoreResult(interp, &state);
+
+ Tcl_DStringFree(&cmd);
+ }
+ /*
+ * We delete when the trace was destroyed or if this is a delete trace,
+ * because command deletes are unconditional, so the trace must go away.
+ */
+ if (flags & (TCL_TRACE_DESTROYED | TCL_TRACE_DELETE)) {
+ if (tcmdPtr->stepTrace != NULL) {
+ Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
+ tcmdPtr->stepTrace = NULL;
+ }
+ /* Postpone deletion, until exec trace returns */
+ if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
+ tcmdPtr->flags = 0;
+ } else {
+ Tcl_EventuallyFree((ClientData) tcmdPtr, TCL_DYNAMIC);
+ }
+ }
+ Tcl_Release((ClientData) tcmdPtr);
+ return;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCheckExecutionTraces --
+ *
+ * Checks on all current command execution traces, and invokes
+ * procedures which have been registered. This procedure can be
+ * used by other code which performs execution to unify the
+ * tracing system, so that execution traces will function for that
+ * other code.
+ *
+ * For instance extensions like [incr Tcl] which use their
+ * own execution technique can make use of Tcl's tracing.
+ *
+ * This procedure is called by 'TclEvalObjvInternal'
+ *
+ * Results:
+ * The return value is a standard Tcl completion code such as
+ * TCL_OK or TCL_ERROR, etc.
+ *
+ * Side effects:
+ * Those side effects made by any trace procedures called.
+ *
+ *----------------------------------------------------------------------
+ */
+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 string. */
+ 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. */
+{
+ Interp *iPtr = (Interp *) interp;
+ CommandTrace *tracePtr, *lastTracePtr;
+ ActiveCommandTrace active;
+ int curLevel;
+ int traceCode = TCL_OK;
+ TraceCommandInfo* tcmdPtr;
+
+ if (command == NULL || cmdPtr->tracePtr == NULL) {
+ return(traceCode);
+ }
+
+ curLevel = ((iPtr->varFramePtr == NULL) ? 0 : iPtr->varFramePtr->level);
+
+ active.nextPtr = iPtr->activeCmdTracePtr;
+ iPtr->activeCmdTracePtr = &active;
+
+ active.cmdPtr = cmdPtr;
+ lastTracePtr = NULL;
+ for ( tracePtr = cmdPtr->tracePtr;
+ (traceCode == TCL_OK) && (tracePtr != NULL);
+ tracePtr = active.nextTracePtr) {
+ if (traceFlags & TCL_TRACE_LEAVE_EXEC) {
+ /* execute the trace command in order of creation for "leave" */
+ active.nextTracePtr = NULL;
+ tracePtr = cmdPtr->tracePtr;
+ while (tracePtr->nextPtr != lastTracePtr) {
+ active.nextTracePtr = tracePtr;
+ tracePtr = tracePtr->nextPtr;
+ }
+ } else {
+ active.nextTracePtr = tracePtr->nextPtr;
+ }
+ tcmdPtr = (TraceCommandInfo*)tracePtr->clientData;
+ if (tcmdPtr->flags != 0) {
+ tcmdPtr->curFlags = traceFlags | TCL_TRACE_EXEC_DIRECT;
+ tcmdPtr->curCode = code;
+ traceCode = TraceExecutionProc((ClientData)tcmdPtr, interp,
+ curLevel, command, (Tcl_Command)cmdPtr, objc, objv);
+ }
+ lastTracePtr = tracePtr;
+ }
+ iPtr->activeCmdTracePtr = active.nextPtr;
+ return(traceCode);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCheckInterpTraces --
+ *
+ * Checks on all current traces, and invokes procedures which
+ * have been registered. This procedure can be used by other
+ * code which performs execution to unify the tracing system.
+ * For instance extensions like [incr Tcl] which use their
+ * own execution technique can make use of Tcl's tracing.
+ *
+ * This procedure is called by 'TclEvalObjvInternal'
+ *
+ * Results:
+ * The return value is a standard Tcl completion code such as
+ * TCL_OK or TCL_ERROR, etc.
+ *
+ * Side effects:
+ * Those side effects made by any trace procedures called.
+ *
+ *----------------------------------------------------------------------
+ */
+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 string. */
+ 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. */
+{
+ Interp *iPtr = (Interp *) interp;
+ Trace *tracePtr, *lastTracePtr;
+ ActiveInterpTrace active;
+ int curLevel;
+ int traceCode = TCL_OK;
+ TraceCommandInfo* tcmdPtr;
+
+ if (command == NULL || iPtr->tracePtr == NULL ||
+ (iPtr->flags & INTERP_TRACE_IN_PROGRESS)) {
+ return(traceCode);
+ }
+
+ curLevel = ((iPtr->varFramePtr == NULL) ? 0 : iPtr->varFramePtr->level);
+
+ active.nextPtr = iPtr->activeInterpTracePtr;
+ iPtr->activeInterpTracePtr = &active;
+
+ lastTracePtr = NULL;
+ for ( tracePtr = iPtr->tracePtr;
+ (traceCode == TCL_OK) && (tracePtr != NULL);
+ tracePtr = active.nextTracePtr) {
+ if (traceFlags & TCL_TRACE_ENTER_EXEC) {
+ /* execute the trace command in reverse order of creation
+ * for "enterstep" operation. The order is changed for
+ * ""enterstep" instead of for "leavestep as was done in
+ * TclCheckExecutionTraces because for step traces,
+ * Tcl_CreateObjTrace creates one more linked list of traces
+ * which results in one more reversal of trace invocation.
+ */
+ active.nextTracePtr = NULL;
+ tracePtr = iPtr->tracePtr;
+ while (tracePtr->nextPtr != lastTracePtr) {
+ active.nextTracePtr = tracePtr;
+ tracePtr = tracePtr->nextPtr;
+ }
+ } else {
+ active.nextTracePtr = tracePtr->nextPtr;
+ }
+ if (tracePtr->level > 0 && curLevel > tracePtr->level) {
+ continue;
+ }
+ if (!(tracePtr->flags & TCL_TRACE_EXEC_IN_PROGRESS)) {
+ /*
+ * The proc invoked might delete the traced command which
+ * which might try to free tracePtr. We want to use tracePtr
+ * until the end of this if section, so we use
+ * Tcl_Preserve() and Tcl_Release() to be sureit is not
+ * freed while we still need it.
+ */
+ Tcl_Preserve((ClientData) tracePtr);
+ tracePtr->flags |= TCL_TRACE_EXEC_IN_PROGRESS;
+ if ((tracePtr->flags != TCL_TRACE_EXEC_IN_PROGRESS) &&
+ ((tracePtr->flags & traceFlags) != 0)) {
+ tcmdPtr = (TraceCommandInfo*)tracePtr->clientData;
+ tcmdPtr->curFlags = traceFlags;
+ tcmdPtr->curCode = code;
+ traceCode = (tracePtr->proc)((ClientData)tcmdPtr,
+ (Tcl_Interp*)interp,
+ curLevel, command,
+ (Tcl_Command)cmdPtr,
+ objc, objv);
+ } else {
+ if (traceFlags & TCL_TRACE_ENTER_EXEC) {
+ /*
+ * Old-style interpreter-wide traces only trigger
+ * before the command is executed.
+ */
+ traceCode = CallTraceProcedure(interp, tracePtr, cmdPtr,
+ command, numChars, objc, objv);
+ }
+ }
+ tracePtr->flags &= ~TCL_TRACE_EXEC_IN_PROGRESS;
+ Tcl_Release((ClientData) tracePtr);
+ }
+ lastTracePtr = tracePtr;
+ }
+ iPtr->activeInterpTracePtr = active.nextPtr;
+ return(traceCode);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CallTraceProcedure --
+ *
+ * Invokes a trace procedure registered with an interpreter. These
+ * procedures trace command execution. Currently this trace procedure
+ * is called with the address of the string-based Tcl_CmdProc for the
+ * command, not the Tcl_ObjCmdProc.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Those side effects made by the trace procedure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CallTraceProcedure(interp, tracePtr, cmdPtr, command, numChars, objc, objv)
+ Tcl_Interp *interp; /* The current interpreter. */
+ register Trace *tracePtr; /* Describes the trace procedure 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 source. */
+ 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;
+ int traceCode;
+
+ /*
+ * Copy the command characters into a new string.
+ */
+
+ commandCopy = (char *) ckalloc((unsigned) (numChars + 1));
+ memcpy((VOID *) commandCopy, (VOID *) command, (size_t) numChars);
+ commandCopy[numChars] = '\0';
+
+ /*
+ * Call the trace procedure then free allocated storage.
+ */
+
+ traceCode = (tracePtr->proc)( tracePtr->clientData, (Tcl_Interp*) iPtr,
+ iPtr->numLevels, commandCopy,
+ (Tcl_Command) cmdPtr, objc, objv );
+
+ ckfree((char *) commandCopy);
+ return(traceCode);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TraceExecutionProc --
+ *
+ * This procedure is invoked whenever code relevant to a
+ * 'trace execution' command is executed. It is called in one
+ * of two ways in Tcl's core:
+ *
+ * (i) by the TclCheckExecutionTraces, when an execution trace has been
+ * triggered.
+ * (ii) by TclCheckInterpTraces, when a prior execution trace has
+ * created a trace of the internals of a procedure, passing in
+ * this procedure as the one to be called.
+ *
+ * Results:
+ * The return value is a standard Tcl completion code such as
+ * TCL_OK or TCL_ERROR, etc.
+ *
+ * Side effects:
+ * May invoke an arbitrary Tcl procedure, and may create or
+ * delete an interpreter-wide trace.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+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;
+ int flags = tcmdPtr->curFlags;
+ int code = tcmdPtr->curCode;
+ int traceCode = TCL_OK;
+
+ if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
+ /*
+ * Inside any kind of execution trace callback, we do
+ * not allow any further execution trace callbacks to
+ * be called for the same trace.
+ */
+ return(traceCode);
+ }
+
+ if (!(flags & TCL_INTERP_DESTROYED)) {
+ /*
+ * Check whether the current call is going to eval arbitrary
+ * Tcl code with a generated trace, or whether we are only
+ * going to setup interpreter-wide traces to implement the
+ * 'step' traces. This latter situation can happen if
+ * we create a command trace without either before or after
+ * operations, but with either of the step operations.
+ */
+ if (flags & TCL_TRACE_EXEC_DIRECT) {
+ call = flags & tcmdPtr->flags & (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC);
+ } else {
+ call = 1;
+ }
+ /*
+ * First, if we have returned back to the level at which we
+ * created an interpreter trace, we remove it
+ */
+ if (flags & TCL_TRACE_LEAVE_EXEC) {
+ if ((tcmdPtr->stepTrace != NULL) && (level == tcmdPtr->startLevel)) {
+ Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
+ tcmdPtr->stepTrace = NULL;
+ }
+
+ }
+
+ /*
+ * Second, create the tcl callback, if required.
+ */
+ if (call) {
+ Tcl_SavedResult state;
+ Tcl_DString cmd;
+ Tcl_DString sub;
+ int i;
+
+ Tcl_DStringInit(&cmd);
+ Tcl_DStringAppend(&cmd, tcmdPtr->command, (int)tcmdPtr->length);
+ /* Append command with arguments */
+ Tcl_DStringInit(&sub);
+ for (i = 0; i < objc; i++) {
+ char* str;
+ int len;
+ str = Tcl_GetStringFromObj(objv[i],&len);
+ Tcl_DStringAppendElement(&sub, str);
+ }
+ Tcl_DStringAppendElement(&cmd, Tcl_DStringValue(&sub));
+ Tcl_DStringFree(&sub);
+
+ if (flags & TCL_TRACE_ENTER_EXEC) {
+ /* Append trace operation */
+ if (flags & TCL_TRACE_EXEC_DIRECT) {
+ Tcl_DStringAppendElement(&cmd, "enter");
+ } else {
+ Tcl_DStringAppendElement(&cmd, "enterstep");
+ }
+ } else if (flags & TCL_TRACE_LEAVE_EXEC) {
+ Tcl_Obj* resultCode;
+ char* resultCodeStr;
+
+ /* Append result code */
+ resultCode = Tcl_NewIntObj(code);
+ resultCodeStr = Tcl_GetString(resultCode);
+ Tcl_DStringAppendElement(&cmd, resultCodeStr);
+ Tcl_DecrRefCount(resultCode);
+
+ /* Append result string */
+ Tcl_DStringAppendElement(&cmd, Tcl_GetStringResult(interp));
+ /* Append trace operation */
+ if (flags & TCL_TRACE_EXEC_DIRECT) {
+ Tcl_DStringAppendElement(&cmd, "leave");
+ } else {
+ Tcl_DStringAppendElement(&cmd, "leavestep");
+ }
+ } else {
+ panic("TraceExecutionProc: bad flag combination");
+ }
+
+ /*
+ * Execute the command. Save the interp's result used for
+ * the command. We discard any object result the command returns.
+ */
+
+ Tcl_SaveResult(interp, &state);
+
+ tcmdPtr->flags |= TCL_TRACE_EXEC_IN_PROGRESS;
+ iPtr->flags |= INTERP_TRACE_IN_PROGRESS;
+ Tcl_Preserve((ClientData)tcmdPtr);
+ /*
+ * This line can have quite arbitrary side-effects,
+ * including deleting the trace, the command being
+ * traced, or even the interpreter.
+ */
+ traceCode = Tcl_Eval(interp, Tcl_DStringValue(&cmd));
+ tcmdPtr->flags &= ~TCL_TRACE_EXEC_IN_PROGRESS;
+ iPtr->flags &= ~INTERP_TRACE_IN_PROGRESS;
+ if (tcmdPtr->flags == 0) {
+ flags |= TCL_TRACE_DESTROYED;
+ }
+
+ if (traceCode == TCL_OK) {
+ /* Restore result if trace execution was successful */
+ Tcl_RestoreResult(interp, &state);
+ }
+
+ Tcl_DStringFree(&cmd);
+ }
+
+ /*
+ * Third, create an interpreter trace, if we need one for
+ * subsequent internal execution traces.
+ */
+ if ((flags & TCL_TRACE_ENTER_EXEC) && (tcmdPtr->stepTrace == NULL)
+ && (tcmdPtr->flags & (TCL_TRACE_ENTER_DURING_EXEC | TCL_TRACE_LEAVE_DURING_EXEC))) {
+ tcmdPtr->startLevel = level;
+ tcmdPtr->stepTrace = Tcl_CreateObjTrace(interp, 0,
+ (tcmdPtr->flags & TCL_TRACE_ANY_EXEC) >> 2,
+ TraceExecutionProc, (ClientData)tcmdPtr, NULL);
+ }
+ }
+ if (flags & TCL_TRACE_DESTROYED) {
+ if (tcmdPtr->stepTrace != NULL) {
+ Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
+ tcmdPtr->stepTrace = NULL;
+ }
+ Tcl_EventuallyFree((ClientData)tcmdPtr, TCL_DYNAMIC);
+ }
+ if (call) {
+ Tcl_Release((ClientData)tcmdPtr);
+ }
+ return(traceCode);
}
/*
@@ -2717,8 +4428,8 @@ static char *
TraceVarProc(clientData, interp, name1, name2, flags)
ClientData clientData; /* Information about the variable trace. */
Tcl_Interp *interp; /* Interpreter containing variable. */
- char *name1; /* Name of variable or array. */
- char *name2; /* Name of element within array; NULL means
+ 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
* information. */
@@ -2729,64 +4440,91 @@ TraceVarProc(clientData, interp, name1, name2, flags)
int code;
Tcl_DString cmd;
+ /*
+ * We might call Tcl_Eval() below, and that might evaluate
+ * [trace vdelete] which might try to free tvarPtr. We want
+ * to use tvarPtr until the end of this function, so we use
+ * Tcl_Preserve() and Tcl_Release() to be sure it is not
+ * freed while we still need it.
+ */
+
+ Tcl_Preserve((ClientData) tvarPtr);
+
result = NULL;
- if (tvarPtr->errMsg != NULL) {
- ckfree(tvarPtr->errMsg);
- tvarPtr->errMsg = NULL;
- }
if ((tvarPtr->flags & flags) && !(flags & TCL_INTERP_DESTROYED)) {
+ if (tvarPtr->length != (size_t) 0) {
+ /*
+ * Generate a command to execute by appending list elements
+ * for the two variable names and the operation.
+ */
- /*
- * Generate a command to execute by appending list elements
- * for the two variable names and the operation. The five
- * extra characters are for three space, the opcode character,
- * and the terminating null.
- */
+ Tcl_DStringInit(&cmd);
+ Tcl_DStringAppend(&cmd, tvarPtr->command, (int) tvarPtr->length);
+ Tcl_DStringAppendElement(&cmd, name1);
+ Tcl_DStringAppendElement(&cmd, (name2 ? name2 : ""));
+#ifndef TCL_REMOVE_OBSOLETE_TRACES
+ if (tvarPtr->flags & TCL_TRACE_OLD_STYLE) {
+ if (flags & TCL_TRACE_ARRAY) {
+ Tcl_DStringAppend(&cmd, " a", 2);
+ } else if (flags & TCL_TRACE_READS) {
+ Tcl_DStringAppend(&cmd, " r", 2);
+ } else if (flags & TCL_TRACE_WRITES) {
+ Tcl_DStringAppend(&cmd, " w", 2);
+ } else if (flags & TCL_TRACE_UNSETS) {
+ Tcl_DStringAppend(&cmd, " u", 2);
+ }
+ } else {
+#endif
+ if (flags & TCL_TRACE_ARRAY) {
+ Tcl_DStringAppend(&cmd, " array", 6);
+ } else if (flags & TCL_TRACE_READS) {
+ Tcl_DStringAppend(&cmd, " read", 5);
+ } else if (flags & TCL_TRACE_WRITES) {
+ Tcl_DStringAppend(&cmd, " write", 6);
+ } else if (flags & TCL_TRACE_UNSETS) {
+ Tcl_DStringAppend(&cmd, " unset", 6);
+ }
+#ifndef TCL_REMOVE_OBSOLETE_TRACES
+ }
+#endif
+
+ /*
+ * Execute the command. Save the interp's result used for
+ * the command. We discard any object result the command returns.
+ *
+ * Add the TCL_TRACE_DESTROYED flag to tvarPtr to indicate to
+ * other areas that this will be destroyed by us, otherwise a
+ * double-free might occur depending on what the eval does.
+ */
- if (name2 == NULL) {
- name2 = "";
- }
- Tcl_DStringInit(&cmd);
- Tcl_DStringAppend(&cmd, tvarPtr->command, (int) tvarPtr->length);
- Tcl_DStringAppendElement(&cmd, name1);
- Tcl_DStringAppendElement(&cmd, name2);
- if (flags & TCL_TRACE_READS) {
- Tcl_DStringAppend(&cmd, " r", 2);
- } else if (flags & TCL_TRACE_WRITES) {
- Tcl_DStringAppend(&cmd, " w", 2);
- } else if (flags & TCL_TRACE_UNSETS) {
- Tcl_DStringAppend(&cmd, " u", 2);
- }
+ Tcl_SaveResult(interp, &state);
+ if (flags & TCL_TRACE_DESTROYED) {
+ tvarPtr->flags |= TCL_TRACE_DESTROYED;
+ }
- /*
- * Execute the command. Save the interp's result used for
- * the command. We discard any object result the command returns.
- */
+ code = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd),
+ Tcl_DStringLength(&cmd), 0);
+ if (code != TCL_OK) { /* copy error msg to result */
+ register Tcl_Obj *errMsgObj = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(errMsgObj);
+ result = (char *) errMsgObj;
+ }
- Tcl_SaveResult(interp, &state);
+ Tcl_RestoreResult(interp, &state);
- code = Tcl_Eval(interp, Tcl_DStringValue(&cmd));
- if (code != TCL_OK) { /* copy error msg to result */
- char *string;
- int length;
-
- string = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length);
- tvarPtr->errMsg = (char *) ckalloc((unsigned) (length + 1));
- memcpy(tvarPtr->errMsg, string, (size_t) (length + 1));
- result = tvarPtr->errMsg;
+ Tcl_DStringFree(&cmd);
}
-
- Tcl_RestoreResult(interp, &state);
-
- Tcl_DStringFree(&cmd);
}
if (flags & TCL_TRACE_DESTROYED) {
- result = NULL;
- if (tvarPtr->errMsg != NULL) {
- ckfree(tvarPtr->errMsg);
+ if (result != NULL) {
+ register Tcl_Obj *errMsgObj = (Tcl_Obj *) result;
+
+ Tcl_DecrRefCount(errMsgObj);
+ result = NULL;
}
- ckfree((char *) tvarPtr);
+ Tcl_EventuallyFree((ClientData) tvarPtr, TCL_DYNAMIC);
}
+ Tcl_Release((ClientData) tvarPtr);
return result;
}
@@ -2855,4 +4593,3 @@ Tcl_WhileObjCmd(dummy, interp, objc, objv)
return result;
}
-
diff --git a/tcl/generic/tclCompCmds.c b/tcl/generic/tclCompCmds.c
index f15b5aa5378..43a24e08557 100644
--- a/tcl/generic/tclCompCmds.c
+++ b/tcl/generic/tclCompCmds.c
@@ -5,6 +5,8 @@
* 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.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -20,8 +22,17 @@
*/
static ClientData DupForeachInfo _ANSI_ARGS_((ClientData clientData));
-static void FreeForeachInfo _ANSI_ARGS_((
- ClientData clientData));
+static void FreeForeachInfo _ANSI_ARGS_((ClientData clientData));
+static int TclPushVarName _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Token *varTokenPtr, CompileEnv *envPtr, int flags,
+ int *localIndexPtr, int *simpleVarNamePtr, int *isScalarPtr));
+
+/*
+ * Flags bits used by TclPushVarName.
+ */
+
+#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 */
/*
* The structures below define the AuxData types defined in this file.
@@ -36,6 +47,130 @@ AuxDataType tclForeachInfoType = {
/*
*----------------------------------------------------------------------
*
+ * TclCompileAppendCmd --
+ *
+ * Procedure called to compile the "append" command.
+ *
+ * Results:
+ * The return value is a standard Tcl result, which is normally TCL_OK
+ * unless there was an error while parsing string. If an error occurs
+ * then the interpreter's result contains a standard error message. If
+ * complation fails because the command requires a second level of
+ * substitutions, TCL_OUT_LINE_COMPILE is returned indicating that the
+ * command should be compiled "out of line" by emitting code to
+ * invoke its command procedure (Tcl_AppendObjCmd) at runtime.
+ *
+ * Side effects:
+ * Instructions are added to envPtr to execute the "append" command
+ * at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileAppendCmd(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, *valueTokenPtr;
+ int simpleVarName, isScalar, localIndex, numWords;
+ int code = TCL_OK;
+
+ numWords = parsePtr->numWords;
+ if (numWords == 1) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ "wrong # args: should be \"append varName ?value value ...?\"",
+ -1);
+ return TCL_ERROR;
+ } else if (numWords == 2) {
+ /*
+ * append varName === set varName
+ */
+ return TclCompileSetCmd(interp, parsePtr, envPtr);
+ } else if (numWords > 3) {
+ /*
+ * APPEND instructions currently only handle one value
+ */
+ return TCL_OUT_LINE_COMPILE;
+ }
+
+ /*
+ * 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 = parsePtr->tokenPtr
+ + (parsePtr->tokenPtr->numComponents + 1);
+
+ code = TclPushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
+ &localIndex, &simpleVarName, &isScalar);
+ if (code != TCL_OK) {
+ goto done;
+ }
+
+ /*
+ * 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 each argument.
+ */
+
+ if (numWords > 2) {
+ valueTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
+ if (valueTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+ TclEmitPush(TclRegisterNewLiteral(envPtr,
+ valueTokenPtr[1].start, valueTokenPtr[1].size), envPtr);
+ } else {
+ code = TclCompileTokens(interp, valueTokenPtr+1,
+ valueTokenPtr->numComponents, envPtr);
+ if (code != TCL_OK) {
+ goto done;
+ }
+ }
+ }
+
+ /*
+ * Emit instructions to set/get the variable.
+ */
+
+ if (simpleVarName) {
+ if (isScalar) {
+ if (localIndex >= 0) {
+ if (localIndex <= 255) {
+ TclEmitInstInt1(INST_APPEND_SCALAR1, localIndex, envPtr);
+ } else {
+ TclEmitInstInt4(INST_APPEND_SCALAR4, localIndex, envPtr);
+ }
+ } else {
+ TclEmitOpcode(INST_APPEND_STK, envPtr);
+ }
+ } else {
+ if (localIndex >= 0) {
+ if (localIndex <= 255) {
+ TclEmitInstInt1(INST_APPEND_ARRAY1, localIndex, envPtr);
+ } else {
+ TclEmitInstInt4(INST_APPEND_ARRAY4, localIndex, envPtr);
+ }
+ } else {
+ TclEmitOpcode(INST_APPEND_ARRAY_STK, envPtr);
+ }
+ }
+ } else {
+ TclEmitOpcode(INST_APPEND_STK, envPtr);
+ }
+
+ done:
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclCompileBreakCmd --
*
* Procedure called to compile the "break" command.
@@ -45,9 +180,6 @@ AuxDataType tclForeachInfoType = {
* there was an error during compilation. If an error occurs then
* the interpreter's result contains a standard error message.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the command.
- *
* Side effects:
* Instructions are added to envPtr to execute the "break" command
* at runtime.
@@ -66,7 +198,6 @@ TclCompileBreakCmd(interp, parsePtr, envPtr)
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
"wrong # args: should be \"break\"", -1);
- envPtr->maxStackDepth = 0;
return TCL_ERROR;
}
@@ -75,7 +206,6 @@ TclCompileBreakCmd(interp, parsePtr, envPtr)
*/
TclEmitOpcode(INST_BREAK, envPtr);
- envPtr->maxStackDepth = 0;
return TCL_OK;
}
@@ -95,9 +225,6 @@ TclCompileBreakCmd(interp, parsePtr, envPtr)
* should be compiled "out of line" by emitting code to invoke its
* command procedure at runtime.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the command.
- *
* Side effects:
* Instructions are added to envPtr to execute the "catch" command
* at runtime.
@@ -114,12 +241,11 @@ TclCompileCatchCmd(interp, parsePtr, envPtr)
{
JumpFixup jumpFixup;
Tcl_Token *cmdTokenPtr, *nameTokenPtr;
- char *name;
- int localIndex, nameChars, range, maxDepth, startOffset, jumpDist;
+ CONST char *name;
+ int localIndex, nameChars, range, startOffset, jumpDist;
int code;
- char buffer[32 + TCL_INTEGER_SPACE];
+ int savedStackDepth = envPtr->currStackDepth;
- envPtr->maxStackDepth = 0;
if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) {
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
@@ -165,8 +291,6 @@ TclCompileCatchCmd(interp, parsePtr, envPtr)
* We will compile the catch command. Emit a beginCatch instruction at
* the start of the catch body: the subcommand it controls.
*/
-
- maxDepth = 0;
envPtr->exceptDepth++;
envPtr->maxExceptDepth =
@@ -174,19 +298,31 @@ TclCompileCatchCmd(interp, parsePtr, envPtr)
range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
TclEmitInstInt4(INST_BEGIN_CATCH4, range, envPtr);
- startOffset = (envPtr->codeNext - envPtr->codeStart);
+ /*
+ * 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]
+ */
+
+ if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+ startOffset = (envPtr->codeNext - envPtr->codeStart);
+ code = TclCompileCmdWord(interp, cmdTokenPtr+1, 1, envPtr);
+ } else {
+ code = TclCompileTokens(interp, cmdTokenPtr+1,
+ cmdTokenPtr->numComponents, envPtr);
+ startOffset = (envPtr->codeNext - envPtr->codeStart);
+ TclEmitOpcode(INST_EVAL_STK, envPtr);
+ }
envPtr->exceptArrayPtr[range].codeOffset = startOffset;
- code = TclCompileCmdWord(interp, cmdTokenPtr+1,
- cmdTokenPtr->numComponents, envPtr);
+
if (code != TCL_OK) {
- if (code == TCL_ERROR) {
- sprintf(buffer, "\n (\"catch\" body line %d)",
- interp->errorLine);
- Tcl_AddObjErrorInfo(interp, buffer, -1);
- }
+ code = TCL_OUT_LINE_COMPILE;
goto done;
}
- maxDepth = envPtr->maxStackDepth;
envPtr->exceptArrayPtr[range].numCodeBytes =
(envPtr->codeNext - envPtr->codeStart) - startOffset;
@@ -204,11 +340,7 @@ TclCompileCatchCmd(interp, parsePtr, envPtr)
}
}
TclEmitOpcode(INST_POP, envPtr);
- TclEmitPush(TclRegisterLiteral(envPtr, "0", 1, /*onHeap*/ 0),
- envPtr);
- if (maxDepth == 0) {
- maxDepth = 1;
- }
+ TclEmitPush(TclRegisterNewLiteral(envPtr, "0", 1), envPtr);
TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
/*
@@ -217,6 +349,7 @@ TclCompileCatchCmd(interp, parsePtr, envPtr)
* the catch's error target.
*/
+ envPtr->currStackDepth = savedStackDepth;
envPtr->exceptArrayPtr[range].catchOffset =
(envPtr->codeNext - envPtr->codeStart);
if (localIndex != -1) {
@@ -230,6 +363,7 @@ TclCompileCatchCmd(interp, parsePtr, envPtr)
}
TclEmitOpcode(INST_PUSH_RETURN_CODE, envPtr);
+
/*
* Update the target of the jump after the "no errors" code, then emit
* an endCatch instruction at the end of the catch command.
@@ -243,8 +377,8 @@ TclCompileCatchCmd(interp, parsePtr, envPtr)
TclEmitOpcode(INST_END_CATCH, envPtr);
done:
+ envPtr->currStackDepth = savedStackDepth + 1;
envPtr->exceptDepth--;
- envPtr->maxStackDepth = maxDepth;
return code;
}
@@ -260,9 +394,6 @@ TclCompileCatchCmd(interp, parsePtr, envPtr)
* there was an error while parsing string. If an error occurs then
* the interpreter's result contains a standard error message.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the command.
- *
* Side effects:
* Instructions are added to envPtr to execute the "continue" command
* at runtime.
@@ -285,7 +416,6 @@ TclCompileContinueCmd(interp, parsePtr, envPtr)
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
"wrong # args: should be \"continue\"", -1);
- envPtr->maxStackDepth = 0;
return TCL_ERROR;
}
@@ -294,7 +424,6 @@ TclCompileContinueCmd(interp, parsePtr, envPtr)
*/
TclEmitOpcode(INST_CONTINUE, envPtr);
- envPtr->maxStackDepth = 0;
return TCL_OK;
}
@@ -310,9 +439,6 @@ TclCompileContinueCmd(interp, parsePtr, envPtr)
* unless there was an error while parsing string. If an error occurs
* then the interpreter's result contains a standard error message.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the "expr" command.
- *
* Side effects:
* Instructions are added to envPtr to execute the "expr" command
* at runtime.
@@ -329,7 +455,6 @@ TclCompileExprCmd(interp, parsePtr, envPtr)
{
Tcl_Token *firstWordPtr;
- envPtr->maxStackDepth = 0;
if (parsePtr->numWords == 1) {
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
@@ -355,16 +480,12 @@ TclCompileExprCmd(interp, parsePtr, envPtr)
* there was an error while parsing string. If an error occurs then
* the interpreter's result contains a standard error message.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the command.
- *
* Side effects:
* Instructions are added to envPtr to execute the "for" command
* at runtime.
*
*----------------------------------------------------------------------
*/
-
int
TclCompileForCmd(interp, parsePtr, envPtr)
Tcl_Interp *interp; /* Used for error reporting. */
@@ -373,13 +494,12 @@ TclCompileForCmd(interp, parsePtr, envPtr)
CompileEnv *envPtr; /* Holds resulting instructions. */
{
Tcl_Token *startTokenPtr, *testTokenPtr, *nextTokenPtr, *bodyTokenPtr;
- JumpFixup jumpFalseFixup;
- int maxDepth, jumpBackDist, jumpBackOffset, testCodeOffset, jumpDist;
+ JumpFixup jumpEvalCondFixup;
+ int testCodeOffset, bodyCodeOffset, nextCodeOffset, jumpDist;
int bodyRange, nextRange, code;
- unsigned char *jumpPc;
char buffer[32 + TCL_INTEGER_SPACE];
+ int savedStackDepth = envPtr->currStackDepth;
- envPtr->maxStackDepth = 0;
if (parsePtr->numWords != 5) {
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
@@ -401,6 +521,18 @@ TclCompileForCmd(interp, parsePtr, envPtr)
}
/*
+ * Bail out also if the body or the next expression require substitutions
+ * in order to insure correct behaviour [Bug 219166]
+ */
+
+ nextTokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1);
+ bodyTokenPtr = nextTokenPtr + (nextTokenPtr->numComponents + 1);
+ if ((nextTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)
+ || (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)) {
+ return TCL_OUT_LINE_COMPILE;
+ }
+
+ /*
* 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).
@@ -416,7 +548,6 @@ TclCompileForCmd(interp, parsePtr, envPtr)
* Inline compile the initial command.
*/
- maxDepth = 0;
code = TclCompileCmdWord(interp, startTokenPtr+1,
startTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
@@ -426,35 +557,31 @@ TclCompileForCmd(interp, parsePtr, envPtr)
}
goto done;
}
- maxDepth = envPtr->maxStackDepth;
TclEmitOpcode(INST_POP, envPtr);
-
+
/*
- * Compile the test then emit the conditional jump that exits the for.
+ * 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
*/
- testCodeOffset = (envPtr->codeNext - envPtr->codeStart);
- code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
- if (code != TCL_OK) {
- if (code == TCL_ERROR) {
- Tcl_AddObjErrorInfo(interp,
- "\n (\"for\" test expression)", -1);
- }
- goto done;
- }
- maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
- TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);
+ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpEvalCondFixup);
/*
* Compile the loop body.
*/
- nextTokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1);
- bodyTokenPtr = nextTokenPtr + (nextTokenPtr->numComponents + 1);
- envPtr->exceptArrayPtr[bodyRange].codeOffset =
- (envPtr->codeNext - envPtr->codeStart);
+ bodyCodeOffset = (envPtr->codeNext - envPtr->codeStart);
+
code = TclCompileCmdWord(interp, bodyTokenPtr+1,
bodyTokenPtr->numComponents, envPtr);
+ envPtr->currStackDepth = savedStackDepth + 1;
if (code != TCL_OK) {
if (code == TCL_ERROR) {
sprintf(buffer, "\n (\"for\" body line %d)",
@@ -463,22 +590,21 @@ TclCompileForCmd(interp, parsePtr, envPtr)
}
goto done;
}
- maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
envPtr->exceptArrayPtr[bodyRange].numCodeBytes =
- (envPtr->codeNext - envPtr->codeStart)
- - envPtr->exceptArrayPtr[bodyRange].codeOffset;
+ (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
TclEmitOpcode(INST_POP, envPtr);
+
/*
* Compile the "next" subcommand.
*/
- envPtr->exceptArrayPtr[bodyRange].continueOffset =
- (envPtr->codeNext - envPtr->codeStart);
- envPtr->exceptArrayPtr[nextRange].codeOffset =
- (envPtr->codeNext - envPtr->codeStart);
+ nextCodeOffset = (envPtr->codeNext - envPtr->codeStart);
+
+ envPtr->currStackDepth = savedStackDepth;
code = TclCompileCmdWord(interp, nextTokenPtr+1,
nextTokenPtr->numComponents, envPtr);
+ envPtr->currStackDepth = savedStackDepth + 1;
if (code != TCL_OK) {
if (code == TCL_ERROR) {
Tcl_AddObjErrorInfo(interp,
@@ -486,62 +612,53 @@ TclCompileForCmd(interp, parsePtr, envPtr)
}
goto done;
}
- maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
envPtr->exceptArrayPtr[nextRange].numCodeBytes =
(envPtr->codeNext - envPtr->codeStart)
- - envPtr->exceptArrayPtr[nextRange].codeOffset;
+ - nextCodeOffset;
TclEmitOpcode(INST_POP, 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.
- */
-
- jumpBackOffset = (envPtr->codeNext - envPtr->codeStart);
- jumpBackDist = (jumpBackOffset - testCodeOffset);
- if (jumpBackDist > 120) {
- TclEmitInstInt4(INST_JUMP4, -jumpBackDist, envPtr);
- } else {
- TclEmitInstInt1(INST_JUMP1, -jumpBackDist, envPtr);
- }
+ envPtr->currStackDepth = savedStackDepth;
/*
- * Fix the target of the jumpFalse after the test.
+ * Compile the test expression then emit the conditional jump that
+ * terminates the for.
*/
- jumpDist = (envPtr->codeNext - envPtr->codeStart)
- - jumpFalseFixup.codeOffset;
- if (TclFixupForwardJump(envPtr, &jumpFalseFixup, jumpDist, 127)) {
- /*
- * Update the loop body and "next" command ExceptionRanges since
- * they moved down.
- */
-
- envPtr->exceptArrayPtr[bodyRange].codeOffset += 3;
- envPtr->exceptArrayPtr[bodyRange].continueOffset += 3;
- envPtr->exceptArrayPtr[nextRange].codeOffset += 3;
-
- /*
- * Update the jump back to the test at the top of the loop since it
- * also moved down 3 bytes.
- */
+ testCodeOffset = (envPtr->codeNext - envPtr->codeStart);
- jumpBackOffset += 3;
- jumpPc = (envPtr->codeStart + jumpBackOffset);
- jumpBackDist += 3;
- if (jumpBackDist > 120) {
- TclUpdateInstInt4AtPc(INST_JUMP4, -jumpBackDist, jumpPc);
- } else {
- TclUpdateInstInt1AtPc(INST_JUMP1, -jumpBackDist, jumpPc);
+ jumpDist = testCodeOffset - jumpEvalCondFixup.codeOffset;
+ if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) {
+ bodyCodeOffset += 3;
+ nextCodeOffset += 3;
+ testCodeOffset += 3;
+ }
+
+ envPtr->currStackDepth = savedStackDepth;
+ code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
+ if (code != TCL_OK) {
+ if (code == TCL_ERROR) {
+ Tcl_AddObjErrorInfo(interp,
+ "\n (\"for\" test expression)", -1);
}
+ goto done;
+ }
+ envPtr->currStackDepth = savedStackDepth + 1;
+
+ jumpDist = (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
+ if (jumpDist > 127) {
+ TclEmitInstInt4(INST_JUMP_TRUE4, -jumpDist, envPtr);
+ } else {
+ TclEmitInstInt1(INST_JUMP_TRUE1, -jumpDist, envPtr);
}
/*
- * Set the loop's break target.
+ * Set the loop's offsets and break target.
*/
+ envPtr->exceptArrayPtr[bodyRange].codeOffset = bodyCodeOffset;
+ envPtr->exceptArrayPtr[bodyRange].continueOffset = nextCodeOffset;
+
+ envPtr->exceptArrayPtr[nextRange].codeOffset = nextCodeOffset;
+
envPtr->exceptArrayPtr[bodyRange].breakOffset =
envPtr->exceptArrayPtr[nextRange].breakOffset =
(envPtr->codeNext - envPtr->codeStart);
@@ -550,14 +667,11 @@ TclCompileForCmd(interp, parsePtr, envPtr)
* The for command's result is an empty string.
*/
- TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr);
- if (maxDepth == 0) {
- maxDepth = 1;
- }
+ envPtr->currStackDepth = savedStackDepth;
+ TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
code = TCL_OK;
done:
- envPtr->maxStackDepth = maxDepth;
envPtr->exceptDepth--;
return code;
}
@@ -578,14 +692,11 @@ TclCompileForCmd(interp, parsePtr, envPtr)
* should be compiled "out of line" by emitting code to invoke its
* command procedure at runtime.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the "while" command.
- *
* Side effects:
* Instructions are added to envPtr to execute the "foreach" command
* at runtime.
*
- *----------------------------------------------------------------------
+n*----------------------------------------------------------------------
*/
int
@@ -604,13 +715,12 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
int loopCtTemp; /* Index of temp var holding the loop's
* iteration count. */
Tcl_Token *tokenPtr, *bodyTokenPtr;
- char *varList;
unsigned char *jumpPc;
JumpFixup jumpFalseFixup;
- int jumpDist, jumpBackDist, jumpBackOffset, maxDepth, infoIndex, range;
+ int jumpDist, jumpBackDist, jumpBackOffset, infoIndex, range;
int numWords, numLists, numVars, loopIndex, tempVar, i, j, code;
- char savedChar;
char buffer[32 + TCL_INTEGER_SPACE];
+ int savedStackDepth = envPtr->currStackDepth;
/*
* We parse the variable list argument words and create two arrays:
@@ -620,22 +730,19 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
#define STATIC_VAR_LIST_SIZE 5
int varcListStaticSpace[STATIC_VAR_LIST_SIZE];
- char **varvListStaticSpace[STATIC_VAR_LIST_SIZE];
+ CONST char **varvListStaticSpace[STATIC_VAR_LIST_SIZE];
int *varcList = varcListStaticSpace;
- char ***varvList = varvListStaticSpace;
+ CONST char ***varvList = varvListStaticSpace;
/*
* If the foreach command isn't in a procedure, don't compile it inline:
* the payoff is too small.
*/
- envPtr->maxStackDepth = 0;
if (procPtr == NULL) {
return TCL_OUT_LINE_COMPILE;
}
- maxDepth = 0;
-
numWords = parsePtr->numWords;
if ((numWords < 4) || (numWords%2 != 0)) {
Tcl_ResetResult(interp);
@@ -645,17 +752,30 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
}
/*
+ * 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 += (tokenPtr->numComponents + 1)) {
+ }
+ bodyTokenPtr = tokenPtr;
+ if (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ return TCL_OUT_LINE_COMPILE;
+ }
+
+ /*
* Allocate storage for the varcList and varvList arrays if necessary.
*/
numLists = (numWords - 2)/2;
if (numLists > STATIC_VAR_LIST_SIZE) {
varcList = (int *) ckalloc(numLists * sizeof(int));
- varvList = (char ***) ckalloc(numLists * sizeof(char **));
+ varvList = (CONST char ***) ckalloc(numLists * sizeof(CONST char **));
}
for (loopIndex = 0; loopIndex < numLists; loopIndex++) {
varcList[loopIndex] = 0;
- varvList[loopIndex] = (char **) NULL;
+ varvList[loopIndex] = NULL;
}
/*
@@ -680,32 +800,29 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
code = TCL_OUT_LINE_COMPILE;
goto done;
- }
- varList = tokenPtr[1].start;
- savedChar = varList[tokenPtr[1].size];
-
- /*
- * Note there is a danger that modifying the string could have
- * undesirable side effects. In this case, Tcl_SplitList does
- * not have any dependencies on shared strings so we should be
- * safe.
- */
+ } else {
+ /* Lots of copying going on here. Need a ListObj wizard
+ * to show a better way. */
- varList[tokenPtr[1].size] = '\0';
- code = Tcl_SplitList(interp, varList,
- &varcList[loopIndex], &varvList[loopIndex]);
- varList[tokenPtr[1].size] = savedChar;
- if (code != TCL_OK) {
- goto done;
- }
+ Tcl_DString varList;
- numVars = varcList[loopIndex];
- for (j = 0; j < numVars; j++) {
- char *varName = varvList[loopIndex][j];
- if (!TclIsLocalScalar(varName, (int) strlen(varName))) {
- code = TCL_OUT_LINE_COMPILE;
+ 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) {
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_OUT_LINE_COMPILE;
+ goto done;
+ }
+ }
}
loopIndex++;
}
@@ -749,7 +866,7 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
sizeof(ForeachVarList) + (numVars * sizeof(int)));
varListPtr->numVars = numVars;
for (j = 0; j < numVars; j++) {
- char *varName = varvList[loopIndex][j];
+ CONST char *varName = varvList[loopIndex][j];
int nameChars = strlen(varName);
varListPtr->varIndexes[j] = TclFindCompiledLocal(varName,
nameChars, /*create*/ 1, /*flags*/ VAR_SCALAR, procPtr);
@@ -774,7 +891,6 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
if (code != TCL_OK) {
goto done;
}
- maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
tempVar = (firstValueTemp + loopIndex);
if (tempVar <= 255) {
@@ -786,7 +902,6 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
loopIndex++;
}
}
- bodyTokenPtr = tokenPtr;
/*
* Initialize the temporary var that holds the count of loop iterations.
@@ -812,6 +927,7 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
(envPtr->codeNext - envPtr->codeStart);
code = TclCompileCmdWord(interp, bodyTokenPtr+1,
bodyTokenPtr->numComponents, envPtr);
+ envPtr->currStackDepth = savedStackDepth + 1;
if (code != TCL_OK) {
if (code == TCL_ERROR) {
sprintf(buffer, "\n (\"foreach\" body line %d)",
@@ -820,7 +936,6 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
}
goto done;
}
- maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
envPtr->exceptArrayPtr[range].numCodeBytes =
(envPtr->codeNext - envPtr->codeStart)
- envPtr->exceptArrayPtr[range].codeOffset;
@@ -881,22 +996,20 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
* The foreach command's result is an empty string.
*/
- TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr);
- if (maxDepth == 0) {
- maxDepth = 1;
- }
+ envPtr->currStackDepth = savedStackDepth;
+ TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
+ envPtr->currStackDepth = savedStackDepth + 1;
done:
for (loopIndex = 0; loopIndex < numLists; loopIndex++) {
- if (varvList[loopIndex] != (char **) NULL) {
- ckfree((char *) varvList[loopIndex]);
- }
+ if (varvList[loopIndex] != (CONST char **) NULL) {
+ ckfree((char *) varvList[loopIndex]);
+ }
}
if (varcList != varcListStaticSpace) {
ckfree((char *) varcList);
ckfree((char *) varvList);
}
- envPtr->maxStackDepth = maxDepth;
envPtr->exceptDepth--;
return code;
}
@@ -1005,16 +1118,12 @@ FreeForeachInfo(clientData)
* should be compiled "out of line" by emitting code to invoke its
* command procedure at runtime.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the command.
- *
* 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. */
@@ -1030,14 +1139,38 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
* body to the end of the "if" when that PC
* is determined. */
Tcl_Token *tokenPtr, *testTokenPtr;
- int jumpDist, jumpFalseDist, jumpIndex;
- int numWords, wordIdx, numBytes, maxDepth, j, code;
- char *word;
+ int jumpDist, jumpFalseDist;
+ int jumpIndex = 0; /* avoid compiler warning. */
+ int numWords, wordIdx, numBytes, j, code;
+ CONST char *word;
char buffer[100];
+ 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;
+
+ for (wordIdx = 0; wordIdx < numWords; wordIdx++) {
+ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ return TCL_OUT_LINE_COMPILE;
+ }
+ tokenPtr += 2;
+ }
+
TclInitJumpFixupArray(&jumpFalseFixupArray);
TclInitJumpFixupArray(&jumpEndFixupArray);
- maxDepth = 0;
code = TCL_OK;
/*
@@ -1047,15 +1180,11 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
tokenPtr = parsePtr->tokenPtr;
wordIdx = 0;
- numWords = parsePtr->numWords;
while (wordIdx < numWords) {
/*
* Stop looping if the token isn't "if" or "elseif".
*/
- if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- break;
- }
word = tokenPtr[1].start;
numBytes = tokenPtr[1].size;
if ((tokenPtr == parsePtr->tokenPtr)
@@ -1077,28 +1206,52 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
/*
* Compile the test expression then emit the conditional jump
- * around the "then" part. If the expression word isn't simple,
- * we back off and compile the if command out-of-line.
+ * around the "then" part.
*/
+ envPtr->currStackDepth = savedStackDepth;
testTokenPtr = tokenPtr;
- code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
- if (code != TCL_OK) {
- if (code == TCL_ERROR) {
- Tcl_AddObjErrorInfo(interp,
- "\n (\"if\" test expression)", -1);
+
+
+ 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);
+ Tcl_DecrRefCount(boolObj);
+ if (code == TCL_OK) {
+ /*
+ * A static condition
+ */
+ realCond = 0;
+ if (!boolVal) {
+ compileScripts = 0;
+ }
+ } else {
+ Tcl_ResetResult(interp);
+ code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
+ if (code != TCL_OK) {
+ if (code == TCL_ERROR) {
+ Tcl_AddObjErrorInfo(interp,
+ "\n (\"if\" test expression)", -1);
+ }
+ goto done;
+ }
+ if (jumpFalseFixupArray.next >= jumpFalseFixupArray.end) {
+ TclExpandJumpFixupArray(&jumpFalseFixupArray);
+ }
+ jumpIndex = jumpFalseFixupArray.next;
+ jumpFalseFixupArray.next++;
+ TclEmitForwardJump(envPtr, TCL_FALSE_JUMP,
+ &(jumpFalseFixupArray.fixup[jumpIndex]));
}
- goto done;
- }
- maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
- if (jumpFalseFixupArray.next >= jumpFalseFixupArray.end) {
- TclExpandJumpFixupArray(&jumpFalseFixupArray);
}
- jumpIndex = jumpFalseFixupArray.next;
- jumpFalseFixupArray.next++;
- TclEmitForwardJump(envPtr, TCL_FALSE_JUMP,
- &(jumpFalseFixupArray.fixup[jumpIndex]));
-
+
+
/*
* Skip over the optional "then" before the then clause.
*/
@@ -1132,56 +1285,83 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
* Compile the "then" command body.
*/
- code = TclCompileCmdWord(interp, tokenPtr+1,
- tokenPtr->numComponents, envPtr);
- if (code != TCL_OK) {
- if (code == TCL_ERROR) {
- sprintf(buffer, "\n (\"if\" then script line %d)",
- interp->errorLine);
- Tcl_AddObjErrorInfo(interp, buffer, -1);
- }
- goto done;
+ if (compileScripts) {
+ envPtr->currStackDepth = savedStackDepth;
+ code = TclCompileCmdWord(interp, tokenPtr+1,
+ tokenPtr->numComponents, envPtr);
+ if (code != TCL_OK) {
+ if (code == TCL_ERROR) {
+ sprintf(buffer, "\n (\"if\" then script line %d)",
+ interp->errorLine);
+ Tcl_AddObjErrorInfo(interp, buffer, -1);
+ }
+ goto done;
+ }
}
- maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
- /*
- * 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]));
+ 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.
+ */
- /*
- * 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.
- */
+ jumpDist = (envPtr->codeNext - envPtr->codeStart)
+ - jumpFalseFixupArray.fixup[jumpIndex].codeOffset;
+ if (TclFixupForwardJump(envPtr,
+ &(jumpFalseFixupArray.fixup[jumpIndex]), jumpDist, 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
+ */
- jumpDist = (envPtr->codeNext - envPtr->codeStart)
- - jumpFalseFixupArray.fixup[jumpIndex].codeOffset;
- if (TclFixupForwardJump(envPtr,
- &(jumpFalseFixupArray.fixup[jumpIndex]), jumpDist, 120)) {
- /*
- * Adjust the code offset for the proceeding jump to the end
- * of the "if" command.
+ compileScripts = 0;
+ } else {
+ /*
+ *We were processing an "if 0 {...}"; reset so that
+ * the rest (elseif, else) is compiled correctly
*/
- jumpEndFixupArray.fixup[jumpIndex].codeOffset += 3;
- }
+ realCond = 1;
+ compileScripts = 1;
+ }
tokenPtr += (tokenPtr->numComponents + 1);
wordIdx++;
}
/*
- * Check for the optional else clause.
+ * Restore the current stack depth in the environment; the
+ * "else" clause (or its default) will add 1 to this.
+ */
+
+ envPtr->currStackDepth = savedStackDepth;
+
+ /*
+ * Check for the optional else clause. Do not compile
+ * anything if this was an "if 1 {...}" case.
*/
if ((wordIdx < numWords)
@@ -1189,7 +1369,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
/*
* 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)) {
@@ -1204,21 +1384,22 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
}
}
- /*
- * Compile the else command body.
- */
-
- code = TclCompileCmdWord(interp, tokenPtr+1,
- tokenPtr->numComponents, envPtr);
- if (code != TCL_OK) {
- if (code == TCL_ERROR) {
- sprintf(buffer, "\n (\"if\" else script line %d)",
- interp->errorLine);
- Tcl_AddObjErrorInfo(interp, buffer, -1);
+ if (compileScripts) {
+ /*
+ * Compile the else command body.
+ */
+
+ code = TclCompileCmdWord(interp, tokenPtr+1,
+ tokenPtr->numComponents, envPtr);
+ if (code != TCL_OK) {
+ if (code == TCL_ERROR) {
+ sprintf(buffer, "\n (\"if\" else script line %d)",
+ interp->errorLine);
+ Tcl_AddObjErrorInfo(interp, buffer, -1);
+ }
+ goto done;
}
- goto done;
}
- maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
/*
* Make sure there are no words after the else clause.
@@ -1237,8 +1418,9 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
* No else clause: the "if" command's result is an empty string.
*/
- TclEmitPush(TclRegisterLiteral(envPtr, "", 0,/*onHeap*/ 0), envPtr);
- maxDepth = TclMax(1, maxDepth);
+ if (compileScripts) {
+ TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
+ }
}
/*
@@ -1272,15 +1454,15 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
}
}
}
-
+
/*
* Free the jumpFixupArray array if malloc'ed storage was used.
*/
done:
+ envPtr->currStackDepth = savedStackDepth + 1;
TclFreeJumpFixupArray(&jumpFalseFixupArray);
TclFreeJumpFixupArray(&jumpEndFixupArray);
- envPtr->maxStackDepth = maxDepth;
return code;
}
@@ -1300,9 +1482,6 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
* should be compiled "out of line" by emitting code to invoke its
* command procedure at runtime.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the "incr" command.
- *
* Side effects:
* Instructions are added to envPtr to execute the "incr" command
* at runtime.
@@ -1318,119 +1497,26 @@ TclCompileIncrCmd(interp, parsePtr, envPtr)
CompileEnv *envPtr; /* Holds resulting instructions. */
{
Tcl_Token *varTokenPtr, *incrTokenPtr;
- Tcl_Parse elemParse;
- int gotElemParse = 0;
- char *name, *elName, *p;
- int nameChars, elNameChars, haveImmValue, immValue, localIndex, i, code;
- int maxDepth = 0;
- char buffer[160];
-
- envPtr->maxStackDepth = 0;
+ int simpleVarName, isScalar, localIndex, haveImmValue, immValue;
+ int code = TCL_OK;
+
if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) {
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
"wrong # args: should be \"incr varName ?increment?\"", -1);
return TCL_ERROR;
}
-
- name = NULL;
- elName = NULL;
- elNameChars = 0;
- localIndex = -1;
- code = TCL_OK;
varTokenPtr = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
- /*
- * Check not only that the type is TCL_TOKEN_SIMPLE_WORD, but whether
- * curly braces surround the variable name.
- * This really matters for array elements to handle things like
- * set {x($foo)} 5
- * which raises an undefined var error if we are not careful here.
- * This goes with the hack in TclCompileSetCmd.
- */
- if ((varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) &&
- (varTokenPtr->start[0] != '{')) {
- /*
- * A simple variable name. Divide it up into "name" and "elName"
- * strings. If it is not a local variable, look it up at runtime.
- */
-
- name = varTokenPtr[1].start;
- nameChars = varTokenPtr[1].size;
- for (i = 0, p = name; i < nameChars; i++, p++) {
- if (*p == '(') {
- char *openParen = p;
- p = (name + nameChars-1);
- if (*p == ')') { /* last char is ')' => array reference */
- nameChars = (openParen - name);
- elName = openParen+1;
- elNameChars = (p - elName);
- }
- break;
- }
- }
- if (envPtr->procPtr != NULL) {
- localIndex = TclFindCompiledLocal(name, nameChars,
- /*create*/ 0, /*flags*/ 0, envPtr->procPtr);
- if (localIndex > 255) { /* we'll push the name */
- localIndex = -1;
- }
- }
- if (localIndex < 0) {
- TclEmitPush(TclRegisterLiteral(envPtr, name, nameChars,
- /*onHeap*/ 0), envPtr);
- maxDepth = 1;
- }
- /*
- * Compile the element script, if any.
- */
-
- if (elName != NULL) {
- /*
- * Temporarily replace the '(' and ')' by '"'s.
- */
-
- *(elName-1) = '"';
- *(elName+elNameChars) = '"';
- code = Tcl_ParseCommand(interp, elName-1, elNameChars+2,
- /*nested*/ 0, &elemParse);
- *(elName-1) = '(';
- *(elName+elNameChars) = ')';
- gotElemParse = 1;
- if ((code != TCL_OK) || (elemParse.numWords > 1)) {
- sprintf(buffer, "\n (parsing index for array \"%.*s\")",
- TclMin(nameChars, 100), name);
- Tcl_AddObjErrorInfo(interp, buffer, -1);
- code = TCL_ERROR;
- goto done;
- } else if (elemParse.numWords == 1) {
- code = TclCompileTokens(interp, elemParse.tokenPtr+1,
- elemParse.tokenPtr->numComponents, envPtr);
- if (code != TCL_OK) {
- goto done;
- }
- maxDepth += envPtr->maxStackDepth;
- } else {
- TclEmitPush(TclRegisterLiteral(envPtr, "", 0,
- /*alreadyAlloced*/ 0), envPtr);
- maxDepth += 1;
- }
- }
- } else {
- /*
- * Not a simple variable name. Look it up at runtime.
- */
-
- code = TclCompileTokens(interp, varTokenPtr+1,
- varTokenPtr->numComponents, envPtr);
- if (code != TCL_OK) {
- goto done;
- }
- maxDepth = envPtr->maxStackDepth;
+ code = TclPushVarName(interp, varTokenPtr, envPtr,
+ (TCL_NO_LARGE_INDEX | TCL_CREATE_VAR),
+ &localIndex, &simpleVarName, &isScalar);
+ if (code != TCL_OK) {
+ goto done;
}
-
+
/*
* If an increment is given, push it, but see first if it's a small
* integer.
@@ -1441,11 +1527,11 @@ TclCompileIncrCmd(interp, parsePtr, envPtr)
if (parsePtr->numWords == 3) {
incrTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
if (incrTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
- char *word = incrTokenPtr[1].start;
+ CONST char *word = incrTokenPtr[1].start;
int numBytes = incrTokenPtr[1].size;
- char savedChar = word[numBytes];
+ int validLength = TclParseInteger(word, numBytes);
long n;
-
+
/*
* Note there is a danger that modifying the string could have
* undesirable side effects. In this case, TclLooksLikeInt and
@@ -1453,19 +1539,20 @@ TclCompileIncrCmd(interp, parsePtr, envPtr)
* should be safe.
*/
- word[numBytes] = '\0';
- if (TclLooksLikeInt(word, numBytes)
- && (TclGetLong((Tcl_Interp *) NULL, word, &n) == TCL_OK)) {
- if ((-127 <= n) && (n <= 127)) {
+ if (validLength == numBytes) {
+ int code;
+ Tcl_Obj *longObj = Tcl_NewStringObj(word, numBytes);
+ Tcl_IncrRefCount(longObj);
+ code = Tcl_GetLongFromObj(NULL, longObj, &n);
+ Tcl_DecrRefCount(longObj);
+ if ((code == TCL_OK) && (-127 <= n) && (n <= 127)) {
haveImmValue = 1;
immValue = n;
}
}
- word[numBytes] = savedChar;
if (!haveImmValue) {
- TclEmitPush(TclRegisterLiteral(envPtr, word, numBytes,
- /*onHeap*/ 0), envPtr);
- maxDepth += 1;
+ TclEmitPush(
+ TclRegisterNewLiteral(envPtr, word, numBytes), envPtr);
}
} else {
code = TclCompileTokens(interp, incrTokenPtr+1,
@@ -1477,7 +1564,6 @@ TclCompileIncrCmd(interp, parsePtr, envPtr)
}
goto done;
}
- maxDepth += envPtr->maxStackDepth;
}
} else { /* no incr amount given so use 1 */
haveImmValue = 1;
@@ -1488,20 +1574,18 @@ TclCompileIncrCmd(interp, parsePtr, envPtr)
* Emit the instruction to increment the variable.
*/
- if (name != NULL) {
- if (elName == NULL) {
+ if (simpleVarName) {
+ if (isScalar) {
if (localIndex >= 0) {
if (haveImmValue) {
- TclEmitInstInt1(INST_INCR_SCALAR1_IMM, localIndex,
- envPtr);
+ 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);
+ TclEmitInstInt1(INST_INCR_SCALAR_STK_IMM, immValue, envPtr);
} else {
TclEmitOpcode(INST_INCR_SCALAR_STK, envPtr);
}
@@ -1509,16 +1593,14 @@ TclCompileIncrCmd(interp, parsePtr, envPtr)
} else {
if (localIndex >= 0) {
if (haveImmValue) {
- TclEmitInstInt1(INST_INCR_ARRAY1_IMM, localIndex,
- envPtr);
+ 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);
+ TclEmitInstInt1(INST_INCR_ARRAY_STK_IMM, immValue, envPtr);
} else {
TclEmitOpcode(INST_INCR_ARRAY_STK, envPtr);
}
@@ -1533,66 +1615,64 @@ TclCompileIncrCmd(interp, parsePtr, envPtr)
}
done:
- if (gotElemParse) {
- Tcl_FreeParse(&elemParse);
- }
- envPtr->maxStackDepth = maxDepth;
return code;
}
/*
*----------------------------------------------------------------------
*
- * TclCompileSetCmd --
+ * TclCompileLappendCmd --
*
- * Procedure called to compile the "set" command.
+ * Procedure called to compile the "lappend" command.
*
* Results:
* The return value is a standard Tcl result, which is normally TCL_OK
* unless there was an error while parsing string. If an error occurs
* then the interpreter's result contains a standard error message. If
- * complation fails because the set command requires a second level of
+ * complation fails because the command requires a second level of
* substitutions, TCL_OUT_LINE_COMPILE is returned indicating that the
- * set command should be compiled "out of line" by emitting code to
- * invoke its command procedure (Tcl_SetCmd) at runtime.
- *
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the incr command.
+ * command should be compiled "out of line" by emitting code to
+ * invoke its command procedure (Tcl_LappendObjCmd) at runtime.
*
* Side effects:
- * Instructions are added to envPtr to execute the "set" command
+ * Instructions are added to envPtr to execute the "lappend" command
* at runtime.
*
*----------------------------------------------------------------------
*/
int
-TclCompileSetCmd(interp, parsePtr, envPtr)
+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. */
{
Tcl_Token *varTokenPtr, *valueTokenPtr;
- Tcl_Parse elemParse;
- int gotElemParse = 0;
- register char *p;
- char *name, *elName;
- int nameChars, elNameChars;
- register int i, n;
- int isAssignment, simpleVarName, localIndex, numWords;
- int maxDepth = 0;
+ int numValues, simpleVarName, isScalar, localIndex, numWords;
int code = TCL_OK;
- envPtr->maxStackDepth = 0;
+ /*
+ * If we're not in a procedure, don't compile.
+ */
+ if (envPtr->procPtr == NULL) {
+ return TCL_OUT_LINE_COMPILE;
+ }
+
numWords = parsePtr->numWords;
- if ((numWords != 2) && (numWords != 3)) {
+ if (numWords == 1) {
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "wrong # args: should be \"set varName ?newValue?\"", -1);
- return TCL_ERROR;
+ "wrong # args: should be \"lappend varName ?value value ...?\"", -1);
+ return TCL_ERROR;
}
- isAssignment = (numWords == 3);
+ if (numWords != 3) {
+ /*
+ * LAPPEND instructions currently only handle one value appends
+ */
+ return TCL_OUT_LINE_COMPILE;
+ }
+ numValues = (numWords - 2);
/*
* Decide if we can use a frame slot for the var/array name or if we
@@ -1602,196 +1682,852 @@ TclCompileSetCmd(interp, parsePtr, envPtr)
* namespace qualifiers.
*/
- simpleVarName = 0;
- name = elName = NULL;
- nameChars = elNameChars = 0;
- localIndex = -1;
-
varTokenPtr = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
+
+ code = TclPushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
+ &localIndex, &simpleVarName, &isScalar);
+ if (code != TCL_OK) {
+ goto done;
+ }
+
/*
- * Check not only that the type is TCL_TOKEN_SIMPLE_WORD, but whether
- * curly braces surround the variable name.
- * This really matters for array elements to handle things like
- * set {x($foo)} 5
- * which raises an undefined var error if we are not careful here.
- * This goes with the hack in TclCompileIncrCmd.
+ * If we are doing an assignment, push the new value.
+ * In the no values case, create an empty object.
*/
- if ((varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) &&
- (varTokenPtr->start[0] != '{')) {
- simpleVarName = 1;
- name = varTokenPtr[1].start;
- nameChars = varTokenPtr[1].size;
- /* last char is ')' => potential array reference */
- if ( *(name + nameChars - 1) == ')') {
- for (i = 0, p = name; i < nameChars; i++, p++) {
- if (*p == '(') {
- elName = p + 1;
- elNameChars = nameChars - i - 2;
- nameChars = i ;
- break;
- }
+ if (numWords > 2) {
+ valueTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
+ if (valueTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+ TclEmitPush(TclRegisterNewLiteral(envPtr,
+ valueTokenPtr[1].start, valueTokenPtr[1].size), envPtr);
+ } else {
+ code = TclCompileTokens(interp, valueTokenPtr+1,
+ valueTokenPtr->numComponents, envPtr);
+ if (code != TCL_OK) {
+ goto done;
}
}
-
+#if 0
+ } else {
/*
- * If elName contains any double quotes ("), we can't inline
- * compile the element script using the replace '()' by '"'
- * technique below.
+ * We need to carefully handle the two arg case, as lappend
+ * always creates the variable.
*/
- for (i = 0, p = elName; i < elNameChars; i++, p++) {
- if (*p == '"') {
- simpleVarName = 0;
- break;
+ TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
+ numValues = 1;
+#endif
+ }
+
+ /*
+ * Emit instructions to set/get the variable.
+ */
+
+ /*
+ * The *_STK opcodes should be refactored to make better use of existing
+ * LOAD/STORE instructions.
+ */
+ if (simpleVarName) {
+ if (isScalar) {
+ if (localIndex >= 0) {
+ if (localIndex <= 255) {
+ TclEmitInstInt1(INST_LAPPEND_SCALAR1, localIndex, envPtr);
+ } else {
+ TclEmitInstInt4(INST_LAPPEND_SCALAR4, localIndex, envPtr);
+ }
+ } else {
+ TclEmitOpcode(INST_LAPPEND_STK, envPtr);
+ }
+ } else {
+ if (localIndex >= 0) {
+ if (localIndex <= 255) {
+ TclEmitInstInt1(INST_LAPPEND_ARRAY1, localIndex, envPtr);
+ } else {
+ TclEmitInstInt4(INST_LAPPEND_ARRAY4, localIndex, envPtr);
+ }
+ } else {
+ TclEmitOpcode(INST_LAPPEND_ARRAY_STK, envPtr);
}
}
- } else if (((n = varTokenPtr->numComponents) > 1)
- && (varTokenPtr[1].type == TCL_TOKEN_TEXT)
- && (varTokenPtr[n].type == TCL_TOKEN_TEXT)
- && (varTokenPtr[n].start[varTokenPtr[n].size - 1] == ')')) {
- simpleVarName = 0;
+ } else {
+ TclEmitOpcode(INST_LAPPEND_STK, envPtr);
+ }
- /*
- * Check for parentheses inside first token
- */
- for (i = 0, p = varTokenPtr[1].start;
- i < varTokenPtr[1].size; i++, p++) {
- if (*p == '(') {
- simpleVarName = 1;
- break;
- }
- }
- if (simpleVarName) {
- name = varTokenPtr[1].start;
- nameChars = p - varTokenPtr[1].start;
- elName = p + 1;
- elNameChars = (varTokenPtr[n].start - p) + varTokenPtr[n].size - 2;
+ done:
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileLindexCmd --
+ *
+ * Procedure called to compile the "lindex" command.
+ *
+ * Results:
+ * The return value is a standard Tcl result, which is TCL_OK if the
+ * compilation was successful. If the command cannot be byte-compiled,
+ * TCL_OUT_LINE_COMPILE is returned. If an error occurs then the
+ * interpreter's result contains an error message, and TCL_ERROR is
+ * returned.
+ *
+ * Side effects:
+ * Instructions are added to envPtr to execute the "lindex" command
+ * at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
- /*
- * If elName contains any double quotes ("), we can't inline
- * compile the element script using the replace '()' by '"'
- * technique below.
- */
-
- for (i = 0, p = elName; i < elNameChars; i++, p++) {
- if (*p == '"') {
- simpleVarName = 0;
- break;
- }
- }
- }
+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 code, i;
+
+ int numWords;
+ numWords = parsePtr->numWords;
+
+ /*
+ * Quit if too few args
+ */
+
+ if ( numWords <= 1 ) {
+ return TCL_OUT_LINE_COMPILE;
}
- if (simpleVarName) {
+ varTokenPtr = parsePtr->tokenPtr
+ + (parsePtr->tokenPtr->numComponents + 1);
+
+ /*
+ * Push the operands onto the stack.
+ */
+
+ for ( i = 1 ; i < numWords ; i++ ) {
+ if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+ TclEmitPush(
+ TclRegisterNewLiteral( envPtr, varTokenPtr[1].start,
+ varTokenPtr[1].size), envPtr);
+ } else {
+ code = TclCompileTokens(interp, varTokenPtr+1,
+ varTokenPtr->numComponents, envPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+ }
+ varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
+ }
+
+ /*
+ * 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:
+ * The return value is a standard Tcl result, which is normally TCL_OK
+ * unless there was an error while parsing string. If an error occurs
+ * then the interpreter's result contains a standard error message. If
+ * complation fails because the command requires a second level of
+ * substitutions, TCL_OUT_LINE_COMPILE is returned indicating that the
+ * command should be compiled "out of line" by emitting code to
+ * invoke its command procedure (Tcl_ListObjCmd) at runtime.
+ *
+ * Side effects:
+ * Instructions are added to envPtr to execute the "list" command
+ * at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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.
+ */
+ if (envPtr->procPtr == NULL) {
+ return TCL_OUT_LINE_COMPILE;
+ }
+
+ if (parsePtr->numWords == 1) {
/*
- * See whether name has any namespace separators (::'s).
+ * Empty args case
*/
- int hasNsQualifiers = 0;
- for (i = 0, p = name; i < nameChars; i++, p++) {
- if ((*p == ':') && ((i+1) < nameChars) && (*(p+1) == ':')) {
- hasNsQualifiers = 1;
- break;
+ TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
+ } else {
+ /*
+ * Push the all values onto the stack.
+ */
+ Tcl_Token *valueTokenPtr;
+ int i, code, numWords;
+
+ numWords = parsePtr->numWords;
+
+ valueTokenPtr = parsePtr->tokenPtr
+ + (parsePtr->tokenPtr->numComponents + 1);
+ for (i = 1; i < numWords; i++) {
+ if (valueTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+ TclEmitPush(TclRegisterNewLiteral(envPtr,
+ valueTokenPtr[1].start, valueTokenPtr[1].size), envPtr);
+ } else {
+ code = TclCompileTokens(interp, valueTokenPtr+1,
+ valueTokenPtr->numComponents, envPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
}
+ valueTokenPtr = valueTokenPtr + (valueTokenPtr->numComponents + 1);
}
-
+ TclEmitInstInt4(INST_LIST, numWords - 1, envPtr);
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileLlengthCmd --
+ *
+ * Procedure called to compile the "llength" command.
+ *
+ * Results:
+ * The return value is a standard Tcl result, which is TCL_OK if the
+ * compilation was successful. If the command cannot be byte-compiled,
+ * TCL_OUT_LINE_COMPILE is returned. If an error occurs then the
+ * interpreter's result contains an error message, and TCL_ERROR is
+ * returned.
+ *
+ * Side effects:
+ * Instructions are added to envPtr to execute the "llength" command
+ * at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+{
+ Tcl_Token *varTokenPtr;
+ int code;
+
+ if (parsePtr->numWords != 2) {
+ Tcl_SetResult(interp, "wrong # args: should be \"llength list\"",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+ varTokenPtr = parsePtr->tokenPtr
+ + (parsePtr->tokenPtr->numComponents + 1);
+
+ if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
/*
- * Look up the var name's index in the array of local vars in the
- * proc frame. If retrieving the var's value and it doesn't already
- * exist, push its name and look it up at runtime.
+ * We could simply count the number of elements here and push
+ * that value, but that is too rare a case to waste the code space.
*/
+ TclEmitPush(TclRegisterNewLiteral(envPtr, varTokenPtr[1].start,
+ varTokenPtr[1].size), envPtr);
+ } else {
+ code = TclCompileTokens(interp, varTokenPtr+1,
+ varTokenPtr->numComponents, envPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+ }
+ TclEmitOpcode(INST_LIST_LENGTH, envPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileLsetCmd --
+ *
+ * Procedure called to compile the "lset" command.
+ *
+ * Results:
+ * The return value is a standard Tcl result, which is TCL_OK if
+ * the compilation was successful. If the "lset" command is too
+ * complex for this function, then TCL_OUT_LINE_COMPILE is returned,
+ * indicating that the command should be compiled "out of line"
+ * (that is, not byte-compiled). If an error occurs, TCL_ERROR is
+ * returned, and the interpreter result contains an error message.
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
- if ((envPtr->procPtr != NULL) && !hasNsQualifiers) {
- localIndex = TclFindCompiledLocal(name, nameChars,
- /*create*/ isAssignment,
- /*flags*/ ((elName==NULL)? VAR_SCALAR : VAR_ARRAY),
- envPtr->procPtr);
+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 */
+{
+
+ 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 result; /* Status return from library calls */
+
+ 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_OUT_LINE_COMPILE;
+ }
+
+ /*
+ * 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 = parsePtr->tokenPtr
+ + (parsePtr->tokenPtr->numComponents + 1);
+ result = TclPushVarName( interp, varTokenPtr, envPtr,
+ TCL_CREATE_VAR, &localIndex, &simpleVarName, &isScalar );
+ if (result != TCL_OK) {
+ return result;
+ }
+
+ /* Push the "index" args and the new element value. */
+
+ for ( i = 2; i < parsePtr->numWords; ++i ) {
+
+ /* Advance to next arg */
+
+ varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
+
+ /* Push an arg */
+
+ if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+ TclEmitPush(TclRegisterNewLiteral( envPtr, varTokenPtr[1].start,
+ varTokenPtr[1].size), envPtr);
+ } else {
+ result = TclCompileTokens(interp, varTokenPtr+1,
+ varTokenPtr->numComponents, envPtr);
+ if ( result != TCL_OK ) {
+ return result;
+ }
+ }
+ }
+
+ /*
+ * Duplicate the variable name if it's been pushed.
+ */
+
+ if ( !simpleVarName || localIndex < 0 ) {
+ if ( !simpleVarName || 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 ( simpleVarName && !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 ( !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 );
+ }
+ }
+
+ /*
+ * 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 ( !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 );
+ }
+ }
+
+ return TCL_OK;
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileRegexpCmd --
+ *
+ * Procedure called to compile the "regexp" command.
+ *
+ * Results:
+ * The return value is a standard Tcl result, which is TCL_OK if
+ * the compilation was successful. If the "regexp" command is too
+ * complex for this function, then TCL_OUT_LINE_COMPILE is returned,
+ * indicating that the command should be compiled "out of line"
+ * (that is, not byte-compiled). If an error occurs, TCL_ERROR is
+ * returned, and the interpreter result contains an error message.
+ *
+ * Side effects:
+ * Instructions are added to envPtr to execute the "regexp" 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 */
+{
+ Tcl_Token *varTokenPtr; /* Pointer to the Tcl_Token representing
+ * the parse of the RE or string */
+ int i, len, code, exactMatch, nocase;
+ Tcl_Obj *patternObj;
+ CONST char *str;
+
+ /*
+ * 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_OUT_LINE_COMPILE;
+ }
+
+ 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.
+ */
+ for (i = 1; i < parsePtr->numWords - 2; i++) {
+ varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
+ if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ /* Not a simple string - punt to runtime. */
+ return TCL_OUT_LINE_COMPILE;
}
- if (localIndex >= 0) {
- maxDepth = 0;
+ str = 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 {
- TclEmitPush(TclRegisterLiteral(envPtr, name, nameChars,
- /*onHeap*/ 0), envPtr);
- maxDepth = 1;
+ /* Not an option we recognize. */
+ return TCL_OUT_LINE_COMPILE;
}
+ }
+
+ if ((parsePtr->numWords - i) != 2) {
+ /* We don't support capturing to variables */
+ return TCL_OUT_LINE_COMPILE;
+ }
+
+ /*
+ * 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.
+ */
+ varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
+ str = varTokenPtr[1].start;
+ len = varTokenPtr[1].size;
+ if ((varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) || (*str == '-')) {
+ return TCL_OUT_LINE_COMPILE;
+ }
+ if (len == 0) {
/*
- * Compile the element script, if any.
+ * The semantics of regexp are always match on re == "".
*/
-
- if (elName != NULL) {
- /*
- * Temporarily replace the '(' and ')' by '"'s.
- */
+ TclEmitPush(TclRegisterNewLiteral(envPtr, "1", 1), envPtr);
+ return TCL_OK;
+ }
- *(elName-1) = '"';
- *(elName+elNameChars) = '"';
- code = Tcl_ParseCommand(interp, elName-1, elNameChars+2,
- /*nested*/ 0, &elemParse);
- *(elName-1) = '(';
- *(elName+elNameChars) = ')';
- gotElemParse = 1;
- if ((code != TCL_OK) || (elemParse.numWords > 1)) {
- char buffer[160];
- sprintf(buffer, "\n (parsing index for array \"%.*s\")",
- TclMin(nameChars, 100), name);
- Tcl_AddObjErrorInfo(interp, buffer, -1);
- code = TCL_ERROR;
- goto done;
- } else if (elemParse.numWords == 1) {
- code = TclCompileTokens(interp, elemParse.tokenPtr+1,
- elemParse.tokenPtr->numComponents, envPtr);
- if (code != TCL_OK) {
- goto done;
- }
- maxDepth += envPtr->maxStackDepth;
- } else {
- TclEmitPush(TclRegisterLiteral(envPtr, "", 0,
- /*alreadyAlloced*/ 0), envPtr);
- maxDepth += 1;
- }
- }
+ /*
+ * 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'.
+ * We can use strchr here because the glob chars are all in the ascii-7
+ * range. If -nocase was specified, we can't do this because INST_STR_EQ
+ * has no support for nocase.
+ */
+
+ if (Tcl_RegExpCompile(NULL, str) == NULL) {
+ /*
+ * This is a bad RE. Let it complain at runtime.
+ */
+ return TCL_OUT_LINE_COMPILE;
+ }
+#if 0
+ if ((len > 2) && (*str == '.') && (str[1] == '*')) {
+ str += 2; len -= 2;
+ }
+ if ((len > 2) && (str[len-3] != '\\')
+ && (str[len-2] == '.') && (str[len-1] == '*')) {
+ len -= 2;
+ }
+#endif
+ if ((len > 1) && (str[0] == '^') && (str[len-1] == '$')
+ && (str[len-2] != '\\')) {
+ /*
+ * It appears and exact search was requested (ie ^foo$), so strip
+ * off the special chars and signal exactMatch.
+ */
+ str++; len -= 2;
+ exactMatch = 1;
+ } else {
+ exactMatch = 0;
+ }
+
+ patternObj = Tcl_NewStringObj(str, len);
+ Tcl_IncrRefCount(patternObj);
+ code = (strpbrk(Tcl_GetString(patternObj), "*+?{}()[].\\|^$") != NULL);
+ Tcl_DecrRefCount(patternObj);
+ if (code) {
+ /* We don't do anything with REs with special chars yet. */
+ return TCL_OUT_LINE_COMPILE;
+ }
+ if (exactMatch) {
+ TclEmitPush(TclRegisterNewLiteral(envPtr, str, len), envPtr);
} else {
/*
- * The var name isn't simple: compile and push it.
+ * This needs to find the substring anywhere in the string, so
+ * use string match and *foo*.
*/
+ char *newStr = ckalloc((unsigned) len + 3);
+ newStr[0] = '*';
+ strncpy(newStr + 1, str, (size_t) len);
+ newStr[len+1] = '*';
+ newStr[len+2] = '\0';
+ TclEmitPush(TclRegisterNewLiteral(envPtr, newStr, len+2), envPtr);
+ ckfree((char *) newStr);
+ }
+ /*
+ * Push the string arg
+ */
+ varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
+ if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+ TclEmitPush(TclRegisterNewLiteral(envPtr,
+ varTokenPtr[1].start, varTokenPtr[1].size), envPtr);
+ } else {
code = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
- goto done;
+ return code;
}
- maxDepth += envPtr->maxStackDepth;
}
-
+
+ if (exactMatch && !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:
+ * The return value is a standard Tcl result, which is TCL_OK if the
+ * compilation was successful. If the particular return command is
+ * too complex for this function (ie, return with any flags like "-code"
+ * or "-errorinfo"), TCL_OUT_LINE_COMPILE is returned, indicating that
+ * the command should be compiled "out of line" (eg, not byte compiled).
+ * If an error occurs then the interpreter's result contains a standard
+ * error message.
+ *
+ * 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. */
+{
+ Tcl_Token *varTokenPtr;
+ int code;
+
+ /*
+ * If we're not in a procedure, don't compile.
+ */
+
+ if (envPtr->procPtr == NULL) {
+ return TCL_OUT_LINE_COMPILE;
+ }
+
+ switch (parsePtr->numWords) {
+ case 1: {
+ /*
+ * Simple case: [return]
+ * Just push the literal string "".
+ */
+ TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
+ break;
+ }
+ case 2: {
+ /*
+ * More complex cases:
+ * [return "foo"]
+ * [return $value]
+ * [return [otherCmd]]
+ */
+ varTokenPtr = parsePtr->tokenPtr
+ + (parsePtr->tokenPtr->numComponents + 1);
+ if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+ /*
+ * [return "foo"] case: the parse token is a simple word,
+ * so just push it.
+ */
+ TclEmitPush(TclRegisterNewLiteral(envPtr, varTokenPtr[1].start,
+ varTokenPtr[1].size), envPtr);
+ } else {
+ /*
+ * Parse token is more complex, so compile it; this handles the
+ * variable reference and nested command cases. If the
+ * parse token can be byte-compiled, then this instance of
+ * "return" will be byte-compiled; otherwise it will be
+ * out line compiled.
+ */
+ code = TclCompileTokens(interp, varTokenPtr+1,
+ varTokenPtr->numComponents, envPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+ }
+ break;
+ }
+ default: {
+ /*
+ * Most complex return cases: everything else, including
+ * [return -code error], etc.
+ */
+ return TCL_OUT_LINE_COMPILE;
+ }
+ }
+
+ /*
+ * The INST_DONE opcode actually causes the branching out of the
+ * subroutine, and takes the top stack item as the return result
+ * (which is why we pushed the value above).
+ */
+ TclEmitOpcode(INST_DONE, envPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileSetCmd --
+ *
+ * Procedure called to compile the "set" command.
+ *
+ * Results:
+ * The return value is a standard Tcl result, which is normally TCL_OK
+ * unless there was an error while parsing string. If an error occurs
+ * then the interpreter's result contains a standard error message. If
+ * complation fails because the set command requires a second level of
+ * substitutions, TCL_OUT_LINE_COMPILE is returned indicating that the
+ * set command should be compiled "out of line" by emitting code to
+ * invoke its command procedure (Tcl_SetCmd) at runtime.
+ *
+ * Side effects:
+ * Instructions are added to envPtr to execute the "set" 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 created by Tcl_ParseCommand. */
+ CompileEnv *envPtr; /* Holds resulting instructions. */
+{
+ Tcl_Token *varTokenPtr, *valueTokenPtr;
+ int isAssignment, isScalar, simpleVarName, localIndex, numWords;
+ int code = TCL_OK;
+
+ numWords = parsePtr->numWords;
+ if ((numWords != 2) && (numWords != 3)) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ "wrong # args: should be \"set varName ?newValue?\"", -1);
+ 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 = parsePtr->tokenPtr
+ + (parsePtr->tokenPtr->numComponents + 1);
+
+ code = TclPushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
+ &localIndex, &simpleVarName, &isScalar);
+ if (code != TCL_OK) {
+ goto done;
+ }
+
/*
* If we are doing an assignment, push the new value.
*/
-
+
if (isAssignment) {
valueTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
if (valueTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
- TclEmitPush(TclRegisterLiteral(envPtr, valueTokenPtr[1].start,
- valueTokenPtr[1].size, /*onHeap*/ 0), envPtr);
- maxDepth += 1;
+ TclEmitPush(TclRegisterNewLiteral(envPtr, valueTokenPtr[1].start,
+ valueTokenPtr[1].size), envPtr);
} else {
code = TclCompileTokens(interp, valueTokenPtr+1,
valueTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
goto done;
}
- maxDepth += envPtr->maxStackDepth;
}
}
-
+
/*
* Emit instructions to set/get the variable.
*/
if (simpleVarName) {
- if (elName == NULL) {
+ if (isScalar) {
if (localIndex >= 0) {
if (localIndex <= 255) {
TclEmitInstInt1((isAssignment?
@@ -1804,8 +2540,7 @@ TclCompileSetCmd(interp, parsePtr, envPtr)
}
} else {
TclEmitOpcode((isAssignment?
- INST_STORE_SCALAR_STK : INST_LOAD_SCALAR_STK),
- envPtr);
+ INST_STORE_SCALAR_STK : INST_LOAD_SCALAR_STK), envPtr);
}
} else {
if (localIndex >= 0) {
@@ -1820,26 +2555,323 @@ TclCompileSetCmd(interp, parsePtr, envPtr)
}
} else {
TclEmitOpcode((isAssignment?
- INST_STORE_ARRAY_STK : INST_LOAD_ARRAY_STK),
- envPtr);
+ INST_STORE_ARRAY_STK : INST_LOAD_ARRAY_STK), envPtr);
}
}
} else {
- TclEmitOpcode((isAssignment? INST_STORE_STK : INST_LOAD_STK),
- envPtr);
+ TclEmitOpcode((isAssignment? INST_STORE_STK : INST_LOAD_STK), envPtr);
}
done:
- if (gotElemParse) {
- Tcl_FreeParse(&elemParse);
- }
- envPtr->maxStackDepth = maxDepth;
return code;
}
/*
*----------------------------------------------------------------------
*
+ * TclCompileStringCmd --
+ *
+ * Procedure called to compile the "string" command.
+ *
+ * Results:
+ * The return value is a standard Tcl result, which is TCL_OK if the
+ * compilation was successful. If the command cannot be byte-compiled,
+ * TCL_OUT_LINE_COMPILE is returned. If an error occurs then the
+ * interpreter's result contains an error message, and TCL_ERROR is
+ * returned.
+ *
+ * Side effects:
+ * Instructions are added to envPtr to execute the "string" 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 created by Tcl_ParseCommand. */
+ CompileEnv *envPtr; /* Holds resulting instructions. */
+{
+ Tcl_Token *opTokenPtr, *varTokenPtr;
+ Tcl_Obj *opObj;
+ int index;
+ int code;
+
+ 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_OUT_LINE_COMPILE;
+ }
+ opTokenPtr = parsePtr->tokenPtr
+ + (parsePtr->tokenPtr->numComponents + 1);
+
+ 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_OUT_LINE_COMPILE;
+ }
+ Tcl_DecrRefCount(opObj);
+
+ varTokenPtr = opTokenPtr + (opTokenPtr->numComponents + 1);
+
+ switch ((enum options) index) {
+ case STR_BYTELENGTH:
+ case STR_FIRST:
+ case STR_IS:
+ case STR_LAST:
+ case STR_MAP:
+ case STR_RANGE:
+ case STR_REPEAT:
+ case STR_REPLACE:
+ case STR_TOLOWER:
+ case STR_TOUPPER:
+ case STR_TOTITLE:
+ case STR_TRIM:
+ case STR_TRIMLEFT:
+ case STR_TRIMRIGHT:
+ case STR_WORDEND:
+ case STR_WORDSTART:
+ /*
+ * All other cases: compile out of line.
+ */
+ return TCL_OUT_LINE_COMPILE;
+
+ case STR_COMPARE:
+ case STR_EQUAL: {
+ int i;
+ /*
+ * 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_OUT_LINE_COMPILE;
+ }
+
+ /*
+ * Push the two operands onto the stack.
+ */
+
+ for (i = 0; i < 2; i++) {
+ if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+ TclEmitPush(TclRegisterNewLiteral(envPtr,
+ varTokenPtr[1].start, varTokenPtr[1].size), envPtr);
+ } else {
+ code = TclCompileTokens(interp, varTokenPtr+1,
+ varTokenPtr->numComponents, envPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+ }
+ varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
+ }
+
+ TclEmitOpcode(((((enum options) index) == STR_COMPARE) ?
+ INST_STR_CMP : INST_STR_EQ), envPtr);
+ return TCL_OK;
+ }
+ case STR_INDEX: {
+ int i;
+
+ if (parsePtr->numWords != 4) {
+ /* Fail at run time, not in compilation */
+ return TCL_OUT_LINE_COMPILE;
+ }
+
+ /*
+ * Push the two operands onto the stack.
+ */
+
+ for (i = 0; i < 2; i++) {
+ if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+ TclEmitPush(TclRegisterNewLiteral(envPtr,
+ varTokenPtr[1].start, varTokenPtr[1].size), envPtr);
+ } else {
+ code = TclCompileTokens(interp, varTokenPtr+1,
+ varTokenPtr->numComponents, envPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+ }
+ varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
+ }
+
+ TclEmitOpcode(INST_STR_INDEX, envPtr);
+ return TCL_OK;
+ }
+ case STR_LENGTH: {
+ if (parsePtr->numWords != 3) {
+ /* Fail at run time, not in compilation */
+ return TCL_OUT_LINE_COMPILE;
+ }
+
+ 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);
+ TclEmitPush(TclRegisterNewLiteral(envPtr, buf, len), envPtr);
+ return TCL_OK;
+ } else {
+ code = TclCompileTokens(interp, varTokenPtr+1,
+ varTokenPtr->numComponents, envPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+ }
+ TclEmitOpcode(INST_STR_LEN, envPtr);
+ return TCL_OK;
+ }
+ case STR_MATCH: {
+ int i, length, exactMatch = 0, nocase = 0;
+ CONST char *str;
+
+ if (parsePtr->numWords < 4 || parsePtr->numWords > 5) {
+ /* Fail at run time, not in compilation */
+ return TCL_OUT_LINE_COMPILE;
+ }
+
+ if (parsePtr->numWords == 5) {
+ if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ return TCL_OUT_LINE_COMPILE;
+ }
+ 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_OUT_LINE_COMPILE;
+ }
+ varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
+ }
+
+ 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)) {
+ /*
+ * On the first (pattern) arg, check to see if any
+ * glob special characters are in the word '*[]?\\'.
+ * If not, this is the same as 'string equal'. We
+ * can use strpbrk here because the glob chars are all
+ * in the ascii-7 range. 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 = (strpbrk(Tcl_GetString(copy),
+ "*[]?\\") == NULL);
+ Tcl_DecrRefCount(copy);
+ }
+ TclEmitPush(
+ TclRegisterNewLiteral(envPtr, str, length), envPtr);
+ } else {
+ code = TclCompileTokens(interp, varTokenPtr+1,
+ varTokenPtr->numComponents, envPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+ }
+ varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
+ }
+
+ if (exactMatch) {
+ TclEmitOpcode(INST_STR_EQ, envPtr);
+ } else {
+ TclEmitInstInt1(INST_STR_MATCH, nocase, envPtr);
+ }
+ return TCL_OK;
+ }
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileVariableCmd --
+ *
+ * Procedure called to reserve the local variables for the
+ * "variable" command. The command itself is *not* compiled.
+ *
+ * Results:
+ * Always returns TCL_OUT_LINE_COMPILE.
+ *
+ * Side effects:
+ * Indexed local variables are added to the environment.
+ *
+ *----------------------------------------------------------------------
+ */
+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. */
+{
+ Tcl_Token *varTokenPtr;
+ int i, numWords;
+ CONST char *varName, *tail;
+
+ if (envPtr->procPtr == NULL) {
+ return TCL_OUT_LINE_COMPILE;
+ }
+
+ numWords = parsePtr->numWords;
+
+ varTokenPtr = parsePtr->tokenPtr
+ + (parsePtr->tokenPtr->numComponents + 1);
+ for (i = 1; i < numWords; i += 2) {
+ if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+ varName = varTokenPtr[1].start;
+ tail = varName + varTokenPtr[1].size - 1;
+ if ((*tail == ')') || (tail < varName)) continue;
+ while ((tail > varName) && ((*tail != ':') || (*(tail-1) != ':'))) {
+ tail--;
+ }
+ if ((*tail == ':') && (tail > varName)) {
+ tail++;
+ }
+ (void) TclFindCompiledLocal(tail, (tail-varName+1),
+ /*create*/ 1, /*flags*/ 0, envPtr->procPtr);
+ varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
+ }
+ }
+ return TCL_OUT_LINE_COMPILE;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclCompileWhileCmd --
*
* Procedure called to compile the "while" command.
@@ -1853,9 +2885,6 @@ TclCompileSetCmd(interp, parsePtr, envPtr)
* indicating that the while command should be compiled "out of line"
* by emitting code to invoke its command procedure at runtime.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the "while" command.
- *
* Side effects:
* Instructions are added to envPtr to execute the "while" command
* at runtime.
@@ -1871,14 +2900,16 @@ TclCompileWhileCmd(interp, parsePtr, envPtr)
CompileEnv *envPtr; /* Holds resulting instructions. */
{
Tcl_Token *testTokenPtr, *bodyTokenPtr;
- JumpFixup jumpFalseFixup;
- unsigned char *jumpPc;
- int testCodeOffset, jumpDist, jumpBackDist, jumpBackOffset;
- int range, maxDepth, code;
+ JumpFixup jumpEvalCondFixup;
+ int testCodeOffset, bodyCodeOffset, jumpDist;
+ int range, code;
char buffer[32 + TCL_INTEGER_SPACE];
+ 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;
- envPtr->maxStackDepth = 0;
- maxDepth = 0;
if (parsePtr->numWords != 3) {
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
@@ -1890,15 +2921,45 @@ TclCompileWhileCmd(interp, parsePtr, envPtr)
* 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 = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
- if (testTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ bodyTokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1);
+ if ((testTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)
+ || (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)) {
return TCL_OUT_LINE_COMPILE;
}
/*
+ * 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);
+ Tcl_DecrRefCount(boolObj);
+ if (code == TCL_OK) {
+ if (boolVal) {
+ /*
+ * it is an infinite loop
+ */
+
+ 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.
*/
@@ -1907,36 +2968,37 @@ TclCompileWhileCmd(interp, parsePtr, envPtr)
envPtr->maxExceptDepth =
TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
- envPtr->exceptArrayPtr[range].continueOffset =
- (envPtr->codeNext - envPtr->codeStart);
/*
- * Compile the test expression then emit the conditional jump that
- * terminates the while. We already know it's a simple word.
+ * 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
*/
- testCodeOffset = (envPtr->codeNext - envPtr->codeStart);
- envPtr->exceptArrayPtr[range].continueOffset = testCodeOffset;
- code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
- if (code != TCL_OK) {
- if (code == TCL_ERROR) {
- Tcl_AddObjErrorInfo(interp,
- "\n (\"while\" test expression)", -1);
- }
- goto error;
+ if (loopMayEnd) {
+ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpEvalCondFixup);
+ testCodeOffset = 0; /* avoid compiler warning */
+ } else {
+ testCodeOffset = (envPtr->codeNext - envPtr->codeStart);
}
- maxDepth = envPtr->maxStackDepth;
- TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);
+
/*
* Compile the loop body.
*/
- bodyTokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1);
- envPtr->exceptArrayPtr[range].codeOffset =
- (envPtr->codeNext - envPtr->codeStart);
+ bodyCodeOffset = (envPtr->codeNext - envPtr->codeStart);
code = TclCompileCmdWord(interp, bodyTokenPtr+1,
bodyTokenPtr->numComponents, envPtr);
+ envPtr->currStackDepth = savedStackDepth + 1;
if (code != TCL_OK) {
if (code == TCL_ERROR) {
sprintf(buffer, "\n (\"while\" body line %d)",
@@ -1945,59 +3007,55 @@ TclCompileWhileCmd(interp, parsePtr, envPtr)
}
goto error;
}
- maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
envPtr->exceptArrayPtr[range].numCodeBytes =
- (envPtr->codeNext - envPtr->codeStart)
- - envPtr->exceptArrayPtr[range].codeOffset;
+ (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
TclEmitOpcode(INST_POP, 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.
- */
-
- jumpBackOffset = (envPtr->codeNext - envPtr->codeStart);
- jumpBackDist = (jumpBackOffset - testCodeOffset);
- if (jumpBackDist > 120) {
- TclEmitInstInt4(INST_JUMP4, -jumpBackDist, envPtr);
- } else {
- TclEmitInstInt1(INST_JUMP1, -jumpBackDist, envPtr);
- }
/*
- * Fix the target of the jumpFalse after the test.
+ * Compile the test expression then emit the conditional jump that
+ * terminates the while. We already know it's a simple word.
*/
- jumpDist = (envPtr->codeNext - envPtr->codeStart)
- - jumpFalseFixup.codeOffset;
- if (TclFixupForwardJump(envPtr, &jumpFalseFixup, jumpDist, 127)) {
- /*
- * Update the loop body's starting PC offset since it moved down.
- */
-
- envPtr->exceptArrayPtr[range].codeOffset += 3;
-
- /*
- * Update the jump back to the test at the top of the loop since it
- * also moved down 3 bytes.
- */
-
- jumpBackOffset += 3;
- jumpPc = (envPtr->codeStart + jumpBackOffset);
- jumpBackDist += 3;
- if (jumpBackDist > 120) {
- TclUpdateInstInt4AtPc(INST_JUMP4, -jumpBackDist, jumpPc);
+ if (loopMayEnd) {
+ testCodeOffset = (envPtr->codeNext - envPtr->codeStart);
+ jumpDist = testCodeOffset - jumpEvalCondFixup.codeOffset;
+ if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) {
+ bodyCodeOffset += 3;
+ testCodeOffset += 3;
+ }
+ envPtr->currStackDepth = savedStackDepth;
+ code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
+ if (code != TCL_OK) {
+ if (code == TCL_ERROR) {
+ Tcl_AddObjErrorInfo(interp,
+ "\n (\"while\" test expression)", -1);
+ }
+ goto error;
+ }
+ envPtr->currStackDepth = savedStackDepth + 1;
+
+ jumpDist = (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
+ if (jumpDist > 127) {
+ TclEmitInstInt4(INST_JUMP_TRUE4, -jumpDist, envPtr);
} else {
- TclUpdateInstInt1AtPc(INST_JUMP1, -jumpBackDist, jumpPc);
+ TclEmitInstInt1(INST_JUMP_TRUE1, -jumpDist, envPtr);
}
+ } else {
+ jumpDist = (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
+ if (jumpDist > 127) {
+ TclEmitInstInt4(INST_JUMP4, -jumpDist, envPtr);
+ } else {
+ TclEmitInstInt1(INST_JUMP1, -jumpDist, envPtr);
+ }
}
+
/*
- * Set the loop's break target.
+ * Set the loop's body, continue and break offsets.
*/
+ envPtr->exceptArrayPtr[range].continueOffset = testCodeOffset;
+ envPtr->exceptArrayPtr[range].codeOffset = bodyCodeOffset;
envPtr->exceptArrayPtr[range].breakOffset =
(envPtr->codeNext - envPtr->codeStart);
@@ -2005,19 +3063,259 @@ TclCompileWhileCmd(interp, parsePtr, envPtr)
* The while command's result is an empty string.
*/
- TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr);
- if (maxDepth == 0) {
- maxDepth = 1;
- }
- envPtr->maxStackDepth = maxDepth;
+ pushResult:
+ envPtr->currStackDepth = savedStackDepth;
+ TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
envPtr->exceptDepth--;
return TCL_OK;
error:
- envPtr->maxStackDepth = maxDepth;
envPtr->exceptDepth--;
return code;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPushVarName --
+ *
+ * Procedure used in the compiling where pushing a variable name
+ * is necessary (append, lappend, set).
+ *
+ * Results:
+ * The return value is a standard Tcl result, which is normally TCL_OK
+ * unless there was an error while parsing string. If an error occurs
+ * then the interpreter's result contains a standard error message.
+ *
+ * Side effects:
+ * Instructions are added to envPtr to execute the "set" command
+ * at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TclPushVarName(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; /* takes 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 */
+{
+ register CONST char *p;
+ CONST char *name, *elName;
+ register int i, n;
+ int nameChars, elNameChars, simpleVarName, localIndex;
+ int code = TCL_OK;
+
+ Tcl_Token *elemTokenPtr = NULL;
+ int elemTokenCount = 0;
+ int allocedTokens = 0;
+ int removedParen = 0;
+ /*
+ * 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.
+ */
+ simpleVarName = 0;
+ name = elName = NULL;
+ nameChars = elNameChars = 0;
+ localIndex = -1;
+ /*
+ * Check not only that the type is TCL_TOKEN_SIMPLE_WORD, but whether
+ * curly braces surround the variable name.
+ * This really matters for array elements to handle things like
+ * set {x($foo)} 5
+ * which raises an undefined var error if we are not careful here.
+ */
+
+ if ((varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) &&
+ (varTokenPtr->start[0] != '{')) {
+ /*
+ * 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;
+ nameChars = varTokenPtr[1].size;
+ if ( *(name + nameChars - 1) == ')') {
+ /*
+ * last char is ')' => potential array reference.
+ */
+
+ for (i = 0, p = name; i < nameChars; i++, p++) {
+ if (*p == '(') {
+ elName = p + 1;
+ elNameChars = nameChars - i - 2;
+ nameChars = i ;
+ break;
+ }
+ }
+
+ if ((elName != NULL) && elNameChars) {
+ /*
+ * An array element, the element name is a simple
+ * string: assemble the corresponding token.
+ */
+
+ elemTokenPtr = (Tcl_Token *) ckalloc(sizeof(Tcl_Token));
+ allocedTokens = 1;
+ elemTokenPtr->type = TCL_TOKEN_TEXT;
+ elemTokenPtr->start = elName;
+ elemTokenPtr->size = elNameChars;
+ elemTokenPtr->numComponents = 0;
+ elemTokenCount = 1;
+ }
+ }
+ } else if (((n = varTokenPtr->numComponents) > 1)
+ && (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
+ */
+
+ simpleVarName = 0;
+ for (i = 0, p = varTokenPtr[1].start;
+ i < varTokenPtr[1].size; i++, p++) {
+ if (*p == '(') {
+ simpleVarName = 1;
+ break;
+ }
+ }
+ if (simpleVarName) {
+ int remainingChars;
+
+ /*
+ * Check the last token: if it is just ')', do not count
+ * it. Otherwise, remove the ')' and flag so that it is
+ * restored at the end.
+ */
+
+ if (varTokenPtr[n].size == 1) {
+ --n;
+ } else {
+ --varTokenPtr[n].size;
+ removedParen = n;
+ }
+
+ name = varTokenPtr[1].start;
+ nameChars = p - varTokenPtr[1].start;
+ elName = p + 1;
+ remainingChars = (varTokenPtr[2].start - p) - 1;
+ elNameChars = (varTokenPtr[n].start - p) + varTokenPtr[n].size - 2;
+
+ if (remainingChars) {
+ /*
+ * Make a first token with the extra characters in the first
+ * token.
+ */
+
+ elemTokenPtr = (Tcl_Token *) ckalloc(n * sizeof(Tcl_Token));
+ allocedTokens = 1;
+ elemTokenPtr->type = TCL_TOKEN_TEXT;
+ elemTokenPtr->start = elName;
+ elemTokenPtr->size = remainingChars;
+ elemTokenPtr->numComponents = 0;
+ elemTokenCount = n;
+
+ /*
+ * Copy the remaining tokens.
+ */
+
+ memcpy((void *) (elemTokenPtr+1), (void *) (&varTokenPtr[2]),
+ ((n-1) * sizeof(Tcl_Token)));
+ } else {
+ /*
+ * Use the already available tokens.
+ */
+
+ elemTokenPtr = &varTokenPtr[2];
+ elemTokenCount = n - 1;
+ }
+ }
+ }
+
+ if (simpleVarName) {
+ /*
+ * See whether name has any namespace separators (::'s).
+ */
+
+ int hasNsQualifiers = 0;
+ for (i = 0, p = name; i < nameChars; i++, p++) {
+ if ((*p == ':') && ((i+1) < nameChars) && (*(p+1) == ':')) {
+ hasNsQualifiers = 1;
+ break;
+ }
+ }
+
+ /*
+ * Look up the var name's index in the array of local vars in the
+ * proc frame. If retrieving the var's value and it doesn't already
+ * exist, 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 ((flags & TCL_NO_LARGE_INDEX) && (localIndex > 255)) {
+ /* we'll push the name */
+ localIndex = -1;
+ }
+ }
+ if (localIndex < 0) {
+ TclEmitPush(TclRegisterNewLiteral(envPtr, name, nameChars), envPtr);
+ }
+
+ /*
+ * Compile the element script, if any.
+ */
+
+ if (elName != NULL) {
+ if (elNameChars) {
+ code = TclCompileTokens(interp, elemTokenPtr,
+ elemTokenCount, envPtr);
+ if (code != TCL_OK) {
+ goto done;
+ }
+ } else {
+ TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
+ }
+ }
+ } else {
+ /*
+ * The var name isn't simple: compile and push it.
+ */
+
+ code = TclCompileTokens(interp, varTokenPtr+1,
+ varTokenPtr->numComponents, envPtr);
+ if (code != TCL_OK) {
+ goto done;
+ }
+ }
+
+ done:
+ if (removedParen) {
+ ++varTokenPtr[removedParen].size;
+ }
+ if (allocedTokens) {
+ ckfree((char *) elemTokenPtr);
+ }
+ *localIndexPtr = localIndex;
+ *simpleVarNamePtr = simpleVarName;
+ *isScalarPtr = (elName == NULL);
+ return code;
+}
diff --git a/tcl/generic/tclCompExpr.c b/tcl/generic/tclCompExpr.c
index ff368e20004..d1f25b5e157 100644
--- a/tcl/generic/tclCompExpr.c
+++ b/tcl/generic/tclCompExpr.c
@@ -4,6 +4,7 @@
* This file contains the code to compile Tcl expressions.
*
* 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.
@@ -50,26 +51,14 @@ typedef struct ExprInfo {
Tcl_Interp *interp; /* Used for error reporting. */
Tcl_Parse *parsePtr; /* Structure filled with information about
* the parsed expression. */
- char *expr; /* The expression that was originally passed
+ CONST char *expr; /* The expression that was originally passed
* to TclCompileExpr. */
- char *lastChar; /* Points just after last byte of expr. */
+ 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. */
- int exprIsJustVarRef; /* Set 1 if the expr consists of just a
- * variable reference as in the expression
- * of "if $b then...". Otherwise 0. If 1 the
- * expr is compiled out-of-line in order to
- * implement expr's 2 level substitution
- * semantics properly. */
- int exprIsComparison; /* Set 1 if the top-level operator in the
- * expr is a comparison. Otherwise 0. If 1,
- * because the operands might be strings,
- * the expr is compiled out-of-line in order
- * to implement expr's 2 level substitution
- * semantics properly. */
} ExprInfo;
/*
@@ -101,6 +90,8 @@ typedef struct ExprInfo {
#define OP_QUESTY 18
#define OP_LNOT 19
#define OP_BITNOT 20
+#define OP_STREQ 21
+#define OP_STRNEQ 22
/*
* Table describing the expression operators. Entries in this table must
@@ -119,7 +110,7 @@ typedef struct OperatorDesc {
* Ignored if numOperands is 0. */
} OperatorDesc;
-OperatorDesc operatorTable[] = {
+static OperatorDesc operatorTable[] = {
{"*", 2, INST_MULT},
{"/", 2, INST_DIV},
{"%", 2, INST_MOD},
@@ -141,6 +132,8 @@ OperatorDesc operatorTable[] = {
{"?", 0},
{"!", 1, INST_LNOT},
{"~", 1, INST_BITNOT},
+ {"eq", 2, INST_STR_EQ},
+ {"ne", 2, INST_STR_NEQ},
{NULL}
};
@@ -163,7 +156,7 @@ static int CompileLandOrLorExpr _ANSI_ARGS_((
ExprInfo *infoPtr, CompileEnv *envPtr,
Tcl_Token **endPtrPtr));
static int CompileMathFuncCall _ANSI_ARGS_((
- Tcl_Token *exprTokenPtr, char *funcName,
+ Tcl_Token *exprTokenPtr, CONST char *funcName,
ExprInfo *infoPtr, CompileEnv *envPtr,
Tcl_Token **endPtrPtr));
static int CompileSubExpr _ANSI_ARGS_((
@@ -201,19 +194,6 @@ static void LogSyntaxError _ANSI_ARGS_((ExprInfo *infoPtr));
* on failure. If TCL_ERROR is returned, then the interpreter's result
* contains an error message.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the expression.
- *
- * envPtr->exprIsJustVarRef is set 1 if the expression consisted of
- * a single variable reference as in the expression of "if $b then...".
- * Otherwise it is set 0. This is used to implement Tcl's two level
- * expression substitution semantics properly.
- *
- * envPtr->exprIsComparison is set 1 if the top-level operator in the
- * expr is a comparison. Otherwise it is set 0. If 1, because the
- * operands might be strings, the expr is compiled out-of-line in order
- * to implement expr's 2 level substitution semantics properly.
- *
* Side effects:
* Adds instructions to envPtr to evaluate the expression at runtime.
*
@@ -223,7 +203,7 @@ static void LogSyntaxError _ANSI_ARGS_((ExprInfo *infoPtr));
int
TclCompileExpr(interp, script, numBytes, envPtr)
Tcl_Interp *interp; /* Used for error reporting. */
- char *script; /* The source script to compile. */
+ 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. */
@@ -232,7 +212,7 @@ TclCompileExpr(interp, script, numBytes, envPtr)
ExprInfo info;
Tcl_Parse parse;
Tcl_HashEntry *hPtr;
- int maxDepth, new, i, code;
+ int new, i, code;
/*
* If this is the first time we've been called, initialize the table
@@ -268,14 +248,11 @@ TclCompileExpr(interp, script, numBytes, envPtr)
info.expr = script;
info.lastChar = (script + numBytes);
info.hasOperators = 0;
- info.exprIsJustVarRef = 1; /* will be set 0 if anything else is seen */
- info.exprIsComparison = 0;
/*
* Parse the expression then compile it.
*/
- maxDepth = 0;
code = Tcl_ParseExpr(interp, script, numBytes, &parse);
if (code != TCL_OK) {
goto done;
@@ -286,7 +263,6 @@ TclCompileExpr(interp, script, numBytes, envPtr)
Tcl_FreeParse(&parse);
goto done;
}
- maxDepth = envPtr->maxStackDepth;
if (!info.hasOperators) {
/*
@@ -301,9 +277,6 @@ TclCompileExpr(interp, script, numBytes, envPtr)
Tcl_FreeParse(&parse);
done:
- envPtr->maxStackDepth = maxDepth;
- envPtr->exprIsJustVarRef = info.exprIsJustVarRef;
- envPtr->exprIsComparison = info.exprIsComparison;
return code;
}
@@ -352,19 +325,6 @@ TclFinalizeCompilation()
* on failure. If TCL_ERROR is returned, then the interpreter's result
* contains an error message.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the subexpression.
- *
- * envPtr->exprIsJustVarRef is set 1 if the subexpression consisted of
- * a single variable reference as in the expression of "if $b then...".
- * Otherwise it is set 0. This is used to implement Tcl's two level
- * expression substitution semantics properly.
- *
- * envPtr->exprIsComparison is set 1 if the top-level operator in the
- * subexpression is a comparison. Otherwise it is set 0. If 1, because
- * the operands might be strings, the expr is compiled out-of-line in
- * order to implement expr's 2 level substitution semantics properly.
- *
* Side effects:
* Adds instructions to envPtr to evaluate the subexpression.
*
@@ -383,15 +343,15 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
Tcl_Token *tokenPtr, *endPtr, *afterSubexprPtr;
OperatorDesc *opDescPtr;
Tcl_HashEntry *hPtr;
- char *operator;
- int maxDepth, objIndex, opIndex, length, code;
+ CONST char *operator;
+ Tcl_DString opBuf;
+ int objIndex, opIndex, length, code;
char buffer[TCL_UTF_MAX];
if (exprTokenPtr->type != TCL_TOKEN_SUB_EXPR) {
panic("CompileSubExpr: token type %d not TCL_TOKEN_SUB_EXPR\n",
exprTokenPtr->type);
}
- maxDepth = 0;
code = TCL_OK;
/*
@@ -410,37 +370,30 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
if (code != TCL_OK) {
goto done;
}
- maxDepth = envPtr->maxStackDepth;
tokenPtr += (tokenPtr->numComponents + 1);
- infoPtr->exprIsJustVarRef = 0;
break;
case TCL_TOKEN_TEXT:
if (tokenPtr->size > 0) {
- objIndex = TclRegisterLiteral(envPtr, tokenPtr->start,
- tokenPtr->size, /*onHeap*/ 0);
+ objIndex = TclRegisterNewLiteral(envPtr, tokenPtr->start,
+ tokenPtr->size);
} else {
- objIndex = TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0);
+ objIndex = TclRegisterNewLiteral(envPtr, "", 0);
}
TclEmitPush(objIndex, envPtr);
- maxDepth = 1;
tokenPtr += 1;
- infoPtr->exprIsJustVarRef = 0;
break;
case TCL_TOKEN_BS:
length = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL,
buffer);
if (length > 0) {
- objIndex = TclRegisterLiteral(envPtr, buffer, length,
- /*onHeap*/ 0);
+ objIndex = TclRegisterNewLiteral(envPtr, buffer, length);
} else {
- objIndex = TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0);
+ objIndex = TclRegisterNewLiteral(envPtr, "", 0);
}
TclEmitPush(objIndex, envPtr);
- maxDepth = 1;
tokenPtr += 1;
- infoPtr->exprIsJustVarRef = 0;
break;
case TCL_TOKEN_COMMAND:
@@ -449,9 +402,7 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
if (code != TCL_OK) {
goto done;
}
- maxDepth = envPtr->maxStackDepth;
tokenPtr += 1;
- infoPtr->exprIsJustVarRef = 0;
break;
case TCL_TOKEN_VARIABLE:
@@ -459,42 +410,37 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
if (code != TCL_OK) {
goto done;
}
- maxDepth = envPtr->maxStackDepth;
tokenPtr += (tokenPtr->numComponents + 1);
break;
case TCL_TOKEN_SUB_EXPR:
- infoPtr->exprIsComparison = 0;
code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
if (code != TCL_OK) {
goto done;
}
- maxDepth = envPtr->maxStackDepth;
tokenPtr += (tokenPtr->numComponents + 1);
break;
- case TCL_TOKEN_OPERATOR: {
- Tcl_DString operatorDString;
-
- Tcl_DStringInit(&operatorDString);
- Tcl_DStringAppend(&operatorDString, tokenPtr->start,
- tokenPtr->size);
- operator = Tcl_DStringValue(&operatorDString);
+ 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(&operatorDString);
+ Tcl_DStringFree(&opBuf);
if (code != TCL_OK) {
goto done;
}
- maxDepth = envPtr->maxStackDepth;
tokenPtr = endPtr;
- infoPtr->exprIsJustVarRef = 0;
- infoPtr->exprIsComparison = 0;
break;
}
- Tcl_DStringFree(&operatorDString);
+ Tcl_DStringFree(&opBuf);
opIndex = (int) Tcl_GetHashValue(hPtr);
opDescPtr = &(operatorTable[opIndex]);
@@ -509,7 +455,6 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
if (code != TCL_OK) {
goto done;
}
- maxDepth = envPtr->maxStackDepth;
tokenPtr += (tokenPtr->numComponents + 1);
if (opDescPtr->numOperands == 2) {
@@ -517,15 +462,10 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
if (code != TCL_OK) {
goto done;
}
- maxDepth = TclMax((envPtr->maxStackDepth + 1),
- maxDepth);
tokenPtr += (tokenPtr->numComponents + 1);
}
TclEmitOpcode(opDescPtr->instruction, envPtr);
infoPtr->hasOperators = 1;
- infoPtr->exprIsJustVarRef = 0;
- infoPtr->exprIsComparison =
- ((opIndex >= OP_LESS) && (opIndex <= OP_NEQ));
break;
}
@@ -542,7 +482,6 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
if (code != TCL_OK) {
goto done;
}
- maxDepth = envPtr->maxStackDepth;
tokenPtr += (tokenPtr->numComponents + 1);
/*
@@ -566,8 +505,6 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
if (code != TCL_OK) {
goto done;
}
- maxDepth = TclMax((envPtr->maxStackDepth + 1),
- maxDepth);
tokenPtr += (tokenPtr->numComponents + 1);
TclEmitOpcode(((opIndex==OP_PLUS)? INST_ADD : INST_SUB),
envPtr);
@@ -580,7 +517,6 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
if (code != TCL_OK) {
goto done;
}
- maxDepth = envPtr->maxStackDepth;
tokenPtr = endPtr;
break;
@@ -590,7 +526,6 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
if (code != TCL_OK) {
goto done;
}
- maxDepth = envPtr->maxStackDepth;
tokenPtr = endPtr;
break;
@@ -599,10 +534,7 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
opIndex);
} /* end switch on operator requiring special treatment */
infoPtr->hasOperators = 1;
- infoPtr->exprIsJustVarRef = 0;
- infoPtr->exprIsComparison = 0;
break;
- }
default:
panic("CompileSubExpr: unexpected token type %d\n",
@@ -622,7 +554,6 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
}
done:
- envPtr->maxStackDepth = maxDepth;
return code;
}
@@ -641,9 +572,6 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
* endPtrPtr. If TCL_ERROR is returned, then the interpreter's result
* contains an error message.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the expression.
- *
* Side effects:
* Adds instructions to envPtr to evaluate the expression at runtime.
*
@@ -669,19 +597,18 @@ CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, endPtrPtr)
/* Used to fix up jumps used to convert the
* first operand to 0 or 1. */
Tcl_Token *tokenPtr;
- int dist, maxDepth, code;
+ int dist, code;
+ int savedStackDepth = envPtr->currStackDepth;
/*
* Emit code for the first operand.
*/
- maxDepth = 0;
tokenPtr = exprTokenPtr+2;
code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
if (code != TCL_OK) {
goto done;
}
- maxDepth = envPtr->maxStackDepth;
tokenPtr += (tokenPtr->numComponents + 1);
/*
@@ -690,14 +617,15 @@ CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, endPtrPtr)
*/
TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &lhsTrueFixup);
- TclEmitPush(TclRegisterLiteral(envPtr, "0", 1, /*onHeap*/ 0), envPtr);
+ TclEmitPush(TclRegisterNewLiteral(envPtr, "0", 1), envPtr);
TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &lhsEndFixup);
dist = (envPtr->codeNext - envPtr->codeStart) - lhsTrueFixup.codeOffset;
if (TclFixupForwardJump(envPtr, &lhsTrueFixup, dist, 127)) {
badDist:
panic("CompileLandOrLorExpr: bad jump distance %d\n", dist);
}
- TclEmitPush(TclRegisterLiteral(envPtr, "1", 1, /*onHeap*/ 0), envPtr);
+ envPtr->currStackDepth = savedStackDepth;
+ TclEmitPush(TclRegisterNewLiteral(envPtr, "1", 1), envPtr);
dist = (envPtr->codeNext - envPtr->codeStart) - lhsEndFixup.codeOffset;
if (TclFixupForwardJump(envPtr, &lhsEndFixup, dist, 127)) {
goto badDist;
@@ -722,7 +650,6 @@ CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, endPtrPtr)
if (code != TCL_OK) {
goto done;
}
- maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
tokenPtr += (tokenPtr->numComponents + 1);
/*
@@ -744,7 +671,7 @@ CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, endPtrPtr)
*endPtrPtr = tokenPtr;
done:
- envPtr->maxStackDepth = maxDepth;
+ envPtr->currStackDepth = savedStackDepth + 1;
return code;
}
@@ -763,9 +690,6 @@ CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, endPtrPtr)
* endPtrPtr. If TCL_ERROR is returned, then the interpreter's result
* contains an error message.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the expression.
- *
* Side effects:
* Adds instructions to envPtr to evaluate the expression at runtime.
*
@@ -788,19 +712,18 @@ CompileCondExpr(exprTokenPtr, infoPtr, envPtr, endPtrPtr)
* around the then and else expressions when
* their target PCs are determined. */
Tcl_Token *tokenPtr;
- int elseCodeOffset, dist, maxDepth, code;
+ int elseCodeOffset, dist, code;
+ int savedStackDepth = envPtr->currStackDepth;
/*
* Emit code for the test.
*/
- maxDepth = 0;
tokenPtr = exprTokenPtr+2;
code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
if (code != TCL_OK) {
goto done;
}
- maxDepth = envPtr->maxStackDepth;
tokenPtr += (tokenPtr->numComponents + 1);
/*
@@ -821,7 +744,6 @@ CompileCondExpr(exprTokenPtr, infoPtr, envPtr, endPtrPtr)
if (code != TCL_OK) {
goto done;
}
- maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
tokenPtr += (tokenPtr->numComponents + 1);
if (!infoPtr->hasOperators) {
TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
@@ -838,13 +760,13 @@ CompileCondExpr(exprTokenPtr, infoPtr, envPtr, endPtrPtr)
* Compile the "else" expression.
*/
+ envPtr->currStackDepth = savedStackDepth;
elseCodeOffset = (envPtr->codeNext - envPtr->codeStart);
infoPtr->hasOperators = 0;
code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
if (code != TCL_OK) {
goto done;
}
- maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
tokenPtr += (tokenPtr->numComponents + 1);
if (!infoPtr->hasOperators) {
TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
@@ -874,7 +796,7 @@ CompileCondExpr(exprTokenPtr, infoPtr, envPtr, endPtrPtr)
*endPtrPtr = tokenPtr;
done:
- envPtr->maxStackDepth = maxDepth;
+ envPtr->currStackDepth = savedStackDepth + 1;
return code;
}
@@ -893,9 +815,6 @@ CompileCondExpr(exprTokenPtr, infoPtr, envPtr, endPtrPtr)
* endPtrPtr. If TCL_ERROR is returned, then the interpreter's result
* contains an error message.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the function.
- *
* Side effects:
* Adds instructions to envPtr to evaluate the math function at
* runtime.
@@ -907,7 +826,7 @@ static int
CompileMathFuncCall(exprTokenPtr, funcName, infoPtr, envPtr, endPtrPtr)
Tcl_Token *exprTokenPtr; /* Points to TCL_TOKEN_SUB_EXPR token
* containing the math function call. */
- char *funcName; /* Name of the math function. */
+ CONST char *funcName; /* Name of the math function. */
ExprInfo *infoPtr; /* Describes the compilation state for the
* expression being compiled. */
CompileEnv *envPtr; /* Holds resulting instructions. */
@@ -920,14 +839,13 @@ CompileMathFuncCall(exprTokenPtr, funcName, infoPtr, envPtr, endPtrPtr)
MathFunc *mathFuncPtr;
Tcl_HashEntry *hPtr;
Tcl_Token *tokenPtr, *afterSubexprPtr;
- int maxDepth, code, i;
+ int code, i;
/*
* Look up the MathFunc record for the function.
*/
code = TCL_OK;
- maxDepth = 0;
hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, funcName);
if (hPtr == NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
@@ -942,9 +860,7 @@ CompileMathFuncCall(exprTokenPtr, funcName, infoPtr, envPtr, endPtrPtr)
*/
if (mathFuncPtr->builtinFuncIndex < 0) {
- TclEmitPush(TclRegisterLiteral(envPtr, funcName, -1, /*onHeap*/ 0),
- envPtr);
- maxDepth = 1;
+ TclEmitPush(TclRegisterNewLiteral(envPtr, funcName, -1), envPtr);
}
/*
@@ -962,13 +878,11 @@ CompileMathFuncCall(exprTokenPtr, funcName, infoPtr, envPtr, endPtrPtr)
code = TCL_ERROR;
goto done;
}
- infoPtr->exprIsComparison = 0;
code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
if (code != TCL_OK) {
goto done;
}
tokenPtr += (tokenPtr->numComponents + 1);
- maxDepth++;
}
if (tokenPtr != afterSubexprPtr) {
Tcl_ResetResult(interp);
@@ -992,15 +906,25 @@ CompileMathFuncCall(exprTokenPtr, funcName, infoPtr, envPtr, endPtrPtr)
*/
if (mathFuncPtr->builtinFuncIndex >= 0) { /* a builtin function */
- TclEmitInstInt1(INST_CALL_BUILTIN_FUNC1,
+ /*
+ * Adjust the current stack depth by the number of arguments
+ * of the builtin function. This cannot be handled by the
+ * TclEmitInstInt1 macro as the number of arguments is not
+ * passed as an operand.
+ */
+
+ if (envPtr->maxStackDepth < envPtr->currStackDepth) {
+ envPtr->maxStackDepth = envPtr->currStackDepth;
+ }
+ TclEmitInstInt1(INST_CALL_BUILTIN_FUNC1,
mathFuncPtr->builtinFuncIndex, envPtr);
+ envPtr->currStackDepth -= mathFuncPtr->numArgs;
} else {
TclEmitInstInt1(INST_CALL_FUNC1, (mathFuncPtr->numArgs+1), envPtr);
}
*endPtrPtr = afterSubexprPtr;
done:
- envPtr->maxStackDepth = maxDepth;
return code;
}
@@ -1033,6 +957,7 @@ LogSyntaxError(infoPtr)
sprintf(buffer, "syntax error in expression \"%.*s\"",
((numBytes > 60)? 60 : numBytes), infoPtr->expr);
+ Tcl_ResetResult(infoPtr->interp);
Tcl_AppendStringsToObj(Tcl_GetObjResult(infoPtr->interp),
buffer, (char *) NULL);
}
diff --git a/tcl/generic/tclCompile.c b/tcl/generic/tclCompile.c
index 4df50f28378..68be045c1b8 100644
--- a/tcl/generic/tclCompile.c
+++ b/tcl/generic/tclCompile.c
@@ -6,6 +6,7 @@
* sequence of instructions ("bytecodes").
*
* Copyright (c) 1996-1998 Sun Microsystems, Inc.
+ * 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.
@@ -34,8 +35,10 @@ TCL_DECLARE_MUTEX(tableMutex)
* This variable is linked to the Tcl variable "tcl_traceCompile".
*/
+#ifdef TCL_COMPILE_DEBUG
int tclTraceCompile = 0;
static int traceInitialized = 0;
+#endif
/*
* A table describing the Tcl bytecode instructions. Entries in this table
@@ -49,167 +52,223 @@ static int traceInitialized = 0;
* existence of a procedure call frame to distinguish these.
*/
-InstructionDesc instructionTable[] = {
- /* Name Bytes #Opnds Operand types Stack top, next */
- {"done", 1, 0, {OPERAND_NONE}},
- /* Finish ByteCode execution and return stktop (top stack item) */
- {"push1", 2, 1, {OPERAND_UINT1}},
- /* Push object at ByteCode objArray[op1] */
- {"push4", 5, 1, {OPERAND_UINT4}},
- /* Push object at ByteCode objArray[op4] */
- {"pop", 1, 0, {OPERAND_NONE}},
- /* Pop the topmost stack object */
- {"dup", 1, 0, {OPERAND_NONE}},
- /* Duplicate the topmost stack object and push the result */
- {"concat1", 2, 1, {OPERAND_UINT1}},
- /* Concatenate the top op1 items and push result */
- {"invokeStk1", 2, 1, {OPERAND_UINT1}},
- /* Invoke command named objv[0]; <objc,objv> = <op1,top op1> */
- {"invokeStk4", 5, 1, {OPERAND_UINT4}},
- /* Invoke command named objv[0]; <objc,objv> = <op4,top op4> */
- {"evalStk", 1, 0, {OPERAND_NONE}},
- /* Evaluate command in stktop using Tcl_EvalObj. */
- {"exprStk", 1, 0, {OPERAND_NONE}},
- /* Execute expression in stktop using Tcl_ExprStringObj. */
+InstructionDesc tclInstructionTable[] = {
+ /* Name Bytes stackEffect #Opnds Operand types Stack top, next */
+ {"done", 1, -1, 0, {OPERAND_NONE}},
+ /* Finish ByteCode execution and return stktop (top stack item) */
+ {"push1", 2, +1, 1, {OPERAND_UINT1}},
+ /* Push object at ByteCode objArray[op1] */
+ {"push4", 5, +1, 1, {OPERAND_UINT4}},
+ /* Push object at ByteCode objArray[op4] */
+ {"pop", 1, -1, 0, {OPERAND_NONE}},
+ /* 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}},
+ /* 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> */
+ {"invokeStk4", 5, INT_MIN, 1, {OPERAND_UINT4}},
+ /* Invoke command named objv[0]; <objc,objv> = <op4,top op4> */
+ {"evalStk", 1, 0, 0, {OPERAND_NONE}},
+ /* Evaluate command in stktop using Tcl_EvalObj. */
+ {"exprStk", 1, 0, 0, {OPERAND_NONE}},
+ /* Execute expression in stktop using Tcl_ExprStringObj. */
- {"loadScalar1", 2, 1, {OPERAND_UINT1}},
- /* Load scalar variable at index op1 <= 255 in call frame */
- {"loadScalar4", 5, 1, {OPERAND_UINT4}},
- /* Load scalar variable at index op1 >= 256 in call frame */
- {"loadScalarStk", 1, 0, {OPERAND_NONE}},
- /* Load scalar variable; scalar's name is stktop */
- {"loadArray1", 2, 1, {OPERAND_UINT1}},
- /* Load array element; array at slot op1<=255, element is stktop */
- {"loadArray4", 5, 1, {OPERAND_UINT4}},
- /* Load array element; array at slot op1 > 255, element is stktop */
- {"loadArrayStk", 1, 0, {OPERAND_NONE}},
- /* Load array element; element is stktop, array name is stknext */
- {"loadStk", 1, 0, {OPERAND_NONE}},
- /* Load general variable; unparsed variable name is stktop */
- {"storeScalar1", 2, 1, {OPERAND_UINT1}},
- /* Store scalar variable at op1<=255 in frame; value is stktop */
- {"storeScalar4", 5, 1, {OPERAND_UINT4}},
- /* Store scalar variable at op1 > 255 in frame; value is stktop */
- {"storeScalarStk", 1, 0, {OPERAND_NONE}},
- /* Store scalar; value is stktop, scalar name is stknext */
- {"storeArray1", 2, 1, {OPERAND_UINT1}},
- /* Store array element; array at op1<=255, value is top then elem */
- {"storeArray4", 5, 1, {OPERAND_UINT4}},
- /* Store array element; array at op1>=256, value is top then elem */
- {"storeArrayStk", 1, 0, {OPERAND_NONE}},
- /* Store array element; value is stktop, then elem, array names */
- {"storeStk", 1, 0, {OPERAND_NONE}},
- /* Store general variable; value is stktop, then unparsed name */
+ {"loadScalar1", 2, 1, 1, {OPERAND_UINT1}},
+ /* Load scalar variable at index op1 <= 255 in call frame */
+ {"loadScalar4", 5, 1, 1, {OPERAND_UINT4}},
+ /* Load scalar variable at index op1 >= 256 in call frame */
+ {"loadScalarStk", 1, 0, 0, {OPERAND_NONE}},
+ /* Load scalar variable; scalar's name is stktop */
+ {"loadArray1", 2, 0, 1, {OPERAND_UINT1}},
+ /* Load array element; array at slot op1<=255, element is stktop */
+ {"loadArray4", 5, 0, 1, {OPERAND_UINT4}},
+ /* Load array element; array at slot op1 > 255, element is stktop */
+ {"loadArrayStk", 1, -1, 0, {OPERAND_NONE}},
+ /* Load array element; element is stktop, array name is stknext */
+ {"loadStk", 1, 0, 0, {OPERAND_NONE}},
+ /* Load general variable; unparsed variable name is stktop */
+ {"storeScalar1", 2, 0, 1, {OPERAND_UINT1}},
+ /* Store scalar variable at op1<=255 in frame; value is stktop */
+ {"storeScalar4", 5, 0, 1, {OPERAND_UINT4}},
+ /* Store scalar variable at op1 > 255 in frame; value is stktop */
+ {"storeScalarStk", 1, -1, 0, {OPERAND_NONE}},
+ /* Store scalar; value is stktop, scalar name is stknext */
+ {"storeArray1", 2, -1, 1, {OPERAND_UINT1}},
+ /* Store array element; array at op1<=255, value is top then elem */
+ {"storeArray4", 5, -1, 1, {OPERAND_UINT4}},
+ /* Store array element; array at op1>=256, value is top then elem */
+ {"storeArrayStk", 1, -2, 0, {OPERAND_NONE}},
+ /* Store array element; value is stktop, then elem, array names */
+ {"storeStk", 1, -1, 0, {OPERAND_NONE}},
+ /* Store general variable; value is stktop, then unparsed name */
- {"incrScalar1", 2, 1, {OPERAND_UINT1}},
- /* Incr scalar at index op1<=255 in frame; incr amount is stktop */
- {"incrScalarStk", 1, 0, {OPERAND_NONE}},
- /* Incr scalar; incr amount is stktop, scalar's name is stknext */
- {"incrArray1", 2, 1, {OPERAND_UINT1}},
- /* Incr array elem; arr at slot op1<=255, amount is top then elem */
- {"incrArrayStk", 1, 0, {OPERAND_NONE}},
- /* Incr array element; amount is top then elem then array names */
- {"incrStk", 1, 0, {OPERAND_NONE}},
- /* Incr general variable; amount is stktop then unparsed var name */
- {"incrScalar1Imm", 3, 2, {OPERAND_UINT1, OPERAND_INT1}},
- /* Incr scalar at slot op1 <= 255; amount is 2nd operand byte */
- {"incrScalarStkImm", 2, 1, {OPERAND_INT1}},
- /* Incr scalar; scalar name is stktop; incr amount is op1 */
- {"incrArray1Imm", 3, 2, {OPERAND_UINT1, OPERAND_INT1}},
- /* Incr array elem; array at slot op1 <= 255, elem is stktop,
+ {"incrScalar1", 2, 0, 1, {OPERAND_UINT1}},
+ /* Incr scalar at index op1<=255 in frame; incr amount is stktop */
+ {"incrScalarStk", 1, -1, 0, {OPERAND_NONE}},
+ /* Incr scalar; incr amount is stktop, scalar's name is stknext */
+ {"incrArray1", 2, -1, 1, {OPERAND_UINT1}},
+ /* Incr array elem; arr at slot op1<=255, amount is top then elem */
+ {"incrArrayStk", 1, -2, 0, {OPERAND_NONE}},
+ /* Incr array element; amount is top then elem then array names */
+ {"incrStk", 1, -1, 0, {OPERAND_NONE}},
+ /* Incr general variable; amount is stktop then unparsed var name */
+ {"incrScalar1Imm", 3, +1, 2, {OPERAND_UINT1, OPERAND_INT1}},
+ /* Incr scalar at slot op1 <= 255; amount is 2nd operand byte */
+ {"incrScalarStkImm", 2, 0, 1, {OPERAND_INT1}},
+ /* Incr scalar; scalar name is stktop; incr amount is op1 */
+ {"incrArray1Imm", 3, 0, 2, {OPERAND_UINT1, OPERAND_INT1}},
+ /* Incr array elem; array at slot op1 <= 255, elem is stktop,
* amount is 2nd operand byte */
- {"incrArrayStkImm", 2, 1, {OPERAND_INT1}},
- /* Incr array element; elem is top then array name, amount is op1 */
- {"incrStkImm", 2, 1, {OPERAND_INT1}},
- /* Incr general variable; unparsed name is top, amount is op1 */
+ {"incrArrayStkImm", 2, -1, 1, {OPERAND_INT1}},
+ /* Incr array element; elem is top then array name, amount is op1 */
+ {"incrStkImm", 2, 0, 1, {OPERAND_INT1}},
+ /* Incr general variable; unparsed name is top, amount is op1 */
- {"jump1", 2, 1, {OPERAND_INT1}},
- /* Jump relative to (pc + op1) */
- {"jump4", 5, 1, {OPERAND_INT4}},
- /* Jump relative to (pc + op4) */
- {"jumpTrue1", 2, 1, {OPERAND_INT1}},
- /* Jump relative to (pc + op1) if stktop expr object is true */
- {"jumpTrue4", 5, 1, {OPERAND_INT4}},
- /* Jump relative to (pc + op4) if stktop expr object is true */
- {"jumpFalse1", 2, 1, {OPERAND_INT1}},
- /* Jump relative to (pc + op1) if stktop expr object is false */
- {"jumpFalse4", 5, 1, {OPERAND_INT4}},
- /* Jump relative to (pc + op4) if stktop expr object is false */
-
- {"lor", 1, 0, {OPERAND_NONE}},
- /* Logical or: push (stknext || stktop) */
- {"land", 1, 0, {OPERAND_NONE}},
- /* Logical and: push (stknext && stktop) */
- {"bitor", 1, 0, {OPERAND_NONE}},
- /* Bitwise or: push (stknext | stktop) */
- {"bitxor", 1, 0, {OPERAND_NONE}},
- /* Bitwise xor push (stknext ^ stktop) */
- {"bitand", 1, 0, {OPERAND_NONE}},
- /* Bitwise and: push (stknext & stktop) */
- {"eq", 1, 0, {OPERAND_NONE}},
- /* Equal: push (stknext == stktop) */
- {"neq", 1, 0, {OPERAND_NONE}},
- /* Not equal: push (stknext != stktop) */
- {"lt", 1, 0, {OPERAND_NONE}},
- /* Less: push (stknext < stktop) */
- {"gt", 1, 0, {OPERAND_NONE}},
- /* Greater: push (stknext || stktop) */
- {"le", 1, 0, {OPERAND_NONE}},
- /* Logical or: push (stknext || stktop) */
- {"ge", 1, 0, {OPERAND_NONE}},
- /* Logical or: push (stknext || stktop) */
- {"lshift", 1, 0, {OPERAND_NONE}},
- /* Left shift: push (stknext << stktop) */
- {"rshift", 1, 0, {OPERAND_NONE}},
- /* Right shift: push (stknext >> stktop) */
- {"add", 1, 0, {OPERAND_NONE}},
- /* Add: push (stknext + stktop) */
- {"sub", 1, 0, {OPERAND_NONE}},
- /* Sub: push (stkext - stktop) */
- {"mult", 1, 0, {OPERAND_NONE}},
- /* Multiply: push (stknext * stktop) */
- {"div", 1, 0, {OPERAND_NONE}},
- /* Divide: push (stknext / stktop) */
- {"mod", 1, 0, {OPERAND_NONE}},
- /* Mod: push (stknext % stktop) */
- {"uplus", 1, 0, {OPERAND_NONE}},
- /* Unary plus: push +stktop */
- {"uminus", 1, 0, {OPERAND_NONE}},
- /* Unary minus: push -stktop */
- {"bitnot", 1, 0, {OPERAND_NONE}},
- /* Bitwise not: push ~stktop */
- {"not", 1, 0, {OPERAND_NONE}},
- /* Logical not: push !stktop */
- {"callBuiltinFunc1", 2, 1, {OPERAND_UINT1}},
- /* Call builtin math function with index op1; any args are on stk */
- {"callFunc1", 2, 1, {OPERAND_UINT1}},
- /* Call non-builtin func objv[0]; <objc,objv>=<op1,top op1> */
- {"tryCvtToNumeric", 1, 0, {OPERAND_NONE}},
- /* Try converting stktop to first int then double if possible. */
-
- {"break", 1, 0, {OPERAND_NONE}},
- /* Abort closest enclosing loop; if none, return TCL_BREAK code. */
- {"continue", 1, 0, {OPERAND_NONE}},
- /* Skip to next iteration of closest enclosing loop; if none,
+ {"jump1", 2, 0, 1, {OPERAND_INT1}},
+ /* Jump relative to (pc + op1) */
+ {"jump4", 5, 0, 1, {OPERAND_INT4}},
+ /* Jump relative to (pc + op4) */
+ {"jumpTrue1", 2, -1, 1, {OPERAND_INT1}},
+ /* Jump relative to (pc + op1) if stktop expr object is true */
+ {"jumpTrue4", 5, -1, 1, {OPERAND_INT4}},
+ /* Jump relative to (pc + op4) if stktop expr object is true */
+ {"jumpFalse1", 2, -1, 1, {OPERAND_INT1}},
+ /* Jump relative to (pc + op1) if stktop expr object is false */
+ {"jumpFalse4", 5, -1, 1, {OPERAND_INT4}},
+ /* Jump relative to (pc + op4) if stktop expr object is false */
+
+ {"lor", 1, -1, 0, {OPERAND_NONE}},
+ /* Logical or: push (stknext || stktop) */
+ {"land", 1, -1, 0, {OPERAND_NONE}},
+ /* Logical and: push (stknext && stktop) */
+ {"bitor", 1, -1, 0, {OPERAND_NONE}},
+ /* Bitwise or: push (stknext | stktop) */
+ {"bitxor", 1, -1, 0, {OPERAND_NONE}},
+ /* Bitwise xor push (stknext ^ stktop) */
+ {"bitand", 1, -1, 0, {OPERAND_NONE}},
+ /* Bitwise and: push (stknext & stktop) */
+ {"eq", 1, -1, 0, {OPERAND_NONE}},
+ /* Equal: push (stknext == stktop) */
+ {"neq", 1, -1, 0, {OPERAND_NONE}},
+ /* Not equal: push (stknext != stktop) */
+ {"lt", 1, -1, 0, {OPERAND_NONE}},
+ /* Less: push (stknext < stktop) */
+ {"gt", 1, -1, 0, {OPERAND_NONE}},
+ /* Greater: push (stknext || stktop) */
+ {"le", 1, -1, 0, {OPERAND_NONE}},
+ /* Logical or: push (stknext || stktop) */
+ {"ge", 1, -1, 0, {OPERAND_NONE}},
+ /* Logical or: push (stknext || stktop) */
+ {"lshift", 1, -1, 0, {OPERAND_NONE}},
+ /* Left shift: push (stknext << stktop) */
+ {"rshift", 1, -1, 0, {OPERAND_NONE}},
+ /* Right shift: push (stknext >> stktop) */
+ {"add", 1, -1, 0, {OPERAND_NONE}},
+ /* Add: push (stknext + stktop) */
+ {"sub", 1, -1, 0, {OPERAND_NONE}},
+ /* Sub: push (stkext - stktop) */
+ {"mult", 1, -1, 0, {OPERAND_NONE}},
+ /* Multiply: push (stknext * stktop) */
+ {"div", 1, -1, 0, {OPERAND_NONE}},
+ /* Divide: push (stknext / stktop) */
+ {"mod", 1, -1, 0, {OPERAND_NONE}},
+ /* Mod: push (stknext % stktop) */
+ {"uplus", 1, 0, 0, {OPERAND_NONE}},
+ /* Unary plus: push +stktop */
+ {"uminus", 1, 0, 0, {OPERAND_NONE}},
+ /* Unary minus: push -stktop */
+ {"bitnot", 1, 0, 0, {OPERAND_NONE}},
+ /* Bitwise not: push ~stktop */
+ {"not", 1, 0, 0, {OPERAND_NONE}},
+ /* Logical not: push !stktop */
+ {"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> */
+ {"tryCvtToNumeric", 1, 0, 0, {OPERAND_NONE}},
+ /* Try converting stktop to first int then double if possible. */
+
+ {"break", 1, 0, 0, {OPERAND_NONE}},
+ /* Abort closest enclosing loop; if none, return TCL_BREAK code. */
+ {"continue", 1, 0, 0, {OPERAND_NONE}},
+ /* Skip to next iteration of closest enclosing loop; if none,
* return TCL_CONTINUE code. */
- {"foreach_start4", 5, 1, {OPERAND_UINT4}},
- /* Initialize execution of a foreach loop. Operand is aux data index
+ {"foreach_start4", 5, 0, 1, {OPERAND_UINT4}},
+ /* Initialize execution of a foreach loop. Operand is aux data index
* of the ForeachInfo structure for the foreach command. */
- {"foreach_step4", 5, 1, {OPERAND_UINT4}},
- /* "Step" or begin next iteration of foreach loop. Push 0 if to
+ {"foreach_step4", 5, +1, 1, {OPERAND_UINT4}},
+ /* "Step" or begin next iteration of foreach loop. Push 0 if to
* terminate loop, else push 1. */
- {"beginCatch4", 5, 1, {OPERAND_UINT4}},
- /* Record start of catch with the operand's exception index.
+ {"beginCatch4", 5, 0, 1, {OPERAND_UINT4}},
+ /* Record start of catch with the operand's exception index.
* Push the current stack depth onto a special catch stack. */
- {"endCatch", 1, 0, {OPERAND_NONE}},
- /* End of last catch. Pop the bytecode interpreter's catch stack. */
- {"pushResult", 1, 0, {OPERAND_NONE}},
- /* Push the interpreter's object result onto the stack. */
- {"pushReturnCode", 1, 0, {OPERAND_NONE}},
- /* Push interpreter's return code (e.g. TCL_OK or TCL_ERROR) as
+ {"endCatch", 1, 0, 0, {OPERAND_NONE}},
+ /* End of last catch. Pop the bytecode interpreter's catch stack. */
+ {"pushResult", 1, +1, 0, {OPERAND_NONE}},
+ /* Push the interpreter's object result onto the stack. */
+ {"pushReturnCode", 1, +1, 0, {OPERAND_NONE}},
+ /* Push interpreter's return code (e.g. TCL_OK or TCL_ERROR) as
* a new object onto the stack. */
+ {"streq", 1, -1, 0, {OPERAND_NONE}},
+ /* Str Equal: push (stknext eq stktop) */
+ {"strneq", 1, -1, 0, {OPERAND_NONE}},
+ /* Str !Equal: push (stknext neq stktop) */
+ {"strcmp", 1, -1, 0, {OPERAND_NONE}},
+ /* Str Compare: push (stknext cmp stktop) */
+ {"strlen", 1, 0, 0, {OPERAND_NONE}},
+ /* Str Length: push (strlen stktop) */
+ {"strindex", 1, -1, 0, {OPERAND_NONE}},
+ /* Str Index: push (strindex stknext stktop) */
+ {"strmatch", 2, -1, 1, {OPERAND_INT1}},
+ /* Str Match: push (strmatch stknext stktop) opnd == nocase */
+ {"list", 5, INT_MIN, 1, {OPERAND_UINT4}},
+ /* List: push (stk1 stk2 ... stktop) */
+ {"listindex", 1, -1, 0, {OPERAND_NONE}},
+ /* List Index: push (listindex stknext stktop) */
+ {"listlength", 1, 0, 0, {OPERAND_NONE}},
+ /* List Len: push (listlength stktop) */
+ {"appendScalar1", 2, 0, 1, {OPERAND_UINT1}},
+ /* Append scalar variable at op1<=255 in frame; value is stktop */
+ {"appendScalar4", 5, 0, 1, {OPERAND_UINT4}},
+ /* Append scalar variable at op1 > 255 in frame; value is stktop */
+ {"appendArray1", 2, -1, 1, {OPERAND_UINT1}},
+ /* Append array element; array at op1<=255, value is top then elem */
+ {"appendArray4", 5, -1, 1, {OPERAND_UINT4}},
+ /* Append array element; array at op1>=256, value is top then elem */
+ {"appendArrayStk", 1, -2, 0, {OPERAND_NONE}},
+ /* Append array element; value is stktop, then elem, array names */
+ {"appendStk", 1, -1, 0, {OPERAND_NONE}},
+ /* Append general variable; value is stktop, then unparsed name */
+ {"lappendScalar1", 2, 0, 1, {OPERAND_UINT1}},
+ /* Lappend scalar variable at op1<=255 in frame; value is stktop */
+ {"lappendScalar4", 5, 0, 1, {OPERAND_UINT4}},
+ /* Lappend scalar variable at op1 > 255 in frame; value is stktop */
+ {"lappendArray1", 2, -1, 1, {OPERAND_UINT1}},
+ /* Lappend array element; array at op1<=255, value is top then elem */
+ {"lappendArray4", 5, -1, 1, {OPERAND_UINT4}},
+ /* Lappend array element; array at op1>=256, value is top then elem */
+ {"lappendArrayStk", 1, -2, 0, {OPERAND_NONE}},
+ /* Lappend array element; value is stktop, then elem, array names */
+ {"lappendStk", 1, -1, 0, {OPERAND_NONE}},
+ /* Lappend general variable; value is stktop, then unparsed name */
+ {"lindexMulti", 5, INT_MIN, 1, {OPERAND_UINT4}},
+ /* Lindex with generalized args, operand is number of stacked objs
+ * used: (operand-1) entries from stktop are the indices; then list
+ * to process. */
+ {"over", 5, +1, 1, {OPERAND_UINT4}},
+ /* Duplicate the arg-th element from top of stack (TOS=0) */
+ {"lsetList", 1, -2, 0, {OPERAND_NONE}},
+ /* Four-arg version of 'lset'. stktop is old value; next is
+ * new element value, next is the index list; pushes new value */
+ {"lsetFlat", 5, INT_MIN, 1, {OPERAND_UINT4}},
+ /* Three- or >=5-arg version of 'lset', operand is number of
+ * stacked objs: stktop is old value, next is new element value, next
+ * come (operand-2) indices; pushes the new value.
+ */
{0}
};
@@ -233,7 +292,8 @@ static void FreeByteCodeInternalRep _ANSI_ARGS_((
static int GetCmdLocEncodingSize _ANSI_ARGS_((
CompileEnv *envPtr));
static void LogCompilationInfo _ANSI_ARGS_((Tcl_Interp *interp,
- char *script, char *command, int length));
+ CONST char *script, CONST char *command,
+ int length));
#ifdef TCL_COMPILE_STATS
static void RecordByteCodeStats _ANSI_ARGS_((
ByteCode *codePtr));
@@ -298,6 +358,7 @@ TclSetByteCodeFromAny(interp, objPtr, hookProc, clientData)
int length, nested, result;
char *string;
+#ifdef TCL_COMPILE_DEBUG
if (!traceInitialized) {
if (Tcl_LinkVar(interp, "tcl_traceCompile",
(char *) &tclTraceCompile, TCL_LINK_INT) != TCL_OK) {
@@ -305,6 +366,7 @@ TclSetByteCodeFromAny(interp, objPtr, hookProc, clientData)
}
traceInitialized = 1;
}
+#endif
if (iPtr->evalFlags & TCL_BRACKET_TERM) {
nested = 1;
@@ -342,7 +404,7 @@ TclSetByteCodeFromAny(interp, objPtr, hookProc, clientData)
TclInitByteCodeObj(objPtr, &compEnv);
#ifdef TCL_COMPILE_DEBUG
- if (tclTraceCompile == 2) {
+ if (tclTraceCompile >= 2) {
TclPrintByteCodeObj(interp, objPtr);
}
#endif /* TCL_COMPILE_DEBUG */
@@ -531,7 +593,7 @@ TclCleanupByteCode(codePtr)
(double) (codePtr->numAuxDataItems * sizeof(AuxData));
statsPtr->currentCmdMapBytes -= (double) codePtr->numCmdLocBytes;
- TclpGetTime(&destroyTime);
+ Tcl_GetTime(&destroyTime);
lifetimeSec = destroyTime.sec - codePtr->createTime.sec;
if (lifetimeSec > 2000) { /* avoid overflow */
lifetimeSec = 2000;
@@ -641,9 +703,8 @@ TclInitCompileEnv(interp, envPtr, string, numBytes)
envPtr->exceptDepth = 0;
envPtr->maxExceptDepth = 0;
envPtr->maxStackDepth = 0;
+ envPtr->currStackDepth = 0;
TclInitLiteralTable(&(envPtr->localLitTable));
- envPtr->exprIsJustVarRef = 0;
- envPtr->exprIsComparison = 0;
envPtr->codeStart = envPtr->staticCodeSpace;
envPtr->codeNext = envPtr->codeStart;
@@ -728,8 +789,6 @@ TclFreeCompileEnv(envPtr)
* interp->termOffset is set to the offset of the character in the
* script just after the last one successfully processed; this will be
* the offset of the ']' if (flags & TCL_BRACKET_TERM).
- * envPtr->maxStackDepth is set to the maximum number of stack elements
- * needed to execute the script's commands.
*
* Side effects:
* Adds instructions to envPtr to evaluate the script at runtime.
@@ -740,7 +799,7 @@ TclFreeCompileEnv(envPtr)
int
TclCompileScript(interp, script, numBytes, nested, envPtr)
Tcl_Interp *interp; /* Used for error and status reporting. */
- char *script; /* The source script to compile. */
+ 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. */
@@ -752,8 +811,6 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
{
Interp *iPtr = (Interp *) interp;
Tcl_Parse parse;
- int maxDepth = 0; /* Maximum number of stack elements needed
- * to execute all cmds. */
int lastTopLevelCmdIndex = -1;
/* Index of most recent toplevel command in
* the command location table. Initialized
@@ -761,7 +818,7 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
int startCodeOffset = -1; /* Offset of first byte of current command's
* code. Init. to avoid compiler warning. */
unsigned char *entryCodeNext = envPtr->codeNext;
- char *p, *next;
+ CONST char *p, *next;
Namespace *cmdNsPtr;
Command *cmdPtr;
Tcl_Token *tokenPtr;
@@ -829,6 +886,7 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
commandLength -= 1;
}
+#ifdef TCL_COMPILE_DEBUG
/*
* If tracing, print a line for each top level command compiled.
*/
@@ -840,7 +898,7 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
TclMin(commandLength, 55));
fprintf(stdout, "\n");
}
-
+#endif
/*
* Each iteration of the following loop compiles one word
* from the command.
@@ -889,12 +947,11 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
if ((cmdPtr != NULL)
&& (cmdPtr->compileProc != NULL)
+ && !(cmdPtr->flags & CMD_HAS_EXEC_TRACES)
&& !(iPtr->flags & DONT_COMPILE_CMDS_INLINE)) {
code = (*(cmdPtr->compileProc))(interp, &parse,
envPtr);
if (code == TCL_OK) {
- maxDepth = TclMax(envPtr->maxStackDepth,
- maxDepth);
goto finishCommand;
} else if (code == TCL_OUT_LINE_COMPILE) {
/* do nothing */
@@ -916,21 +973,18 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
* reduce runtime lookups.
*/
- objIndex = TclRegisterLiteral(envPtr,
- tokenPtr[1].start, tokenPtr[1].size,
- /*onHeap*/ 0);
+ objIndex = TclRegisterNewLiteral(envPtr,
+ tokenPtr[1].start, tokenPtr[1].size);
if (cmdPtr != NULL) {
TclSetCmdNameObj(interp,
envPtr->literalArrayPtr[objIndex].objPtr,
cmdPtr);
}
} else {
- objIndex = TclRegisterLiteral(envPtr,
- tokenPtr[1].start, tokenPtr[1].size,
- /*onHeap*/ 0);
+ objIndex = TclRegisterNewLiteral(envPtr,
+ tokenPtr[1].start, tokenPtr[1].size);
}
TclEmitPush(objIndex, envPtr);
- maxDepth = TclMax((wordIdx + 1), maxDepth);
} else {
/*
* The word is not a simple string of characters.
@@ -941,8 +995,6 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
if (code != TCL_OK) {
goto error;
}
- maxDepth = TclMax((wordIdx + envPtr->maxStackDepth),
- maxDepth);
}
}
@@ -998,7 +1050,6 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
if (envPtr->codeNext == entryCodeNext) {
TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0),
envPtr);
- maxDepth = 1;
}
if ((nested != 0) && (p > script) && (p[-1] == ']')) {
@@ -1006,7 +1057,6 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
} else {
iPtr->termOffset = (p - script);
}
- envPtr->maxStackDepth = maxDepth;
Tcl_DStringFree(&ds);
return TCL_OK;
@@ -1039,7 +1089,6 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
Tcl_FreeParse(&parse);
}
iPtr->termOffset = (p - script);
- envPtr->maxStackDepth = maxDepth;
Tcl_DStringFree(&ds);
return code;
}
@@ -1058,9 +1107,6 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
* The return value is a standard Tcl result. If an error occurs, an
* error message is left in the interpreter's result.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to evaluate the tokens.
- *
* Side effects:
* Instructions are added to envPtr to push and evaluate the tokens
* at runtime.
@@ -1080,13 +1126,12 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
Tcl_DString textBuffer; /* Holds concatenated chars from adjacent
* TCL_TOKEN_TEXT, TCL_TOKEN_BS tokens. */
char buffer[TCL_UTF_MAX];
- char *name, *p;
- int numObjsToConcat, nameBytes, hasNsQualifiers, localVar;
- int length, maxDepth, depthForVar, i, code;
+ CONST char *name, *p;
+ int numObjsToConcat, nameBytes, localVarName, localVar;
+ int length, i, code;
unsigned char *entryCodeNext = envPtr->codeNext;
Tcl_DStringInit(&textBuffer);
- maxDepth = 0;
numObjsToConcat = 0;
for ( ; count > 0; count--, tokenPtr++) {
switch (tokenPtr->type) {
@@ -1114,7 +1159,6 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
Tcl_DStringLength(&textBuffer), /*onHeap*/ 0);
TclEmitPush(literal, envPtr);
numObjsToConcat++;
- maxDepth = TclMax(numObjsToConcat, maxDepth);
Tcl_DStringFree(&textBuffer);
}
@@ -1123,8 +1167,6 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
if (code != TCL_OK) {
goto error;
}
- maxDepth = TclMax((numObjsToConcat + envPtr->maxStackDepth),
- maxDepth);
numObjsToConcat++;
break;
@@ -1141,44 +1183,49 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
Tcl_DStringLength(&textBuffer), /*onHeap*/ 0);
TclEmitPush(literal, envPtr);
numObjsToConcat++;
- maxDepth = TclMax(numObjsToConcat, maxDepth);
Tcl_DStringFree(&textBuffer);
}
/*
- * Check if the name contains any namespace qualifiers.
+ * 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;
- hasNsQualifiers = 0;
- for (i = 0, p = name; i < nameBytes; i++, p++) {
- if ((*p == ':') && (i < (nameBytes-1))
- && (*(p+1) == ':')) {
- hasNsQualifiers = 1;
- break;
+ 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.
+ * the array of local variables in a procedure frame.
*/
- depthForVar = 0;
- if ((envPtr->procPtr == NULL) || hasNsQualifiers) {
- localVar = -1;
- TclEmitPush(TclRegisterLiteral(envPtr, name, nameBytes,
- /*onHeap*/ 0), envPtr);
- depthForVar = 1;
- } else {
+ localVar = -1;
+ if (localVarName != -1) {
localVar = TclFindCompiledLocal(name, nameBytes,
- /*create*/ 0, /*flags*/ 0, envPtr->procPtr);
- if (localVar < 0) {
- TclEmitPush(TclRegisterLiteral(envPtr, name,
- nameBytes, /*onHeap*/ 0), envPtr);
- depthForVar = 1;
- }
+ localVarName, /*flags*/ 0, envPtr->procPtr);
+ }
+ if (localVar < 0) {
+ TclEmitPush(TclRegisterNewLiteral(envPtr, name, nameBytes),
+ envPtr);
}
/*
@@ -1199,13 +1246,13 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
code = TclCompileTokens(interp, tokenPtr+2,
tokenPtr->numComponents-1, envPtr);
if (code != TCL_OK) {
- sprintf(buffer,
+ char errorBuffer[150];
+ sprintf(errorBuffer,
"\n (parsing index for array \"%.*s\")",
((nameBytes > 100)? 100 : nameBytes), name);
- Tcl_AddObjErrorInfo(interp, buffer, -1);
+ Tcl_AddObjErrorInfo(interp, errorBuffer, -1);
goto error;
}
- depthForVar += envPtr->maxStackDepth;
if (localVar < 0) {
TclEmitOpcode(INST_LOAD_ARRAY_STK, envPtr);
} else if (localVar <= 255) {
@@ -1216,7 +1263,6 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
envPtr);
}
}
- maxDepth = TclMax(numObjsToConcat + depthForVar, maxDepth);
numObjsToConcat++;
count -= tokenPtr->numComponents;
tokenPtr += tokenPtr->numComponents;
@@ -1238,7 +1284,6 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
Tcl_DStringLength(&textBuffer), /*onHeap*/ 0);
TclEmitPush(literal, envPtr);
numObjsToConcat++;
- maxDepth = TclMax(numObjsToConcat, maxDepth);
}
/*
@@ -1260,15 +1305,12 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
if (envPtr->codeNext == entryCodeNext) {
TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0),
envPtr);
- maxDepth = 1;
}
Tcl_DStringFree(&textBuffer);
- envPtr->maxStackDepth = maxDepth;
return TCL_OK;
error:
Tcl_DStringFree(&textBuffer);
- envPtr->maxStackDepth = maxDepth;
return code;
}
@@ -1287,9 +1329,6 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
* The return value is a standard Tcl result. If an error occurs, an
* error message is left in the interpreter's result.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the tokens.
- *
* Side effects:
* Instructions are added to envPtr to execute the tokens at runtime.
*
@@ -1312,7 +1351,6 @@ TclCompileCmdWord(interp, tokenPtr, count, envPtr)
* into an inline sequence of instructions.
*/
- envPtr->maxStackDepth = 0;
if ((count == 1) && (tokenPtr->type == TCL_TOKEN_TEXT)) {
code = TclCompileScript(interp, tokenPtr->start, tokenPtr->size,
/*nested*/ 0, envPtr);
@@ -1348,9 +1386,6 @@ TclCompileCmdWord(interp, tokenPtr, count, envPtr)
* The return value is a standard Tcl result. If an error occurs, an
* error message is left in the interpreter's result.
*
- * envPtr->maxStackDepth is updated with the maximum number of stack
- * elements needed to execute the expression.
- *
* Side effects:
* Instructions are added to envPtr to execute the expression.
*
@@ -1369,13 +1404,9 @@ TclCompileExprWords(interp, tokenPtr, numWords, envPtr)
CompileEnv *envPtr; /* Holds the resulting instructions. */
{
Tcl_Token *wordPtr;
- int maxDepth, range, numBytes, i, code;
- char *script;
- int saveExprIsJustVarRef = envPtr->exprIsJustVarRef;
- int saveExprIsComparison = envPtr->exprIsComparison;
+ int range, numBytes, i, code;
+ CONST char *script;
- envPtr->maxStackDepth = 0;
- maxDepth = 0;
range = -1;
code = TCL_OK;
@@ -1411,9 +1442,6 @@ TclCompileExprWords(interp, tokenPtr, numWords, envPtr)
if (i < (numWords - 1)) {
TclEmitPush(TclRegisterLiteral(envPtr, " ", 1, /*onHeap*/ 0),
envPtr);
- maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
- } else {
- maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
}
wordPtr += (wordPtr->numComponents + 1);
}
@@ -1429,9 +1457,6 @@ TclCompileExprWords(interp, tokenPtr, numWords, envPtr)
TclEmitOpcode(INST_EXPR_STK, envPtr);
}
- envPtr->exprIsJustVarRef = saveExprIsJustVarRef;
- envPtr->exprIsComparison = saveExprIsComparison;
- envPtr->maxStackDepth = maxDepth;
return code;
}
@@ -1523,7 +1548,7 @@ TclInitByteCodeObj(objPtr, envPtr)
codePtr->numCmdLocBytes = cmdLocBytes;
codePtr->maxExceptDepth = envPtr->maxExceptDepth;
codePtr->maxStackDepth = envPtr->maxStackDepth;
-
+
p += sizeof(ByteCode);
codePtr->codeStart = p;
memcpy((VOID *) p, (VOID *) envPtr->codeStart, (size_t) codeBytes);
@@ -1568,7 +1593,7 @@ TclInitByteCodeObj(objPtr, envPtr)
#ifdef TCL_COMPILE_STATS
codePtr->structureSize = structureSize
- (sizeof(size_t) + sizeof(Tcl_Time));
- TclpGetTime(&(codePtr->createTime));
+ Tcl_GetTime(&(codePtr->createTime));
RecordByteCodeStats(codePtr);
#endif /* TCL_COMPILE_STATS */
@@ -1613,15 +1638,15 @@ static void
LogCompilationInfo(interp, script, command, length)
Tcl_Interp *interp; /* Interpreter in which to log the
* information. */
- char *script; /* First character in script containing
+ CONST char *script; /* First character in script containing
* command (must be <= command). */
- char *command; /* First character in command that
+ 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). */
{
char buffer[200];
- register char *p;
+ register CONST char *p;
char *ellipsis = "";
Interp *iPtr = (Interp *) interp;
@@ -1690,7 +1715,7 @@ LogCompilationInfo(interp, script, command, length)
int
TclFindCompiledLocal(name, nameBytes, create, flags, procPtr)
- register char *name; /* Points to first character of the name of
+ 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. */
@@ -1744,7 +1769,7 @@ TclFindCompiledLocal(name, nameBytes, create, flags, procPtr)
localPtr->nextPtr = NULL;
localPtr->nameLength = nameBytes;
localPtr->frameIndex = localVar;
- localPtr->flags = flags;
+ localPtr->flags = flags | VAR_UNDEFINED;
if (name == NULL) {
localPtr->flags |= VAR_TEMPORARY;
}
@@ -1868,7 +1893,7 @@ TclInitCompiledLocals(interp, framePtr, nsPtr)
varPtr->refCount = 0;
varPtr->tracePtr = NULL;
varPtr->searchPtr = NULL;
- varPtr->flags = (localPtr->flags | VAR_UNDEFINED);
+ varPtr->flags = localPtr->flags;
}
varPtr++;
}
@@ -1895,10 +1920,13 @@ TclInitCompiledLocals(interp, framePtr, nsPtr)
*/
void
-TclExpandCodeArray(envPtr)
- CompileEnv *envPtr; /* Points to the CompileEnv whose code array
+TclExpandCodeArray(envArgPtr)
+ void *envArgPtr; /* Points to the CompileEnv whose code array
* must be enlarged. */
{
+ CompileEnv *envPtr = (CompileEnv*) envArgPtr; /* Points to the CompileEnv whose code array
+ * must be enlarged. */
+
/*
* envPtr->codeNext is equal to envPtr->codeEnd. The currently defined
* code bytes are stored between envPtr->codeStart and
@@ -2489,7 +2517,7 @@ TclFixupForwardJump(envPtr, jumpFixupPtr, jumpDist, distThreshold)
*
* Results:
* Returns a pointer to the global instruction table, same as the
- * expression (&instructionTable[0]).
+ * expression (&tclInstructionTable[0]).
*
* Side effects:
* None.
@@ -2497,10 +2525,10 @@ TclFixupForwardJump(envPtr, jumpFixupPtr, jumpDist, distThreshold)
*----------------------------------------------------------------------
*/
-InstructionDesc *
+void * /* == InstructionDesc* == */
TclGetInstructionTable()
{
- return &instructionTable[0];
+ return &tclInstructionTable[0];
}
/*
@@ -3157,7 +3185,7 @@ TclPrintInstruction(codePtr, pc)
{
Proc *procPtr = codePtr->procPtr;
unsigned char opCode = *pc;
- register InstructionDesc *instDesc = &instructionTable[opCode];
+ register InstructionDesc *instDesc = &tclInstructionTable[opCode];
unsigned char *codeStart = codePtr->codeStart;
unsigned int pcOffset = (pc - codeStart);
int opnd, i, j;
@@ -3383,7 +3411,7 @@ RecordByteCodeStats(codePtr)
statsPtr->currentByteCodeBytes += (double) codePtr->structureSize;
statsPtr->srcCount[TclLog2(codePtr->numSrcBytes)]++;
- statsPtr->byteCodeCount[TclLog2(codePtr->structureSize)]++;
+ statsPtr->byteCodeCount[TclLog2((int)(codePtr->structureSize))]++;
statsPtr->currentInstBytes += (double) codePtr->numCodeBytes;
statsPtr->currentLitBytes +=
@@ -3395,4 +3423,3 @@ RecordByteCodeStats(codePtr)
statsPtr->currentCmdMapBytes += (double) codePtr->numCmdLocBytes;
}
#endif /* TCL_COMPILE_STATS */
-
diff --git a/tcl/generic/tclCompile.h b/tcl/generic/tclCompile.h
index cd513510f38..92c8aae5587 100644
--- a/tcl/generic/tclCompile.h
+++ b/tcl/generic/tclCompile.h
@@ -2,6 +2,8 @@
* tclCompile.h --
*
* Copyright (c) 1996-1998 Sun Microsystems, Inc.
+ * Copyright (c) 1998-2000 by Scriptics Corporation.
+ * 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.
@@ -28,14 +30,7 @@
*------------------------------------------------------------------------
*/
-/*
- * Variable that denotes the command name Tcl object type. Objects of this
- * type cache the Command pointer that results from looking up command names
- * in the command hashtable.
- */
-
-extern Tcl_ObjType tclCmdNameType;
-
+#ifdef TCL_COMPILE_DEBUG
/*
* Variable that controls whether compilation tracing is enabled and, if so,
* what level of tracing is desired:
@@ -46,7 +41,9 @@ extern Tcl_ObjType tclCmdNameType;
*/
extern int tclTraceCompile;
+#endif
+#ifdef TCL_COMPILE_DEBUG
/*
* Variable that controls whether execution tracing is enabled and, if so,
* what level of tracing is desired:
@@ -58,6 +55,7 @@ extern int tclTraceCompile;
*/
extern int tclTraceExec;
+#endif
/*
*------------------------------------------------------------------------
@@ -211,23 +209,12 @@ typedef struct CompileEnv {
int maxStackDepth; /* Maximum number of stack elements needed
* to execute the code. Set by compilation
* procedures before returning. */
+ int currStackDepth; /* Current stack depth. */
LiteralTable localLitTable; /* Contains LiteralEntry's describing
* all Tcl objects referenced by this
* compiled code. Indexed by the string
* representations of the literals. Used to
* avoid creating duplicate objects. */
- int exprIsJustVarRef; /* Set 1 if the expression last compiled by
- * TclCompileExpr consisted of just a
- * variable reference as in the expression
- * of "if $b then...". Otherwise 0. Used
- * to implement expr's 2 level substitution
- * semantics properly. */
- int exprIsComparison; /* Set 1 if the top-level operator in the
- * expression last compiled is a comparison.
- * Otherwise 0. If 1, since the operands
- * might be strings, the expr is compiled
- * out-of-line to implement expr's 2 level
- * substitution semantics properly. */
unsigned char *codeStart; /* Points to the first byte of the code. */
unsigned char *codeNext; /* Points to next code array byte to use. */
unsigned char *codeEnd; /* Points just after the last allocated
@@ -397,11 +384,11 @@ typedef struct ByteCode {
} ByteCode;
/*
- * Opcodes for the Tcl bytecode instructions. These must correspond to the
- * entries in the table of instruction descriptions, instructionTable, in
- * tclCompile.c. Also, the order and number of the expression opcodes
- * (e.g., INST_LOR) must match the entries in the array operatorStrings in
- * tclExecute.c.
+ * Opcodes for the Tcl bytecode instructions. These must correspond to
+ * the entries in the table of instruction descriptions,
+ * tclInstructionTable, in tclCompile.c. Also, the order and number of
+ * the expression opcodes (e.g., INST_LOR) must match the entries in
+ * the array operatorStrings in tclExecute.c.
*/
/* Opcodes 0 to 9 */
@@ -493,8 +480,50 @@ typedef struct ByteCode {
#define INST_PUSH_RESULT 71
#define INST_PUSH_RETURN_CODE 72
+/* Opcodes 73 to 78 */
+#define INST_STR_EQ 73
+#define INST_STR_NEQ 74
+#define INST_STR_CMP 75
+#define INST_STR_LEN 76
+#define INST_STR_INDEX 77
+#define INST_STR_MATCH 78
+
+/* Opcodes 78 to 81 */
+#define INST_LIST 79
+#define INST_LIST_INDEX 80
+#define INST_LIST_LENGTH 81
+
+/* Opcodes 82 to 87 */
+#define INST_APPEND_SCALAR1 82
+#define INST_APPEND_SCALAR4 83
+#define INST_APPEND_ARRAY1 84
+#define INST_APPEND_ARRAY4 85
+#define INST_APPEND_ARRAY_STK 86
+#define INST_APPEND_STK 87
+
+/* Opcodes 88 to 93 */
+#define INST_LAPPEND_SCALAR1 88
+#define INST_LAPPEND_SCALAR4 89
+#define INST_LAPPEND_ARRAY1 90
+#define INST_LAPPEND_ARRAY4 91
+#define INST_LAPPEND_ARRAY_STK 92
+#define INST_LAPPEND_STK 93
+
+/* TIP #22 - LINDEX operator with flat arg list */
+
+#define INST_LIST_INDEX_MULTI 94
+
+/*
+ * TIP #33 - 'lset' command. Code gen also required a Forth-like
+ * OVER operation.
+ */
+
+#define INST_OVER 95
+#define INST_LSET_LIST 96
+#define INST_LSET_FLAT 97
+
/* The last opcode */
-#define LAST_INST_OPCODE 72
+#define LAST_INST_OPCODE 97
/*
* Table describing the Tcl bytecode instructions: their name (for
@@ -518,17 +547,23 @@ typedef enum InstOperandType {
typedef struct InstructionDesc {
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).
+ */
int numOperands; /* Number of operands. */
InstOperandType opTypes[MAX_INSTRUCTION_OPERANDS];
/* The type of each operand. */
} InstructionDesc;
-extern InstructionDesc instructionTable[];
+extern InstructionDesc tclInstructionTable[];
/*
* Definitions of the values of the INST_CALL_BUILTIN_FUNC instruction's
* operand byte. Each value denotes a builtin Tcl math function. These
- * values must correspond to the entries in the builtinFuncTable array
+ * values must correspond to the entries in the tclBuiltinFuncTable array
* below and to the values stored in the tclInt.h MathFunc structure's
* builtinFuncIndex field.
*/
@@ -558,8 +593,9 @@ extern InstructionDesc instructionTable[];
#define BUILTIN_FUNC_RAND 22
#define BUILTIN_FUNC_ROUND 23
#define BUILTIN_FUNC_SRAND 24
+#define BUILTIN_FUNC_WIDE 25
-#define LAST_BUILTIN_FUNC 24
+#define LAST_BUILTIN_FUNC 25
/*
* Table describing the built-in math functions. Entries in this table are
@@ -580,7 +616,7 @@ typedef struct {
* function when invoking it. */
} BuiltinFunc;
-extern BuiltinFunc builtinFuncTable[];
+extern BuiltinFunc tclBuiltinFuncTable[];
/*
* Compilation of some Tcl constructs such as if commands and the logical or
@@ -672,40 +708,27 @@ typedef struct ForeachInfo {
extern AuxDataType tclForeachInfoType;
+
/*
- * 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
- * representation for a cmdName object. It contains the pointer along
- * with some information that is used to check the pointer's validity.
- */
-
-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). */
- 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 namespace was deleted and a
- * new one created at the same address). */
- int refNsCmdEpoch; /* Value of the referencing namespace's
- * cmdRefEpoch when the pointer was cached.
- * Before using the cached pointer, we check
- * if the namespace's epoch was incremented;
- * if so, this cached pointer is invalid. */
- int cmdEpoch; /* Value of the command's cmdEpoch when this
- * pointer was cached. Before using the
- * cached pointer, we check if the cmd's
- * epoch was incremented; if so, the cmd was
- * renamed, deleted, hidden, or exposed, and
- * so the pointer is invalid. */
- int refCount; /* Reference count: 1 for each cmdName
- * object that has a pointer to this
- * ResolvedCmdName structure as its internal
- * rep. This structure can be freed when
- * refCount becomes zero. */
-} ResolvedCmdName;
+ *----------------------------------------------------------------
+ * Procedures exported by tclBasic.c to be used within the engine.
+ *----------------------------------------------------------------
+ */
+
+EXTERN int TclEvalObjvInternal _ANSI_ARGS_((Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[], CONST char *command, int length,
+ int flags));
+EXTERN int TclInterpReady _ANSI_ARGS_((Tcl_Interp *interp));
+
+
+/*
+ *----------------------------------------------------------------
+ * Procedures exported by the engine to be used by tclBasic.c
+ *----------------------------------------------------------------
+ */
+
+EXTERN int TclCompEvalObj _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr));
/*
*----------------------------------------------------------------
@@ -719,13 +742,13 @@ EXTERN int TclCompileCmdWord _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Token *tokenPtr, int count,
CompileEnv *envPtr));
EXTERN int TclCompileExpr _ANSI_ARGS_((Tcl_Interp *interp,
- char *script, int numBytes,
+ CONST char *script, int numBytes,
CompileEnv *envPtr));
EXTERN int TclCompileExprWords _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Token *tokenPtr, int numWords,
CompileEnv *envPtr));
EXTERN int TclCompileScript _ANSI_ARGS_((Tcl_Interp *interp,
- char *script, int numBytes, int nested,
+ CONST char *script, int numBytes, int nested,
CompileEnv *envPtr));
EXTERN int TclCompileTokens _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Token *tokenPtr, int count,
@@ -743,15 +766,10 @@ EXTERN void TclEmitForwardJump _ANSI_ARGS_((CompileEnv *envPtr,
EXTERN ExceptionRange * TclGetExceptionRangeForPc _ANSI_ARGS_((
unsigned char *pc, int catchOnly,
ByteCode* codePtr));
-EXTERN InstructionDesc * TclGetInstructionTable _ANSI_ARGS_(());
-EXTERN int TclExecuteByteCode _ANSI_ARGS_((Tcl_Interp *interp,
- ByteCode *codePtr));
-EXTERN void TclExpandCodeArray _ANSI_ARGS_((
- CompileEnv *envPtr));
EXTERN void TclExpandJumpFixupArray _ANSI_ARGS_((
JumpFixupArray *fixupArrayPtr));
EXTERN void TclFinalizeAuxDataTypeTable _ANSI_ARGS_((void));
-EXTERN int TclFindCompiledLocal _ANSI_ARGS_((char *name,
+EXTERN int TclFindCompiledLocal _ANSI_ARGS_((CONST char *name,
int nameChars, int create, int flags,
Proc *procPtr));
EXTERN LiteralEntry * TclLookupLiteralEntry _ANSI_ARGS_((
@@ -810,6 +828,40 @@ EXTERN void TclVerifyLocalLiteralTable _ANSI_ARGS_((
*/
/*
+ * 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.
+ */
+
+#define TclRegisterNewLiteral(envPtr, bytes, length) \
+ TclRegisterLiteral(envPtr, (char *)(bytes), length, /*onHeap*/ 0)
+
+/*
+ * 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 updated.
+ */
+
+#define TclUpdateStackReqs(op, i, envPtr) \
+ {\
+ int delta = tclInstructionTable[(op)].stackEffect;\
+ if (delta) {\
+ if (delta < 0) {\
+ if((envPtr)->maxStackDepth < (envPtr)->currStackDepth) {\
+ (envPtr)->maxStackDepth = (envPtr)->currStackDepth;\
+ }\
+ if (delta == INT_MIN) {\
+ delta = 1 - (i);\
+ }\
+ }\
+ (envPtr)->currStackDepth += delta;\
+ }\
+ }
+
+/*
* Macro to emit an opcode byte into a CompileEnv's code array.
* The ANSI C "prototype" for this macro is:
*
@@ -820,7 +872,8 @@ EXTERN void TclVerifyLocalLiteralTable _ANSI_ARGS_((
#define TclEmitOpcode(op, envPtr) \
if ((envPtr)->codeNext == (envPtr)->codeEnd) \
TclExpandCodeArray(envPtr); \
- *(envPtr)->codeNext++ = (unsigned char) (op)
+ *(envPtr)->codeNext++ = (unsigned char) (op);\
+ TclUpdateStackReqs(op, 0, envPtr)
/*
* Macro to emit an integer operand.
@@ -846,12 +899,14 @@ EXTERN void TclVerifyLocalLiteralTable _ANSI_ARGS_((
* 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))
+ *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i));\
+ TclUpdateStackReqs(op, i, envPtr)
#define TclEmitInstInt4(op, i, envPtr) \
if (((envPtr)->codeNext + 5) > (envPtr)->codeEnd) { \
@@ -865,7 +920,8 @@ EXTERN void TclVerifyLocalLiteralTable _ANSI_ARGS_((
*(envPtr)->codeNext++ = \
(unsigned char) ((unsigned int) (i) >> 8); \
*(envPtr)->codeNext++ = \
- (unsigned char) ((unsigned int) (i) )
+ (unsigned char) ((unsigned int) (i) );\
+ TclUpdateStackReqs(op, i, envPtr)
/*
* Macro to push a Tcl object onto the Tcl evaluation stack. It emits the
@@ -877,10 +933,13 @@ EXTERN void TclVerifyLocalLiteralTable _ANSI_ARGS_((
*/
#define TclEmitPush(objIndex, envPtr) \
- if ((objIndex) <= 255) { \
- TclEmitInstInt1(INST_PUSH1, (objIndex), (envPtr)); \
- } else { \
- TclEmitInstInt4(INST_PUSH4, (objIndex), (envPtr)); \
+ {\
+ register int objIndexCopy = (objIndex);\
+ if (objIndexCopy <= 255) { \
+ TclEmitInstInt1(INST_PUSH1, objIndexCopy, (envPtr)); \
+ } else { \
+ TclEmitInstInt4(INST_PUSH4, objIndexCopy, (envPtr)); \
+ }\
}
/*
@@ -978,3 +1037,8 @@ EXTERN void TclVerifyLocalLiteralTable _ANSI_ARGS_((
# define TCL_STORAGE_CLASS DLLIMPORT
#endif /* _TCLCOMPILATION */
+
+
+
+
+
diff --git a/tcl/generic/tclDate.c b/tcl/generic/tclDate.c
index c7d01419618..9b87542c25c 100644
--- a/tcl/generic/tclDate.c
+++ b/tcl/generic/tclDate.c
@@ -16,7 +16,7 @@
#include "tclInt.h"
#include "tclPort.h"
-#ifdef MAC_TCL
+#if defined(MAC_TCL) && !defined(TCL_MAC_USE_MSL_EPOCH)
# define EPOCH 1904
# define START_OF_TIME 1904
# define END_OF_TIME 2039
@@ -579,6 +579,23 @@ RelativeMonth(Start, RelMonth, TimePtr)
result = Convert(Month, (time_t) tm->tm_mday, Year,
(time_t) tm->tm_hour, (time_t) tm->tm_min, (time_t) tm->tm_sec,
MER24, DSTmaybe, &Julian);
+
+ /*
+ * The Julian time returned above is behind by one day, if "month"
+ * or "year" is used to specify relative time and the GMT flag is true.
+ * This problem occurs only when the current time is closer to
+ * midnight, the difference being not more than its time difference
+ * with GMT. For example, in US/Pacific time zone, the problem occurs
+ * whenever the current time is between midnight to 8:00am or 7:00amDST.
+ * See Bug# 413397 for more details and sample script.
+ * To resolve this bug, we simply add the number of seconds corresponding
+ * to timezone difference with GMT to Julian time, if GMT flag is true.
+ */
+
+ if (TclDateTimezone == 0) {
+ Julian += TclpGetTimeZone((unsigned long) Start) * 60L;
+ }
+
/*
* The following iteration takes into account the case were we jump
* into a "short month". Far example, "one month from Jan 31" will
@@ -1853,4 +1870,3 @@ case 55:{
goto TclDatestack; /* reset registers in driver code */
}
-
diff --git a/tcl/generic/tclDecls.h b/tcl/generic/tclDecls.h
index b231e49d59c..7af2597c099 100644
--- a/tcl/generic/tclDecls.h
+++ b/tcl/generic/tclDecls.h
@@ -27,15 +27,16 @@
*/
/* 0 */
-EXTERN int Tcl_PkgProvideEx _ANSI_ARGS_((Tcl_Interp * interp,
- char * name, char * version,
+EXTERN int Tcl_PkgProvideEx _ANSI_ARGS_((Tcl_Interp* interp,
+ CONST char* name, CONST char* version,
ClientData clientData));
/* 1 */
-EXTERN char * Tcl_PkgRequireEx _ANSI_ARGS_((Tcl_Interp * interp,
- char * name, char * version, int exact,
+EXTERN CONST84_RETURN char * Tcl_PkgRequireEx _ANSI_ARGS_((
+ Tcl_Interp * interp, CONST char * name,
+ CONST char * version, int exact,
ClientData * clientDataPtr));
/* 2 */
-EXTERN void Tcl_Panic _ANSI_ARGS_(TCL_VARARGS(char *,format));
+EXTERN void Tcl_Panic _ANSI_ARGS_(TCL_VARARGS(CONST char *,format));
/* 3 */
EXTERN char * Tcl_Alloc _ANSI_ARGS_((unsigned int size));
/* 4 */
@@ -45,13 +46,14 @@ EXTERN char * Tcl_Realloc _ANSI_ARGS_((char * ptr,
unsigned int size));
/* 6 */
EXTERN char * Tcl_DbCkalloc _ANSI_ARGS_((unsigned int size,
- char * file, int line));
+ CONST char * file, int line));
/* 7 */
-EXTERN int Tcl_DbCkfree _ANSI_ARGS_((char * ptr, char * file,
- int line));
+EXTERN int Tcl_DbCkfree _ANSI_ARGS_((char * ptr,
+ CONST char * file, int line));
/* 8 */
EXTERN char * Tcl_DbCkrealloc _ANSI_ARGS_((char * ptr,
- unsigned int size, char * file, int line));
+ unsigned int size, CONST char * file,
+ int line));
#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
/* 9 */
EXTERN void Tcl_CreateFileHandler _ANSI_ARGS_((int fd, int mask,
@@ -73,8 +75,8 @@ EXTERN int Tcl_AppendAllObjTypes _ANSI_ARGS_((
/* 15 */
EXTERN void Tcl_AppendStringsToObj _ANSI_ARGS_(TCL_VARARGS(Tcl_Obj *,objPtr));
/* 16 */
-EXTERN void Tcl_AppendToObj _ANSI_ARGS_((Tcl_Obj * objPtr,
- char * bytes, int length));
+EXTERN void Tcl_AppendToObj _ANSI_ARGS_((Tcl_Obj* objPtr,
+ CONST char* bytes, int length));
/* 17 */
EXTERN Tcl_Obj * Tcl_ConcatObj _ANSI_ARGS_((int objc,
Tcl_Obj *CONST objv[]));
@@ -83,41 +85,43 @@ EXTERN int Tcl_ConvertToType _ANSI_ARGS_((Tcl_Interp * interp,
Tcl_Obj * objPtr, Tcl_ObjType * typePtr));
/* 19 */
EXTERN void Tcl_DbDecrRefCount _ANSI_ARGS_((Tcl_Obj * objPtr,
- char * file, int line));
+ CONST char * file, int line));
/* 20 */
EXTERN void Tcl_DbIncrRefCount _ANSI_ARGS_((Tcl_Obj * objPtr,
- char * file, int line));
+ CONST char * file, int line));
/* 21 */
EXTERN int Tcl_DbIsShared _ANSI_ARGS_((Tcl_Obj * objPtr,
- char * file, int line));
+ CONST char * file, int line));
/* 22 */
EXTERN Tcl_Obj * Tcl_DbNewBooleanObj _ANSI_ARGS_((int boolValue,
- char * file, int line));
+ CONST char * file, int line));
/* 23 */
EXTERN Tcl_Obj * Tcl_DbNewByteArrayObj _ANSI_ARGS_((
- unsigned char * bytes, int length,
- char * file, int line));
+ CONST unsigned char * bytes, int length,
+ CONST char * file, int line));
/* 24 */
EXTERN Tcl_Obj * Tcl_DbNewDoubleObj _ANSI_ARGS_((double doubleValue,
- char * file, int line));
+ CONST char * file, int line));
/* 25 */
EXTERN Tcl_Obj * Tcl_DbNewListObj _ANSI_ARGS_((int objc,
- Tcl_Obj *CONST objv[], char * file, int line));
+ Tcl_Obj *CONST * objv, CONST char * file,
+ int line));
/* 26 */
EXTERN Tcl_Obj * Tcl_DbNewLongObj _ANSI_ARGS_((long longValue,
- char * file, int line));
+ CONST char * file, int line));
/* 27 */
-EXTERN Tcl_Obj * Tcl_DbNewObj _ANSI_ARGS_((char * file, int line));
+EXTERN Tcl_Obj * Tcl_DbNewObj _ANSI_ARGS_((CONST char * file,
+ int line));
/* 28 */
EXTERN Tcl_Obj * Tcl_DbNewStringObj _ANSI_ARGS_((CONST char * bytes,
- int length, char * file, int line));
+ int length, CONST char * file, int line));
/* 29 */
EXTERN Tcl_Obj * Tcl_DuplicateObj _ANSI_ARGS_((Tcl_Obj * objPtr));
/* 30 */
EXTERN void TclFreeObj _ANSI_ARGS_((Tcl_Obj * objPtr));
/* 31 */
EXTERN int Tcl_GetBoolean _ANSI_ARGS_((Tcl_Interp * interp,
- char * str, int * boolPtr));
+ CONST char * str, int * boolPtr));
/* 32 */
EXTERN int Tcl_GetBooleanFromObj _ANSI_ARGS_((
Tcl_Interp * interp, Tcl_Obj * objPtr,
@@ -127,18 +131,18 @@ EXTERN unsigned char * Tcl_GetByteArrayFromObj _ANSI_ARGS_((
Tcl_Obj * objPtr, int * lengthPtr));
/* 34 */
EXTERN int Tcl_GetDouble _ANSI_ARGS_((Tcl_Interp * interp,
- char * str, double * doublePtr));
+ CONST char * str, double * doublePtr));
/* 35 */
EXTERN int Tcl_GetDoubleFromObj _ANSI_ARGS_((
Tcl_Interp * interp, Tcl_Obj * objPtr,
double * doublePtr));
/* 36 */
EXTERN int Tcl_GetIndexFromObj _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj * objPtr, char ** tablePtr,
- char * msg, int flags, int * indexPtr));
+ Tcl_Obj * objPtr, CONST84 char ** tablePtr,
+ CONST char * msg, int flags, int * indexPtr));
/* 37 */
EXTERN int Tcl_GetInt _ANSI_ARGS_((Tcl_Interp * interp,
- char * str, int * intPtr));
+ CONST char * str, int * intPtr));
/* 38 */
EXTERN int Tcl_GetIntFromObj _ANSI_ARGS_((Tcl_Interp * interp,
Tcl_Obj * objPtr, int * intPtr));
@@ -146,7 +150,7 @@ EXTERN int Tcl_GetIntFromObj _ANSI_ARGS_((Tcl_Interp * interp,
EXTERN int Tcl_GetLongFromObj _ANSI_ARGS_((Tcl_Interp * interp,
Tcl_Obj * objPtr, long * longPtr));
/* 40 */
-EXTERN Tcl_ObjType * Tcl_GetObjType _ANSI_ARGS_((char * typeName));
+EXTERN Tcl_ObjType * Tcl_GetObjType _ANSI_ARGS_((CONST char * typeName));
/* 41 */
EXTERN char * Tcl_GetStringFromObj _ANSI_ARGS_((Tcl_Obj * objPtr,
int * lengthPtr));
@@ -171,7 +175,7 @@ EXTERN int Tcl_ListObjIndex _ANSI_ARGS_((Tcl_Interp * interp,
Tcl_Obj ** objPtrPtr));
/* 47 */
EXTERN int Tcl_ListObjLength _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj * listPtr, int * intPtr));
+ Tcl_Obj * listPtr, int * lengthPtr));
/* 48 */
EXTERN int Tcl_ListObjReplace _ANSI_ARGS_((Tcl_Interp * interp,
Tcl_Obj * listPtr, int first, int count,
@@ -180,7 +184,7 @@ EXTERN int Tcl_ListObjReplace _ANSI_ARGS_((Tcl_Interp * interp,
EXTERN Tcl_Obj * Tcl_NewBooleanObj _ANSI_ARGS_((int boolValue));
/* 50 */
EXTERN Tcl_Obj * Tcl_NewByteArrayObj _ANSI_ARGS_((
- unsigned char * bytes, int length));
+ CONST unsigned char* bytes, int length));
/* 51 */
EXTERN Tcl_Obj * Tcl_NewDoubleObj _ANSI_ARGS_((double doubleValue));
/* 52 */
@@ -203,7 +207,7 @@ EXTERN unsigned char * Tcl_SetByteArrayLength _ANSI_ARGS_((Tcl_Obj * objPtr,
int length));
/* 59 */
EXTERN void Tcl_SetByteArrayObj _ANSI_ARGS_((Tcl_Obj * objPtr,
- unsigned char * bytes, int length));
+ CONST unsigned char * bytes, int length));
/* 60 */
EXTERN void Tcl_SetDoubleObj _ANSI_ARGS_((Tcl_Obj * objPtr,
double doubleValue));
@@ -220,8 +224,8 @@ EXTERN void Tcl_SetLongObj _ANSI_ARGS_((Tcl_Obj * objPtr,
EXTERN void Tcl_SetObjLength _ANSI_ARGS_((Tcl_Obj * objPtr,
int length));
/* 65 */
-EXTERN void Tcl_SetStringObj _ANSI_ARGS_((Tcl_Obj * objPtr,
- char * bytes, int length));
+EXTERN void Tcl_SetStringObj _ANSI_ARGS_((Tcl_Obj* objPtr,
+ CONST char* bytes, int length));
/* 66 */
EXTERN void Tcl_AddErrorInfo _ANSI_ARGS_((Tcl_Interp * interp,
CONST char * message));
@@ -254,8 +258,8 @@ EXTERN char Tcl_Backslash _ANSI_ARGS_((CONST char * src,
int * readPtr));
/* 78 */
EXTERN int Tcl_BadChannelOption _ANSI_ARGS_((
- Tcl_Interp * interp, char * optionName,
- char * optionList));
+ Tcl_Interp * interp, CONST char * optionName,
+ CONST char * optionList));
/* 79 */
EXTERN void Tcl_CallWhenDeleted _ANSI_ARGS_((Tcl_Interp * interp,
Tcl_InterpDeleteProc * proc,
@@ -268,9 +272,10 @@ EXTERN void Tcl_CancelIdleCall _ANSI_ARGS_((
EXTERN int Tcl_Close _ANSI_ARGS_((Tcl_Interp * interp,
Tcl_Channel chan));
/* 82 */
-EXTERN int Tcl_CommandComplete _ANSI_ARGS_((char * cmd));
+EXTERN int Tcl_CommandComplete _ANSI_ARGS_((CONST char * cmd));
/* 83 */
-EXTERN char * Tcl_Concat _ANSI_ARGS_((int argc, char ** argv));
+EXTERN char * Tcl_Concat _ANSI_ARGS_((int argc,
+ CONST84 char * CONST * argv));
/* 84 */
EXTERN int Tcl_ConvertElement _ANSI_ARGS_((CONST char * src,
char * dst, int flags));
@@ -280,16 +285,18 @@ EXTERN int Tcl_ConvertCountedElement _ANSI_ARGS_((
int flags));
/* 86 */
EXTERN int Tcl_CreateAlias _ANSI_ARGS_((Tcl_Interp * slave,
- char * slaveCmd, Tcl_Interp * target,
- char * targetCmd, int argc, char ** argv));
+ 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,
- char * slaveCmd, Tcl_Interp * target,
- char * targetCmd, int objc,
+ 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, char * chanName,
+ Tcl_ChannelType * typePtr,
+ CONST char * chanName,
ClientData instanceData, int mask));
/* 89 */
EXTERN void Tcl_CreateChannelHandler _ANSI_ARGS_((
@@ -301,7 +308,7 @@ EXTERN void Tcl_CreateCloseHandler _ANSI_ARGS_((Tcl_Channel chan,
Tcl_CloseProc * proc, ClientData clientData));
/* 91 */
EXTERN Tcl_Command Tcl_CreateCommand _ANSI_ARGS_((Tcl_Interp * interp,
- char * cmdName, Tcl_CmdProc * proc,
+ CONST char * cmdName, Tcl_CmdProc * proc,
ClientData clientData,
Tcl_CmdDeleteProc * deleteProc));
/* 92 */
@@ -316,17 +323,17 @@ EXTERN void Tcl_CreateExitHandler _ANSI_ARGS_((
EXTERN Tcl_Interp * Tcl_CreateInterp _ANSI_ARGS_((void));
/* 95 */
EXTERN void Tcl_CreateMathFunc _ANSI_ARGS_((Tcl_Interp * interp,
- char * name, int numArgs,
+ CONST char * name, int numArgs,
Tcl_ValueType * argTypes,
Tcl_MathProc * proc, ClientData clientData));
/* 96 */
EXTERN Tcl_Command Tcl_CreateObjCommand _ANSI_ARGS_((
- Tcl_Interp * interp, char * cmdName,
+ 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,
- char * slaveName, int isSafe));
+ CONST char * slaveName, int isSafe));
/* 98 */
EXTERN Tcl_TimerToken Tcl_CreateTimerHandler _ANSI_ARGS_((int milliseconds,
Tcl_TimerProc * proc, ClientData clientData));
@@ -336,7 +343,7 @@ EXTERN Tcl_Trace Tcl_CreateTrace _ANSI_ARGS_((Tcl_Interp * interp,
ClientData clientData));
/* 100 */
EXTERN void Tcl_DeleteAssocData _ANSI_ARGS_((Tcl_Interp * interp,
- char * name));
+ CONST char * name));
/* 101 */
EXTERN void Tcl_DeleteChannelHandler _ANSI_ARGS_((
Tcl_Channel chan, Tcl_ChannelProc * proc,
@@ -346,7 +353,7 @@ EXTERN void Tcl_DeleteCloseHandler _ANSI_ARGS_((Tcl_Channel chan,
Tcl_CloseProc * proc, ClientData clientData));
/* 103 */
EXTERN int Tcl_DeleteCommand _ANSI_ARGS_((Tcl_Interp * interp,
- char * cmdName));
+ CONST char * cmdName));
/* 104 */
EXTERN int Tcl_DeleteCommandFromToken _ANSI_ARGS_((
Tcl_Interp * interp, Tcl_Command command));
@@ -424,15 +431,15 @@ EXTERN void Tcl_DStringStartSublist _ANSI_ARGS_((
/* 126 */
EXTERN int Tcl_Eof _ANSI_ARGS_((Tcl_Channel chan));
/* 127 */
-EXTERN char * Tcl_ErrnoId _ANSI_ARGS_((void));
+EXTERN CONST84_RETURN char * Tcl_ErrnoId _ANSI_ARGS_((void));
/* 128 */
-EXTERN char * Tcl_ErrnoMsg _ANSI_ARGS_((int err));
+EXTERN CONST84_RETURN char * Tcl_ErrnoMsg _ANSI_ARGS_((int err));
/* 129 */
EXTERN int Tcl_Eval _ANSI_ARGS_((Tcl_Interp * interp,
- char * string));
+ CONST char * string));
/* 130 */
EXTERN int Tcl_EvalFile _ANSI_ARGS_((Tcl_Interp * interp,
- char * fileName));
+ CONST char * fileName));
/* 131 */
EXTERN int Tcl_EvalObj _ANSI_ARGS_((Tcl_Interp * interp,
Tcl_Obj * objPtr));
@@ -444,22 +451,23 @@ EXTERN void Tcl_EventuallyFree _ANSI_ARGS_((
EXTERN void Tcl_Exit _ANSI_ARGS_((int status));
/* 134 */
EXTERN int Tcl_ExposeCommand _ANSI_ARGS_((Tcl_Interp * interp,
- char * hiddenCmdToken, char * cmdName));
+ CONST char * hiddenCmdToken,
+ CONST char * cmdName));
/* 135 */
EXTERN int Tcl_ExprBoolean _ANSI_ARGS_((Tcl_Interp * interp,
- char * str, int * ptr));
+ CONST char * str, int * ptr));
/* 136 */
EXTERN int Tcl_ExprBooleanObj _ANSI_ARGS_((Tcl_Interp * interp,
Tcl_Obj * objPtr, int * ptr));
/* 137 */
EXTERN int Tcl_ExprDouble _ANSI_ARGS_((Tcl_Interp * interp,
- char * str, double * ptr));
+ CONST char * str, double * ptr));
/* 138 */
EXTERN int Tcl_ExprDoubleObj _ANSI_ARGS_((Tcl_Interp * interp,
Tcl_Obj * objPtr, double * ptr));
/* 139 */
EXTERN int Tcl_ExprLong _ANSI_ARGS_((Tcl_Interp * interp,
- char * str, long * ptr));
+ CONST char * str, long * ptr));
/* 140 */
EXTERN int Tcl_ExprLongObj _ANSI_ARGS_((Tcl_Interp * interp,
Tcl_Obj * objPtr, long * ptr));
@@ -468,7 +476,7 @@ EXTERN int Tcl_ExprObj _ANSI_ARGS_((Tcl_Interp * interp,
Tcl_Obj * objPtr, Tcl_Obj ** resultPtrPtr));
/* 142 */
EXTERN int Tcl_ExprString _ANSI_ARGS_((Tcl_Interp * interp,
- char * string));
+ CONST char * string));
/* 143 */
EXTERN void Tcl_Finalize _ANSI_ARGS_((void));
/* 144 */
@@ -483,22 +491,23 @@ EXTERN int Tcl_Flush _ANSI_ARGS_((Tcl_Channel chan));
EXTERN void Tcl_FreeResult _ANSI_ARGS_((Tcl_Interp * interp));
/* 148 */
EXTERN int Tcl_GetAlias _ANSI_ARGS_((Tcl_Interp * interp,
- char * slaveCmd,
+ CONST char * slaveCmd,
Tcl_Interp ** targetInterpPtr,
- char ** targetCmdPtr, int * argcPtr,
- char *** argvPtr));
+ CONST84 char ** targetCmdPtr, int * argcPtr,
+ CONST84 char *** argvPtr));
/* 149 */
EXTERN int Tcl_GetAliasObj _ANSI_ARGS_((Tcl_Interp * interp,
- char * slaveCmd,
+ CONST char * slaveCmd,
Tcl_Interp ** targetInterpPtr,
- char ** targetCmdPtr, int * objcPtr,
+ CONST84 char ** targetCmdPtr, int * objcPtr,
Tcl_Obj *** objv));
/* 150 */
EXTERN ClientData Tcl_GetAssocData _ANSI_ARGS_((Tcl_Interp * interp,
- char * name, Tcl_InterpDeleteProc ** procPtr));
+ CONST char * name,
+ Tcl_InterpDeleteProc ** procPtr));
/* 151 */
EXTERN Tcl_Channel Tcl_GetChannel _ANSI_ARGS_((Tcl_Interp * interp,
- char * chanName, int * modePtr));
+ CONST char * chanName, int * modePtr));
/* 152 */
EXTERN int Tcl_GetChannelBufferSize _ANSI_ARGS_((
Tcl_Channel chan));
@@ -511,23 +520,24 @@ EXTERN ClientData Tcl_GetChannelInstanceData _ANSI_ARGS_((
/* 155 */
EXTERN int Tcl_GetChannelMode _ANSI_ARGS_((Tcl_Channel chan));
/* 156 */
-EXTERN char * Tcl_GetChannelName _ANSI_ARGS_((Tcl_Channel chan));
+EXTERN CONST84_RETURN char * Tcl_GetChannelName _ANSI_ARGS_((
+ Tcl_Channel chan));
/* 157 */
EXTERN int Tcl_GetChannelOption _ANSI_ARGS_((
Tcl_Interp * interp, Tcl_Channel chan,
- char * optionName, Tcl_DString * dsPtr));
+ CONST char * optionName, Tcl_DString * dsPtr));
/* 158 */
EXTERN Tcl_ChannelType * Tcl_GetChannelType _ANSI_ARGS_((Tcl_Channel chan));
/* 159 */
EXTERN int Tcl_GetCommandInfo _ANSI_ARGS_((Tcl_Interp * interp,
- char * cmdName, Tcl_CmdInfo * infoPtr));
+ CONST char * cmdName, Tcl_CmdInfo * infoPtr));
/* 160 */
-EXTERN char * Tcl_GetCommandName _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Command command));
+EXTERN CONST84_RETURN char * Tcl_GetCommandName _ANSI_ARGS_((
+ Tcl_Interp * interp, Tcl_Command command));
/* 161 */
EXTERN int Tcl_GetErrno _ANSI_ARGS_((void));
/* 162 */
-EXTERN char * Tcl_GetHostName _ANSI_ARGS_((void));
+EXTERN CONST84_RETURN char * Tcl_GetHostName _ANSI_ARGS_((void));
/* 163 */
EXTERN int Tcl_GetInterpPath _ANSI_ARGS_((
Tcl_Interp * askInterp,
@@ -541,11 +551,11 @@ EXTERN Tcl_Obj * Tcl_GetObjResult _ANSI_ARGS_((Tcl_Interp * interp));
#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
/* 167 */
EXTERN int Tcl_GetOpenFile _ANSI_ARGS_((Tcl_Interp * interp,
- char * str, int forWriting, int checkUsage,
- ClientData * filePtr));
+ CONST char * str, int forWriting,
+ int checkUsage, ClientData * filePtr));
#endif /* UNIX */
/* 168 */
-EXTERN Tcl_PathType Tcl_GetPathType _ANSI_ARGS_((char * path));
+EXTERN Tcl_PathType Tcl_GetPathType _ANSI_ARGS_((CONST char * path));
/* 169 */
EXTERN int Tcl_Gets _ANSI_ARGS_((Tcl_Channel chan,
Tcl_DString * dsPtr));
@@ -556,26 +566,29 @@ EXTERN int Tcl_GetsObj _ANSI_ARGS_((Tcl_Channel chan,
EXTERN int Tcl_GetServiceMode _ANSI_ARGS_((void));
/* 172 */
EXTERN Tcl_Interp * Tcl_GetSlave _ANSI_ARGS_((Tcl_Interp * interp,
- char * slaveName));
+ CONST char * slaveName));
/* 173 */
EXTERN Tcl_Channel Tcl_GetStdChannel _ANSI_ARGS_((int type));
/* 174 */
-EXTERN char * Tcl_GetStringResult _ANSI_ARGS_((Tcl_Interp * interp));
+EXTERN CONST84_RETURN char * Tcl_GetStringResult _ANSI_ARGS_((
+ Tcl_Interp * interp));
/* 175 */
-EXTERN char * Tcl_GetVar _ANSI_ARGS_((Tcl_Interp * interp,
- char * varName, int flags));
+EXTERN CONST84_RETURN char * Tcl_GetVar _ANSI_ARGS_((Tcl_Interp * interp,
+ CONST char * varName, int flags));
/* 176 */
-EXTERN char * Tcl_GetVar2 _ANSI_ARGS_((Tcl_Interp * interp,
- char * part1, char * part2, int flags));
+EXTERN CONST84_RETURN char * Tcl_GetVar2 _ANSI_ARGS_((Tcl_Interp * interp,
+ CONST char * part1, CONST char * part2,
+ int flags));
/* 177 */
EXTERN int Tcl_GlobalEval _ANSI_ARGS_((Tcl_Interp * interp,
- char * command));
+ CONST char * command));
/* 178 */
EXTERN int Tcl_GlobalEvalObj _ANSI_ARGS_((Tcl_Interp * interp,
Tcl_Obj * objPtr));
/* 179 */
EXTERN int Tcl_HideCommand _ANSI_ARGS_((Tcl_Interp * interp,
- char * cmdName, char * hiddenCmdToken));
+ CONST char * cmdName,
+ CONST char * hiddenCmdToken));
/* 180 */
EXTERN int Tcl_Init _ANSI_ARGS_((Tcl_Interp * interp));
/* 181 */
@@ -590,11 +603,12 @@ EXTERN int Tcl_InterpDeleted _ANSI_ARGS_((Tcl_Interp * interp));
/* 185 */
EXTERN int Tcl_IsSafe _ANSI_ARGS_((Tcl_Interp * interp));
/* 186 */
-EXTERN char * Tcl_JoinPath _ANSI_ARGS_((int argc, char ** argv,
+EXTERN char * Tcl_JoinPath _ANSI_ARGS_((int argc,
+ CONST84 char * CONST * argv,
Tcl_DString * resultPtr));
/* 187 */
EXTERN int Tcl_LinkVar _ANSI_ARGS_((Tcl_Interp * interp,
- char * varName, char * addr, int type));
+ CONST char * varName, char * addr, int type));
/* Slot 188 is reserved */
/* 189 */
EXTERN Tcl_Channel Tcl_MakeFileChannel _ANSI_ARGS_((ClientData handle,
@@ -605,7 +619,8 @@ EXTERN int Tcl_MakeSafe _ANSI_ARGS_((Tcl_Interp * interp));
EXTERN Tcl_Channel Tcl_MakeTcpClientChannel _ANSI_ARGS_((
ClientData tcpSocket));
/* 192 */
-EXTERN char * Tcl_Merge _ANSI_ARGS_((int argc, char ** argv));
+EXTERN char * Tcl_Merge _ANSI_ARGS_((int argc,
+ CONST84 char * CONST * argv));
/* 193 */
EXTERN Tcl_HashEntry * Tcl_NextHashEntry _ANSI_ARGS_((
Tcl_HashSearch * searchPtr));
@@ -623,26 +638,26 @@ EXTERN Tcl_Obj * Tcl_ObjSetVar2 _ANSI_ARGS_((Tcl_Interp * interp,
#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
/* 197 */
EXTERN Tcl_Channel Tcl_OpenCommandChannel _ANSI_ARGS_((
- Tcl_Interp * interp, int argc, char ** argv,
- int flags));
+ Tcl_Interp * interp, int argc,
+ CONST84 char ** argv, int flags));
#endif /* UNIX */
#ifdef __WIN32__
/* 197 */
EXTERN Tcl_Channel Tcl_OpenCommandChannel _ANSI_ARGS_((
- Tcl_Interp * interp, int argc, char ** argv,
- int flags));
+ Tcl_Interp * interp, int argc,
+ CONST84 char ** argv, int flags));
#endif /* __WIN32__ */
/* 198 */
EXTERN Tcl_Channel Tcl_OpenFileChannel _ANSI_ARGS_((Tcl_Interp * interp,
- char * fileName, char * modeString,
- int permissions));
+ CONST char * fileName,
+ CONST char * modeString, int permissions));
/* 199 */
EXTERN Tcl_Channel Tcl_OpenTcpClient _ANSI_ARGS_((Tcl_Interp * interp,
- int port, char * address, char * myaddr,
- int myport, int async));
+ 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, char * host,
+ int port, CONST char * host,
Tcl_TcpAcceptProc * acceptProc,
ClientData callbackData));
/* 201 */
@@ -653,7 +668,7 @@ EXTERN void Tcl_PrintDouble _ANSI_ARGS_((Tcl_Interp * interp,
/* 203 */
EXTERN int Tcl_PutEnv _ANSI_ARGS_((CONST char * string));
/* 204 */
-EXTERN char * Tcl_PosixError _ANSI_ARGS_((Tcl_Interp * interp));
+EXTERN CONST84_RETURN char * Tcl_PosixError _ANSI_ARGS_((Tcl_Interp * interp));
/* 205 */
EXTERN void Tcl_QueueEvent _ANSI_ARGS_((Tcl_Event * evPtr,
Tcl_QueuePosition position));
@@ -670,7 +685,7 @@ EXTERN void Tcl_ReapDetachedProcs _ANSI_ARGS_((void));
#endif /* __WIN32__ */
/* 208 */
EXTERN int Tcl_RecordAndEval _ANSI_ARGS_((Tcl_Interp * interp,
- char * cmd, int flags));
+ CONST char * cmd, int flags));
/* 209 */
EXTERN int Tcl_RecordAndEvalObj _ANSI_ARGS_((
Tcl_Interp * interp, Tcl_Obj * cmdPtr,
@@ -683,17 +698,18 @@ EXTERN void Tcl_RegisterObjType _ANSI_ARGS_((
Tcl_ObjType * typePtr));
/* 212 */
EXTERN Tcl_RegExp Tcl_RegExpCompile _ANSI_ARGS_((Tcl_Interp * interp,
- char * string));
+ CONST char * string));
/* 213 */
EXTERN int Tcl_RegExpExec _ANSI_ARGS_((Tcl_Interp * interp,
Tcl_RegExp regexp, CONST char * str,
CONST char * start));
/* 214 */
EXTERN int Tcl_RegExpMatch _ANSI_ARGS_((Tcl_Interp * interp,
- char * str, char * pattern));
+ CONST char * str, CONST char * pattern));
/* 215 */
EXTERN void Tcl_RegExpRange _ANSI_ARGS_((Tcl_RegExp regexp,
- int index, char ** startPtr, char ** endPtr));
+ int index, CONST84 char ** startPtr,
+ CONST84 char ** endPtr));
/* 216 */
EXTERN void Tcl_Release _ANSI_ARGS_((ClientData clientData));
/* 217 */
@@ -705,15 +721,16 @@ EXTERN int Tcl_ScanElement _ANSI_ARGS_((CONST char * str,
EXTERN int Tcl_ScanCountedElement _ANSI_ARGS_((CONST char * str,
int length, int * flagPtr));
/* 220 */
-EXTERN int Tcl_Seek _ANSI_ARGS_((Tcl_Channel chan, int offset,
- int mode));
+EXTERN int Tcl_SeekOld _ANSI_ARGS_((Tcl_Channel chan,
+ int offset, int mode));
/* 221 */
EXTERN int Tcl_ServiceAll _ANSI_ARGS_((void));
/* 222 */
EXTERN int Tcl_ServiceEvent _ANSI_ARGS_((int flags));
/* 223 */
EXTERN void Tcl_SetAssocData _ANSI_ARGS_((Tcl_Interp * interp,
- char * name, Tcl_InterpDeleteProc * proc,
+ CONST char * name,
+ Tcl_InterpDeleteProc * proc,
ClientData clientData));
/* 224 */
EXTERN void Tcl_SetChannelBufferSize _ANSI_ARGS_((
@@ -721,10 +738,12 @@ EXTERN void Tcl_SetChannelBufferSize _ANSI_ARGS_((
/* 225 */
EXTERN int Tcl_SetChannelOption _ANSI_ARGS_((
Tcl_Interp * interp, Tcl_Channel chan,
- char * optionName, char * newValue));
+ CONST char * optionName,
+ CONST char * newValue));
/* 226 */
EXTERN int Tcl_SetCommandInfo _ANSI_ARGS_((Tcl_Interp * interp,
- char * cmdName, Tcl_CmdInfo * infoPtr));
+ CONST char * cmdName,
+ CONST Tcl_CmdInfo * infoPtr));
/* 227 */
EXTERN void Tcl_SetErrno _ANSI_ARGS_((int err));
/* 228 */
@@ -752,108 +771,112 @@ EXTERN void Tcl_SetObjResult _ANSI_ARGS_((Tcl_Interp * interp,
EXTERN void Tcl_SetStdChannel _ANSI_ARGS_((Tcl_Channel channel,
int type));
/* 237 */
-EXTERN char * Tcl_SetVar _ANSI_ARGS_((Tcl_Interp * interp,
- char * varName, char * newValue, int flags));
-/* 238 */
-EXTERN char * Tcl_SetVar2 _ANSI_ARGS_((Tcl_Interp * interp,
- char * part1, char * part2, char * newValue,
+EXTERN CONST84_RETURN char * Tcl_SetVar _ANSI_ARGS_((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));
/* 239 */
-EXTERN char * Tcl_SignalId _ANSI_ARGS_((int sig));
+EXTERN CONST84_RETURN char * Tcl_SignalId _ANSI_ARGS_((int sig));
/* 240 */
-EXTERN char * Tcl_SignalMsg _ANSI_ARGS_((int sig));
+EXTERN CONST84_RETURN char * Tcl_SignalMsg _ANSI_ARGS_((int sig));
/* 241 */
EXTERN void Tcl_SourceRCFile _ANSI_ARGS_((Tcl_Interp * interp));
/* 242 */
EXTERN int Tcl_SplitList _ANSI_ARGS_((Tcl_Interp * interp,
CONST char * listStr, int * argcPtr,
- char *** argvPtr));
+ CONST84 char *** argvPtr));
/* 243 */
EXTERN void Tcl_SplitPath _ANSI_ARGS_((CONST char * path,
- int * argcPtr, char *** argvPtr));
+ int * argcPtr, CONST84 char *** argvPtr));
/* 244 */
EXTERN void Tcl_StaticPackage _ANSI_ARGS_((Tcl_Interp * interp,
- char * pkgName,
+ CONST char * pkgName,
Tcl_PackageInitProc * initProc,
Tcl_PackageInitProc * safeInitProc));
/* 245 */
EXTERN int Tcl_StringMatch _ANSI_ARGS_((CONST char * str,
CONST char * pattern));
/* 246 */
-EXTERN int Tcl_Tell _ANSI_ARGS_((Tcl_Channel chan));
+EXTERN int Tcl_TellOld _ANSI_ARGS_((Tcl_Channel chan));
/* 247 */
EXTERN int Tcl_TraceVar _ANSI_ARGS_((Tcl_Interp * interp,
- char * varName, int flags,
+ CONST char * varName, int flags,
Tcl_VarTraceProc * proc,
ClientData clientData));
/* 248 */
EXTERN int Tcl_TraceVar2 _ANSI_ARGS_((Tcl_Interp * interp,
- char * part1, char * part2, int flags,
- Tcl_VarTraceProc * proc,
+ CONST char * part1, CONST char * part2,
+ int flags, Tcl_VarTraceProc * proc,
ClientData clientData));
/* 249 */
EXTERN char * Tcl_TranslateFileName _ANSI_ARGS_((
- Tcl_Interp * interp, char * name,
+ Tcl_Interp * interp, CONST char * name,
Tcl_DString * bufferPtr));
/* 250 */
-EXTERN int Tcl_Ungets _ANSI_ARGS_((Tcl_Channel chan, char * str,
- int len, int atHead));
+EXTERN int Tcl_Ungets _ANSI_ARGS_((Tcl_Channel chan,
+ CONST char * str, int len, int atHead));
/* 251 */
EXTERN void Tcl_UnlinkVar _ANSI_ARGS_((Tcl_Interp * interp,
- char * varName));
+ CONST char * varName));
/* 252 */
EXTERN int Tcl_UnregisterChannel _ANSI_ARGS_((
Tcl_Interp * interp, Tcl_Channel chan));
/* 253 */
EXTERN int Tcl_UnsetVar _ANSI_ARGS_((Tcl_Interp * interp,
- char * varName, int flags));
+ CONST char * varName, int flags));
/* 254 */
EXTERN int Tcl_UnsetVar2 _ANSI_ARGS_((Tcl_Interp * interp,
- char * part1, char * part2, int flags));
+ CONST char * part1, CONST char * part2,
+ int flags));
/* 255 */
EXTERN void Tcl_UntraceVar _ANSI_ARGS_((Tcl_Interp * interp,
- char * varName, int flags,
+ CONST char * varName, int flags,
Tcl_VarTraceProc * proc,
ClientData clientData));
/* 256 */
EXTERN void Tcl_UntraceVar2 _ANSI_ARGS_((Tcl_Interp * interp,
- char * part1, char * part2, int flags,
- Tcl_VarTraceProc * proc,
+ CONST char * part1, CONST char * part2,
+ int flags, Tcl_VarTraceProc * proc,
ClientData clientData));
/* 257 */
EXTERN void Tcl_UpdateLinkedVar _ANSI_ARGS_((Tcl_Interp * interp,
- char * varName));
+ CONST char * varName));
/* 258 */
EXTERN int Tcl_UpVar _ANSI_ARGS_((Tcl_Interp * interp,
- char * frameName, char * varName,
- char * localName, int flags));
+ CONST char * frameName, CONST char * varName,
+ CONST char * localName, int flags));
/* 259 */
EXTERN int Tcl_UpVar2 _ANSI_ARGS_((Tcl_Interp * interp,
- char * frameName, char * part1, char * part2,
- char * localName, int flags));
+ CONST char * frameName, CONST char * part1,
+ CONST char * part2, CONST char * localName,
+ int flags));
/* 260 */
EXTERN int Tcl_VarEval _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp));
/* 261 */
EXTERN ClientData Tcl_VarTraceInfo _ANSI_ARGS_((Tcl_Interp * interp,
- char * varName, int flags,
+ CONST char * varName, int flags,
Tcl_VarTraceProc * procPtr,
ClientData prevClientData));
/* 262 */
EXTERN ClientData Tcl_VarTraceInfo2 _ANSI_ARGS_((Tcl_Interp * interp,
- char * part1, char * part2, int flags,
- Tcl_VarTraceProc * procPtr,
+ CONST char * part1, CONST char * part2,
+ int flags, Tcl_VarTraceProc * procPtr,
ClientData prevClientData));
/* 263 */
-EXTERN int Tcl_Write _ANSI_ARGS_((Tcl_Channel chan, char * s,
- int slen));
+EXTERN int Tcl_Write _ANSI_ARGS_((Tcl_Channel chan,
+ CONST char * s, int slen));
/* 264 */
EXTERN void Tcl_WrongNumArgs _ANSI_ARGS_((Tcl_Interp * interp,
int objc, Tcl_Obj *CONST objv[],
- char * message));
+ CONST char * message));
/* 265 */
-EXTERN int Tcl_DumpActiveMemory _ANSI_ARGS_((char * fileName));
+EXTERN int Tcl_DumpActiveMemory _ANSI_ARGS_((
+ CONST char * fileName));
/* 266 */
-EXTERN void Tcl_ValidateAllMemory _ANSI_ARGS_((char * file,
+EXTERN void Tcl_ValidateAllMemory _ANSI_ARGS_((CONST char * file,
int line));
/* 267 */
EXTERN void Tcl_AppendResultVA _ANSI_ARGS_((Tcl_Interp * interp,
@@ -862,23 +885,27 @@ EXTERN void Tcl_AppendResultVA _ANSI_ARGS_((Tcl_Interp * interp,
EXTERN void Tcl_AppendStringsToObjVA _ANSI_ARGS_((
Tcl_Obj * objPtr, va_list argList));
/* 269 */
-EXTERN char * Tcl_HashStats _ANSI_ARGS_((Tcl_HashTable * tablePtr));
+EXTERN CONST84_RETURN char * Tcl_HashStats _ANSI_ARGS_((
+ Tcl_HashTable * tablePtr));
/* 270 */
-EXTERN char * Tcl_ParseVar _ANSI_ARGS_((Tcl_Interp * interp,
- char * str, char ** termPtr));
+EXTERN CONST84_RETURN char * Tcl_ParseVar _ANSI_ARGS_((Tcl_Interp * interp,
+ CONST char * str, CONST84 char ** termPtr));
/* 271 */
-EXTERN char * Tcl_PkgPresent _ANSI_ARGS_((Tcl_Interp * interp,
- char * name, char * version, int exact));
+EXTERN CONST84_RETURN char * Tcl_PkgPresent _ANSI_ARGS_((Tcl_Interp * interp,
+ CONST char * name, CONST char * version,
+ int exact));
/* 272 */
-EXTERN char * Tcl_PkgPresentEx _ANSI_ARGS_((Tcl_Interp * interp,
- char * name, char * version, int exact,
+EXTERN CONST84_RETURN char * Tcl_PkgPresentEx _ANSI_ARGS_((
+ Tcl_Interp * interp, CONST char * name,
+ CONST char * version, int exact,
ClientData * clientDataPtr));
/* 273 */
EXTERN int Tcl_PkgProvide _ANSI_ARGS_((Tcl_Interp * interp,
- char * name, char * version));
+ CONST char * name, CONST char * version));
/* 274 */
-EXTERN char * Tcl_PkgRequire _ANSI_ARGS_((Tcl_Interp * interp,
- char * name, char * version, int exact));
+EXTERN CONST84_RETURN char * Tcl_PkgRequire _ANSI_ARGS_((Tcl_Interp * interp,
+ CONST char * name, CONST char * version,
+ int exact));
/* 275 */
EXTERN void Tcl_SetErrorCodeVA _ANSI_ARGS_((Tcl_Interp * interp,
va_list argList));
@@ -888,16 +915,9 @@ EXTERN int Tcl_VarEvalVA _ANSI_ARGS_((Tcl_Interp * interp,
/* 277 */
EXTERN Tcl_Pid Tcl_WaitPid _ANSI_ARGS_((Tcl_Pid pid, int * statPtr,
int options));
-#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
-/* 278 */
-EXTERN void Tcl_PanicVA _ANSI_ARGS_((char * format,
- va_list argList));
-#endif /* UNIX */
-#ifdef __WIN32__
/* 278 */
-EXTERN void Tcl_PanicVA _ANSI_ARGS_((char * format,
+EXTERN void Tcl_PanicVA _ANSI_ARGS_((CONST char * format,
va_list argList));
-#endif /* __WIN32__ */
/* 279 */
EXTERN void Tcl_GetVersion _ANSI_ARGS_((int * major, int * minor,
int * patchLevel, int * type));
@@ -913,7 +933,8 @@ EXTERN int Tcl_UnstackChannel _ANSI_ARGS_((Tcl_Interp * interp,
Tcl_Channel chan));
/* 283 */
EXTERN Tcl_Channel Tcl_GetStackedChannel _ANSI_ARGS_((Tcl_Channel chan));
-/* Slot 284 is reserved */
+/* 284 */
+EXTERN void Tcl_SetMainLoop _ANSI_ARGS_((Tcl_MainLoopProc * proc));
/* Slot 285 is reserved */
/* 286 */
EXTERN void Tcl_AppendObjToObj _ANSI_ARGS_((Tcl_Obj * objPtr,
@@ -932,7 +953,7 @@ EXTERN void Tcl_DiscardResult _ANSI_ARGS_((
Tcl_SavedResult * statePtr));
/* 291 */
EXTERN int Tcl_EvalEx _ANSI_ARGS_((Tcl_Interp * interp,
- char * script, int numBytes, int flags));
+ 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));
@@ -965,7 +986,7 @@ EXTERN Tcl_ThreadId Tcl_GetCurrentThread _ANSI_ARGS_((void));
EXTERN Tcl_Encoding Tcl_GetEncoding _ANSI_ARGS_((Tcl_Interp * interp,
CONST char * name));
/* 302 */
-EXTERN char * Tcl_GetEncodingName _ANSI_ARGS_((
+EXTERN CONST84_RETURN char * Tcl_GetEncodingName _ANSI_ARGS_((
Tcl_Encoding encoding));
/* 303 */
EXTERN void Tcl_GetEncodingNames _ANSI_ARGS_((
@@ -973,14 +994,15 @@ EXTERN void Tcl_GetEncodingNames _ANSI_ARGS_((
/* 304 */
EXTERN int Tcl_GetIndexFromObjStruct _ANSI_ARGS_((
Tcl_Interp * interp, Tcl_Obj * objPtr,
- char ** tablePtr, int offset, char * msg,
- int flags, int * indexPtr));
+ CONST VOID * tablePtr, int offset,
+ CONST char * msg, int flags, int * indexPtr));
/* 305 */
EXTERN VOID * Tcl_GetThreadData _ANSI_ARGS_((
Tcl_ThreadDataKey * keyPtr, int size));
/* 306 */
EXTERN Tcl_Obj * Tcl_GetVar2Ex _ANSI_ARGS_((Tcl_Interp * interp,
- char * part1, char * part2, int flags));
+ CONST char * part1, CONST char * part2,
+ int flags));
/* 307 */
EXTERN ClientData Tcl_InitNotifier _ANSI_ARGS_((void));
/* 308 */
@@ -1012,7 +1034,7 @@ EXTERN int Tcl_SetSystemEncoding _ANSI_ARGS_((
Tcl_Interp * interp, CONST char * name));
/* 317 */
EXTERN Tcl_Obj * Tcl_SetVar2Ex _ANSI_ARGS_((Tcl_Interp * interp,
- char * part1, char * part2,
+ CONST char * part1, CONST char * part2,
Tcl_Obj * newValuePtr, int flags));
/* 318 */
EXTERN void Tcl_ThreadAlert _ANSI_ARGS_((Tcl_ThreadId threadId));
@@ -1032,7 +1054,7 @@ EXTERN Tcl_UniChar Tcl_UniCharToUpper _ANSI_ARGS_((int ch));
/* 324 */
EXTERN int Tcl_UniCharToUtf _ANSI_ARGS_((int ch, char * buf));
/* 325 */
-EXTERN char * Tcl_UtfAtIndex _ANSI_ARGS_((CONST char * src,
+EXTERN CONST84_RETURN char * Tcl_UtfAtIndex _ANSI_ARGS_((CONST char * src,
int index));
/* 326 */
EXTERN int Tcl_UtfCharComplete _ANSI_ARGS_((CONST char * src,
@@ -1041,15 +1063,15 @@ EXTERN int Tcl_UtfCharComplete _ANSI_ARGS_((CONST char * src,
EXTERN int Tcl_UtfBackslash _ANSI_ARGS_((CONST char * src,
int * readPtr, char * dst));
/* 328 */
-EXTERN char * Tcl_UtfFindFirst _ANSI_ARGS_((CONST char * src,
+EXTERN CONST84_RETURN char * Tcl_UtfFindFirst _ANSI_ARGS_((CONST char * src,
int ch));
/* 329 */
-EXTERN char * Tcl_UtfFindLast _ANSI_ARGS_((CONST char * src,
+EXTERN CONST84_RETURN char * Tcl_UtfFindLast _ANSI_ARGS_((CONST char * src,
int ch));
/* 330 */
-EXTERN char * Tcl_UtfNext _ANSI_ARGS_((CONST char * src));
+EXTERN CONST84_RETURN char * Tcl_UtfNext _ANSI_ARGS_((CONST char * src));
/* 331 */
-EXTERN char * Tcl_UtfPrev _ANSI_ARGS_((CONST char * src,
+EXTERN CONST84_RETURN char * Tcl_UtfPrev _ANSI_ARGS_((CONST char * src,
CONST char * start));
/* 332 */
EXTERN int Tcl_UtfToExternal _ANSI_ARGS_((Tcl_Interp * interp,
@@ -1080,9 +1102,10 @@ EXTERN int Tcl_WriteObj _ANSI_ARGS_((Tcl_Channel chan,
/* 340 */
EXTERN char * Tcl_GetString _ANSI_ARGS_((Tcl_Obj * objPtr));
/* 341 */
-EXTERN char * Tcl_GetDefaultEncodingDir _ANSI_ARGS_((void));
+EXTERN CONST84_RETURN char * Tcl_GetDefaultEncodingDir _ANSI_ARGS_((void));
/* 342 */
-EXTERN void Tcl_SetDefaultEncodingDir _ANSI_ARGS_((char * path));
+EXTERN void Tcl_SetDefaultEncodingDir _ANSI_ARGS_((
+ CONST char * path));
/* 343 */
EXTERN void Tcl_AlertNotifier _ANSI_ARGS_((ClientData clientData));
/* 344 */
@@ -1102,7 +1125,7 @@ EXTERN int Tcl_UniCharIsUpper _ANSI_ARGS_((int ch));
/* 351 */
EXTERN int Tcl_UniCharIsWordChar _ANSI_ARGS_((int ch));
/* 352 */
-EXTERN int Tcl_UniCharLen _ANSI_ARGS_((Tcl_UniChar * str));
+EXTERN int Tcl_UniCharLen _ANSI_ARGS_((CONST Tcl_UniChar * str));
/* 353 */
EXTERN int Tcl_UniCharNcmp _ANSI_ARGS_((CONST Tcl_UniChar * cs,
CONST Tcl_UniChar * ct, unsigned long n));
@@ -1125,28 +1148,29 @@ EXTERN Tcl_Obj * Tcl_EvalTokens _ANSI_ARGS_((Tcl_Interp * interp,
EXTERN void Tcl_FreeParse _ANSI_ARGS_((Tcl_Parse * parsePtr));
/* 359 */
EXTERN void Tcl_LogCommandInfo _ANSI_ARGS_((Tcl_Interp * interp,
- char * script, char * command, int length));
+ CONST char * script, CONST char * command,
+ int length));
/* 360 */
EXTERN int Tcl_ParseBraces _ANSI_ARGS_((Tcl_Interp * interp,
- char * string, int numBytes,
+ CONST char * string, int numBytes,
Tcl_Parse * parsePtr, int append,
- char ** termPtr));
+ CONST84 char ** termPtr));
/* 361 */
EXTERN int Tcl_ParseCommand _ANSI_ARGS_((Tcl_Interp * interp,
- char * string, int numBytes, int nested,
- Tcl_Parse * parsePtr));
+ CONST char * string, int numBytes,
+ int nested, Tcl_Parse * parsePtr));
/* 362 */
EXTERN int Tcl_ParseExpr _ANSI_ARGS_((Tcl_Interp * interp,
- char * string, int numBytes,
+ CONST char * string, int numBytes,
Tcl_Parse * parsePtr));
/* 363 */
EXTERN int Tcl_ParseQuotedString _ANSI_ARGS_((
- Tcl_Interp * interp, char * string,
+ Tcl_Interp * interp, CONST char * string,
int numBytes, Tcl_Parse * parsePtr,
- int append, char ** termPtr));
+ int append, CONST84 char ** termPtr));
/* 364 */
EXTERN int Tcl_ParseVarName _ANSI_ARGS_((Tcl_Interp * interp,
- char * string, int numBytes,
+ CONST char * string, int numBytes,
Tcl_Parse * parsePtr, int append));
/* 365 */
EXTERN char * Tcl_GetCwd _ANSI_ARGS_((Tcl_Interp * interp,
@@ -1183,11 +1207,11 @@ EXTERN int Tcl_RegExpExecObj _ANSI_ARGS_((Tcl_Interp * interp,
EXTERN void Tcl_RegExpGetInfo _ANSI_ARGS_((Tcl_RegExp regexp,
Tcl_RegExpInfo * infoPtr));
/* 378 */
-EXTERN Tcl_Obj * Tcl_NewUnicodeObj _ANSI_ARGS_((Tcl_UniChar * unicode,
- int numChars));
+EXTERN Tcl_Obj * Tcl_NewUnicodeObj _ANSI_ARGS_((
+ CONST Tcl_UniChar * unicode, int numChars));
/* 379 */
EXTERN void Tcl_SetUnicodeObj _ANSI_ARGS_((Tcl_Obj * objPtr,
- Tcl_UniChar * unicode, int numChars));
+ CONST Tcl_UniChar * unicode, int numChars));
/* 380 */
EXTERN int Tcl_GetCharLength _ANSI_ARGS_((Tcl_Obj * objPtr));
/* 381 */
@@ -1200,7 +1224,7 @@ EXTERN Tcl_Obj * Tcl_GetRange _ANSI_ARGS_((Tcl_Obj * objPtr,
int first, int last));
/* 384 */
EXTERN void Tcl_AppendUnicodeToObj _ANSI_ARGS_((Tcl_Obj * objPtr,
- Tcl_UniChar * unicode, int length));
+ CONST Tcl_UniChar * unicode, int length));
/* 385 */
EXTERN int Tcl_RegExpMatchObj _ANSI_ARGS_((Tcl_Interp * interp,
Tcl_Obj * stringObj, Tcl_Obj * patternObj));
@@ -1213,7 +1237,7 @@ EXTERN Tcl_Mutex * Tcl_GetAllocMutex _ANSI_ARGS_((void));
EXTERN int Tcl_GetChannelNames _ANSI_ARGS_((Tcl_Interp * interp));
/* 389 */
EXTERN int Tcl_GetChannelNamesEx _ANSI_ARGS_((
- Tcl_Interp * interp, char * pattern));
+ Tcl_Interp * interp, CONST char * pattern));
/* 390 */
EXTERN int Tcl_ProcObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp * interp, int objc,
@@ -1233,13 +1257,13 @@ EXTERN int Tcl_ReadRaw _ANSI_ARGS_((Tcl_Channel chan,
char * dst, int bytesToRead));
/* 395 */
EXTERN int Tcl_WriteRaw _ANSI_ARGS_((Tcl_Channel chan,
- char * src, int srcLen));
+ CONST char * src, int srcLen));
/* 396 */
EXTERN Tcl_Channel Tcl_GetTopChannel _ANSI_ARGS_((Tcl_Channel chan));
/* 397 */
EXTERN int Tcl_ChannelBuffered _ANSI_ARGS_((Tcl_Channel chan));
/* 398 */
-EXTERN char * Tcl_ChannelName _ANSI_ARGS_((
+EXTERN CONST84_RETURN char * Tcl_ChannelName _ANSI_ARGS_((
Tcl_ChannelType * chanTypePtr));
/* 399 */
EXTERN Tcl_ChannelTypeVersion Tcl_ChannelVersion _ANSI_ARGS_((
@@ -1280,6 +1304,266 @@ EXTERN Tcl_DriverFlushProc * Tcl_ChannelFlushProc _ANSI_ARGS_((
/* 411 */
EXTERN Tcl_DriverHandlerProc * Tcl_ChannelHandlerProc _ANSI_ARGS_((
Tcl_ChannelType * chanTypePtr));
+/* 412 */
+EXTERN int Tcl_JoinThread _ANSI_ARGS_((Tcl_ThreadId id,
+ int* result));
+/* 413 */
+EXTERN int Tcl_IsChannelShared _ANSI_ARGS_((Tcl_Channel channel));
+/* 414 */
+EXTERN int Tcl_IsChannelRegistered _ANSI_ARGS_((
+ Tcl_Interp* interp, Tcl_Channel channel));
+/* 415 */
+EXTERN void Tcl_CutChannel _ANSI_ARGS_((Tcl_Channel channel));
+/* 416 */
+EXTERN void Tcl_SpliceChannel _ANSI_ARGS_((Tcl_Channel channel));
+/* 417 */
+EXTERN void Tcl_ClearChannelHandlers _ANSI_ARGS_((
+ Tcl_Channel channel));
+/* 418 */
+EXTERN int Tcl_IsChannelExisting _ANSI_ARGS_((
+ CONST char* channelName));
+/* 419 */
+EXTERN int Tcl_UniCharNcasecmp _ANSI_ARGS_((
+ CONST Tcl_UniChar * cs,
+ CONST Tcl_UniChar * ct, unsigned long n));
+/* 420 */
+EXTERN int Tcl_UniCharCaseMatch _ANSI_ARGS_((
+ CONST Tcl_UniChar * ustr,
+ CONST Tcl_UniChar * pattern, int nocase));
+/* 421 */
+EXTERN Tcl_HashEntry * Tcl_FindHashEntry _ANSI_ARGS_((
+ Tcl_HashTable * tablePtr, CONST char * key));
+/* 422 */
+EXTERN Tcl_HashEntry * Tcl_CreateHashEntry _ANSI_ARGS_((
+ Tcl_HashTable * tablePtr, CONST char * key,
+ int * newPtr));
+/* 423 */
+EXTERN void Tcl_InitCustomHashTable _ANSI_ARGS_((
+ Tcl_HashTable * tablePtr, int keyType,
+ Tcl_HashKeyType * typePtr));
+/* 424 */
+EXTERN void Tcl_InitObjHashTable _ANSI_ARGS_((
+ Tcl_HashTable * tablePtr));
+/* 425 */
+EXTERN ClientData Tcl_CommandTraceInfo _ANSI_ARGS_((
+ 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));
+/* 427 */
+EXTERN void Tcl_UntraceCommand _ANSI_ARGS_((Tcl_Interp * interp,
+ CONST char * varName, int flags,
+ Tcl_CommandTraceProc * proc,
+ ClientData clientData));
+/* 428 */
+EXTERN char * Tcl_AttemptAlloc _ANSI_ARGS_((unsigned int size));
+/* 429 */
+EXTERN char * Tcl_AttemptDbCkalloc _ANSI_ARGS_((unsigned int size,
+ CONST char * file, int line));
+/* 430 */
+EXTERN char * Tcl_AttemptRealloc _ANSI_ARGS_((char * ptr,
+ unsigned int size));
+/* 431 */
+EXTERN char * Tcl_AttemptDbCkrealloc _ANSI_ARGS_((char * ptr,
+ unsigned int size, CONST char * file,
+ int line));
+/* 432 */
+EXTERN int Tcl_AttemptSetObjLength _ANSI_ARGS_((
+ Tcl_Obj * objPtr, int length));
+/* 433 */
+EXTERN Tcl_ThreadId Tcl_GetChannelThread _ANSI_ARGS_((
+ Tcl_Channel channel));
+/* 434 */
+EXTERN Tcl_UniChar * Tcl_GetUnicodeFromObj _ANSI_ARGS_((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));
+/* 436 */
+EXTERN Tcl_Obj * Tcl_ListMathFuncs _ANSI_ARGS_((Tcl_Interp * interp,
+ CONST char * pattern));
+/* 437 */
+EXTERN Tcl_Obj * Tcl_SubstObj _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Obj * objPtr, int flags));
+/* 438 */
+EXTERN int Tcl_DetachChannel _ANSI_ARGS_((Tcl_Interp* interp,
+ Tcl_Channel channel));
+/* 439 */
+EXTERN int Tcl_IsStandardChannel _ANSI_ARGS_((
+ Tcl_Channel channel));
+/* 440 */
+EXTERN int Tcl_FSCopyFile _ANSI_ARGS_((Tcl_Obj * srcPathPtr,
+ Tcl_Obj * destPathPtr));
+/* 441 */
+EXTERN int Tcl_FSCopyDirectory _ANSI_ARGS_((
+ Tcl_Obj * srcPathPtr, Tcl_Obj * destPathPtr,
+ Tcl_Obj ** errorPtr));
+/* 442 */
+EXTERN int Tcl_FSCreateDirectory _ANSI_ARGS_((Tcl_Obj * pathPtr));
+/* 443 */
+EXTERN int Tcl_FSDeleteFile _ANSI_ARGS_((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));
+/* 445 */
+EXTERN int Tcl_FSMatchInDirectory _ANSI_ARGS_((
+ 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));
+/* 447 */
+EXTERN int Tcl_FSRemoveDirectory _ANSI_ARGS_((Tcl_Obj * pathPtr,
+ int recursive, Tcl_Obj ** errorPtr));
+/* 448 */
+EXTERN int Tcl_FSRenameFile _ANSI_ARGS_((Tcl_Obj * srcPathPtr,
+ Tcl_Obj * destPathPtr));
+/* 449 */
+EXTERN int Tcl_FSLstat _ANSI_ARGS_((Tcl_Obj * pathPtr,
+ Tcl_StatBuf * buf));
+/* 450 */
+EXTERN int Tcl_FSUtime _ANSI_ARGS_((Tcl_Obj * pathPtr,
+ struct utimbuf * tval));
+/* 451 */
+EXTERN int Tcl_FSFileAttrsGet _ANSI_ARGS_((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));
+/* 453 */
+EXTERN CONST char ** Tcl_FSFileAttrStrings _ANSI_ARGS_((Tcl_Obj * pathPtr,
+ Tcl_Obj ** objPtrRef));
+/* 454 */
+EXTERN int Tcl_FSStat _ANSI_ARGS_((Tcl_Obj * pathPtr,
+ Tcl_StatBuf * buf));
+/* 455 */
+EXTERN int Tcl_FSAccess _ANSI_ARGS_((Tcl_Obj * pathPtr,
+ int mode));
+/* 456 */
+EXTERN Tcl_Channel Tcl_FSOpenFileChannel _ANSI_ARGS_((
+ Tcl_Interp * interp, Tcl_Obj * pathPtr,
+ CONST char * modeString, int permissions));
+/* 457 */
+EXTERN Tcl_Obj* Tcl_FSGetCwd _ANSI_ARGS_((Tcl_Interp * interp));
+/* 458 */
+EXTERN int Tcl_FSChdir _ANSI_ARGS_((Tcl_Obj * pathPtr));
+/* 459 */
+EXTERN int Tcl_FSConvertToPathType _ANSI_ARGS_((
+ Tcl_Interp * interp, Tcl_Obj * pathPtr));
+/* 460 */
+EXTERN Tcl_Obj* Tcl_FSJoinPath _ANSI_ARGS_((Tcl_Obj * listObj,
+ int elements));
+/* 461 */
+EXTERN Tcl_Obj* Tcl_FSSplitPath _ANSI_ARGS_((Tcl_Obj* pathPtr,
+ int * lenPtr));
+/* 462 */
+EXTERN int Tcl_FSEqualPaths _ANSI_ARGS_((Tcl_Obj* firstPtr,
+ Tcl_Obj* secondPtr));
+/* 463 */
+EXTERN Tcl_Obj* Tcl_FSGetNormalizedPath _ANSI_ARGS_((
+ Tcl_Interp * interp, Tcl_Obj* pathObjPtr));
+/* 464 */
+EXTERN Tcl_Obj* Tcl_FSJoinToPath _ANSI_ARGS_((Tcl_Obj * basePtr,
+ int objc, Tcl_Obj *CONST objv[]));
+/* 465 */
+EXTERN ClientData Tcl_FSGetInternalRep _ANSI_ARGS_((
+ Tcl_Obj* pathObjPtr, Tcl_Filesystem * fsPtr));
+/* 466 */
+EXTERN Tcl_Obj* Tcl_FSGetTranslatedPath _ANSI_ARGS_((
+ Tcl_Interp * interp, Tcl_Obj* pathPtr));
+/* 467 */
+EXTERN int Tcl_FSEvalFile _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Obj * fileName));
+/* 468 */
+EXTERN Tcl_Obj* Tcl_FSNewNativePath _ANSI_ARGS_((
+ Tcl_Filesystem* fromFilesystem,
+ ClientData clientData));
+/* 469 */
+EXTERN CONST char* Tcl_FSGetNativePath _ANSI_ARGS_((Tcl_Obj* pathObjPtr));
+/* 470 */
+EXTERN Tcl_Obj* Tcl_FSFileSystemInfo _ANSI_ARGS_((
+ Tcl_Obj* pathObjPtr));
+/* 471 */
+EXTERN Tcl_Obj* Tcl_FSPathSeparator _ANSI_ARGS_((Tcl_Obj* pathObjPtr));
+/* 472 */
+EXTERN Tcl_Obj* Tcl_FSListVolumes _ANSI_ARGS_((void));
+/* 473 */
+EXTERN int Tcl_FSRegister _ANSI_ARGS_((ClientData clientData,
+ Tcl_Filesystem * fsPtr));
+/* 474 */
+EXTERN int Tcl_FSUnregister _ANSI_ARGS_((Tcl_Filesystem * fsPtr));
+/* 475 */
+EXTERN ClientData Tcl_FSData _ANSI_ARGS_((Tcl_Filesystem * fsPtr));
+/* 476 */
+EXTERN CONST char* Tcl_FSGetTranslatedStringPath _ANSI_ARGS_((
+ Tcl_Interp * interp, Tcl_Obj* pathPtr));
+/* 477 */
+EXTERN Tcl_Filesystem* Tcl_FSGetFileSystemForPath _ANSI_ARGS_((
+ Tcl_Obj* pathObjPtr));
+/* 478 */
+EXTERN Tcl_PathType Tcl_FSGetPathType _ANSI_ARGS_((Tcl_Obj * pathObjPtr));
+/* 479 */
+EXTERN int Tcl_OutputBuffered _ANSI_ARGS_((Tcl_Channel chan));
+/* 480 */
+EXTERN void Tcl_FSMountsChanged _ANSI_ARGS_((
+ Tcl_Filesystem * fsPtr));
+/* 481 */
+EXTERN int Tcl_EvalTokensStandard _ANSI_ARGS_((
+ Tcl_Interp * interp, Tcl_Token * tokenPtr,
+ int count));
+/* 482 */
+EXTERN void Tcl_GetTime _ANSI_ARGS_((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));
+/* 484 */
+EXTERN int Tcl_GetCommandInfoFromToken _ANSI_ARGS_((
+ Tcl_Command token, Tcl_CmdInfo* infoPtr));
+/* 485 */
+EXTERN int Tcl_SetCommandInfoFromToken _ANSI_ARGS_((
+ Tcl_Command token,
+ CONST Tcl_CmdInfo* infoPtr));
+/* 486 */
+EXTERN Tcl_Obj * Tcl_DbNewWideIntObj _ANSI_ARGS_((
+ Tcl_WideInt wideValue, CONST char * file,
+ int line));
+/* 487 */
+EXTERN int Tcl_GetWideIntFromObj _ANSI_ARGS_((
+ Tcl_Interp * interp, Tcl_Obj * objPtr,
+ Tcl_WideInt * widePtr));
+/* 488 */
+EXTERN Tcl_Obj * Tcl_NewWideIntObj _ANSI_ARGS_((Tcl_WideInt wideValue));
+/* 489 */
+EXTERN void Tcl_SetWideIntObj _ANSI_ARGS_((Tcl_Obj * objPtr,
+ Tcl_WideInt wideValue));
+/* 490 */
+EXTERN Tcl_StatBuf * Tcl_AllocStatBuf _ANSI_ARGS_((void));
+/* 491 */
+EXTERN Tcl_WideInt Tcl_Seek _ANSI_ARGS_((Tcl_Channel chan,
+ Tcl_WideInt offset, int mode));
+/* 492 */
+EXTERN Tcl_WideInt Tcl_Tell _ANSI_ARGS_((Tcl_Channel chan));
+/* 493 */
+EXTERN Tcl_DriverWideSeekProc * Tcl_ChannelWideSeekProc _ANSI_ARGS_((
+ Tcl_ChannelType * chanTypePtr));
typedef struct TclStubHooks {
struct TclPlatStubs *tclPlatStubs;
@@ -1291,15 +1575,15 @@ typedef struct TclStubs {
int magic;
struct TclStubHooks *hooks;
- int (*tcl_PkgProvideEx) _ANSI_ARGS_((Tcl_Interp * interp, char * name, char * version, ClientData clientData)); /* 0 */
- char * (*tcl_PkgRequireEx) _ANSI_ARGS_((Tcl_Interp * interp, char * name, char * version, int exact, ClientData * clientDataPtr)); /* 1 */
- void (*tcl_Panic) _ANSI_ARGS_(TCL_VARARGS(char *,format)); /* 2 */
+ 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_(TCL_VARARGS(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, char * file, int line)); /* 6 */
- int (*tcl_DbCkfree) _ANSI_ARGS_((char * ptr, char * file, int line)); /* 7 */
- char * (*tcl_DbCkrealloc) _ANSI_ARGS_((char * ptr, unsigned int size, char * file, int line)); /* 8 */
+ 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__) && !defined(MAC_TCL) /* UNIX */
void (*tcl_CreateFileHandler) _ANSI_ARGS_((int fd, int mask, Tcl_FileProc * proc, ClientData clientData)); /* 9 */
#endif /* UNIX */
@@ -1323,41 +1607,41 @@ typedef struct TclStubs {
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_VARARGS(Tcl_Obj *,objPtr)); /* 15 */
- void (*tcl_AppendToObj) _ANSI_ARGS_((Tcl_Obj * objPtr, char * bytes, int length)); /* 16 */
+ 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, char * file, int line)); /* 19 */
- void (*tcl_DbIncrRefCount) _ANSI_ARGS_((Tcl_Obj * objPtr, char * file, int line)); /* 20 */
- int (*tcl_DbIsShared) _ANSI_ARGS_((Tcl_Obj * objPtr, char * file, int line)); /* 21 */
- Tcl_Obj * (*tcl_DbNewBooleanObj) _ANSI_ARGS_((int boolValue, char * file, int line)); /* 22 */
- Tcl_Obj * (*tcl_DbNewByteArrayObj) _ANSI_ARGS_((unsigned char * bytes, int length, char * file, int line)); /* 23 */
- Tcl_Obj * (*tcl_DbNewDoubleObj) _ANSI_ARGS_((double doubleValue, char * file, int line)); /* 24 */
- Tcl_Obj * (*tcl_DbNewListObj) _ANSI_ARGS_((int objc, Tcl_Obj *CONST objv[], char * file, int line)); /* 25 */
- Tcl_Obj * (*tcl_DbNewLongObj) _ANSI_ARGS_((long longValue, char * file, int line)); /* 26 */
- Tcl_Obj * (*tcl_DbNewObj) _ANSI_ARGS_((char * file, int line)); /* 27 */
- Tcl_Obj * (*tcl_DbNewStringObj) _ANSI_ARGS_((CONST char * bytes, int length, char * file, int line)); /* 28 */
+ 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, char * str, int * boolPtr)); /* 31 */
+ int (*tcl_GetBoolean) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, 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, char * str, double * doublePtr)); /* 34 */
+ int (*tcl_GetDouble) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, 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, char ** tablePtr, char * msg, int flags, int * indexPtr)); /* 36 */
- int (*tcl_GetInt) _ANSI_ARGS_((Tcl_Interp * interp, char * str, int * intPtr)); /* 37 */
+ 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 * str, 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_((char * typeName)); /* 40 */
+ 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 * intPtr)); /* 47 */
+ 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_((unsigned char * bytes, int length)); /* 50 */
+ 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 */
@@ -1366,13 +1650,13 @@ typedef struct TclStubs {
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, unsigned char * bytes, int length)); /* 59 */
+ 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, char * bytes, int length)); /* 65 */
+ 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 */
@@ -1385,32 +1669,32 @@ typedef struct TclStubs {
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, char * optionName, char * optionList)); /* 78 */
+ 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_((char * cmd)); /* 82 */
- char * (*tcl_Concat) _ANSI_ARGS_((int argc, char ** argv)); /* 83 */
+ 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, char * slaveCmd, Tcl_Interp * target, char * targetCmd, int argc, char ** argv)); /* 86 */
- int (*tcl_CreateAliasObj) _ANSI_ARGS_((Tcl_Interp * slave, char * slaveCmd, Tcl_Interp * target, char * targetCmd, int objc, Tcl_Obj *CONST objv[])); /* 87 */
- Tcl_Channel (*tcl_CreateChannel) _ANSI_ARGS_((Tcl_ChannelType * typePtr, char * chanName, ClientData instanceData, int mask)); /* 88 */
+ 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, char * cmdName, Tcl_CmdProc * proc, ClientData clientData, Tcl_CmdDeleteProc * deleteProc)); /* 91 */
+ 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, char * name, int numArgs, Tcl_ValueType * argTypes, Tcl_MathProc * proc, ClientData clientData)); /* 95 */
- Tcl_Command (*tcl_CreateObjCommand) _ANSI_ARGS_((Tcl_Interp * interp, char * cmdName, Tcl_ObjCmdProc * proc, ClientData clientData, Tcl_CmdDeleteProc * deleteProc)); /* 96 */
- Tcl_Interp * (*tcl_CreateSlave) _ANSI_ARGS_((Tcl_Interp * interp, char * slaveName, int isSafe)); /* 97 */
+ 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, char * name)); /* 100 */
+ 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, char * cmdName)); /* 103 */
+ 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 */
@@ -1442,48 +1726,48 @@ typedef struct TclStubs {
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 */
- char * (*tcl_ErrnoId) _ANSI_ARGS_((void)); /* 127 */
- char * (*tcl_ErrnoMsg) _ANSI_ARGS_((int err)); /* 128 */
- int (*tcl_Eval) _ANSI_ARGS_((Tcl_Interp * interp, char * string)); /* 129 */
- int (*tcl_EvalFile) _ANSI_ARGS_((Tcl_Interp * interp, char * fileName)); /* 130 */
+ 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 * string)); /* 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, char * hiddenCmdToken, char * cmdName)); /* 134 */
- int (*tcl_ExprBoolean) _ANSI_ARGS_((Tcl_Interp * interp, char * str, int * ptr)); /* 135 */
+ 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 * str, 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, char * str, double * ptr)); /* 137 */
+ int (*tcl_ExprDouble) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, 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, char * str, long * ptr)); /* 139 */
+ int (*tcl_ExprLong) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, 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, char * string)); /* 142 */
+ int (*tcl_ExprString) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string)); /* 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, char * slaveCmd, Tcl_Interp ** targetInterpPtr, char ** targetCmdPtr, int * argcPtr, char *** argvPtr)); /* 148 */
- int (*tcl_GetAliasObj) _ANSI_ARGS_((Tcl_Interp * interp, char * slaveCmd, Tcl_Interp ** targetInterpPtr, char ** targetCmdPtr, int * objcPtr, Tcl_Obj *** objv)); /* 149 */
- ClientData (*tcl_GetAssocData) _ANSI_ARGS_((Tcl_Interp * interp, char * name, Tcl_InterpDeleteProc ** procPtr)); /* 150 */
- Tcl_Channel (*tcl_GetChannel) _ANSI_ARGS_((Tcl_Interp * interp, char * chanName, int * modePtr)); /* 151 */
+ 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 */
- char * (*tcl_GetChannelName) _ANSI_ARGS_((Tcl_Channel chan)); /* 156 */
- int (*tcl_GetChannelOption) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan, char * optionName, Tcl_DString * dsPtr)); /* 157 */
+ 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, char * cmdName, Tcl_CmdInfo * infoPtr)); /* 159 */
- char * (*tcl_GetCommandName) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Command command)); /* 160 */
+ 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 */
- char * (*tcl_GetHostName) _ANSI_ARGS_((void)); /* 162 */
+ 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__) && !defined(MAC_TCL) /* UNIX */
- int (*tcl_GetOpenFile) _ANSI_ARGS_((Tcl_Interp * interp, char * str, int forWriting, int checkUsage, ClientData * filePtr)); /* 167 */
+ int (*tcl_GetOpenFile) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, int forWriting, int checkUsage, ClientData * filePtr)); /* 167 */
#endif /* UNIX */
#ifdef __WIN32__
void *reserved167;
@@ -1491,51 +1775,51 @@ typedef struct TclStubs {
#ifdef MAC_TCL
void *reserved167;
#endif /* MAC_TCL */
- Tcl_PathType (*tcl_GetPathType) _ANSI_ARGS_((char * path)); /* 168 */
+ 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, char * slaveName)); /* 172 */
+ Tcl_Interp * (*tcl_GetSlave) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * slaveName)); /* 172 */
Tcl_Channel (*tcl_GetStdChannel) _ANSI_ARGS_((int type)); /* 173 */
- char * (*tcl_GetStringResult) _ANSI_ARGS_((Tcl_Interp * interp)); /* 174 */
- char * (*tcl_GetVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags)); /* 175 */
- char * (*tcl_GetVar2) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, char * part2, int flags)); /* 176 */
- int (*tcl_GlobalEval) _ANSI_ARGS_((Tcl_Interp * interp, char * command)); /* 177 */
+ 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, char * cmdName, char * hiddenCmdToken)); /* 179 */
+ 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, char ** argv, Tcl_DString * resultPtr)); /* 186 */
- int (*tcl_LinkVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, char * addr, int type)); /* 187 */
+ 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, char ** argv)); /* 192 */
+ 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__) && !defined(MAC_TCL) /* UNIX */
- Tcl_Channel (*tcl_OpenCommandChannel) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv, int flags)); /* 197 */
+ 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, char ** argv, int flags)); /* 197 */
+ Tcl_Channel (*tcl_OpenCommandChannel) _ANSI_ARGS_((Tcl_Interp * interp, int argc, CONST84 char ** argv, int flags)); /* 197 */
#endif /* __WIN32__ */
#ifdef MAC_TCL
void *reserved197;
#endif /* MAC_TCL */
- Tcl_Channel (*tcl_OpenFileChannel) _ANSI_ARGS_((Tcl_Interp * interp, char * fileName, char * modeString, int permissions)); /* 198 */
- Tcl_Channel (*tcl_OpenTcpClient) _ANSI_ARGS_((Tcl_Interp * interp, int port, char * address, char * myaddr, int myport, int async)); /* 199 */
- Tcl_Channel (*tcl_OpenTcpServer) _ANSI_ARGS_((Tcl_Interp * interp, int port, char * host, Tcl_TcpAcceptProc * acceptProc, ClientData callbackData)); /* 200 */
+ 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 * string)); /* 203 */
- char * (*tcl_PosixError) _ANSI_ARGS_((Tcl_Interp * interp)); /* 204 */
+ 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__) && !defined(MAC_TCL) /* UNIX */
@@ -1547,25 +1831,25 @@ typedef struct TclStubs {
#ifdef MAC_TCL
void *reserved207;
#endif /* MAC_TCL */
- int (*tcl_RecordAndEval) _ANSI_ARGS_((Tcl_Interp * interp, char * cmd, int flags)); /* 208 */
+ 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, char * string)); /* 212 */
+ Tcl_RegExp (*tcl_RegExpCompile) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string)); /* 212 */
int (*tcl_RegExpExec) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_RegExp regexp, CONST char * str, CONST char * start)); /* 213 */
- int (*tcl_RegExpMatch) _ANSI_ARGS_((Tcl_Interp * interp, char * str, char * pattern)); /* 214 */
- void (*tcl_RegExpRange) _ANSI_ARGS_((Tcl_RegExp regexp, int index, char ** startPtr, char ** endPtr)); /* 215 */
+ int (*tcl_RegExpMatch) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, 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_Seek) _ANSI_ARGS_((Tcl_Channel chan, int offset, int mode)); /* 220 */
+ 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, char * name, Tcl_InterpDeleteProc * proc, ClientData clientData)); /* 223 */
+ 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, char * optionName, char * newValue)); /* 225 */
- int (*tcl_SetCommandInfo) _ANSI_ARGS_((Tcl_Interp * interp, char * cmdName, Tcl_CmdInfo * infoPtr)); /* 226 */
+ 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_VARARGS(Tcl_Interp *,interp)); /* 228 */
void (*tcl_SetMaxBlockTime) _ANSI_ARGS_((Tcl_Time * timePtr)); /* 229 */
@@ -1576,69 +1860,61 @@ typedef struct TclStubs {
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 */
- char * (*tcl_SetVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, char * newValue, int flags)); /* 237 */
- char * (*tcl_SetVar2) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, char * part2, char * newValue, int flags)); /* 238 */
- char * (*tcl_SignalId) _ANSI_ARGS_((int sig)); /* 239 */
- char * (*tcl_SignalMsg) _ANSI_ARGS_((int sig)); /* 240 */
+ 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, char *** argvPtr)); /* 242 */
- void (*tcl_SplitPath) _ANSI_ARGS_((CONST char * path, int * argcPtr, char *** argvPtr)); /* 243 */
- void (*tcl_StaticPackage) _ANSI_ARGS_((Tcl_Interp * interp, char * pkgName, Tcl_PackageInitProc * initProc, Tcl_PackageInitProc * safeInitProc)); /* 244 */
+ 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_Tell) _ANSI_ARGS_((Tcl_Channel chan)); /* 246 */
- int (*tcl_TraceVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 247 */
- int (*tcl_TraceVar2) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, char * part2, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 248 */
- char * (*tcl_TranslateFileName) _ANSI_ARGS_((Tcl_Interp * interp, char * name, Tcl_DString * bufferPtr)); /* 249 */
- int (*tcl_Ungets) _ANSI_ARGS_((Tcl_Channel chan, char * str, int len, int atHead)); /* 250 */
- void (*tcl_UnlinkVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName)); /* 251 */
+ 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, char * varName, int flags)); /* 253 */
- int (*tcl_UnsetVar2) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, char * part2, int flags)); /* 254 */
- void (*tcl_UntraceVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 255 */
- void (*tcl_UntraceVar2) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, char * part2, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 256 */
- void (*tcl_UpdateLinkedVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName)); /* 257 */
- int (*tcl_UpVar) _ANSI_ARGS_((Tcl_Interp * interp, char * frameName, char * varName, char * localName, int flags)); /* 258 */
- int (*tcl_UpVar2) _ANSI_ARGS_((Tcl_Interp * interp, char * frameName, char * part1, char * part2, char * localName, int flags)); /* 259 */
+ 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_VARARGS(Tcl_Interp *,interp)); /* 260 */
- ClientData (*tcl_VarTraceInfo) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags, Tcl_VarTraceProc * procPtr, ClientData prevClientData)); /* 261 */
- ClientData (*tcl_VarTraceInfo2) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, char * part2, int flags, Tcl_VarTraceProc * procPtr, ClientData prevClientData)); /* 262 */
- int (*tcl_Write) _ANSI_ARGS_((Tcl_Channel chan, char * s, int slen)); /* 263 */
- void (*tcl_WrongNumArgs) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[], char * message)); /* 264 */
- int (*tcl_DumpActiveMemory) _ANSI_ARGS_((char * fileName)); /* 265 */
- void (*tcl_ValidateAllMemory) _ANSI_ARGS_((char * file, int line)); /* 266 */
+ 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 */
- char * (*tcl_HashStats) _ANSI_ARGS_((Tcl_HashTable * tablePtr)); /* 269 */
- char * (*tcl_ParseVar) _ANSI_ARGS_((Tcl_Interp * interp, char * str, char ** termPtr)); /* 270 */
- char * (*tcl_PkgPresent) _ANSI_ARGS_((Tcl_Interp * interp, char * name, char * version, int exact)); /* 271 */
- char * (*tcl_PkgPresentEx) _ANSI_ARGS_((Tcl_Interp * interp, char * name, char * version, int exact, ClientData * clientDataPtr)); /* 272 */
- int (*tcl_PkgProvide) _ANSI_ARGS_((Tcl_Interp * interp, char * name, char * version)); /* 273 */
- char * (*tcl_PkgRequire) _ANSI_ARGS_((Tcl_Interp * interp, char * name, char * version, int exact)); /* 274 */
+ CONST84_RETURN char * (*tcl_HashStats) _ANSI_ARGS_((Tcl_HashTable * tablePtr)); /* 269 */
+ CONST84_RETURN char * (*tcl_ParseVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, 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 */
-#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
- void (*tcl_PanicVA) _ANSI_ARGS_((char * format, va_list argList)); /* 278 */
-#endif /* UNIX */
-#ifdef __WIN32__
- void (*tcl_PanicVA) _ANSI_ARGS_((char * format, va_list argList)); /* 278 */
-#endif /* __WIN32__ */
-#ifdef MAC_TCL
- void *reserved278;
-#endif /* MAC_TCL */
+ 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 *reserved284;
+ 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, char * script, int numBytes, int flags)); /* 291 */
+ 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 */
@@ -1649,11 +1925,11 @@ typedef struct TclStubs {
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 */
- char * (*tcl_GetEncodingName) _ANSI_ARGS_((Tcl_Encoding encoding)); /* 302 */
+ 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, char ** tablePtr, int offset, char * msg, int flags, int * indexPtr)); /* 304 */
+ 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, char * part1, char * part2, int flags)); /* 306 */
+ 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 */
@@ -1664,7 +1940,7 @@ typedef struct TclStubs {
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, char * part1, char * part2, Tcl_Obj * newValuePtr, int flags)); /* 317 */
+ 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 */
@@ -1672,13 +1948,13 @@ typedef struct TclStubs {
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 */
- char * (*tcl_UtfAtIndex) _ANSI_ARGS_((CONST char * src, int index)); /* 325 */
+ CONST84_RETURN char * (*tcl_UtfAtIndex) _ANSI_ARGS_((CONST char * src, int index)); /* 325 */
int (*tcl_UtfCharComplete) _ANSI_ARGS_((CONST char * src, int len)); /* 326 */
int (*tcl_UtfBackslash) _ANSI_ARGS_((CONST char * src, int * readPtr, char * dst)); /* 327 */
- char * (*tcl_UtfFindFirst) _ANSI_ARGS_((CONST char * src, int ch)); /* 328 */
- char * (*tcl_UtfFindLast) _ANSI_ARGS_((CONST char * src, int ch)); /* 329 */
- char * (*tcl_UtfNext) _ANSI_ARGS_((CONST char * src)); /* 330 */
- char * (*tcl_UtfPrev) _ANSI_ARGS_((CONST char * src, CONST char * start)); /* 331 */
+ 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 */
@@ -1688,8 +1964,8 @@ typedef struct TclStubs {
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 */
- char * (*tcl_GetDefaultEncodingDir) _ANSI_ARGS_((void)); /* 341 */
- void (*tcl_SetDefaultEncodingDir) _ANSI_ARGS_((char * path)); /* 342 */
+ 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 */
@@ -1699,19 +1975,19 @@ typedef struct TclStubs {
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_((Tcl_UniChar * str)); /* 352 */
+ int (*tcl_UniCharLen) _ANSI_ARGS_((CONST Tcl_UniChar * str)); /* 352 */
int (*tcl_UniCharNcmp) _ANSI_ARGS_((CONST Tcl_UniChar * cs, CONST Tcl_UniChar * ct, unsigned long n)); /* 353 */
char * (*tcl_UniCharToUtfDString) _ANSI_ARGS_((CONST Tcl_UniChar * string, int numChars, Tcl_DString * dsPtr)); /* 354 */
Tcl_UniChar * (*tcl_UtfToUniCharDString) _ANSI_ARGS_((CONST char * string, 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, char * script, char * command, int length)); /* 359 */
- int (*tcl_ParseBraces) _ANSI_ARGS_((Tcl_Interp * interp, char * string, int numBytes, Tcl_Parse * parsePtr, int append, char ** termPtr)); /* 360 */
- int (*tcl_ParseCommand) _ANSI_ARGS_((Tcl_Interp * interp, char * string, int numBytes, int nested, Tcl_Parse * parsePtr)); /* 361 */
- int (*tcl_ParseExpr) _ANSI_ARGS_((Tcl_Interp * interp, char * string, int numBytes, Tcl_Parse * parsePtr)); /* 362 */
- int (*tcl_ParseQuotedString) _ANSI_ARGS_((Tcl_Interp * interp, char * string, int numBytes, Tcl_Parse * parsePtr, int append, char ** termPtr)); /* 363 */
- int (*tcl_ParseVarName) _ANSI_ARGS_((Tcl_Interp * interp, char * string, int numBytes, Tcl_Parse * parsePtr, int append)); /* 364 */
+ 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 * string, int numBytes, Tcl_Parse * parsePtr, int append, CONST84 char ** termPtr)); /* 360 */
+ int (*tcl_ParseCommand) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string, int numBytes, int nested, Tcl_Parse * parsePtr)); /* 361 */
+ int (*tcl_ParseExpr) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string, int numBytes, Tcl_Parse * parsePtr)); /* 362 */
+ int (*tcl_ParseQuotedString) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string, int numBytes, Tcl_Parse * parsePtr, int append, CONST84 char ** termPtr)); /* 363 */
+ int (*tcl_ParseVarName) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string, 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 */
@@ -1725,27 +2001,27 @@ typedef struct TclStubs {
int (*tcl_UniCharIsPunct) _ANSI_ARGS_((int ch)); /* 375 */
int (*tcl_RegExpExecObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_RegExp regexp, Tcl_Obj * objPtr, 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_((Tcl_UniChar * unicode, int numChars)); /* 378 */
- void (*tcl_SetUnicodeObj) _ANSI_ARGS_((Tcl_Obj * objPtr, Tcl_UniChar * unicode, int numChars)); /* 379 */
+ 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, Tcl_UniChar * unicode, int length)); /* 384 */
+ 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 * stringObj, 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, char * pattern)); /* 389 */
+ 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, char * src, int srcLen)); /* 395 */
+ 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 */
- char * (*tcl_ChannelName) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 398 */
+ 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 */
@@ -1759,6 +2035,88 @@ typedef struct TclStubs {
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 id, 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 * cs, CONST Tcl_UniChar * ct, unsigned long n)); /* 419 */
+ int (*tcl_UniCharCaseMatch) _ANSI_ARGS_((CONST Tcl_UniChar * ustr, CONST Tcl_UniChar * pattern, 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* pathObjPtr)); /* 463 */
+ Tcl_Obj* (*tcl_FSJoinToPath) _ANSI_ARGS_((Tcl_Obj * basePtr, int objc, Tcl_Obj *CONST objv[])); /* 464 */
+ ClientData (*tcl_FSGetInternalRep) _ANSI_ARGS_((Tcl_Obj* pathObjPtr, 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* pathObjPtr)); /* 469 */
+ Tcl_Obj* (*tcl_FSFileSystemInfo) _ANSI_ARGS_((Tcl_Obj* pathObjPtr)); /* 470 */
+ Tcl_Obj* (*tcl_FSPathSeparator) _ANSI_ARGS_((Tcl_Obj* pathObjPtr)); /* 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* pathObjPtr)); /* 477 */
+ Tcl_PathType (*tcl_FSGetPathType) _ANSI_ARGS_((Tcl_Obj * pathObjPtr)); /* 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 */
} TclStubs;
#ifdef __cplusplus
@@ -2682,9 +3040,9 @@ extern TclStubs *tclStubsPtr;
#define Tcl_ScanCountedElement \
(tclStubsPtr->tcl_ScanCountedElement) /* 219 */
#endif
-#ifndef Tcl_Seek
-#define Tcl_Seek \
- (tclStubsPtr->tcl_Seek) /* 220 */
+#ifndef Tcl_SeekOld
+#define Tcl_SeekOld \
+ (tclStubsPtr->tcl_SeekOld) /* 220 */
#endif
#ifndef Tcl_ServiceAll
#define Tcl_ServiceAll \
@@ -2786,9 +3144,9 @@ extern TclStubs *tclStubsPtr;
#define Tcl_StringMatch \
(tclStubsPtr->tcl_StringMatch) /* 245 */
#endif
-#ifndef Tcl_Tell
-#define Tcl_Tell \
- (tclStubsPtr->tcl_Tell) /* 246 */
+#ifndef Tcl_TellOld
+#define Tcl_TellOld \
+ (tclStubsPtr->tcl_TellOld) /* 246 */
#endif
#ifndef Tcl_TraceVar
#define Tcl_TraceVar \
@@ -2914,18 +3272,10 @@ extern TclStubs *tclStubsPtr;
#define Tcl_WaitPid \
(tclStubsPtr->tcl_WaitPid) /* 277 */
#endif
-#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
-#ifndef Tcl_PanicVA
-#define Tcl_PanicVA \
- (tclStubsPtr->tcl_PanicVA) /* 278 */
-#endif
-#endif /* UNIX */
-#ifdef __WIN32__
#ifndef Tcl_PanicVA
#define Tcl_PanicVA \
(tclStubsPtr->tcl_PanicVA) /* 278 */
#endif
-#endif /* __WIN32__ */
#ifndef Tcl_GetVersion
#define Tcl_GetVersion \
(tclStubsPtr->tcl_GetVersion) /* 279 */
@@ -2946,7 +3296,10 @@ extern TclStubs *tclStubsPtr;
#define Tcl_GetStackedChannel \
(tclStubsPtr->tcl_GetStackedChannel) /* 283 */
#endif
-/* Slot 284 is reserved */
+#ifndef Tcl_SetMainLoop
+#define Tcl_SetMainLoop \
+ (tclStubsPtr->tcl_SetMainLoop) /* 284 */
+#endif
/* Slot 285 is reserved */
#ifndef Tcl_AppendObjToObj
#define Tcl_AppendObjToObj \
@@ -3452,6 +3805,334 @@ extern TclStubs *tclStubsPtr;
#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
#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
@@ -3459,4 +4140,3 @@ extern TclStubs *tclStubsPtr;
#endif /* _TCLDECLS */
-
diff --git a/tcl/generic/tclEncoding.c b/tcl/generic/tclEncoding.c
index 8a43126c075..e97062a7eb1 100644
--- a/tcl/generic/tclEncoding.c
+++ b/tcl/generic/tclEncoding.c
@@ -310,18 +310,16 @@ TclFinalizeEncodingSubsystem()
{
Tcl_HashSearch search;
Tcl_HashEntry *hPtr;
- Encoding *encodingPtr;
Tcl_MutexLock(&encodingMutex);
encodingsInitialized = 0;
hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
while (hPtr != NULL) {
- encodingPtr = (Encoding *) Tcl_GetHashValue(hPtr);
- if (encodingPtr->freeProc != NULL) {
- (*encodingPtr->freeProc)(encodingPtr->clientData);
- }
- ckfree((char *) encodingPtr->name);
- ckfree((char *) encodingPtr);
+ /*
+ * Call FreeEncoding instead of doing it directly to handle refcounts
+ * like escape encodings use. [Bug #524674]
+ */
+ FreeEncoding((Tcl_Encoding) Tcl_GetHashValue(hPtr));
hPtr = Tcl_NextHashEntry(&search);
}
Tcl_DeleteHashTable(&encodingTable);
@@ -341,7 +339,7 @@ TclFinalizeEncodingSubsystem()
*-------------------------------------------------------------------------
*/
-char *
+CONST char *
Tcl_GetDefaultEncodingDir()
{
return tclDefaultEncodingDir;
@@ -362,7 +360,7 @@ Tcl_GetDefaultEncodingDir()
void
Tcl_SetDefaultEncodingDir(path)
- char *path;
+ CONST char *path;
{
tclDefaultEncodingDir = (char *)ckalloc((unsigned) strlen(path) + 1);
strcpy(tclDefaultEncodingDir, path);
@@ -505,7 +503,7 @@ FreeEncoding(encoding)
*---------------------------------------------------------------------------
*/
-char *
+CONST char *
Tcl_GetEncodingName(encoding)
Tcl_Encoding encoding; /* The encoding whose name to fetch. */
{
@@ -563,20 +561,22 @@ Tcl_GetEncodingNames(interp)
if (pathPtr != NULL) {
int i, objc;
Tcl_Obj **objv;
- Tcl_DString pwdString;
char globArgString[10];
-
+ Tcl_Obj* encodingObj = Tcl_NewStringObj("encoding",-1);
+ Tcl_IncrRefCount(encodingObj);
+
objc = 0;
Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
- Tcl_GetCwd(interp, &pwdString);
-
for (i = 0; i < objc; i++) {
- char *string;
- int j, objc2, length;
- Tcl_Obj **objv2;
-
- string = Tcl_GetStringFromObj(objv[i], NULL);
+ Tcl_Obj *searchIn;
+
+ /*
+ * Construct the path from the element of pathPtr,
+ * joined with 'encoding'.
+ */
+ searchIn = Tcl_FSJoinToPath(objv[i],1,&encodingObj);
+ Tcl_IncrRefCount(searchIn);
Tcl_ResetResult(interp);
/*
@@ -586,15 +586,22 @@ Tcl_GetEncodingNames(interp)
*/
strcpy(globArgString, "*.enc");
- if ((Tcl_Chdir(string) == 0)
- && (Tcl_Chdir("encoding") == 0)
- && (TclGlob(interp, globArgString, NULL, 0, NULL) == TCL_OK)) {
- objc2 = 0;
+ /*
+ * The GLOBMODE_TAILS flag returns just the tail of each file
+ * which is the encoding name with a .enc extension
+ */
+ if ((TclGlob(interp, globArgString, searchIn,
+ TCL_GLOBMODE_TAILS, NULL) == TCL_OK)) {
+ int objc2 = 0;
+ Tcl_Obj **objv2;
+ int j;
Tcl_ListObjGetElements(NULL, Tcl_GetObjResult(interp), &objc2,
&objv2);
for (j = 0; j < objc2; j++) {
+ int length;
+ char *string;
string = Tcl_GetStringFromObj(objv2[j], &length);
length -= 4;
if (length > 0) {
@@ -604,9 +611,9 @@ Tcl_GetEncodingNames(interp)
}
}
}
- Tcl_Chdir(Tcl_DStringValue(&pwdString));
+ Tcl_DecrRefCount(searchIn);
}
- Tcl_DStringFree(&pwdString);
+ Tcl_DecrRefCount(encodingObj);
}
/*
@@ -828,7 +835,7 @@ Tcl_ExternalToUtfDString(encoding, src, srcLen, dstPtr)
*
* Tcl_ExternalToUtf --
*
- * Convert a source buffer from the specified encoding into UTF-8,
+ * Convert a source buffer from the specified encoding into UTF-8.
*
* Results:
* The return value is one of TCL_OK, TCL_CONVERT_MULTIBYTE,
@@ -1271,19 +1278,25 @@ OpenEncodingFile(dir, name)
CONST char *name;
{
- char *argv[3];
+ CONST char *argv[3];
Tcl_DString pathString;
- char *path;
+ CONST char *path;
Tcl_Channel chan;
+ Tcl_Obj *pathPtr;
- argv[0] = (char *) dir;
+ argv[0] = dir;
argv[1] = "encoding";
- argv[2] = (char *) name;
+ argv[2] = name;
Tcl_DStringInit(&pathString);
Tcl_JoinPath(3, argv, &pathString);
path = Tcl_DStringAppend(&pathString, ".enc", -1);
- chan = Tcl_OpenFileChannel(NULL, path, "r", 0);
+ pathPtr = Tcl_NewStringObj(path,-1);
+
+ Tcl_IncrRefCount(pathPtr);
+ chan = Tcl_FSOpenFileChannel(NULL, pathPtr, "r", 0);
+ Tcl_DecrRefCount(pathPtr);
+
Tcl_DStringFree(&pathString);
return chan;
@@ -1328,14 +1341,31 @@ LoadTableEncoding(interp, name, type, chan)
TableEncodingData *dataPtr;
unsigned short *pageMemPtr;
Tcl_EncodingType encType;
- char *hex;
+
+ /*
+ * Speed over memory. Use a full 256 character table to decode hex
+ * sequences in the encoding files.
+ */
+
static char staticHex[] = {
- 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 0, 0, 0, 0, 0, 0,
- 10, 11, 12, 13, 14, 15
+ 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 */
+ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 0, 0, 0, 0, 0, /* 48 ... 63 */
+ 0, 10, 11, 12, 13, 14, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 64 ... 79 */
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 80 ... 95 */
+ 0, 10, 11, 12, 13, 14, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 96 ... 111 */
+ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 0, 0, 0, 0, 0, /* 112 ... 127 */
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 128 ... 143 */
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 144 ... 159 */
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 160 ... 175 */
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 176 ... 191 */
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 192 ... 207 */
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 208 ... 223 */
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 224 ... 239 */
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 240 ... 255 */
};
- hex = staticHex - '0';
-
Tcl_DStringInit(&lineString);
Tcl_Gets(chan, &lineString);
line = Tcl_DStringValue(&lineString);
@@ -1383,15 +1413,15 @@ LoadTableEncoding(interp, name, type, chan)
Tcl_ReadChars(chan, objPtr, 3 + 16 * (16 * 4 + 1), 0);
p = Tcl_GetString(objPtr);
- hi = (hex[(int)p[0]] << 4) + hex[(int)p[1]];
+ hi = (staticHex[(unsigned int)p[0]] << 4) + staticHex[(unsigned int)p[1]];
dataPtr->toUnicode[hi] = pageMemPtr;
p += 2;
for (lo = 0; lo < 256; lo++) {
if ((lo & 0x0f) == 0) {
p++;
}
- ch = (hex[(int)p[0]] << 12) + (hex[(int)p[1]] << 8)
- + (hex[(int)p[2]] << 4) + hex[(int)p[3]];
+ ch = (staticHex[(unsigned int)p[0]] << 12) + (staticHex[(unsigned int)p[1]] << 8)
+ + (staticHex[(unsigned int)p[2]] << 4) + staticHex[(unsigned int)p[3]];
if (ch != 0) {
used[ch >> 8] = 1;
}
@@ -1510,7 +1540,6 @@ LoadTableEncoding(interp, name, type, chan)
encType.nullSize = (type == ENCODING_DOUBLEBYTE) ? 2 : 1;
encType.clientData = (ClientData) dataPtr;
return Tcl_CreateEncoding(&encType);
-
}
/*
@@ -1553,7 +1582,7 @@ LoadEscapeEncoding(name, chan)
while (1) {
int argc;
- char **argv;
+ CONST char **argv;
char *line;
Tcl_DString lineString;
@@ -2175,6 +2204,10 @@ TableFreeProc(clientData)
{
TableEncodingData *dataPtr;
+ /*
+ * Make sure we aren't freeing twice on shutdown. [Bug #219314]
+ */
+
dataPtr = (TableEncodingData *) clientData;
ckfree((char *) dataPtr->toUnicode);
ckfree((char *) dataPtr->fromUnicode);
@@ -2460,12 +2493,14 @@ EscapeFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
dstStart = dst;
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]
+ */
+
if (flags & TCL_ENCODING_START) {
- unsigned int len;
-
state = 0;
- len = dataPtr->subTables[0].sequenceLen;
- if (dst + dataPtr->initLen + len > dstEnd) {
+ if (dst + dataPtr->initLen > dstEnd) {
*srcReadPtr = 0;
*dstWrotePtr = 0;
return TCL_CONVERT_NOSPACE;
@@ -2473,9 +2508,6 @@ EscapeFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
memcpy((VOID *) dst, (VOID *) dataPtr->init,
(size_t) dataPtr->initLen);
dst += dataPtr->initLen;
- memcpy((VOID *) dst, (VOID *) dataPtr->subTables[0].sequence,
- (size_t) len);
- dst += len;
} else {
state = (int) *statePtr;
}
@@ -2530,14 +2562,28 @@ EscapeFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
tablePrefixBytes = tableDataPtr->prefixBytes;
tableFromUnicode = tableDataPtr->fromUnicode;
- subTablePtr = &dataPtr->subTables[state];
- if (dst + subTablePtr->sequenceLen > dstEnd) {
- result = TCL_CONVERT_NOSPACE;
- break;
+ /*
+ * The state variable has the value of oldState when word is 0.
+ * In this case, the escape sequense should not be copied to dst
+ * because the current character set is not changed.
+ */
+ if (state != oldState) {
+ subTablePtr = &dataPtr->subTables[state];
+ if ((dst + subTablePtr->sequenceLen) > dstEnd) {
+ /*
+ * If there is no space to write the escape sequence, the
+ * state variable must be changed to the value of oldState
+ * variable because this escape sequence must be written
+ * in the next conversion.
+ */
+ state = oldState;
+ result = TCL_CONVERT_NOSPACE;
+ break;
+ }
+ memcpy((VOID *) dst, (VOID *) subTablePtr->sequence,
+ (size_t) subTablePtr->sequenceLen);
+ dst += subTablePtr->sequenceLen;
}
- memcpy((VOID *) dst, (VOID *) subTablePtr->sequence,
- (size_t) subTablePtr->sequenceLen);
- dst += subTablePtr->sequenceLen;
}
if (tablePrefixBytes[(word >> 8)] != 0) {
@@ -2560,9 +2606,15 @@ EscapeFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
}
if ((result == TCL_OK) && (flags & TCL_ENCODING_END)) {
- if (dst + dataPtr->finalLen > dstEnd) {
+ unsigned int len = dataPtr->subTables[0].sequenceLen;
+ 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);
+ dst += len;
+ }
memcpy((VOID *) dst, (VOID *) dataPtr->final,
(size_t) dataPtr->finalLen);
dst += dataPtr->finalLen;
diff --git a/tcl/generic/tclEnv.c b/tcl/generic/tclEnv.c
index 994bc292dbd..cc609bda6fe 100644
--- a/tcl/generic/tclEnv.c
+++ b/tcl/generic/tclEnv.c
@@ -20,28 +20,6 @@
TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ */
-/* CYGNUS LOCAL */
-#ifdef __CYGWIN32__
-
-/* On cygwin32, the environment is imported from the cygwin32 DLL. */
-
-__declspec(dllimport) extern char **__cygwin_environ;
-
-#define environ (__cygwin_environ)
-
-/* We need to use a special putenv function to handle PATH. */
-#ifndef USE_PUTENV
-#define USE_PUTENV
-#endif
-#define putenv TclCygwin32Putenv
-#endif
-/* END CYGNUS LOCAL */
-
-#ifdef TCL_THREADS
-
-static Tcl_Mutex envMutex; /* To serialize access to environ */
-#endif
-
static int cacheSize = 0; /* Number of env strings in environCache. */
static char **environCache = NULL;
/* Array containing all of the environment
@@ -68,18 +46,14 @@ char **environ = NULL;
*/
static char * EnvTraceProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, char *name1, char *name2,
- int flags));
+ 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));
-/* CYGNUS LOCAL */
-#ifdef __CYGWIN32__
-static void TclCygwin32Putenv _ANSI_ARGS_((CONST char *string));
-#endif
/*
*----------------------------------------------------------------------
@@ -200,7 +174,8 @@ TclSetEnv(name, value)
{
Tcl_DString envString;
int index, length, nameLength;
- char *p, *p2, *oldValue;
+ char *p, *oldValue;
+ CONST char *p2;
/*
* Figure out where the entry is going to go. If the name doesn't
@@ -218,12 +193,6 @@ TclSetEnv(name, value)
newEnviron = (char **) ckalloc((unsigned)
((length + 5) * sizeof(char *)));
-
- /* CYGNUS LOCAL: Added to avoid an error from Purify,
- although I don't personally see where the error would
- occur--ian. */
- memset((VOID *) newEnviron, 0, (length+5) * sizeof(char *));
-
memcpy((VOID *) newEnviron, (VOID *) environ,
length*sizeof(char *));
if (environSize != 0) {
@@ -231,6 +200,12 @@ TclSetEnv(name, value)
}
environ = newEnviron;
environSize = length + 5;
+#if defined(__APPLE__) && defined(__DYNAMIC__)
+ {
+ char ***e = _NSGetEnviron();
+ *e = environ;
+ }
+#endif
}
index = length;
environ[index + 1] = NULL;
@@ -238,7 +213,7 @@ TclSetEnv(name, value)
oldValue = NULL;
nameLength = strlen(name);
} else {
- char *env;
+ CONST char *env;
/*
* Compare the new value to the existing value. If they're
@@ -300,9 +275,23 @@ TclSetEnv(name, value)
if ((index != -1) && (environ[index] == p)) {
ReplaceString(oldValue, p);
+#ifdef HAVE_PUTENV_THAT_COPIES
+ } else {
+ /* This putenv() copies instead of taking ownership */
+ ckfree(p);
+#endif
}
Tcl_MutexUnlock(&envMutex);
+
+ if (!strcmp(name, "HOME")) {
+ /*
+ * If the user's home directory has changed, we must invalidate
+ * the filesystem cache, because '~' expansions will now be
+ * incorrect.
+ */
+ Tcl_FSMountsChanged(NULL);
+ }
}
/*
@@ -335,7 +324,8 @@ Tcl_PutEnv(string)
{
Tcl_DString nameString;
int nameLength;
- char *name, *value;
+ CONST char *name;
+ char *value;
if (string == NULL) {
return 0;
@@ -388,7 +378,7 @@ TclUnsetEnv(name)
CONST char *name; /* Name of variable to remove (UTF-8). */
{
char *oldValue;
- unsigned int length;
+ int length;
int index;
#ifdef USE_PUTENV
Tcl_DString envString;
@@ -475,7 +465,7 @@ TclUnsetEnv(name)
*----------------------------------------------------------------------
*/
-char *
+CONST char *
TclGetEnv(name, valuePtr)
CONST char *name; /* Name of environment variable to find
* (UTF-8). */
@@ -484,7 +474,7 @@ TclGetEnv(name, valuePtr)
* stored. */
{
int length, index;
- char *result;
+ CONST char *result;
Tcl_MutexLock(&envMutex);
index = TclpFindVariable(name, &length);
@@ -535,8 +525,8 @@ EnvTraceProc(clientData, interp, name1, name2, flags)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Interpreter whose "env" variable is
* being modified. */
- char *name1; /* Better be "env". */
- char *name2; /* Name of variable being modified, or NULL
+ 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. */
{
@@ -562,7 +552,7 @@ EnvTraceProc(clientData, interp, name1, name2, flags)
*/
if (flags & TCL_TRACE_WRITES) {
- char *value;
+ CONST char *value;
value = Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY);
TclSetEnv(name2, value);
@@ -574,7 +564,7 @@ EnvTraceProc(clientData, interp, name1, name2, flags)
if (flags & TCL_TRACE_READS) {
Tcl_DString valueString;
- char *value;
+ CONST char *value;
value = TclGetEnv(name2, &valueString);
if (value == NULL) {
@@ -665,7 +655,7 @@ ReplaceString(oldStr, newStr)
ckfree((char *) environCache);
}
environCache = newCache;
- environCache[cacheSize] = (char *) newStr;
+ environCache[cacheSize] = newStr;
environCache[cacheSize+1] = NULL;
cacheSize += 5;
}
@@ -709,86 +699,3 @@ TclFinalizeEnvironment()
#endif
}
}
-
-/* CYGNUS LOCAL */
-#ifdef __CYGWIN32__
-
-/* When using cygwin32, when an environment variable changes, we need
- to synch with both the cygwin32 environment (in case the
- application C code calls fork) and the Windows environment (in case
- the application TCL code calls exec, which calls the Windows
- CreateProcess function). */
-
-static void
-TclCygwin32Putenv(str)
- const char *str;
-{
- char *name, *value;
-
- /* Get the name and value, so that we can change the environment
- variable for Windows. */
- name = (char *) alloca (strlen (str) + 1);
- strcpy (name, str);
- for (value = name; *value != '=' && *value != '\0'; ++value)
- ;
- if (*value == '\0')
- {
- /* Can't happen. */
- return;
- }
- *value = '\0';
- ++value;
- if (*value == '\0')
- value = NULL;
-
- /* Set the cygwin32 environment variable. */
-#undef putenv
- if (value == NULL)
- unsetenv (name);
- else
- putenv(str);
-
- /* Before changing the environment variable in Windows, if this is
- PATH, we need to convert the value back to a Windows style path.
-
- FIXME: The calling program may now it is running under windows,
- and may have set the path to a Windows path, or, worse, appended
- or prepended a Windows path to PATH. */
- if (strcmp (name, "PATH") != 0)
- {
- /* If this is Path, eliminate any PATH variable, to prevent any
- confusion. */
- if (strcmp (name, "Path") == 0)
- {
- SetEnvironmentVariable ("PATH", (char *) NULL);
- unsetenv ("PATH");
- }
-
- SetEnvironmentVariable (name, value);
- }
- else
- {
- char *buf;
-
- /* Eliminate any Path variable, to prevent any confusion. */
- SetEnvironmentVariable ("Path", (char *) NULL);
- unsetenv ("Path");
-
- if (value == NULL)
- buf = NULL;
- else
- {
- int size;
-
- size = cygwin32_posix_to_win32_path_list_buf_size (value);
- buf = (char *) alloca (size + 1);
- cygwin32_posix_to_win32_path_list (value, buf);
- }
-
- SetEnvironmentVariable (name, buf);
- }
-}
-
-#endif /* __CYGWIN32__ */
-/* END CYGNUS LOCAL */
-
diff --git a/tcl/generic/tclEvent.c b/tcl/generic/tclEvent.c
index c4b16abdfce..d3351856489 100644
--- a/tcl/generic/tclEvent.c
+++ b/tcl/generic/tclEvent.c
@@ -99,6 +99,11 @@ typedef struct ThreadSpecificData {
static Tcl_ThreadDataKey dataKey;
/*
+ * Common string for the library path for sharing across threads.
+ */
+char *tclLibraryPathStr;
+
+/*
* Prototypes for procedures referenced only in this file:
*/
@@ -106,8 +111,8 @@ 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, char *name1, char *name2,
- int flags));
+ Tcl_Interp *interp, CONST char *name1,
+ CONST char *name2, int flags));
/*
*----------------------------------------------------------------------
@@ -135,7 +140,7 @@ Tcl_BackgroundError(interp)
* occurred. */
{
BgError *errPtr;
- char *errResult, *varValue;
+ CONST char *errResult, *varValue;
ErrAssocData *assocPtr;
int length;
@@ -217,7 +222,7 @@ HandleBgErrors(clientData)
ClientData clientData; /* Pointer to ErrAssocData structure. */
{
Tcl_Interp *interp;
- char *argv[2];
+ CONST char *argv[2];
int code;
BgError *errPtr;
ErrAssocData *assocPtr = (ErrAssocData *) clientData;
@@ -285,7 +290,7 @@ HandleBgErrors(clientData)
int len;
string = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &len);
- if (strcmp(string, "\"bgerror\" is an invalid command name or ambiguous abbreviation") == 0) {
+ if (Tcl_FindCommand(interp, "bgerror", NULL, TCL_GLOBAL_ONLY) == NULL) {
Tcl_WriteChars(errChannel, assocPtr->firstBgPtr->errorInfo, -1);
Tcl_WriteChars(errChannel, "\n", -1);
} else {
@@ -596,6 +601,12 @@ TclSetLibraryPath(pathPtr)
Tcl_DecrRefCount(tsdPtr->tclLibraryPath);
}
tsdPtr->tclLibraryPath = pathPtr;
+
+ /*
+ * No mutex locking is needed here as up the stack we're within
+ * TclpInitLock().
+ */
+ tclLibraryPathStr = Tcl_GetStringFromObj(pathPtr, NULL);
}
/*
@@ -619,6 +630,17 @@ Tcl_Obj *
TclGetLibraryPath()
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if (tsdPtr->tclLibraryPath == NULL) {
+ /*
+ * Grab the shared string and place it into a new thread specific
+ * Tcl_Obj.
+ */
+ tsdPtr->tclLibraryPath = Tcl_NewStringObj(tclLibraryPathStr, -1);
+
+ /* take ownership */
+ Tcl_IncrRefCount(tsdPtr->tclLibraryPath);
+ }
return tsdPtr->tclLibraryPath;
}
@@ -744,10 +766,11 @@ Tcl_Finalize()
ThreadSpecificData *tsdPtr;
TclpInitLock();
- tsdPtr = TCL_TSD_INIT(&dataKey);
if (subsystemsInitialized != 0) {
subsystemsInitialized = 0;
+ tsdPtr = TCL_TSD_INIT(&dataKey);
+
/*
* Invoke exit handlers first.
*/
@@ -772,15 +795,6 @@ Tcl_Finalize()
Tcl_MutexUnlock(&exitMutex);
/*
- * Clean up the library path now, before we invalidate thread-local
- * storage.
- */
- if (tsdPtr->tclLibraryPath != NULL) {
- Tcl_DecrRefCount(tsdPtr->tclLibraryPath);
- tsdPtr->tclLibraryPath = NULL;
- }
-
- /*
* 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.
@@ -822,13 +836,12 @@ Tcl_Finalize()
TclFinalizeSynchronization();
- /*
- * We defer unloading of packages until very late
- * to avoid memory access issues. Both exit callbacks and
- * synchronization variables may be stored in packages.
+ /**
+ * Finalizing the filesystem must come after anything which
+ * might conceivably interact with the 'Tcl_FS' API. This
+ * will also unload any extensions which have been loaded.
*/
-
- TclFinalizeLoad();
+ TclFinalizeFilesystem();
/*
* There shouldn't be any malloc'ed memory after this.
@@ -870,6 +883,17 @@ Tcl_FinalizeThread()
*/
tsdPtr->inExit = 1;
+
+ /*
+ * Clean up the library path now, before we invalidate thread-local
+ * storage or calling thread exit handlers.
+ */
+
+ if (tsdPtr->tclLibraryPath != NULL) {
+ Tcl_DecrRefCount(tsdPtr->tclLibraryPath);
+ tsdPtr->tclLibraryPath = NULL;
+ }
+
for (exitPtr = tsdPtr->firstExitPtr; exitPtr != NULL;
exitPtr = tsdPtr->firstExitPtr) {
/*
@@ -884,6 +908,7 @@ Tcl_FinalizeThread()
}
TclFinalizeIOSubsystem();
TclFinalizeNotifier();
+ TclFinalizeAsync();
/*
* Blow away all thread local storage blocks.
@@ -912,8 +937,13 @@ Tcl_FinalizeThread()
int
TclInExit()
{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- return tsdPtr->inExit;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ TclThreadDataKeyGet(&dataKey);
+ if (tsdPtr == NULL) {
+ return inFinalize;
+ } else {
+ return tsdPtr->inExit;
+ }
}
/*
@@ -982,8 +1012,8 @@ static char *
VwaitVarProc(clientData, interp, name1, name2, flags)
ClientData clientData; /* Pointer to integer to set to 1. */
Tcl_Interp *interp; /* Interpreter containing variable. */
- char *name1; /* Name of variable. */
- char *name2; /* Second part of variable name. */
+ CONST char *name1; /* Name of variable. */
+ CONST char *name2; /* Second part of variable name. */
int flags; /* Information about what happened. */
{
int *donePtr = (int *) clientData;
@@ -1019,7 +1049,7 @@ Tcl_UpdateObjCmd(clientData, interp, objc, objv)
{
int optionIndex;
int flags = 0; /* Initialized to avoid compiler warning. */
- static char *updateOptions[] = {"idletasks", (char *) NULL};
+ static CONST char *updateOptions[] = {"idletasks", (char *) NULL};
enum updateOptions {REGEXP_IDLETASKS};
if (objc == 1) {
@@ -1055,4 +1085,3 @@ Tcl_UpdateObjCmd(clientData, interp, objc, objv)
Tcl_ResetResult(interp);
return TCL_OK;
}
-
diff --git a/tcl/generic/tclExecute.c b/tcl/generic/tclExecute.c
index 95c0c9e04d5..d86a7c1e9c5 100644
--- a/tcl/generic/tclExecute.c
+++ b/tcl/generic/tclExecute.c
@@ -5,6 +5,8 @@
* commands.
*
* Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-2000 by Scriptics Corporation.
+ * 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.
@@ -15,13 +17,8 @@
#include "tclInt.h"
#include "tclCompile.h"
-#ifdef NO_FLOAT_H
-# include "../compat/float.h"
-#else
-# include <float.h>
-#endif
#ifndef TCL_NO_MATH
-#include "tclMath.h"
+# include "tclMath.h"
#endif
/*
@@ -31,18 +28,40 @@
*/
#ifndef TCL_GENERIC_ONLY
-#include "tclPort.h"
-#else
-#define NO_ERRNO_H
-#endif
+# include "tclPort.h"
+#else /* 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
+# 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 */
+
+/*
* Boolean flag indicating whether the Tcl bytecode interpreter has been
* initialized.
*/
@@ -50,6 +69,7 @@ int errno;
static int execInitialized = 0;
TCL_DECLARE_MUTEX(execMutex)
+#ifdef TCL_COMPILE_DEBUG
/*
* Variable that controls whether execution tracing is enabled and, if so,
* what level of tracing is desired:
@@ -61,32 +81,6 @@ TCL_DECLARE_MUTEX(execMutex)
*/
int tclTraceExec = 0;
-
-typedef struct ThreadSpecificData {
- /*
- * The following global variable is use to signal matherr that Tcl
- * is responsible for the arithmetic, so errors can be handled in a
- * fashion appropriate for Tcl. Zero means no Tcl math is in
- * progress; non-zero means Tcl is doing math.
- */
-
- int mathInProgress;
-
-} ThreadSpecificData;
-
-static Tcl_ThreadDataKey dataKey;
-
-/*
- * The variable below serves no useful purpose except to generate
- * a reference to matherr, so that the Tcl version of matherr is
- * linked in rather than the system version. Without this reference
- * the need for matherr won't be discovered during linking until after
- * libtcl.a has been processed, so Tcl's version won't be used.
- */
-
-#ifdef NEED_MATHERR
-extern int matherr();
-int (*tclMatherrPtr)() = matherr;
#endif
/*
@@ -98,9 +92,10 @@ int (*tclMatherrPtr)() = matherr;
static char *operatorStrings[] = {
"||", "&&", "|", "^", "&", "==", "!=", "<", ">", "<=", ">=", "<<", ">>",
"+", "-", "*", "/", "%", "+", "-", "~", "!",
- "BUILTIN FUNCTION", "FUNCTION"
+ "BUILTIN FUNCTION", "FUNCTION",
+ "", "", "", "", "", "", "", "", "eq", "ne",
};
-
+
/*
* Mapping from Tcl result codes to strings; used for error and debugging
* messages.
@@ -113,26 +108,82 @@ static char *resultStrings[] = {
#endif
/*
+ * These are used by evalstats to monitor object usage in Tcl.
+ */
+
+#ifdef TCL_COMPILE_STATS
+long tclObjsAlloced = 0;
+long tclObjsFreed = 0;
+#define TCL_MAX_SHARED_OBJ_STATS 5
+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.
*/
#define IS_NAN(v) ((v) != (v))
-#ifdef DBL_MAX
-# define IS_INF(v) (((v) > DBL_MAX) || ((v) < -DBL_MAX))
-#else
-# define IS_INF(v) 0
-#endif
+#define IS_INF(v) (((v) > DBL_MAX) || ((v) < -DBL_MAX))
/*
- * Macro to adjust the program counter and restart the instruction execution
- * loop after each instruction is executed.
+ * 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; the macro
+ * NEXT_INST_F handles constant (nCleanup), NEXT_INST_V is
+ * resolved at runtime for variable (nCleanup).
+ *
+ * ARGUMENTS:
+ * pcAdjustment: how much to increment pc
+ * nCleanup: how many objects to remove from the stack
+ * result: 0 indicates no object should be pushed on the
+ * stack; otherwise, push objResultPtr. If (result < 0),
+ * objResultPtr already has the correct reference count.
*/
-#define ADJUST_PC(instBytes) \
- pc += (instBytes); \
- continue
+#define NEXT_INST_F(pcAdjustment, nCleanup, result) \
+ if (nCleanup == 0) {\
+ if (result != 0) {\
+ if ((result) > 0) {\
+ PUSH_OBJECT(objResultPtr);\
+ } else {\
+ stackPtr[++stackTop] = objResultPtr;\
+ }\
+ } \
+ pc += (pcAdjustment);\
+ goto cleanup0;\
+ } else if (result != 0) {\
+ if ((result) > 0) {\
+ Tcl_IncrRefCount(objResultPtr);\
+ }\
+ pc += (pcAdjustment);\
+ switch (nCleanup) {\
+ case 1: goto cleanup1_pushObjResultPtr;\
+ case 2: goto cleanup2_pushObjResultPtr;\
+ default: panic("ERROR: bad usage of macro NEXT_INST_F");\
+ }\
+ } else {\
+ pc += (pcAdjustment);\
+ switch (nCleanup) {\
+ case 1: goto cleanup1;\
+ case 2: goto cleanup2;\
+ default: panic("ERROR: bad usage of macro NEXT_INST_F");\
+ }\
+ }
+
+#define NEXT_INST_V(pcAdjustment, nCleanup, result) \
+ pc += (pcAdjustment);\
+ cleanup = (nCleanup);\
+ if (result) {\
+ if ((result) > 0) {\
+ Tcl_IncrRefCount(objResultPtr);\
+ }\
+ goto cleanupV_pushObjResultPtr;\
+ } else {\
+ goto cleanupV;\
+ }
+
/*
* Macros used to cache often-referenced Tcl evaluation stack information
@@ -149,6 +200,7 @@ static char *resultStrings[] = {
#define DECACHE_STACK_INFO() \
eePtr->stackTop = stackTop
+
/*
* Macros used to access items on the Tcl evaluation stack. PUSH_OBJECT
* increments the object's ref count since it makes the stack have another
@@ -177,40 +229,130 @@ static char *resultStrings[] = {
*/
#ifdef TCL_COMPILE_DEBUG
-#define TRACE(a) \
+# define TRACE(a) \
if (traceInstructions) { \
fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, stackTop, \
(unsigned int)(pc - codePtr->codeStart), \
GetOpcodeName(pc)); \
printf a; \
}
-#define TRACE_WITH_OBJ(a, objPtr) \
+# define TRACE_APPEND(a) \
+ if (traceInstructions) { \
+ printf a; \
+ }
+# define TRACE_WITH_OBJ(a, objPtr) \
if (traceInstructions) { \
fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, stackTop, \
(unsigned int)(pc - codePtr->codeStart), \
GetOpcodeName(pc)); \
printf a; \
- TclPrintObject(stdout, (objPtr), 30); \
+ TclPrintObject(stdout, objPtr, 30); \
fprintf(stdout, "\n"); \
}
-#define O2S(objPtr) \
- Tcl_GetString(objPtr)
-#else
-#define TRACE(a)
-#define TRACE_WITH_OBJ(a, objPtr)
-#define O2S(objPtr)
+# define O2S(objPtr) \
+ (objPtr ? TclGetString(objPtr) : "")
+#else /* !TCL_COMPILE_DEBUG */
+# define TRACE(a)
+# define TRACE_APPEND(a)
+# define TRACE_WITH_OBJ(a, objPtr)
+# define O2S(objPtr)
#endif /* TCL_COMPILE_DEBUG */
+
+/*
+ * Most of the code to support working with wide values is factored
+ * out here because it greatly reduces the number of conditionals
+ * through the rest of the file. Note that this needs to be
+ * conditional because we do not want to alter Tcl's behaviour on
+ * native-64bit platforms...
+ */
+
+#ifndef TCL_WIDE_INT_IS_LONG
+#define W0 Tcl_LongAsWide(0)
+
+/*
+ * 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.
+ */
+#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 IS_INTEGER_TYPE(typePtr) \
+ ((typePtr) == &tclIntType || (typePtr) == &tclWideIntType)
+/*
+ * Extract a double value from a general numeric object.
+ */
+#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; \
+ }
+/*
+ * Combined with REQUIRE_WIDE_OR_INT, this gets a long value from
+ * an obj.
+ */
+#define FORCE_LONG(objPtr, longVar, wideVar) \
+ if ((objPtr)->typePtr == &tclWideIntType) { \
+ (longVar) = Tcl_WideAsLong(wideVar); \
+ }
+/*
+ * For tracing that uses wide values.
+ */
+#define LLTRACE(a) TRACE(a)
+#define LLTRACE_WITH_OBJ(a,b) TRACE_WITH_OBJ(a,b)
+#define LLD "%" TCL_LL_MODIFIER "d"
+#else /* TCL_WIDE_INT_IS_LONG */
+/*
+ * Versions of the above that do not use wide values.
+ */
+#define REQUIRE_WIDE_OR_INT(resultVar, objPtr, longVar, wideVar) \
+ (resultVar) = Tcl_GetLongFromObj(interp, (objPtr), &(longVar));
+#define GET_WIDE_OR_INT(resultVar, objPtr, longVar, wideVar) \
+ (resultVar) = Tcl_GetLongFromObj((Tcl_Interp *) NULL, (objPtr), \
+ &(longVar));
+#define IS_INTEGER_TYPE(typePtr) ((typePtr) == &tclIntType)
+#define GET_DOUBLE_VALUE(doubleVar, objPtr, typePtr) \
+ if ((typePtr) == &tclIntType) { \
+ (doubleVar) = (double) (objPtr)->internalRep.longValue; \
+ } else { \
+ (doubleVar) = (objPtr)->internalRep.doubleValue; \
+ }
+#define FORCE_LONG(objPtr, longVar, wideVar)
+#define LLTRACE(a)
+#define LLTRACE_WITH_OBJ(a,b)
+#endif /* TCL_WIDE_INT_IS_LONG */
+#define IS_NUMERIC_TYPE(typePtr) \
+ (IS_INTEGER_TYPE(typePtr) || (typePtr) == &tclDoubleType)
+
/*
* Declarations for local procedures to this file:
*/
-static void CallTraceProcedure _ANSI_ARGS_((Tcl_Interp *interp,
- Trace *tracePtr, Command *cmdPtr,
- char *command, int numChars,
- int objc, Tcl_Obj *objv[]));
-static void DupCmdNameInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,
- Tcl_Obj *copyPtr));
+static int TclExecuteByteCode _ANSI_ARGS_((Tcl_Interp *interp,
+ ByteCode *codePtr));
static int ExprAbsFunc _ANSI_ARGS_((Tcl_Interp *interp,
ExecEnv *eePtr, ClientData clientData));
static int ExprBinaryFunc _ANSI_ARGS_((Tcl_Interp *interp,
@@ -229,12 +371,14 @@ static int ExprSrandFunc _ANSI_ARGS_((Tcl_Interp *interp,
ExecEnv *eePtr, ClientData clientData));
static int ExprUnaryFunc _ANSI_ARGS_((Tcl_Interp *interp,
ExecEnv *eePtr, ClientData clientData));
+#ifndef TCL_WIDE_INT_IS_LONG
+static int ExprWideFunc _ANSI_ARGS_((Tcl_Interp *interp,
+ ExecEnv *eePtr, ClientData clientData));
+#endif
#ifdef TCL_COMPILE_STATS
static int EvalStatsCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
#endif
-static void FreeCmdNameInternalRep _ANSI_ARGS_((
- Tcl_Obj *objPtr));
#ifdef TCL_COMPILE_DEBUG
static char * GetOpcodeName _ANSI_ARGS_((unsigned char *pc));
#endif
@@ -250,15 +394,10 @@ static void InitByteCodeExecution _ANSI_ARGS_((
Tcl_Interp *interp));
#ifdef TCL_COMPILE_DEBUG
static void PrintByteCodeInfo _ANSI_ARGS_((ByteCode *codePtr));
-#endif
-static int SetCmdNameFromAny _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr));
-#ifdef TCL_COMPILE_DEBUG
static char * StringForResultCode _ANSI_ARGS_((int result));
static void ValidatePcAndStackTop _ANSI_ARGS_((
ByteCode *codePtr, unsigned char *pc,
- int stackTop, int stackLowerBound,
- int stackUpperBound));
+ int stackTop, int stackLowerBound));
#endif
static int VerifyExprObjType _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Obj *objPtr));
@@ -269,7 +408,7 @@ static int VerifyExprObjType _ANSI_ARGS_((Tcl_Interp *interp,
* operand byte.
*/
-BuiltinFunc builtinFuncTable[] = {
+BuiltinFunc tclBuiltinFuncTable[] = {
#ifndef TCL_NO_MATH
{"acos", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) acos},
{"asin", 1, {TCL_DOUBLE}, ExprUnaryFunc, (ClientData) asin},
@@ -297,24 +436,13 @@ BuiltinFunc builtinFuncTable[] = {
{"rand", 0, {TCL_EITHER}, ExprRandFunc, 0}, /* NOTE: rand takes no args. */
{"round", 1, {TCL_EITHER}, ExprRoundFunc, 0},
{"srand", 1, {TCL_INT}, ExprSrandFunc, 0},
+#ifdef TCL_WIDE_INT_IS_LONG
+ {"wide", 1, {TCL_EITHER}, ExprIntFunc, 0},
+#else
+ {"wide", 1, {TCL_EITHER}, ExprWideFunc, 0},
+#endif /* TCL_WIDE_INT_IS_LONG */
{0},
};
-
-/*
- * 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 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.
- */
-
-Tcl_ObjType tclCmdNameType = {
- "cmdName", /* name */
- FreeCmdNameInternalRep, /* freeIntRepProc */
- DupCmdNameInternalRep, /* dupIntRepProc */
- (Tcl_UpdateStringProc *) NULL, /* updateStringProc */
- SetCmdNameFromAny /* setFromAnyProc */
-};
/*
*----------------------------------------------------------------------
@@ -331,9 +459,8 @@ Tcl_ObjType tclCmdNameType = {
* This procedure initializes the array of instruction names. If
* compiling with the TCL_COMPILE_STATS flag, it initializes the
* array that counts the executions of each instruction and it
- * creates the "evalstats" command. It also registers the command name
- * Tcl_ObjType. It also establishes the link between the Tcl
- * "tcl_traceExec" and C "tclTraceExec" variables.
+ * creates the "evalstats" command. It also establishes the link
+ * between the Tcl "tcl_traceExec" and C "tclTraceExec" variables.
*
*----------------------------------------------------------------------
*/
@@ -344,12 +471,12 @@ InitByteCodeExecution(interp)
* "tcl_traceExec" is linked to control
* instruction tracing. */
{
- Tcl_RegisterObjType(&tclCmdNameType);
+#ifdef TCL_COMPILE_DEBUG
if (Tcl_LinkVar(interp, "tcl_traceExec", (char *) &tclTraceExec,
TCL_LINK_INT) != TCL_OK) {
panic("InitByteCodeExecution: can't create link for tcl_traceExec variable");
}
-
+#endif
#ifdef TCL_COMPILE_STATS
Tcl_CreateCommand(interp, "evalstats", EvalStatsCmd,
(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
@@ -386,11 +513,28 @@ TclCreateExecEnv(interp)
* environment is being created. */
{
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->stackPtr = (Tcl_Obj **)
- ckalloc((unsigned) (TCL_STACK_INITIAL_SIZE * sizeof(Tcl_Obj *)));
eePtr->stackTop = -1;
- eePtr->stackEnd = (TCL_STACK_INITIAL_SIZE - 1);
+ eePtr->stackEnd = (TCL_STACK_INITIAL_SIZE - 2);
+
+ eePtr->errorInfo = Tcl_NewStringObj("::errorInfo", -1);
+ Tcl_IncrRefCount(eePtr->errorInfo);
+
+ eePtr->errorCode = Tcl_NewStringObj("::errorCode", -1);
+ Tcl_IncrRefCount(eePtr->errorCode);
Tcl_MutexLock(&execMutex);
if (!execInitialized) {
@@ -425,7 +569,13 @@ void
TclDeleteExecEnv(eePtr)
ExecEnv *eePtr; /* Execution environment to free. */
{
- ckfree((char *) eePtr->stackPtr);
+ if (eePtr->stackPtr[-1] == (Tcl_Obj *) ((char *) 1)) {
+ ckfree((char *) (eePtr->stackPtr-1));
+ } else {
+ panic("ERROR: freeing an execEnv whose stack is still in use.\n");
+ }
+ TclDecrRefCount(eePtr->errorInfo);
+ TclDecrRefCount(eePtr->errorCode);
ckfree((char *) eePtr);
}
@@ -487,17 +637,416 @@ GrowEvaluationStack(eePtr)
int currBytes = currElems * sizeof(Tcl_Obj *);
int newBytes = 2*currBytes;
Tcl_Obj **newStackPtr = (Tcl_Obj **) ckalloc((unsigned) newBytes);
+ Tcl_Obj **oldStackPtr = eePtr->stackPtr;
+
+ /*
+ * We keep the stack reference count as a (char *), as that
+ * works nicely as a portable pointer-sized counter.
+ */
+
+ char *refCount = (char *) oldStackPtr[-1];
/*
* Copy the existing stack items to the new stack space, free the old
- * storage if appropriate, and mark new space as malloc'ed.
+ * storage if appropriate, and record the refCount of the new stack
+ * held by the environment.
*/
- memcpy((VOID *) newStackPtr, (VOID *) eePtr->stackPtr,
+ newStackPtr++;
+ memcpy((VOID *) newStackPtr, (VOID *) oldStackPtr,
(size_t) currBytes);
- ckfree((char *) eePtr->stackPtr);
+
+ if (refCount == (char *) 1) {
+ ckfree((VOID *) (oldStackPtr-1));
+ } else {
+ /*
+ * Remove the reference corresponding to the
+ * environment pointer.
+ */
+
+ oldStackPtr[-1] = (Tcl_Obj *) (refCount-1);
+ }
+
eePtr->stackPtr = newStackPtr;
- eePtr->stackEnd = (newElems - 1); /* i.e. index of last usable item */
+ eePtr->stackEnd = (newElems - 2); /* index of last usable item */
+ newStackPtr[-1] = (Tcl_Obj *) ((char *) 1);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tcl_ExprObj --
+ *
+ * Evaluate an expression in a Tcl_Obj.
+ *
+ * Results:
+ * A standard Tcl object result. If the result is other than TCL_OK,
+ * then the interpreter's result contains an error message. If the
+ * result is TCL_OK, then a pointer to the expression's result value
+ * object is stored in resultPtrPtr. In that case, the object's ref
+ * count is incremented to reflect the reference returned to the
+ * caller; the caller is then responsible for the resulting object
+ * and must, for example, decrement the ref count when it is finished
+ * with the object.
+ *
+ * Side effects:
+ * Any side effects caused by subcommands in the expression, if any.
+ * The interpreter result is not modified unless there is an error.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tcl_ExprObj(interp, objPtr, resultPtrPtr)
+ Tcl_Interp *interp; /* Context in which to evaluate the
+ * expression. */
+ register Tcl_Obj *objPtr; /* Points to Tcl object containing
+ * expression to evaluate. */
+ Tcl_Obj **resultPtrPtr; /* Where the Tcl_Obj* that is the expression
+ * result is stored if no errors occur. */
+{
+ 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 to avoid compiler warning. */
+ AuxData *auxDataPtr;
+ LiteralEntry *entryPtr;
+ Tcl_Obj *saveObjPtr;
+ char *string;
+ int length, i, result;
+
+ /*
+ * First handle some common expressions specially.
+ */
+
+ string = Tcl_GetStringFromObj(objPtr, &length);
+ if (length == 1) {
+ if (*string == '0') {
+ *resultPtrPtr = Tcl_NewLongObj(0);
+ Tcl_IncrRefCount(*resultPtrPtr);
+ return TCL_OK;
+ } else if (*string == '1') {
+ *resultPtrPtr = Tcl_NewLongObj(1);
+ Tcl_IncrRefCount(*resultPtrPtr);
+ return TCL_OK;
+ }
+ } else if ((length == 2) && (*string == '!')) {
+ if (*(string+1) == '0') {
+ *resultPtrPtr = Tcl_NewLongObj(1);
+ Tcl_IncrRefCount(*resultPtrPtr);
+ return TCL_OK;
+ } else if (*(string+1) == '1') {
+ *resultPtrPtr = Tcl_NewLongObj(0);
+ Tcl_IncrRefCount(*resultPtrPtr);
+ 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.
+ *
+ */
+
+ if (objPtr->typePtr == &tclByteCodeType) {
+ codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+ if (((Interp *) *codePtr->interpHandle != iPtr)
+ || (codePtr->compileEpoch != iPtr->compileEpoch)) {
+ if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
+ if ((Interp *) *codePtr->interpHandle != iPtr) {
+ panic("Tcl_ExprObj: compiled expression jumped interps");
+ }
+ codePtr->compileEpoch = iPtr->compileEpoch;
+ } else {
+ (*tclByteCodeType.freeIntRepProc)(objPtr);
+ objPtr->typePtr = (Tcl_ObjType *) NULL;
+ }
+ }
+ }
+ if (objPtr->typePtr != &tclByteCodeType) {
+ TclInitCompileEnv(interp, &compEnv, string, length);
+ result = TclCompileExpr(interp, string, length, &compEnv);
+
+ /*
+ * Free the compilation environment's literal table bucket array if
+ * it was dynamically allocated.
+ */
+
+ 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*/
+
+ 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;
+ }
+
+ /*
+ * Successful compilation. If the expression yielded no
+ * instructions, push an zero object as the expression's result.
+ */
+
+ if (compEnv.codeNext == compEnv.codeStart) {
+ TclEmitPush(TclRegisterLiteral(&compEnv, "0", 1, /*onHeap*/ 0),
+ &compEnv);
+ }
+
+ /*
+ * 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.
+ */
+
+ compEnv.numSrcBytes = iPtr->termOffset;
+ TclEmitOpcode(INST_DONE, &compEnv);
+ TclInitByteCodeObj(objPtr, &compEnv);
+ TclFreeCompileEnv(&compEnv);
+ codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+#ifdef TCL_COMPILE_DEBUG
+ if (tclTraceCompile == 2) {
+ TclPrintByteCodeObj(interp, objPtr);
+ }
+#endif /* TCL_COMPILE_DEBUG */
+ }
+
+ /*
+ * Execute the expression after first saving the interpreter's result.
+ */
+
+ saveObjPtr = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(saveObjPtr);
+ Tcl_ResetResult(interp);
+
+ /*
+ * Increment the code's ref count while it is being executed. If
+ * afterwards no references to it remain, free the code.
+ */
+
+ codePtr->refCount++;
+ result = TclExecuteByteCode(interp, codePtr);
+ 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 --
+ *
+ * This procedure evaluates the script contained in a Tcl_Obj by
+ * first compiling it and then passing it to TclExecuteByteCode.
+ *
+ * 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.
+ *
+ * Side effects:
+ * Almost certainly, depending on the ByteCode's instructions.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompEvalObj(interp, objPtr)
+ Tcl_Interp *interp;
+ Tcl_Obj *objPtr;
+{
+ register Interp *iPtr = (Interp *) interp;
+ register ByteCode* codePtr; /* Tcl Internal type of bytecode. */
+ int oldCount = iPtr->cmdCount; /* Used to tell whether any commands
+ * at all were executed. */
+ char *script;
+ int numSrcBytes;
+ int result;
+ Namespace *namespacePtr;
+
+
+ /*
+ * Check that the interpreter is ready to execute scripts
+ */
+
+ if (TclInterpReady(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ if (iPtr->varFramePtr != NULL) {
+ namespacePtr = iPtr->varFramePtr->nsPtr;
+ } else {
+ namespacePtr = iPtr->globalNsPtr;
+ }
+
+ /*
+ * 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.
+ */
+
+ if (objPtr->typePtr != &tclByteCodeType) {
+ recompileObj:
+ iPtr->errorLine = 1;
+ result = tclByteCodeType.setFromAnyProc(interp, objPtr);
+ if (result != TCL_OK) {
+ return result;
+ }
+ iPtr->evalFlags = 0;
+ codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+ } else {
+ /*
+ * 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 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 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 #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;
+ 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) {
+ panic("Tcl_EvalObj: compiled script jumped interps");
+ }
+ codePtr->compileEpoch = iPtr->compileEpoch;
+ } else {
+ /*
+ * This byteCode is invalid: free it and recompile
+ */
+ tclByteCodeType.freeIntRepProc(objPtr);
+ goto recompileObj;
+ }
+ }
+ }
+
+ /*
+ * Execute the commands. If the code was compiled from an empty string,
+ * don't bother executing the code.
+ */
+
+ numSrcBytes = codePtr->numSrcBytes;
+ if ((numSrcBytes > 0) || (codePtr->flags & TCL_BYTECODE_PRECOMPILED)) {
+ /*
+ * Increment the code's ref count while it is being executed. If
+ * afterwards no references to it remain, free the code.
+ */
+
+ codePtr->refCount++;
+ iPtr->numLevels++;
+ result = TclExecuteByteCode(interp, codePtr);
+ iPtr->numLevels--;
+ codePtr->refCount--;
+ if (codePtr->refCount <= 0) {
+ TclCleanupByteCode(codePtr);
+ }
+ } else {
+ result = TCL_OK;
+ }
+
+ /*
+ * If no commands at all were executed, check for asynchronous
+ * handlers so that they at least get one change to execute.
+ * This is needed to handle event loops written in Tcl with
+ * empty bodies.
+ */
+
+ if ((oldCount == iPtr->cmdCount) && Tcl_AsyncReady()) {
+ result = Tcl_AsyncInvoke(interp, result);
+
+
+ /*
+ * If an error occurred, record information about what was being
+ * executed when the error occurred.
+ */
+
+ if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
+ script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
+ Tcl_LogCommandInfo(interp, script, script, numSrcBytes);
+ }
+ }
+
+ /*
+ * Set the interpreter's termOffset member to the offset of the
+ * character just after the last one executed. We approximate the offset
+ * of the last character executed by using the number of characters
+ * compiled.
+ */
+
+ iPtr->termOffset = numSrcBytes;
+ iPtr->flags &= ~ERR_ALREADY_LOGGED;
+
+ return result;
}
/*
@@ -519,8 +1068,8 @@ GrowEvaluationStack(eePtr)
*
*----------------------------------------------------------------------
*/
-
-int
+
+static int
TclExecuteByteCode(interp, codePtr)
Tcl_Interp *interp; /* Token for command interpreter. */
ByteCode *codePtr; /* The bytecode sequence to interpret. */
@@ -534,7 +1083,7 @@ TclExecuteByteCode(interp, codePtr)
/* Cached top index of evaluation stack. */
register unsigned char *pc = codePtr->codeStart;
/* The current program counter. */
- int opnd; /* Current instruction's operand byte. */
+ int opnd; /* Current instruction's operand byte(s). */
int pcAdjustment; /* Hold pc adjustment after instruction. */
int initStackTop = stackTop;/* Stack top at start of execution. */
ExceptionRange *rangePtr; /* Points to closest loop or catch exception
@@ -542,11 +1091,23 @@ TclExecuteByteCode(interp, codePtr)
* instructions and processCatch to
* process break, continue, and errors. */
int result = TCL_OK; /* Return code returned after execution. */
- int traceInstructions = (tclTraceExec == 3);
+ int storeFlags;
Tcl_Obj *valuePtr, *value2Ptr, *objPtr;
char *bytes;
int length;
- long i;
+ long i = 0; /* Init. avoids compiler warning. */
+#ifndef TCL_WIDE_INT_IS_LONG
+ Tcl_WideInt w;
+#endif
+ register int cleanup;
+ Tcl_Obj *objResultPtr;
+ char *part1, *part2;
+ Var *varPtr, *arrayPtr;
+ CallFrame *varFramePtr = iPtr->varFramePtr;
+#ifdef TCL_COMPILE_DEBUG
+ int traceInstructions = (tclTraceExec == 3);
+ char cmdNameBuf[21];
+#endif
/*
* This procedure uses a stack to hold information about catch commands.
@@ -566,6 +1127,7 @@ TclExecuteByteCode(interp, codePtr)
fprintf(stdout, " Starting stack top=%d\n", eePtr->stackTop);
fflush(stdout);
}
+ opnd = 0; /* Init. avoids compiler warning. */
#endif
#ifdef TCL_COMPILE_STATS
@@ -593,2324 +1155,3059 @@ TclExecuteByteCode(interp, codePtr)
}
/*
- * Loop executing instructions until a "done" instruction, a TCL_RETURN,
- * or some error.
+ * Loop executing instructions until a "done" instruction, a
+ * TCL_RETURN, or some error.
*/
- for (;;) {
+ goto cleanup0;
+
+
+ /*
+ * Targets for standard instruction endings; unrolled
+ * for speed in the most frequent cases (instructions that
+ * consume up to two stack elements).
+ *
+ * This used to be a "for(;;)" loop, with each instruction doing
+ * its own cleanup.
+ */
+
+ cleanupV_pushObjResultPtr:
+ switch (cleanup) {
+ case 0:
+ stackPtr[++stackTop] = (objResultPtr);
+ goto cleanup0;
+ default:
+ cleanup -= 2;
+ while (cleanup--) {
+ valuePtr = POP_OBJECT();
+ TclDecrRefCount(valuePtr);
+ }
+ case 2:
+ cleanup2_pushObjResultPtr:
+ valuePtr = POP_OBJECT();
+ TclDecrRefCount(valuePtr);
+ case 1:
+ cleanup1_pushObjResultPtr:
+ valuePtr = stackPtr[stackTop];
+ TclDecrRefCount(valuePtr);
+ }
+ stackPtr[stackTop] = objResultPtr;
+ goto cleanup0;
+
+ cleanupV:
+ switch (cleanup) {
+ default:
+ cleanup -= 2;
+ while (cleanup--) {
+ valuePtr = POP_OBJECT();
+ TclDecrRefCount(valuePtr);
+ }
+ 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;
+ }
+
+ cleanup0:
+
#ifdef TCL_COMPILE_DEBUG
- ValidatePcAndStackTop(codePtr, pc, stackTop, initStackTop,
- eePtr->stackEnd);
-#else /* not TCL_COMPILE_DEBUG */
- if (traceInstructions) {
- fprintf(stdout, "%2d: %2d ", iPtr->numLevels, stackTop);
- TclPrintInstruction(codePtr, pc);
- fflush(stdout);
- }
+ ValidatePcAndStackTop(codePtr, pc, stackTop, initStackTop);
+ if (traceInstructions) {
+ fprintf(stdout, "%2d: %2d ", iPtr->numLevels, stackTop);
+ TclPrintInstruction(codePtr, pc);
+ fflush(stdout);
+ }
#endif /* TCL_COMPILE_DEBUG */
-
+
#ifdef TCL_COMPILE_STATS
- iPtr->stats.instructionCount[*pc]++;
+ iPtr->stats.instructionCount[*pc]++;
#endif
- switch (*pc) {
- case INST_DONE:
- /*
- * Pop the topmost object from the stack, set the interpreter's
- * object result to point to it, and return.
- */
- valuePtr = POP_OBJECT();
- Tcl_SetObjResult(interp, valuePtr);
- TclDecrRefCount(valuePtr);
- if (stackTop != initStackTop) {
- fprintf(stderr, "\nTclExecuteByteCode: done instruction at pc %u: stack top %d != entry stack top %d\n",
- (unsigned int)(pc - codePtr->codeStart),
- (unsigned int) stackTop,
- (unsigned int) initStackTop);
- panic("TclExecuteByteCode execution failure: end stack top != start stack top");
- }
- TRACE_WITH_OBJ(("=> return code=%d, result=", result),
- iPtr->objResultPtr);
+ switch (*pc) {
+ case INST_DONE:
+ if (stackTop <= initStackTop) {
+ stackTop--;
+ goto abnormalReturn;
+ }
+
+ /*
+ * 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".
+ */
+
+ valuePtr = stackPtr[stackTop];
+ Tcl_SetObjResult(interp, valuePtr);
#ifdef TCL_COMPILE_DEBUG
- if (traceInstructions) {
- fprintf(stdout, "\n");
- }
+ TRACE_WITH_OBJ(("=> return code=%d, result=", result),
+ iPtr->objResultPtr);
+ if (traceInstructions) {
+ fprintf(stdout, "\n");
+ }
#endif
- goto done;
-
- case INST_PUSH1:
-#ifdef TCL_COMPILE_DEBUG
- valuePtr = codePtr->objArrayPtr[TclGetUInt1AtPtr(pc+1)];
- PUSH_OBJECT(valuePtr);
- TRACE_WITH_OBJ(("%u => ", TclGetInt1AtPtr(pc+1)), valuePtr);
-#else
- PUSH_OBJECT(codePtr->objArrayPtr[TclGetUInt1AtPtr(pc+1)]);
-#endif /* TCL_COMPILE_DEBUG */
- ADJUST_PC(2);
-
- case INST_PUSH4:
- valuePtr = codePtr->objArrayPtr[TclGetUInt4AtPtr(pc+1)];
- PUSH_OBJECT(valuePtr);
- TRACE_WITH_OBJ(("%u => ", TclGetUInt4AtPtr(pc+1)), valuePtr);
- ADJUST_PC(5);
+ goto checkForCatch;
+
+ case INST_PUSH1:
+ objResultPtr = codePtr->objArrayPtr[TclGetUInt1AtPtr(pc+1)];
+ TRACE_WITH_OBJ(("%u => ", TclGetInt1AtPtr(pc+1)), objResultPtr);
+ NEXT_INST_F(2, 0, 1);
+
+ 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 "), stackPtr[stackTop]);
+ valuePtr = POP_OBJECT();
+ TclDecrRefCount(valuePtr);
+ NEXT_INST_F(1, 0, 0);
+
+ case INST_DUP:
+ objResultPtr = stackPtr[stackTop];
+ TRACE_WITH_OBJ(("=> "), objResultPtr);
+ NEXT_INST_F(1, 0, 1);
+
+ case INST_OVER:
+ opnd = TclGetUInt4AtPtr( pc+1 );
+ objResultPtr = stackPtr[ stackTop - opnd ];
+ TRACE_WITH_OBJ(("=> "), objResultPtr);
+ NEXT_INST_F(5, 0, 1);
+
+ case INST_CONCAT1:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ {
+ int totalLen = 0;
- case INST_POP:
- valuePtr = POP_OBJECT();
- TRACE_WITH_OBJ(("=> discarding "), valuePtr);
- TclDecrRefCount(valuePtr); /* finished with pop'ed object. */
- ADJUST_PC(1);
-
- case INST_DUP:
- valuePtr = stackPtr[stackTop];
- PUSH_OBJECT(Tcl_DuplicateObj(valuePtr));
- TRACE_WITH_OBJ(("=> "), valuePtr);
- ADJUST_PC(1);
+ /*
+ * Concatenate strings (with no separators) from the top
+ * opnd items on the stack starting with the deepest item.
+ * First, determine how many characters are needed.
+ */
- case INST_CONCAT1:
- opnd = TclGetUInt1AtPtr(pc+1);
- {
- Tcl_Obj *concatObjPtr;
- int totalLen = 0;
+ for (i = (stackTop - (opnd-1)); i <= stackTop; i++) {
+ bytes = Tcl_GetStringFromObj(stackPtr[i], &length);
+ if (bytes != NULL) {
+ totalLen += length;
+ }
+ }
- /*
- * Concatenate strings (with no separators) from the top
- * opnd items on the stack starting with the deepest item.
- * First, determine how many characters are needed.
- */
+ /*
+ * Initialize the new append string object by appending the
+ * strings of the opnd stack objects. Also pop the objects.
+ */
+ TclNewObj(objResultPtr);
+ if (totalLen > 0) {
+ char *p = (char *) ckalloc((unsigned) (totalLen + 1));
+ objResultPtr->bytes = p;
+ objResultPtr->length = totalLen;
for (i = (stackTop - (opnd-1)); i <= stackTop; i++) {
- bytes = Tcl_GetStringFromObj(stackPtr[i], &length);
+ valuePtr = stackPtr[i];
+ bytes = Tcl_GetStringFromObj(valuePtr, &length);
if (bytes != NULL) {
- totalLen += length;
- }
- }
-
- /*
- * Initialize the new append string object by appending the
- * strings of the opnd stack objects. Also pop the objects.
- */
-
- TclNewObj(concatObjPtr);
- if (totalLen > 0) {
- char *p = (char *) ckalloc((unsigned) (totalLen + 1));
- concatObjPtr->bytes = p;
- concatObjPtr->length = totalLen;
- for (i = (stackTop - (opnd-1)); i <= stackTop; i++) {
- valuePtr = stackPtr[i];
- bytes = Tcl_GetStringFromObj(valuePtr, &length);
- if (bytes != NULL) {
- memcpy((VOID *) p, (VOID *) bytes,
- (size_t) length);
- p += length;
- }
- TclDecrRefCount(valuePtr);
- }
- *p = '\0';
- } else {
- for (i = (stackTop - (opnd-1)); i <= stackTop; i++) {
- Tcl_DecrRefCount(stackPtr[i]);
+ memcpy((VOID *) p, (VOID *) bytes,
+ (size_t) length);
+ p += length;
}
}
- stackTop -= opnd;
+ *p = '\0';
+ }
- PUSH_OBJECT(concatObjPtr);
- TRACE_WITH_OBJ(("%u => ", opnd), concatObjPtr);
- ADJUST_PC(2);
- }
+ TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
+ NEXT_INST_V(2, opnd, 1);
+ }
- case INST_INVOKE_STK4:
- opnd = TclGetUInt4AtPtr(pc+1);
- pcAdjustment = 5;
- goto doInvocation;
-
- case INST_INVOKE_STK1:
- opnd = TclGetUInt1AtPtr(pc+1);
- pcAdjustment = 2;
+ case INST_INVOKE_STK4:
+ opnd = TclGetUInt4AtPtr(pc+1);
+ pcAdjustment = 5;
+ goto doInvocation;
+
+ case INST_INVOKE_STK1:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ pcAdjustment = 2;
- doInvocation:
- {
- int objc = opnd; /* The number of arguments. */
- Tcl_Obj **objv; /* The array of argument objects. */
- Command *cmdPtr; /* Points to command's Command struct. */
- int newPcOffset; /* New inst offset for break, continue. */
-#ifdef TCL_COMPILE_DEBUG
- int isUnknownCmd = 0;
- char cmdNameBuf[21];
-#endif /* TCL_COMPILE_DEBUG */
-
- /*
- * If the interpreter was deleted, return an error.
- */
-
- if (iPtr->flags & DELETED) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "attempt to call eval in deleted interpreter", -1);
- Tcl_SetErrorCode(interp, "CORE", "IDELETE",
- "attempt to call eval in deleted interpreter",
- (char *) NULL);
- result = TCL_ERROR;
- goto checkForCatch;
- }
-
- /*
- * Find the procedure to execute this command. If the
- * command is not found, handle it with the "unknown" proc.
- */
+ doInvocation:
+ {
+ int objc = opnd; /* The number of arguments. */
+ Tcl_Obj **objv; /* The array of argument objects. */
- objv = &(stackPtr[stackTop - (objc-1)]);
- cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]);
- if (cmdPtr == NULL) {
- cmdPtr = (Command *) Tcl_FindCommand(interp, "unknown",
- (Tcl_Namespace *) NULL, TCL_GLOBAL_ONLY);
- if (cmdPtr == NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "invalid command name \"",
- Tcl_GetString(objv[0]), "\"",
- (char *) NULL);
- TRACE(("%u => unknown proc not found: ", objc));
- result = TCL_ERROR;
- goto checkForCatch;
- }
-#ifdef TCL_COMPILE_DEBUG
- isUnknownCmd = 1;
-#endif /*TCL_COMPILE_DEBUG*/
- stackTop++; /* need room for new inserted objv[0] */
- for (i = objc-1; i >= 0; i--) {
- objv[i+1] = objv[i];
- }
- objc++;
- objv[0] = Tcl_NewStringObj("unknown", -1);
- Tcl_IncrRefCount(objv[0]);
- }
-
- /*
- * Call any trace procedures.
- */
-
- if (iPtr->tracePtr != NULL) {
- Trace *tracePtr, *nextTracePtr;
-
- for (tracePtr = iPtr->tracePtr; tracePtr != NULL;
- tracePtr = nextTracePtr) {
- nextTracePtr = tracePtr->nextPtr;
- if (iPtr->numLevels <= tracePtr->level) {
- int numChars;
- char *cmd = GetSrcInfoForPc(pc, codePtr,
- &numChars);
- if (cmd != NULL) {
- DECACHE_STACK_INFO();
- CallTraceProcedure(interp, tracePtr, cmdPtr,
- cmd, numChars, objc, objv);
- CACHE_STACK_INFO();
- }
- }
- }
- }
-
- /*
- * Finally, invoke the command's Tcl_ObjCmdProc. First reset
- * the interpreter's string and object results to their
- * default empty values since they could have gotten changed
- * by earlier invocations.
- */
-
- Tcl_ResetResult(interp);
- if (tclTraceExec >= 2) {
-#ifdef TCL_COMPILE_DEBUG
- if (traceInstructions) {
- strncpy(cmdNameBuf, Tcl_GetString(objv[0]), 20);
- TRACE(("%u => call ", (isUnknownCmd? objc-1: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);
-#else /* TCL_COMPILE_DEBUG */
- fprintf(stdout, "%d: (%u) invoking %s\n",
- iPtr->numLevels,
- (unsigned int)(pc - codePtr->codeStart),
- Tcl_GetString(objv[0]));
-#endif /*TCL_COMPILE_DEBUG*/
- }
+ /*
+ * We keep the stack reference count as a (char *), as that
+ * works nicely as a portable pointer-sized counter.
+ */
- iPtr->cmdCount++;
- DECACHE_STACK_INFO();
- result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp,
- objc, objv);
- if (Tcl_AsyncReady()) {
- result = Tcl_AsyncInvoke(interp, result);
- }
- CACHE_STACK_INFO();
+ char **preservedStackRefCountPtr;
+
+ /*
+ * Reference to memory block containing
+ * objv array (must be kept live throughout
+ * trace and command invokations.)
+ */
- /*
- * 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.
- */
+ objv = &(stackPtr[stackTop - (objc-1)]);
- if (*(iPtr->result) != 0) {
- (void) Tcl_GetObjResult(interp);
+#ifdef TCL_COMPILE_DEBUG
+ if (tclTraceExec >= 2) {
+ 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));
}
-
- /*
- * Pop the objc top stack elements and decrement their ref
- * counts.
- */
-
for (i = 0; i < objc; i++) {
- valuePtr = stackPtr[stackTop];
- TclDecrRefCount(valuePtr);
- stackTop--;
+ TclPrintObject(stdout, objv[i], 15);
+ fprintf(stdout, " ");
}
+ fprintf(stdout, "\n");
+ fflush(stdout);
+ }
+#endif /*TCL_COMPILE_DEBUG*/
- /*
- * Process the result of the Tcl_ObjCmdProc call.
- */
-
- switch (result) {
- case TCL_OK:
- /*
- * Push the call's object result and continue execution
- * with the next instruction.
- */
- PUSH_OBJECT(Tcl_GetObjResult(interp));
- TRACE_WITH_OBJ(("%u => ...after \"%.20s\", result=",
- objc, cmdNameBuf), Tcl_GetObjResult(interp));
- ADJUST_PC(pcAdjustment);
+ /*
+ * 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.
+ */
+
+ bytes = NULL;
+ length = 0;
+ if (iPtr->tracePtr != NULL) {
+ Trace *tracePtr, *nextTracePtr;
- case TCL_BREAK:
- case TCL_CONTINUE:
- /*
- * The invoked command requested a break or continue.
- * Find the closest enclosing loop or catch exception
- * range, if any. If a loop is found, terminate its
- * execution or skip to its next iteration. If the
- * closest is a catch exception range, jump to its
- * catchOffset. If no enclosing range is found, stop
- * execution and return the TCL_BREAK or TCL_CONTINUE.
- */
- rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 0,
- codePtr);
- if (rangePtr == NULL) {
- TRACE(("%u => ... after \"%.20s\", no encl. loop or catch, returning %s\n",
- objc, cmdNameBuf,
- StringForResultCode(result)));
- goto abnormalReturn; /* no catch exists to check */
- }
- newPcOffset = 0;
- switch (rangePtr->type) {
- case LOOP_EXCEPTION_RANGE:
- if (result == TCL_BREAK) {
- newPcOffset = rangePtr->breakOffset;
- } else if (rangePtr->continueOffset == -1) {
- TRACE(("%u => ... after \"%.20s\", %s, loop w/o continue, checking for catch\n",
- objc, cmdNameBuf,
- StringForResultCode(result)));
- goto checkForCatch;
- } else {
- newPcOffset = rangePtr->continueOffset;
- }
- TRACE(("%u => ... after \"%.20s\", %s, range at %d, new pc %d\n",
- objc, cmdNameBuf,
- StringForResultCode(result),
- rangePtr->codeOffset, newPcOffset));
+ 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;
- case CATCH_EXCEPTION_RANGE:
- TRACE(("%u => ... after \"%.20s\", %s...\n",
- objc, cmdNameBuf,
- StringForResultCode(result)));
- goto processCatch; /* it will use rangePtr */
- default:
- panic("TclExecuteByteCode: bad ExceptionRange type\n");
}
- result = TCL_OK;
- pc = (codePtr->codeStart + newPcOffset);
- continue; /* restart outer instruction loop at pc */
-
- case TCL_ERROR:
- /*
- * The invoked command returned an error. Look for an
- * enclosing catch exception range, if any.
- */
- TRACE_WITH_OBJ(("%u => ... after \"%.20s\", TCL_ERROR ",
- objc, cmdNameBuf), Tcl_GetObjResult(interp));
- goto checkForCatch;
+ }
+ } else {
+ Command *cmdPtr;
+ cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]);
+ if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) {
+ bytes = GetSrcInfoForPc(pc, codePtr, &length);
+ }
+ }
- case TCL_RETURN:
- /*
- * The invoked command requested that the current
- * procedure stop execution and return. First check
- * for an enclosing catch exception range, if any.
- */
- TRACE(("%u => ... after \"%.20s\", TCL_RETURN\n",
- objc, cmdNameBuf));
- goto checkForCatch;
+ /*
+ * 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.
+ */
- default:
- TRACE_WITH_OBJ(("%u => ... after \"%.20s\", OTHER RETURN CODE %d ",
- objc, cmdNameBuf, result),
- Tcl_GetObjResult(interp));
- goto checkForCatch;
- }
- }
-
- case INST_EVAL_STK:
- objPtr = POP_OBJECT();
+ preservedStackRefCountPtr = (char **) (stackPtr-1);
+ ++*preservedStackRefCountPtr;
+
+ /*
+ * Finally, let TclEvalObjvInternal handle the command.
+ */
+
+ Tcl_ResetResult(interp);
DECACHE_STACK_INFO();
- result = Tcl_EvalObjEx(interp, objPtr, 0);
+ result = TclEvalObjvInternal(interp, objc, objv, bytes, length, 0);
CACHE_STACK_INFO();
+
+ /*
+ * 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.
+ */
+
+ --*preservedStackRefCountPtr;
+ if (*preservedStackRefCountPtr == (char *) 0) {
+ ckfree((VOID *) preservedStackRefCountPtr);
+ }
+
if (result == TCL_OK) {
/*
- * Normal return; push the eval's object result.
- */
- PUSH_OBJECT(Tcl_GetObjResult(interp));
- TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)),
- Tcl_GetObjResult(interp));
- TclDecrRefCount(objPtr);
- ADJUST_PC(1);
- } else if ((result == TCL_BREAK) || (result == TCL_CONTINUE)) {
- /*
- * Find the closest enclosing loop or catch exception range,
- * if any. If a loop is found, terminate its execution or
- * skip to its next iteration. If the closest is a catch
- * exception range, jump to its catchOffset. If no enclosing
- * range is found, stop execution and return that same
- * TCL_BREAK or TCL_CONTINUE.
+ * Push the call's object result and continue execution
+ * with the next instruction.
*/
- int newPcOffset = 0; /* Pc offset computed during break,
- * continue, error processing. Init.
- * to avoid compiler warning. */
-
- rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 0,
- codePtr);
- if (rangePtr == NULL) {
- TRACE(("\"%.30s\" => no encl. loop or catch, returning %s\n",
- O2S(objPtr), StringForResultCode(result)));
- Tcl_DecrRefCount(objPtr);
- goto abnormalReturn; /* no catch exists to check */
- }
- switch (rangePtr->type) {
- case LOOP_EXCEPTION_RANGE:
- if (result == TCL_BREAK) {
- newPcOffset = rangePtr->breakOffset;
- } else if (rangePtr->continueOffset == -1) {
- TRACE(("\"%.30s\" => %s, loop w/o continue, checking for catch\n",
- O2S(objPtr), StringForResultCode(result)));
- Tcl_DecrRefCount(objPtr);
- goto checkForCatch;
- } else {
- newPcOffset = rangePtr->continueOffset;
- }
- result = TCL_OK;
- TRACE_WITH_OBJ(("\"%.30s\" => %s, range at %d, new pc %d ",
- O2S(objPtr), StringForResultCode(result),
- rangePtr->codeOffset, newPcOffset), valuePtr);
- break;
- case CATCH_EXCEPTION_RANGE:
- TRACE_WITH_OBJ(("\"%.30s\" => %s ",
- O2S(objPtr), StringForResultCode(result)),
- valuePtr);
- Tcl_DecrRefCount(objPtr);
- goto processCatch; /* it will use rangePtr */
- default:
- panic("TclExecuteByteCode: unrecognized ExceptionRange type %d\n", rangePtr->type);
- }
- Tcl_DecrRefCount(objPtr);
- pc = (codePtr->codeStart + newPcOffset);
- continue; /* restart outer instruction loop at pc */
- } else { /* eval returned TCL_ERROR, TCL_RETURN, unknown code */
- TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", O2S(objPtr)),
- Tcl_GetObjResult(interp));
- Tcl_DecrRefCount(objPtr);
- goto checkForCatch;
- }
+ TRACE_WITH_OBJ(("%u => ... after \"%.20s\": TCL_OK, result=",
+ objc, cmdNameBuf), Tcl_GetObjResult(interp));
- case INST_EXPR_STK:
- objPtr = POP_OBJECT();
- Tcl_ResetResult(interp);
- DECACHE_STACK_INFO();
- result = Tcl_ExprObj(interp, objPtr, &valuePtr);
- CACHE_STACK_INFO();
- if (result != TCL_OK) {
- TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ",
- O2S(objPtr)), Tcl_GetObjResult(interp));
- Tcl_DecrRefCount(objPtr);
- goto checkForCatch;
+ objResultPtr = Tcl_GetObjResult(interp);
+ NEXT_INST_V(pcAdjustment, opnd, 1);
+ } else {
+ cleanup = opnd;
+ goto processExceptionReturn;
}
- stackPtr[++stackTop] = valuePtr; /* already has right refct */
- TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)), valuePtr);
- TclDecrRefCount(objPtr);
- ADJUST_PC(1);
+ }
- case INST_LOAD_SCALAR1:
-#ifdef TCL_COMPILE_DEBUG
- opnd = TclGetUInt1AtPtr(pc+1);
- DECACHE_STACK_INFO();
- valuePtr = TclGetIndexedScalar(interp, opnd,
- /*leaveErrorMsg*/ 1);
- CACHE_STACK_INFO();
- if (valuePtr == NULL) {
- TRACE_WITH_OBJ(("%u => ERROR: ", opnd),
- Tcl_GetObjResult(interp));
- result = TCL_ERROR;
- goto checkForCatch;
- }
- PUSH_OBJECT(valuePtr);
- TRACE_WITH_OBJ(("%u => ", opnd), valuePtr);
-#else /* TCL_COMPILE_DEBUG */
- DECACHE_STACK_INFO();
- opnd = TclGetUInt1AtPtr(pc+1);
- valuePtr = TclGetIndexedScalar(interp, opnd, /*leaveErrorMsg*/ 1);
- CACHE_STACK_INFO();
- if (valuePtr == NULL) {
- result = TCL_ERROR;
- goto checkForCatch;
- }
- PUSH_OBJECT(valuePtr);
-#endif /* TCL_COMPILE_DEBUG */
- ADJUST_PC(2);
+ case INST_EVAL_STK:
+ /*
+ * Note to maintainers: it is important that INST_EVAL_STK
+ * pop its argument from the stack before jumping to
+ * checkForCatch! DO NOT OPTIMISE!
+ */
- case INST_LOAD_SCALAR4:
- opnd = TclGetUInt4AtPtr(pc+1);
- DECACHE_STACK_INFO();
- valuePtr = TclGetIndexedScalar(interp, opnd,
- /*leaveErrorMsg*/ 1);
- CACHE_STACK_INFO();
- if (valuePtr == NULL) {
- TRACE_WITH_OBJ(("%u => ERROR: ", opnd),
- Tcl_GetObjResult(interp));
- result = TCL_ERROR;
- goto checkForCatch;
- }
- PUSH_OBJECT(valuePtr);
- TRACE_WITH_OBJ(("%u => ", opnd), valuePtr);
- ADJUST_PC(5);
+ objPtr = stackPtr[stackTop];
+ DECACHE_STACK_INFO();
+ result = TclCompEvalObj(interp, objPtr);
+ CACHE_STACK_INFO();
+ if (result == TCL_OK) {
+ /*
+ * Normal return; push the eval's object result.
+ */
- case INST_LOAD_SCALAR_STK:
- objPtr = POP_OBJECT(); /* scalar name */
- DECACHE_STACK_INFO();
- valuePtr = Tcl_ObjGetVar2(interp, objPtr, NULL, TCL_LEAVE_ERR_MSG);
- CACHE_STACK_INFO();
- if (valuePtr == NULL) {
- TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", O2S(objPtr)),
- Tcl_GetObjResult(interp));
- Tcl_DecrRefCount(objPtr);
- result = TCL_ERROR;
- goto checkForCatch;
- }
- PUSH_OBJECT(valuePtr);
- TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)), valuePtr);
- TclDecrRefCount(objPtr);
- ADJUST_PC(1);
-
- case INST_LOAD_ARRAY4:
- opnd = TclGetUInt4AtPtr(pc+1);
- pcAdjustment = 5;
- goto doLoadArray;
-
- case INST_LOAD_ARRAY1:
- opnd = TclGetUInt1AtPtr(pc+1);
- pcAdjustment = 2;
-
- doLoadArray:
- {
- Tcl_Obj *elemPtr = POP_OBJECT();
-
- DECACHE_STACK_INFO();
- valuePtr = TclGetElementOfIndexedArray(interp, opnd,
- elemPtr, /*leaveErrorMsg*/ 1);
- CACHE_STACK_INFO();
- if (valuePtr == NULL) {
- TRACE_WITH_OBJ(("%u \"%.30s\" => ERROR: ",
- opnd, O2S(elemPtr)), Tcl_GetObjResult(interp));
- Tcl_DecrRefCount(elemPtr);
- result = TCL_ERROR;
- goto checkForCatch;
- }
- PUSH_OBJECT(valuePtr);
- TRACE_WITH_OBJ(("%u \"%.30s\" => ",
- opnd, O2S(elemPtr)),valuePtr);
- TclDecrRefCount(elemPtr);
- }
- ADJUST_PC(pcAdjustment);
+ objResultPtr = Tcl_GetObjResult(interp);
+ TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)),
+ Tcl_GetObjResult(interp));
+ NEXT_INST_F(1, 1, 1);
+ } else {
+ cleanup = 1;
+ goto processExceptionReturn;
+ }
- case INST_LOAD_ARRAY_STK:
- {
- Tcl_Obj *elemPtr = POP_OBJECT();
-
- objPtr = POP_OBJECT(); /* array name */
- DECACHE_STACK_INFO();
- valuePtr = Tcl_ObjGetVar2(interp, objPtr, elemPtr,
- TCL_LEAVE_ERR_MSG);
- CACHE_STACK_INFO();
- if (valuePtr == NULL) {
- TRACE_WITH_OBJ(("\"%.30s(%.30s)\" => ERROR: ",
- O2S(objPtr), O2S(elemPtr)),
- Tcl_GetObjResult(interp));
- Tcl_DecrRefCount(objPtr);
- Tcl_DecrRefCount(elemPtr);
- result = TCL_ERROR;
- goto checkForCatch;
- }
- PUSH_OBJECT(valuePtr);
- TRACE_WITH_OBJ(("\"%.30s(%.30s)\" => ",
- O2S(objPtr), O2S(elemPtr)), valuePtr);
- TclDecrRefCount(objPtr);
- TclDecrRefCount(elemPtr);
- }
- ADJUST_PC(1);
+ case INST_EXPR_STK:
+ objPtr = stackPtr[stackTop];
+ Tcl_ResetResult(interp);
+ DECACHE_STACK_INFO();
+ 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;
+ }
+ objResultPtr = valuePtr;
+ TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)), valuePtr);
+ NEXT_INST_F(1, 1, -1); /* already has right refct */
- case INST_LOAD_STK:
- objPtr = POP_OBJECT(); /* variable name */
- DECACHE_STACK_INFO();
- valuePtr = Tcl_ObjGetVar2(interp, objPtr, NULL, TCL_LEAVE_ERR_MSG);
- CACHE_STACK_INFO();
- if (valuePtr == NULL) {
- TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ",
- O2S(objPtr)), Tcl_GetObjResult(interp));
- Tcl_DecrRefCount(objPtr);
- result = TCL_ERROR;
- goto checkForCatch;
- }
- PUSH_OBJECT(valuePtr);
- TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)), valuePtr);
- TclDecrRefCount(objPtr);
- ADJUST_PC(1);
-
- case INST_STORE_SCALAR4:
- opnd = TclGetUInt4AtPtr(pc+1);
- pcAdjustment = 5;
- goto doStoreScalar;
-
- case INST_STORE_SCALAR1:
- opnd = TclGetUInt1AtPtr(pc+1);
- pcAdjustment = 2;
-
- doStoreScalar:
- valuePtr = POP_OBJECT();
- DECACHE_STACK_INFO();
- value2Ptr = TclSetIndexedScalar(interp, opnd, valuePtr,
- /*leaveErrorMsg*/ 1);
- CACHE_STACK_INFO();
- if (value2Ptr == NULL) {
- TRACE_WITH_OBJ(("%u <- \"%.30s\" => ERROR: ",
- opnd, O2S(valuePtr)), Tcl_GetObjResult(interp));
- Tcl_DecrRefCount(valuePtr);
- result = TCL_ERROR;
- goto checkForCatch;
- }
- PUSH_OBJECT(value2Ptr);
- TRACE_WITH_OBJ(("%u <- \"%.30s\" => ",
- opnd, O2S(valuePtr)), value2Ptr);
- TclDecrRefCount(valuePtr);
- ADJUST_PC(pcAdjustment);
+ /*
+ * ---------------------------------------------------------
+ * 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 common execution code.
+ */
- case INST_STORE_SCALAR_STK:
- valuePtr = POP_OBJECT();
- objPtr = POP_OBJECT(); /* scalar name */
- DECACHE_STACK_INFO();
- value2Ptr = Tcl_ObjSetVar2(interp, objPtr, NULL, valuePtr,
- TCL_LEAVE_ERR_MSG);
- CACHE_STACK_INFO();
- if (value2Ptr == NULL) {
- TRACE_WITH_OBJ(("\"%.30s\" <- \"%.30s\" => ERROR: ",
- O2S(objPtr), O2S(valuePtr)),
- Tcl_GetObjResult(interp));
- Tcl_DecrRefCount(objPtr);
- Tcl_DecrRefCount(valuePtr);
- result = TCL_ERROR;
- goto checkForCatch;
- }
- PUSH_OBJECT(value2Ptr);
- TRACE_WITH_OBJ(("\"%.30s\" <- \"%.30s\" => ",
- O2S(objPtr), O2S(valuePtr)), value2Ptr);
- TclDecrRefCount(objPtr);
- TclDecrRefCount(valuePtr);
- ADJUST_PC(1);
+ case INST_LOAD_SCALAR1:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ varPtr = &(varFramePtr->compiledLocals[opnd]);
+ part1 = varPtr->name;
+ while (TclIsVarLink(varPtr)) {
+ varPtr = varPtr->value.linkPtr;
+ }
+ TRACE(("%u => ", opnd));
+ if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)
+ && (varPtr->tracePtr == NULL)) {
+ /*
+ * No errors, no traces: just get the value.
+ */
+ objResultPtr = varPtr->value.objPtr;
+ TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ NEXT_INST_F(2, 0, 1);
+ }
+ pcAdjustment = 2;
+ cleanup = 0;
+ arrayPtr = NULL;
+ part2 = NULL;
+ goto doCallPtrGetVar;
+
+ case INST_LOAD_SCALAR4:
+ opnd = TclGetUInt4AtPtr(pc+1);
+ varPtr = &(varFramePtr->compiledLocals[opnd]);
+ part1 = varPtr->name;
+ while (TclIsVarLink(varPtr)) {
+ varPtr = varPtr->value.linkPtr;
+ }
+ TRACE(("%u => ", opnd));
+ if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)
+ && (varPtr->tracePtr == NULL)) {
+ /*
+ * No errors, no traces: just get the value.
+ */
+ objResultPtr = varPtr->value.objPtr;
+ TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ NEXT_INST_F(5, 0, 1);
+ }
+ pcAdjustment = 5;
+ cleanup = 0;
+ arrayPtr = NULL;
+ part2 = NULL;
+ goto doCallPtrGetVar;
+
+ case INST_LOAD_ARRAY_STK:
+ cleanup = 2;
+ part2 = Tcl_GetString(stackPtr[stackTop]); /* element name */
+ objPtr = stackPtr[stackTop-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 = stackPtr[stackTop]; /* 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 (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)
+ && (varPtr->tracePtr == NULL)
+ && ((arrayPtr == NULL)
+ || (arrayPtr->tracePtr == NULL))) {
+ /*
+ * 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;
+ goto doCallPtrGetVar;
- case INST_STORE_ARRAY4:
- opnd = TclGetUInt4AtPtr(pc+1);
- pcAdjustment = 5;
- goto doStoreArray;
+ case INST_LOAD_ARRAY4:
+ opnd = TclGetUInt4AtPtr(pc+1);
+ pcAdjustment = 5;
+ goto doLoadArray;
- case INST_STORE_ARRAY1:
- opnd = TclGetUInt1AtPtr(pc+1);
- pcAdjustment = 2;
-
- doStoreArray:
- {
- Tcl_Obj *elemPtr;
+ case INST_LOAD_ARRAY1:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ pcAdjustment = 2;
+
+ doLoadArray:
+ part2 = TclGetString(stackPtr[stackTop]);
+ arrayPtr = &(varFramePtr->compiledLocals[opnd]);
+ part1 = arrayPtr->name;
+ 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);
+ if (varPtr == NULL) {
+ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ result = TCL_ERROR;
+ goto checkForCatch;
+ }
+ if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)
+ && (varPtr->tracePtr == NULL)
+ && ((arrayPtr == NULL)
+ || (arrayPtr->tracePtr == NULL))) {
+ /*
+ * No errors, no traces: just get the value.
+ */
+ objResultPtr = varPtr->value.objPtr;
+ TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ NEXT_INST_F(pcAdjustment, 1, 1);
+ }
+ cleanup = 1;
+ goto doCallPtrGetVar;
- valuePtr = POP_OBJECT();
- elemPtr = POP_OBJECT();
- DECACHE_STACK_INFO();
- value2Ptr = TclSetElementOfIndexedArray(interp, opnd,
- elemPtr, valuePtr, TCL_LEAVE_ERR_MSG);
- CACHE_STACK_INFO();
- if (value2Ptr == NULL) {
- TRACE_WITH_OBJ(("%u \"%.30s\" <- \"%.30s\" => ERROR: ",
- opnd, O2S(elemPtr), O2S(valuePtr)),
- Tcl_GetObjResult(interp));
- Tcl_DecrRefCount(elemPtr);
- Tcl_DecrRefCount(valuePtr);
- result = TCL_ERROR;
- goto checkForCatch;
- }
- PUSH_OBJECT(value2Ptr);
- TRACE_WITH_OBJ(("%u \"%.30s\" <- \"%.30s\" => ",
- opnd, O2S(elemPtr), O2S(valuePtr)), value2Ptr);
- TclDecrRefCount(elemPtr);
- TclDecrRefCount(valuePtr);
- }
- ADJUST_PC(pcAdjustment);
+ doCallPtrGetVar:
+ /*
+ * There are either errors or the variable is traced:
+ * call TclPtrGetVar to process fully.
+ */
- case INST_STORE_ARRAY_STK:
- {
- Tcl_Obj *elemPtr;
+ DECACHE_STACK_INFO();
+ objResultPtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1,
+ part2, TCL_LEAVE_ERR_MSG);
+ CACHE_STACK_INFO();
+ if (objResultPtr == NULL) {
+ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ result = TCL_ERROR;
+ goto checkForCatch;
+ }
+ TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ NEXT_INST_V(pcAdjustment, cleanup, 1);
- valuePtr = POP_OBJECT();
- elemPtr = POP_OBJECT();
- objPtr = POP_OBJECT(); /* array name */
- DECACHE_STACK_INFO();
- value2Ptr = Tcl_ObjSetVar2(interp, objPtr, elemPtr, valuePtr,
- TCL_LEAVE_ERR_MSG);
- CACHE_STACK_INFO();
- if (value2Ptr == NULL) {
- TRACE_WITH_OBJ(("\"%.30s(%.30s)\" <- \"%.30s\" => ERROR: ",
- O2S(objPtr), O2S(elemPtr), O2S(valuePtr)),
- Tcl_GetObjResult(interp));
- Tcl_DecrRefCount(objPtr);
- Tcl_DecrRefCount(elemPtr);
- Tcl_DecrRefCount(valuePtr);
- result = TCL_ERROR;
- goto checkForCatch;
- }
- PUSH_OBJECT(value2Ptr);
- TRACE_WITH_OBJ(("\"%.30s(%.30s)\" <- \"%.30s\" => ",
- O2S(objPtr), O2S(elemPtr), O2S(valuePtr)),
- value2Ptr);
- TclDecrRefCount(objPtr);
- TclDecrRefCount(elemPtr);
- TclDecrRefCount(valuePtr);
- }
- ADJUST_PC(1);
+ /*
+ * End of INST_LOAD instructions.
+ * ---------------------------------------------------------
+ */
- case INST_STORE_STK:
- valuePtr = POP_OBJECT();
- objPtr = POP_OBJECT(); /* variable name */
- DECACHE_STACK_INFO();
- value2Ptr = Tcl_ObjSetVar2(interp, objPtr, NULL, valuePtr,
- TCL_LEAVE_ERR_MSG);
- CACHE_STACK_INFO();
- if (value2Ptr == NULL) {
- TRACE_WITH_OBJ(("\"%.30s\" <- \"%.30s\" => ERROR: ",
- O2S(objPtr), O2S(valuePtr)),
- Tcl_GetObjResult(interp));
- Tcl_DecrRefCount(objPtr);
- Tcl_DecrRefCount(valuePtr);
- result = TCL_ERROR;
- goto checkForCatch;
- }
- PUSH_OBJECT(value2Ptr);
- TRACE_WITH_OBJ(("\"%.30s\" <- \"%.30s\" => ",
- O2S(objPtr), O2S(valuePtr)), value2Ptr);
- TclDecrRefCount(objPtr);
- TclDecrRefCount(valuePtr);
- ADJUST_PC(1);
+ /*
+ * ---------------------------------------------------------
+ * Start of INST_STORE and related instructions.
+ *
+ * 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.
+ */
- case INST_INCR_SCALAR1:
- opnd = TclGetUInt1AtPtr(pc+1);
- valuePtr = POP_OBJECT();
- if (valuePtr->typePtr != &tclIntType) {
- result = tclIntType.setFromAnyProc(interp, valuePtr);
- if (result != TCL_OK) {
- TRACE_WITH_OBJ(("%u (by %s) => ERROR converting increment amount to int: ",
- opnd, O2S(valuePtr)), Tcl_GetObjResult(interp));
- Tcl_DecrRefCount(valuePtr);
- goto checkForCatch;
+ case INST_LAPPEND_STK:
+ valuePtr = stackPtr[stackTop]; /* value to append */
+ part2 = NULL;
+ storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
+ | TCL_LIST_ELEMENT | TCL_TRACE_READS);
+ goto doStoreStk;
+
+ case INST_LAPPEND_ARRAY_STK:
+ valuePtr = stackPtr[stackTop]; /* value to append */
+ part2 = TclGetString(stackPtr[stackTop - 1]);
+ storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
+ | TCL_LIST_ELEMENT | TCL_TRACE_READS);
+ goto doStoreStk;
+
+ case INST_APPEND_STK:
+ valuePtr = stackPtr[stackTop]; /* value to append */
+ part2 = NULL;
+ storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
+ goto doStoreStk;
+
+ case INST_APPEND_ARRAY_STK:
+ valuePtr = stackPtr[stackTop]; /* value to append */
+ part2 = TclGetString(stackPtr[stackTop - 1]);
+ storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
+ goto doStoreStk;
+
+ case INST_STORE_ARRAY_STK:
+ valuePtr = stackPtr[stackTop];
+ part2 = TclGetString(stackPtr[stackTop - 1]);
+ storeFlags = TCL_LEAVE_ERR_MSG;
+ goto doStoreStk;
+
+ case INST_STORE_STK:
+ case INST_STORE_SCALAR_STK:
+ valuePtr = stackPtr[stackTop];
+ part2 = NULL;
+ storeFlags = TCL_LEAVE_ERR_MSG;
+
+ doStoreStk:
+ objPtr = stackPtr[stackTop - 1 - (part2 != NULL)]; /* variable name */
+ part1 = TclGetString(objPtr);
+#ifdef TCL_COMPILE_DEBUG
+ if (part2 == NULL) {
+ TRACE(("\"%.30s\" <- \"%.30s\" =>",
+ part1, O2S(valuePtr)));
+ } else {
+ TRACE(("\"%.30s(%.30s)\" <- \"%.30s\" => ",
+ part1, part2, O2S(valuePtr)));
+ }
+#endif
+ varPtr = TclObjLookupVar(interp, objPtr, part2,
+ 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;
+ }
+ cleanup = ((part2 == NULL)? 2 : 3);
+ pcAdjustment = 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);
+ 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);
+ goto doStoreArray;
+
+ case INST_APPEND_ARRAY4:
+ opnd = TclGetUInt4AtPtr(pc+1);
+ pcAdjustment = 5;
+ storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
+ goto doStoreArray;
+
+ case INST_APPEND_ARRAY1:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ pcAdjustment = 2;
+ 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 = stackPtr[stackTop];
+ part2 = TclGetString(stackPtr[stackTop - 1]);
+ arrayPtr = &(varFramePtr->compiledLocals[opnd]);
+ part1 = arrayPtr->name;
+ TRACE(("%u \"%.30s\" <- \"%.30s\" => ",
+ opnd, part2, 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;
+ 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);
+ 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);
+ goto doStoreScalar;
+
+ case INST_APPEND_SCALAR4:
+ opnd = TclGetUInt4AtPtr(pc+1);
+ pcAdjustment = 5;
+ storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
+ goto doStoreScalar;
+
+ case INST_APPEND_SCALAR1:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ pcAdjustment = 2;
+ 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 = stackPtr[stackTop];
+ varPtr = &(varFramePtr->compiledLocals[opnd]);
+ part1 = varPtr->name;
+ TRACE(("%u <- \"%.30s\" => ", opnd, O2S(valuePtr)));
+ while (TclIsVarLink(varPtr)) {
+ varPtr = varPtr->value.linkPtr;
+ }
+ cleanup = 1;
+ arrayPtr = NULL;
+ part2 = NULL;
+
+ doCallPtrSetVar:
+ if ((storeFlags == TCL_LEAVE_ERR_MSG)
+ && !((varPtr->flags & VAR_IN_HASHTABLE)
+ && (varPtr->hPtr == NULL))
+ && (varPtr->tracePtr == NULL)
+ && (TclIsVarScalar(varPtr)
+ || TclIsVarUndefined(varPtr))
+ && ((arrayPtr == NULL)
+ || (arrayPtr->tracePtr == NULL))) {
+ /*
+ * 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 = stackPtr[stackTop];
+ if (valuePtr != objResultPtr) {
+ if (valuePtr != NULL) {
+ TclDecrRefCount(valuePtr);
+ } else {
+ TclSetVarScalar(varPtr);
+ TclClearVarUndefined(varPtr);
}
+ varPtr->value.objPtr = objResultPtr;
+ Tcl_IncrRefCount(objResultPtr);
}
- i = valuePtr->internalRep.longValue;
+#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();
- value2Ptr = TclIncrIndexedScalar(interp, opnd, i);
+ objResultPtr = TclPtrSetVar(interp, varPtr, arrayPtr,
+ part1, part2, valuePtr, storeFlags);
CACHE_STACK_INFO();
- if (value2Ptr == NULL) {
- TRACE_WITH_OBJ(("%u (by %ld) => ERROR: ", opnd, i),
- Tcl_GetObjResult(interp));
- Tcl_DecrRefCount(valuePtr);
+ if (objResultPtr == NULL) {
+ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
result = TCL_ERROR;
goto checkForCatch;
}
- PUSH_OBJECT(value2Ptr);
- TRACE_WITH_OBJ(("%u (by %ld) => ", opnd, i), value2Ptr);
- TclDecrRefCount(valuePtr);
- ADJUST_PC(2);
+ }
+#ifndef TCL_COMPILE_DEBUG
+ if (*(pc+pcAdjustment) == INST_POP) {
+ NEXT_INST_V((pcAdjustment+1), cleanup, 0);
+ }
+#endif
+ TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ NEXT_INST_V(pcAdjustment, cleanup, 1);
- case INST_INCR_SCALAR_STK:
- case INST_INCR_STK:
- valuePtr = POP_OBJECT();
- objPtr = POP_OBJECT(); /* scalar name */
- if (valuePtr->typePtr != &tclIntType) {
- result = tclIntType.setFromAnyProc(interp, valuePtr);
- if (result != TCL_OK) {
- TRACE_WITH_OBJ(("\"%.30s\" (by %s) => ERROR converting increment amount to int: ",
- O2S(objPtr), O2S(valuePtr)),
- Tcl_GetObjResult(interp));
- Tcl_DecrRefCount(objPtr);
- Tcl_DecrRefCount(valuePtr);
- goto checkForCatch;
- }
- }
+
+ /*
+ * End of INST_STORE and related instructions.
+ * ---------------------------------------------------------
+ */
+
+ /*
+ * ---------------------------------------------------------
+ * Start of INST_INCR instructions.
+ *
+ * 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.
+ */
+
+ case INST_INCR_SCALAR1:
+ case INST_INCR_ARRAY1:
+ case INST_INCR_ARRAY_STK:
+ case INST_INCR_SCALAR_STK:
+ case INST_INCR_STK:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ valuePtr = stackPtr[stackTop];
+ if (valuePtr->typePtr == &tclIntType) {
i = valuePtr->internalRep.longValue;
- DECACHE_STACK_INFO();
- value2Ptr = TclIncrVar2(interp, objPtr, (Tcl_Obj *) NULL, i,
- TCL_LEAVE_ERR_MSG);
- CACHE_STACK_INFO();
- if (value2Ptr == NULL) {
- TRACE_WITH_OBJ(("\"%.30s\" (by %ld) => ERROR: ",
- O2S(objPtr), i), Tcl_GetObjResult(interp));
- Tcl_DecrRefCount(objPtr);
- Tcl_DecrRefCount(valuePtr);
- result = TCL_ERROR;
+#ifndef TCL_WIDE_INT_IS_LONG
+ } else if (valuePtr->typePtr == &tclWideIntType) {
+ i = Tcl_WideAsLong(valuePtr->internalRep.wideValue);
+#endif /* TCL_WIDE_INT_IS_LONG */
+ } else {
+ REQUIRE_WIDE_OR_INT(result, valuePtr, i, w);
+ if (result != TCL_OK) {
+ TRACE_WITH_OBJ(("%u (by %s) => ERROR converting increment amount to int: ",
+ opnd, O2S(valuePtr)), Tcl_GetObjResult(interp));
goto checkForCatch;
}
- PUSH_OBJECT(value2Ptr);
- TRACE_WITH_OBJ(("\"%.30s\" (by %ld) => ", O2S(objPtr), i),
- value2Ptr);
- Tcl_DecrRefCount(objPtr);
- Tcl_DecrRefCount(valuePtr);
- ADJUST_PC(1);
-
- case INST_INCR_ARRAY1:
- {
- Tcl_Obj *elemPtr;
-
- opnd = TclGetUInt1AtPtr(pc+1);
- valuePtr = POP_OBJECT();
- elemPtr = POP_OBJECT();
- if (valuePtr->typePtr != &tclIntType) {
- result = tclIntType.setFromAnyProc(interp, valuePtr);
- if (result != TCL_OK) {
- TRACE_WITH_OBJ(("%u \"%.30s\" (by %s) => ERROR converting increment amount to int: ",
- opnd, O2S(elemPtr), O2S(valuePtr)),
- Tcl_GetObjResult(interp));
- Tcl_DecrRefCount(elemPtr);
- Tcl_DecrRefCount(valuePtr);
- goto checkForCatch;
- }
- }
- i = valuePtr->internalRep.longValue;
- DECACHE_STACK_INFO();
- value2Ptr = TclIncrElementOfIndexedArray(interp, opnd,
- elemPtr, i);
- CACHE_STACK_INFO();
- if (value2Ptr == NULL) {
- TRACE_WITH_OBJ(("%u \"%.30s\" (by %ld) => ERROR: ",
- opnd, O2S(elemPtr), i),
- Tcl_GetObjResult(interp));
- Tcl_DecrRefCount(elemPtr);
- Tcl_DecrRefCount(valuePtr);
- result = TCL_ERROR;
- goto checkForCatch;
- }
- PUSH_OBJECT(value2Ptr);
- TRACE_WITH_OBJ(("%u \"%.30s\" (by %ld) => ",
- opnd, O2S(elemPtr), i), value2Ptr);
- Tcl_DecrRefCount(elemPtr);
- Tcl_DecrRefCount(valuePtr);
- }
- ADJUST_PC(2);
-
- case INST_INCR_ARRAY_STK:
- {
- Tcl_Obj *elemPtr;
+ FORCE_LONG(valuePtr, i, w);
+ }
+ stackTop--;
+ TclDecrRefCount(valuePtr);
+ switch (*pc) {
+ case INST_INCR_SCALAR1:
+ pcAdjustment = 2;
+ goto doIncrScalar;
+ case INST_INCR_ARRAY1:
+ pcAdjustment = 2;
+ goto doIncrArray;
+ default:
+ pcAdjustment = 1;
+ goto doIncrStk;
+ }
- valuePtr = POP_OBJECT();
- elemPtr = POP_OBJECT();
- objPtr = POP_OBJECT(); /* array name */
- if (valuePtr->typePtr != &tclIntType) {
- result = tclIntType.setFromAnyProc(interp, valuePtr);
- if (result != TCL_OK) {
- TRACE_WITH_OBJ(("\"%.30s(%.30s)\" (by %s) => ERROR converting increment amount to int: ",
- O2S(objPtr), O2S(elemPtr), O2S(valuePtr)),
- Tcl_GetObjResult(interp));
- Tcl_DecrRefCount(objPtr);
- Tcl_DecrRefCount(elemPtr);
- Tcl_DecrRefCount(valuePtr);
- goto checkForCatch;
- }
- }
- i = valuePtr->internalRep.longValue;
- DECACHE_STACK_INFO();
- value2Ptr = TclIncrVar2(interp, objPtr, elemPtr, i,
- TCL_LEAVE_ERR_MSG);
- CACHE_STACK_INFO();
- if (value2Ptr == NULL) {
- TRACE_WITH_OBJ(("\"%.30s(%.30s)\" (by %ld) => ERROR: ",
- O2S(objPtr), O2S(elemPtr), i),
- Tcl_GetObjResult(interp));
- Tcl_DecrRefCount(objPtr);
- Tcl_DecrRefCount(elemPtr);
- Tcl_DecrRefCount(valuePtr);
- result = TCL_ERROR;
- goto checkForCatch;
- }
- PUSH_OBJECT(value2Ptr);
- TRACE_WITH_OBJ(("\"%.30s(%.30s)\" (by %ld) => ",
- O2S(objPtr), O2S(elemPtr), i), value2Ptr);
- Tcl_DecrRefCount(objPtr);
- Tcl_DecrRefCount(elemPtr);
- Tcl_DecrRefCount(valuePtr);
- }
- ADJUST_PC(1);
+ case INST_INCR_ARRAY_STK_IMM:
+ case INST_INCR_SCALAR_STK_IMM:
+ case INST_INCR_STK_IMM:
+ i = TclGetInt1AtPtr(pc+1);
+ pcAdjustment = 2;
- case INST_INCR_SCALAR1_IMM:
- opnd = TclGetUInt1AtPtr(pc+1);
- i = TclGetInt1AtPtr(pc+2);
- DECACHE_STACK_INFO();
- value2Ptr = TclIncrIndexedScalar(interp, opnd, i);
- CACHE_STACK_INFO();
- if (value2Ptr == NULL) {
- TRACE_WITH_OBJ(("%u %ld => ERROR: ", opnd, i),
- Tcl_GetObjResult(interp));
- result = TCL_ERROR;
- goto checkForCatch;
+ doIncrStk:
+ if ((*pc == INST_INCR_ARRAY_STK_IMM)
+ || (*pc == INST_INCR_ARRAY_STK)) {
+ part2 = TclGetString(stackPtr[stackTop]);
+ objPtr = stackPtr[stackTop - 1];
+ TRACE(("\"%.30s(%.30s)\" (by %ld) => ",
+ O2S(objPtr), part2, i));
+ } else {
+ part2 = NULL;
+ objPtr = stackPtr[stackTop];
+ 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;
+ }
+ cleanup = ((part2 == NULL)? 1 : 2);
+ goto doIncrVar;
+
+ case INST_INCR_ARRAY1_IMM:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ i = TclGetInt1AtPtr(pc+2);
+ pcAdjustment = 3;
+
+ doIncrArray:
+ part2 = TclGetString(stackPtr[stackTop]);
+ arrayPtr = &(varFramePtr->compiledLocals[opnd]);
+ part1 = arrayPtr->name;
+ 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;
+ }
+ cleanup = 1;
+ goto doIncrVar;
+
+ case INST_INCR_SCALAR1_IMM:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ i = TclGetInt1AtPtr(pc+2);
+ pcAdjustment = 3;
+
+ doIncrScalar:
+ varPtr = &(varFramePtr->compiledLocals[opnd]);
+ part1 = varPtr->name;
+ while (TclIsVarLink(varPtr)) {
+ varPtr = varPtr->value.linkPtr;
+ }
+ arrayPtr = NULL;
+ part2 = NULL;
+ cleanup = 0;
+ TRACE(("%u %ld => ", opnd, i));
+
+
+ doIncrVar:
+ objPtr = varPtr->value.objPtr;
+ if (TclIsVarScalar(varPtr)
+ && !TclIsVarUndefined(varPtr)
+ && (varPtr->tracePtr == NULL)
+ && ((arrayPtr == NULL)
+ || (arrayPtr->tracePtr == NULL))
+ && (objPtr->typePtr == &tclIntType)) {
+ /*
+ * No errors, no traces, the variable already has an
+ * integer value: inline processing.
+ */
+
+ i += objPtr->internalRep.longValue;
+ if (Tcl_IsShared(objPtr)) {
+ objResultPtr = Tcl_NewLongObj(i);
+ TclDecrRefCount(objPtr);
+ Tcl_IncrRefCount(objResultPtr);
+ varPtr->value.objPtr = objResultPtr;
+ } else {
+ Tcl_SetLongObj(objPtr, i);
+ objResultPtr = objPtr;
}
- PUSH_OBJECT(value2Ptr);
- TRACE_WITH_OBJ(("%u %ld => ", opnd, i), value2Ptr);
- ADJUST_PC(3);
-
- case INST_INCR_SCALAR_STK_IMM:
- case INST_INCR_STK_IMM:
- objPtr = POP_OBJECT(); /* variable name */
- i = TclGetInt1AtPtr(pc+1);
+ TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ } else {
DECACHE_STACK_INFO();
- value2Ptr = TclIncrVar2(interp, objPtr, (Tcl_Obj *) NULL, i,
- TCL_LEAVE_ERR_MSG);
+ objResultPtr = TclPtrIncrVar(interp, varPtr, arrayPtr, part1,
+ part2, i, TCL_LEAVE_ERR_MSG);
CACHE_STACK_INFO();
- if (value2Ptr == NULL) {
- TRACE_WITH_OBJ(("\"%.30s\" %ld => ERROR: ",
- O2S(objPtr), i), Tcl_GetObjResult(interp));
+ if (objResultPtr == NULL) {
+ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
result = TCL_ERROR;
- Tcl_DecrRefCount(objPtr);
goto checkForCatch;
}
- PUSH_OBJECT(value2Ptr);
- TRACE_WITH_OBJ(("\"%.30s\" %ld => ", O2S(objPtr), i),
- value2Ptr);
- TclDecrRefCount(objPtr);
- ADJUST_PC(2);
-
- case INST_INCR_ARRAY1_IMM:
- {
- Tcl_Obj *elemPtr;
-
- opnd = TclGetUInt1AtPtr(pc+1);
- i = TclGetInt1AtPtr(pc+2);
- elemPtr = POP_OBJECT();
- DECACHE_STACK_INFO();
- value2Ptr = TclIncrElementOfIndexedArray(interp, opnd,
- elemPtr, i);
- CACHE_STACK_INFO();
- if (value2Ptr == NULL) {
- TRACE_WITH_OBJ(("%u \"%.30s\" (by %ld) => ERROR: ",
- opnd, O2S(elemPtr), i),
- Tcl_GetObjResult(interp));
- Tcl_DecrRefCount(elemPtr);
- result = TCL_ERROR;
- goto checkForCatch;
- }
- PUSH_OBJECT(value2Ptr);
- TRACE_WITH_OBJ(("%u \"%.30s\" (by %ld) => ",
- opnd, O2S(elemPtr), i), value2Ptr);
- Tcl_DecrRefCount(elemPtr);
- }
- ADJUST_PC(3);
+ }
+ 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.
+ * ---------------------------------------------------------
+ */
+
+
+ case INST_JUMP1:
+ opnd = TclGetInt1AtPtr(pc+1);
+ TRACE(("%d => new pc %u\n", opnd,
+ (unsigned int)(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 int)(pc + opnd - codePtr->codeStart)));
+ NEXT_INST_F(opnd, 0, 0);
+
+ case INST_JUMP_FALSE4:
+ opnd = 5; /* TRUE */
+ pcAdjustment = TclGetInt4AtPtr(pc+1); /* FALSE */
+ goto doJumpTrue;
+
+ case INST_JUMP_TRUE4:
+ opnd = TclGetInt4AtPtr(pc+1); /* TRUE */
+ pcAdjustment = 5; /* FALSE */
+ goto doJumpTrue;
+
+ case INST_JUMP_FALSE1:
+ opnd = 2; /* TRUE */
+ pcAdjustment = TclGetInt1AtPtr(pc+1); /* FALSE */
+ goto doJumpTrue;
+
+ case INST_JUMP_TRUE1:
+ opnd = TclGetInt1AtPtr(pc+1); /* TRUE */
+ pcAdjustment = 2; /* FALSE */
- case INST_INCR_ARRAY_STK_IMM:
- {
- Tcl_Obj *elemPtr;
-
- i = TclGetInt1AtPtr(pc+1);
- elemPtr = POP_OBJECT();
- objPtr = POP_OBJECT(); /* array name */
- DECACHE_STACK_INFO();
- value2Ptr = TclIncrVar2(interp, objPtr, elemPtr, i,
- TCL_LEAVE_ERR_MSG);
- CACHE_STACK_INFO();
- if (value2Ptr == NULL) {
- TRACE_WITH_OBJ(("\"%.30s(%.30s)\" (by %ld) => ERROR: ",
- O2S(objPtr), O2S(elemPtr), i),
- Tcl_GetObjResult(interp));
- Tcl_DecrRefCount(objPtr);
- Tcl_DecrRefCount(elemPtr);
- result = TCL_ERROR;
+ doJumpTrue:
+ {
+ int b;
+
+ valuePtr = stackPtr[stackTop];
+ if (valuePtr->typePtr == &tclIntType) {
+ b = (valuePtr->internalRep.longValue != 0);
+ } else if (valuePtr->typePtr == &tclDoubleType) {
+ b = (valuePtr->internalRep.doubleValue != 0.0);
+#ifndef TCL_WIDE_INT_IS_LONG
+ } else if (valuePtr->typePtr == &tclWideIntType) {
+ b = (valuePtr->internalRep.wideValue != W0);
+#endif /* TCL_WIDE_INT_IS_LONG */
+ } else {
+ result = Tcl_GetBooleanFromObj(interp, valuePtr, &b);
+ if (result != TCL_OK) {
+ TRACE_WITH_OBJ(("%d => ERROR: ", opnd), Tcl_GetObjResult(interp));
goto checkForCatch;
}
- PUSH_OBJECT(value2Ptr);
- TRACE_WITH_OBJ(("\"%.30s(%.30s)\" (by %ld) => ",
- O2S(objPtr), O2S(elemPtr), i), value2Ptr);
- Tcl_DecrRefCount(objPtr);
- Tcl_DecrRefCount(elemPtr);
}
- ADJUST_PC(2);
-
- case INST_JUMP1:
-#ifdef TCL_COMPILE_DEBUG
- opnd = TclGetInt1AtPtr(pc+1);
- TRACE(("%d => new pc %u\n", opnd,
- (unsigned int)(pc + opnd - codePtr->codeStart)));
- pc += opnd;
+#ifndef TCL_COMPILE_DEBUG
+ NEXT_INST_F((b? opnd : pcAdjustment), 1, 0);
#else
- pc += TclGetInt1AtPtr(pc+1);
-#endif /* TCL_COMPILE_DEBUG */
- continue;
-
- case INST_JUMP4:
- opnd = TclGetInt4AtPtr(pc+1);
- TRACE(("%d => new pc %u\n", opnd,
- (unsigned int)(pc + opnd - codePtr->codeStart)));
- ADJUST_PC(opnd);
-
- case INST_JUMP_TRUE4:
- opnd = TclGetInt4AtPtr(pc+1);
- pcAdjustment = 5;
- goto doJumpTrue;
-
- case INST_JUMP_TRUE1:
- opnd = TclGetInt1AtPtr(pc+1);
- pcAdjustment = 2;
-
- doJumpTrue:
- {
- int b;
-
- valuePtr = POP_OBJECT();
- if (valuePtr->typePtr == &tclIntType) {
- b = (valuePtr->internalRep.longValue != 0);
- } else if (valuePtr->typePtr == &tclDoubleType) {
- b = (valuePtr->internalRep.doubleValue != 0.0);
- } else {
- result = Tcl_GetBooleanFromObj(interp, valuePtr, &b);
- if (result != TCL_OK) {
- TRACE_WITH_OBJ(("%d => ERROR: ", opnd),
- Tcl_GetObjResult(interp));
- Tcl_DecrRefCount(valuePtr);
- goto checkForCatch;
- }
- }
- if (b) {
- TRACE(("%d => %.20s true, new pc %u\n",
- opnd, O2S(valuePtr),
+ if (b) {
+ if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE1)) {
+ TRACE(("%d => %.20s true, new pc %u\n", opnd, O2S(valuePtr),
(unsigned int)(pc+opnd - codePtr->codeStart)));
- TclDecrRefCount(valuePtr);
- ADJUST_PC(opnd);
} else {
+ TRACE(("%d => %.20s true\n", pcAdjustment, O2S(valuePtr)));
+ }
+ NEXT_INST_F(opnd, 1, 0);
+ } else {
+ if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE1)) {
TRACE(("%d => %.20s false\n", opnd, O2S(valuePtr)));
- TclDecrRefCount(valuePtr);
- ADJUST_PC(pcAdjustment);
+ } else {
+ opnd = pcAdjustment;
+ TRACE(("%d => %.20s false, new pc %u\n", opnd, O2S(valuePtr),
+ (unsigned int)(pc + opnd - codePtr->codeStart)));
}
+ NEXT_INST_F(pcAdjustment, 1, 0);
}
-
- case INST_JUMP_FALSE4:
- opnd = TclGetInt4AtPtr(pc+1);
- pcAdjustment = 5;
- goto doJumpFalse;
-
- case INST_JUMP_FALSE1:
- opnd = TclGetInt1AtPtr(pc+1);
- pcAdjustment = 2;
-
- doJumpFalse:
- {
- int b;
+#endif
+ }
+
+ case INST_LOR:
+ case INST_LAND:
+ {
+ /*
+ * Operands must be boolean or numeric. No int->double
+ * conversions are performed.
+ */
- valuePtr = POP_OBJECT();
+ int i1, i2;
+ int iResult;
+ char *s;
+ Tcl_ObjType *t1Ptr, *t2Ptr;
+
+ value2Ptr = stackPtr[stackTop];
+ valuePtr = stackPtr[stackTop - 1];;
+ t1Ptr = valuePtr->typePtr;
+ t2Ptr = value2Ptr->typePtr;
+
+ if ((t1Ptr == &tclIntType) || (t1Ptr == &tclBooleanType)) {
+ i1 = (valuePtr->internalRep.longValue != 0);
+#ifndef TCL_WIDE_INT_IS_LONG
+ } else if (t1Ptr == &tclWideIntType) {
+ i1 = (valuePtr->internalRep.wideValue != W0);
+#endif /* TCL_WIDE_INT_IS_LONG */
+ } else if (t1Ptr == &tclDoubleType) {
+ i1 = (valuePtr->internalRep.doubleValue != 0.0);
+ } else {
+ s = Tcl_GetStringFromObj(valuePtr, &length);
+ if (TclLooksLikeInt(s, length)) {
+#ifdef TCL_WIDE_INT_IS_LONG
+ result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
+ valuePtr, &i);
+ i1 = (i != 0);
+#else /* !TCL_WIDE_INT_IS_LONG */
+ GET_WIDE_OR_INT(result, valuePtr, i, w);
if (valuePtr->typePtr == &tclIntType) {
- b = (valuePtr->internalRep.longValue != 0);
- } else if (valuePtr->typePtr == &tclDoubleType) {
- b = (valuePtr->internalRep.doubleValue != 0.0);
+ i1 = (i != 0);
} else {
- result = Tcl_GetBooleanFromObj(interp, valuePtr, &b);
- if (result != TCL_OK) {
- TRACE_WITH_OBJ(("%d => ERROR: ", opnd),
- Tcl_GetObjResult(interp));
- Tcl_DecrRefCount(valuePtr);
- goto checkForCatch;
- }
- }
- if (b) {
- TRACE(("%d => %.20s true\n", opnd, O2S(valuePtr)));
- TclDecrRefCount(valuePtr);
- ADJUST_PC(pcAdjustment);
- } else {
- TRACE(("%d => %.20s false, new pc %u\n",
- opnd, O2S(valuePtr),
- (unsigned int)(pc + opnd - codePtr->codeStart)));
- TclDecrRefCount(valuePtr);
- ADJUST_PC(opnd);
+ i1 = (w != W0);
}
+#endif /* TCL_WIDE_INT_IS_LONG */
+ } else {
+ result = Tcl_GetBooleanFromObj((Tcl_Interp *) NULL,
+ valuePtr, &i1);
+ i1 = (i1 != 0);
}
-
- case INST_LOR:
- case INST_LAND:
- {
- /*
- * Operands must be boolean or numeric. No int->double
- * conversions are performed.
- */
-
- int i1, i2;
- int iResult;
- char *s;
- Tcl_ObjType *t1Ptr, *t2Ptr;
-
- value2Ptr = POP_OBJECT();
- valuePtr = POP_OBJECT();
- t1Ptr = valuePtr->typePtr;
- t2Ptr = value2Ptr->typePtr;
-
- if ((t1Ptr == &tclIntType) || (t1Ptr == &tclBooleanType)) {
- i1 = (valuePtr->internalRep.longValue != 0);
- } else if (t1Ptr == &tclDoubleType) {
- i1 = (valuePtr->internalRep.doubleValue != 0.0);
- } else {
- s = Tcl_GetStringFromObj(valuePtr, &length);
- if (TclLooksLikeInt(s, length)) {
- result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
- valuePtr, &i);
- i1 = (i != 0);
- } else {
- result = Tcl_GetBooleanFromObj((Tcl_Interp *) NULL,
- valuePtr, &i1);
- i1 = (i1 != 0);
- }
- if (result != TCL_OK) {
- TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n",
- O2S(valuePtr),
- (t1Ptr? t1Ptr->name : "null")));
- IllegalExprOperandType(interp, pc, valuePtr);
- Tcl_DecrRefCount(valuePtr);
- Tcl_DecrRefCount(value2Ptr);
- goto checkForCatch;
- }
- }
+ if (result != TCL_OK) {
+ TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
+ (t1Ptr? t1Ptr->name : "null")));
+ IllegalExprOperandType(interp, pc, valuePtr);
+ goto checkForCatch;
+ }
+ }
- if ((t2Ptr == &tclIntType) || (t2Ptr == &tclBooleanType)) {
- i2 = (value2Ptr->internalRep.longValue != 0);
- } else if (t2Ptr == &tclDoubleType) {
- i2 = (value2Ptr->internalRep.doubleValue != 0.0);
+ if ((t2Ptr == &tclIntType) || (t2Ptr == &tclBooleanType)) {
+ i2 = (value2Ptr->internalRep.longValue != 0);
+#ifndef TCL_WIDE_INT_IS_LONG
+ } else if (t2Ptr == &tclWideIntType) {
+ i2 = (value2Ptr->internalRep.wideValue != W0);
+#endif /* TCL_WIDE_INT_IS_LONG */
+ } else if (t2Ptr == &tclDoubleType) {
+ i2 = (value2Ptr->internalRep.doubleValue != 0.0);
+ } else {
+ s = Tcl_GetStringFromObj(value2Ptr, &length);
+ if (TclLooksLikeInt(s, length)) {
+#ifdef TCL_WIDE_INT_IS_LONG
+ result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
+ value2Ptr, &i);
+ i2 = (i != 0);
+#else /* !TCL_WIDE_INT_IS_LONG */
+ GET_WIDE_OR_INT(result, value2Ptr, i, w);
+ if (value2Ptr->typePtr == &tclIntType) {
+ i2 = (i != 0);
} else {
- s = Tcl_GetStringFromObj(value2Ptr, &length);
- if (TclLooksLikeInt(s, length)) {
- result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
- value2Ptr, &i);
- i2 = (i != 0);
- } else {
- result = Tcl_GetBooleanFromObj((Tcl_Interp *) NULL,
- value2Ptr, &i2);
- }
- if (result != TCL_OK) {
- TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n",
- O2S(value2Ptr),
- (t2Ptr? t2Ptr->name : "null")));
- IllegalExprOperandType(interp, pc, value2Ptr);
- Tcl_DecrRefCount(valuePtr);
- Tcl_DecrRefCount(value2Ptr);
- goto checkForCatch;
- }
+ i2 = (w != W0);
}
+#endif /* TCL_WIDE_INT_IS_LONG */
+ } else {
+ result = Tcl_GetBooleanFromObj((Tcl_Interp *) NULL, value2Ptr, &i2);
+ }
+ if (result != TCL_OK) {
+ TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(value2Ptr),
+ (t2Ptr? t2Ptr->name : "null")));
+ IllegalExprOperandType(interp, pc, value2Ptr);
+ goto checkForCatch;
+ }
+ }
+
+ /*
+ * Reuse the valuePtr object already on stack if possible.
+ */
+
+ if (*pc == INST_LOR) {
+ iResult = (i1 || i2);
+ } else {
+ iResult = (i1 && i2);
+ }
+ if (Tcl_IsShared(valuePtr)) {
+ objResultPtr = Tcl_NewLongObj(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));
+ Tcl_SetLongObj(valuePtr, iResult);
+ NEXT_INST_F(1, 1, 0);
+ }
+ }
+
+ /*
+ * ---------------------------------------------------------
+ * Start of INST_LIST and related instructions.
+ */
+
+ case INST_LIST:
+ /*
+ * Pop the opnd (objc) top stack elements into a new list obj
+ * and then decrement their ref counts.
+ */
+
+ opnd = TclGetUInt4AtPtr(pc+1);
+ objResultPtr = Tcl_NewListObj(opnd, &(stackPtr[stackTop - (opnd-1)]));
+ TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
+ NEXT_INST_V(5, opnd, 1);
+
+ case INST_LIST_LENGTH:
+ valuePtr = stackPtr[stackTop];
+
+ result = Tcl_ListObjLength(interp, valuePtr, &length);
+ if (result != TCL_OK) {
+ TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(valuePtr)),
+ Tcl_GetObjResult(interp));
+ goto checkForCatch;
+ }
+ objResultPtr = Tcl_NewIntObj(length);
+ TRACE(("%.20s => %d\n", O2S(valuePtr), length));
+ NEXT_INST_F(1, 1, 1);
+
+ case INST_LIST_INDEX:
+ /*** lindex with objc == 3 ***/
+ /*
+ * Pop the two operands
+ */
+ value2Ptr = stackPtr[stackTop];
+ valuePtr = stackPtr[stackTop- 1];
+
+ /*
+ * Extract the desired list element
+ */
+ 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;
+ }
+
+ /*
+ * 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_MULTI:
+ {
+ /*
+ * 'lindex' with multiple index args:
+ *
+ * Determine the count of index args.
+ */
+
+ int numIdx;
+
+ opnd = TclGetUInt4AtPtr(pc+1);
+ numIdx = opnd-1;
+
+ /*
+ * Do the 'lindex' operation.
+ */
+ objResultPtr = TclLindexFlat(interp, stackPtr[stackTop - numIdx],
+ numIdx, stackPtr + stackTop - numIdx + 1);
+
+ /*
+ * Check for errors
+ */
+ if (objResultPtr == NULL) {
+ TRACE_WITH_OBJ(("%d => ERROR: ", opnd), Tcl_GetObjResult(interp));
+ result = TCL_ERROR;
+ goto checkForCatch;
+ }
+
+ /*
+ * Set result
+ */
+ TRACE(("%d => %s\n", opnd, O2S(objResultPtr)));
+ NEXT_INST_V(5, opnd, -1);
+ }
+
+ case INST_LSET_FLAT:
+ {
+ /*
+ * Lset with 3, 5, or more args. Get the number
+ * of index args.
+ */
+ int numIdx;
+
+ opnd = TclGetUInt4AtPtr( pc + 1 );
+ numIdx = opnd - 2;
+
+ /*
+ * 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.
+ */
+ value2Ptr = POP_OBJECT();
+ TclDecrRefCount(value2Ptr); /* This one should be done here */
+
+ /*
+ * Get the new element value.
+ */
+ valuePtr = stackPtr[stackTop];
+
+ /*
+ * Compute the new variable value
+ */
+ objResultPtr = TclLsetFlat(interp, value2Ptr, numIdx,
+ stackPtr + stackTop - numIdx, valuePtr);
+
+
+ /*
+ * Check for errors
+ */
+ if (objResultPtr == NULL) {
+ TRACE_WITH_OBJ(("%d => ERROR: ", opnd), Tcl_GetObjResult(interp));
+ result = TCL_ERROR;
+ goto checkForCatch;
+ }
+
+ /*
+ * Set result
+ */
+ TRACE(("%d => %s\n", opnd, O2S(objResultPtr)));
+ NEXT_INST_V(5, (numIdx+1), -1);
+ }
+
+ case INST_LSET_LIST:
+ /*
+ * 'lset' with 4 args.
+ *
+ * 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.
+ */
+ objPtr = POP_OBJECT();
+ TclDecrRefCount(objPtr); /* This one should be done here */
+
+ /*
+ * Get the new element value, and the index list
+ */
+ valuePtr = stackPtr[stackTop];
+ value2Ptr = stackPtr[stackTop - 1];
+
+ /*
+ * Compute the new variable value
+ */
+ objResultPtr = TclLsetList(interp, objPtr, value2Ptr, valuePtr);
+
+ /*
+ * Check for errors
+ */
+ if (objResultPtr == NULL) {
+ TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", O2S(value2Ptr)),
+ Tcl_GetObjResult(interp));
+ result = TCL_ERROR;
+ goto checkForCatch;
+ }
+
+ /*
+ * Set result
+ */
+ TRACE(("=> %s\n", O2S(objResultPtr)));
+ NEXT_INST_F(1, 2, -1);
+
+ /*
+ * End of INST_LIST and related instructions.
+ * ---------------------------------------------------------
+ */
+
+ case INST_STR_EQ:
+ case INST_STR_NEQ:
+ {
+ /*
+ * String (in)equality check
+ */
+ int iResult;
+
+ value2Ptr = stackPtr[stackTop];
+ valuePtr = stackPtr[stackTop - 1];
+
+ if (valuePtr == value2Ptr) {
+ /*
+ * On the off-chance that the objects are the same,
+ * we don't really have to think hard about equality.
+ */
+ 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) {
/*
- * Reuse the valuePtr object already on stack if possible.
+ * We only need to check (in)equality when
+ * we have equal length strings.
*/
-
- if (*pc == INST_LOR) {
- iResult = (i1 || i2);
+ if (*pc == INST_STR_NEQ) {
+ iResult = (strcmp(s1, s2) != 0);
} else {
- iResult = (i1 && i2);
+ /* INST_STR_EQ */
+ iResult = (strcmp(s1, s2) == 0);
}
- if (Tcl_IsShared(valuePtr)) {
- PUSH_OBJECT(Tcl_NewLongObj(iResult));
- TRACE(("%.20s %.20s => %d\n",
- O2S(valuePtr), O2S(value2Ptr), iResult));
- TclDecrRefCount(valuePtr);
- } else { /* reuse the valuePtr object */
- TRACE(("%.20s %.20s => %d\n",
- O2S(valuePtr), O2S(value2Ptr), iResult));
- Tcl_SetLongObj(valuePtr, iResult);
- ++stackTop; /* valuePtr now on stk top has right r.c. */
- }
- TclDecrRefCount(value2Ptr);
+ } else {
+ iResult = (*pc == INST_STR_NEQ);
}
- ADJUST_PC(1);
-
- case INST_EQ:
- case INST_NEQ:
- case INST_LT:
- case INST_GT:
- case INST_LE:
- case INST_GE:
- {
+ }
+
+ TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), iResult));
+
+ /*
+ * Peep-hole optimisation: if you're about to jump, do jump
+ * from here.
+ */
+
+ 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 = Tcl_NewIntObj(iResult);
+ NEXT_INST_F(0, 2, 1);
+ }
+
+ case INST_STR_CMP:
+ {
+ /*
+ * String compare
+ */
+ CONST char *s1, *s2;
+ int s1len, s2len, iResult;
+
+ value2Ptr = stackPtr[stackTop];
+ valuePtr = stackPtr[stackTop - 1];
+
+ /*
+ * The comparison function should compare up to the
+ * minimum byte length only.
+ */
+ 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. In benchmark testing this proved
+ * the most efficient check between the unicode and
+ * string comparison operations.
+ */
+ Tcl_UniChar *uni1, *uni2;
+ uni1 = Tcl_GetUnicodeFromObj(valuePtr, &s1len);
+ uni2 = Tcl_GetUnicodeFromObj(value2Ptr, &s2len);
+ iResult = TclUniCharNcmp(uni1, uni2,
+ (unsigned) ((s1len < s2len) ? s1len : s2len));
+ } else {
+ /*
+ * We can't do a simple memcmp in order to handle the
+ * special Tcl \xC0\x80 null encoding for utf-8.
+ */
+ s1 = Tcl_GetStringFromObj(valuePtr, &s1len);
+ s2 = Tcl_GetStringFromObj(value2Ptr, &s2len);
+ iResult = TclpUtfNcmp2(s1, s2,
+ (size_t) ((s1len < s2len) ? s1len : s2len));
+ }
+
+ /*
+ * Make sure only -1,0,1 is returned
+ */
+ if (iResult == 0) {
+ iResult = s1len - s2len;
+ }
+ if (iResult < 0) {
+ iResult = -1;
+ } else if (iResult > 0) {
+ iResult = 1;
+ }
+
+ objResultPtr = Tcl_NewIntObj(iResult);
+ TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), iResult));
+ NEXT_INST_F(1, 2, 1);
+ }
+
+ case INST_STR_LEN:
+ {
+ int length1;
+
+ valuePtr = stackPtr[stackTop];
+
+ if (valuePtr->typePtr == &tclByteArrayType) {
+ (void) Tcl_GetByteArrayFromObj(valuePtr, &length1);
+ } else {
+ length1 = Tcl_GetCharLength(valuePtr);
+ }
+ objResultPtr = Tcl_NewIntObj(length1);
+ TRACE(("%.20s => %d\n", O2S(valuePtr), length1));
+ NEXT_INST_F(1, 1, 1);
+ }
+
+ case INST_STR_INDEX:
+ {
+ /*
+ * String compare
+ */
+ int index;
+ bytes = NULL; /* lint */
+
+ value2Ptr = stackPtr[stackTop];
+ valuePtr = stackPtr[stackTop - 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 index'th char.
+ */
+
+ if (valuePtr->typePtr == &tclByteArrayType) {
+ bytes = (char *)Tcl_GetByteArrayFromObj(valuePtr, &length);
+ } else {
+ /*
+ * Get Unicode char length to calulate what 'end' means.
+ */
+ length = Tcl_GetCharLength(valuePtr);
+ }
+
+ result = TclGetIntForIndex(interp, value2Ptr, length - 1, &index);
+ if (result != TCL_OK) {
+ goto checkForCatch;
+ }
+
+ if ((index >= 0) && (index < length)) {
+ if (valuePtr->typePtr == &tclByteArrayType) {
+ objResultPtr = Tcl_NewByteArrayObj((unsigned char *)
+ (&bytes[index]), 1);
+ } else {
+ char buf[TCL_UTF_MAX];
+ Tcl_UniChar ch;
+
+ ch = Tcl_GetUniChar(valuePtr, index);
/*
- * Any type is allowed but the two operands must have the
- * same type. We will compute value op value2.
+ * 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);
+ }
+ } else {
+ TclNewObj(objResultPtr);
+ }
+
+ TRACE(("%.20s %.20s => %s\n", O2S(valuePtr), O2S(value2Ptr),
+ O2S(objResultPtr)));
+ NEXT_INST_F(1, 2, 1);
+ }
+
+ case INST_STR_MATCH:
+ {
+ int nocase, match;
+
+ nocase = TclGetInt1AtPtr(pc+1);
+ valuePtr = stackPtr[stackTop]; /* String */
+ value2Ptr = stackPtr[stackTop - 1]; /* Pattern */
+
+ /*
+ * Check that at least one of the objects is Unicode before
+ * promoting both.
+ */
+ if ((valuePtr->typePtr == &tclStringType)
+ || (value2Ptr->typePtr == &tclStringType)) {
+ match = Tcl_UniCharCaseMatch(Tcl_GetUnicode(valuePtr),
+ Tcl_GetUnicode(value2Ptr), nocase);
+ } else {
+ match = Tcl_StringCaseMatch(TclGetString(valuePtr),
+ TclGetString(value2Ptr), nocase);
+ }
+
+ /*
+ * 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));
+ if (Tcl_IsShared(value2Ptr)) {
+ objResultPtr = Tcl_NewIntObj(match);
+ NEXT_INST_F(2, 2, 1);
+ } else { /* reuse the valuePtr object */
+ Tcl_SetIntObj(value2Ptr, match);
+ NEXT_INST_F(2, 1, 0);
+ }
+ }
+
+ 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.
+ */
- 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_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. */
- value2Ptr = POP_OBJECT();
- valuePtr = POP_OBJECT();
+ value2Ptr = stackPtr[stackTop];
+ valuePtr = stackPtr[stackTop - 1];
+
+ if (valuePtr == value2Ptr) {
+ /*
+ * Optimize the equal object case.
+ */
+ switch (*pc) {
+ case INST_EQ:
+ case INST_LE:
+ case INST_GE:
+ iResult = 1;
+ break;
+ case INST_NEQ:
+ case INST_LT:
+ case INST_GT:
+ iResult = 0;
+ break;
+ }
+ goto foundResult;
+ }
+
+ t1Ptr = valuePtr->typePtr;
+ t2Ptr = value2Ptr->typePtr;
+
+ /*
+ * 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]).
+ */
+ 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;
+ }
+ 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;
-
- /*
- * 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]).
- */
- if (!((((t1Ptr == NULL) && (valuePtr->bytes == NULL))
- || (valuePtr->bytes && (valuePtr->length == 0)))
- || (((t2Ptr == NULL) && (value2Ptr->bytes == NULL))
- || (value2Ptr->bytes && (value2Ptr->length == 0))))) {
- if ((t1Ptr != &tclIntType) && (t1Ptr != &tclDoubleType)) {
- s1 = Tcl_GetStringFromObj(valuePtr, &length);
- if (TclLooksLikeInt(s1, length)) {
- (void) Tcl_GetLongFromObj((Tcl_Interp *) NULL,
- valuePtr, &i);
- } else {
- (void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
- valuePtr, &d1);
- }
- t1Ptr = valuePtr->typePtr;
+ }
+ }
+ if (!IS_NUMERIC_TYPE(t1Ptr) || !IS_NUMERIC_TYPE(t2Ptr)) {
+ /*
+ * 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.
+ */
+ 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;
}
- if ((t2Ptr != &tclIntType) && (t2Ptr != &tclDoubleType)) {
- s2 = Tcl_GetStringFromObj(value2Ptr, &length);
- if (TclLooksLikeInt(s2, length)) {
- (void) Tcl_GetLongFromObj((Tcl_Interp *) NULL,
- value2Ptr, &i2);
- } else {
- (void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
- value2Ptr, &d2);
- }
- t2Ptr = value2Ptr->typePtr;
+ 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)) {
+ /*
+ * Compare as doubles.
+ */
+ 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;
+ }
+#ifndef TCL_WIDE_INT_IS_LONG
+ } else if ((t1Ptr == &tclWideIntType)
+ || (t2Ptr == &tclWideIntType)) {
+ Tcl_WideInt w2;
+ /*
+ * Compare as wide ints (neither are doubles)
+ */
+ if (t1Ptr == &tclIntType) {
+ w = Tcl_LongAsWide(valuePtr->internalRep.longValue);
+ w2 = value2Ptr->internalRep.wideValue;
+ } else if (t2Ptr == &tclIntType) {
+ w = valuePtr->internalRep.wideValue;
+ w2 = Tcl_LongAsWide(value2Ptr->internalRep.longValue);
+ } else {
+ w = valuePtr->internalRep.wideValue;
+ w2 = value2Ptr->internalRep.wideValue;
+ }
+ 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;
+ }
+#endif /* TCL_WIDE_INT_IS_LONG */
+ } else {
+ /*
+ * Compare as ints.
+ */
+ 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;
+ }
+ }
+
+ foundResult:
+ TRACE(("%.20s %.20s => %ld\n", O2S(valuePtr), O2S(value2Ptr), iResult));
+
+ /*
+ * Peep-hole optimisation: if you're about to jump, do jump
+ * from here.
+ */
+
+ 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 = Tcl_NewIntObj(iResult);
+ NEXT_INST_F(0, 2, 1);
+ }
+
+ case INST_MOD:
+ case INST_LSHIFT:
+ case INST_RSHIFT:
+ case INST_BITOR:
+ case INST_BITXOR:
+ case INST_BITAND:
+ {
+ /*
+ * Only integers are allowed. We compute value op value2.
+ */
+
+ long i2 = 0, rem, negative;
+ long iResult = 0; /* Init. avoids compiler warning. */
+#ifndef TCL_WIDE_INT_IS_LONG
+ Tcl_WideInt w2, wResult = W0;
+ int doWide = 0;
+#endif /* TCL_WIDE_INT_IS_LONG */
+
+ value2Ptr = stackPtr[stackTop];
+ valuePtr = stackPtr[stackTop - 1];
+ if (valuePtr->typePtr == &tclIntType) {
+ i = valuePtr->internalRep.longValue;
+#ifndef TCL_WIDE_INT_IS_LONG
+ } else if (valuePtr->typePtr == &tclWideIntType) {
+ w = valuePtr->internalRep.wideValue;
+#endif /* TCL_WIDE_INT_IS_LONG */
+ } 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;
+#ifndef TCL_WIDE_INT_IS_LONG
+ } else if (value2Ptr->typePtr == &tclWideIntType) {
+ w2 = value2Ptr->internalRep.wideValue;
+#endif /* TCL_WIDE_INT_IS_LONG */
+ } 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:
+ /*
+ * This code is tricky: C doesn't guarantee much about
+ * the quotient or remainder, but Tcl does. The
+ * remainder always has the same sign as the divisor and
+ * a smaller absolute value.
+ */
+#ifdef TCL_WIDE_INT_IS_LONG
+ if (i2 == 0) {
+ TRACE(("%ld %ld => DIVIDE BY ZERO\n", i, i2));
+ goto divideByZero;
+ }
+#else /* !TCL_WIDE_INT_IS_LONG */
+ if (value2Ptr->typePtr == &tclWideIntType && w2 == W0) {
+ if (valuePtr->typePtr == &tclIntType) {
+ LLTRACE(("%ld "LLD" => DIVIDE BY ZERO\n", i, w2));
+ } else {
+ LLTRACE((LLD" "LLD" => DIVIDE BY ZERO\n", w, w2));
}
- if (((t1Ptr != &tclIntType) && (t1Ptr != &tclDoubleType))
- || ((t2Ptr != &tclIntType) && (t2Ptr != &tclDoubleType))) {
- /*
- * One operand is not numeric. Compare as strings.
- */
- int cmpValue;
- s1 = Tcl_GetString(valuePtr);
- s2 = Tcl_GetString(value2Ptr);
- cmpValue = strcmp(s1, s2);
- switch (*pc) {
- case INST_EQ:
- iResult = (cmpValue == 0);
- break;
- case INST_NEQ:
- iResult = (cmpValue != 0);
- break;
- case INST_LT:
- iResult = (cmpValue < 0);
- break;
- case INST_GT:
- iResult = (cmpValue > 0);
- break;
- case INST_LE:
- iResult = (cmpValue <= 0);
- break;
- case INST_GE:
- iResult = (cmpValue >= 0);
- break;
- }
- } else if ((t1Ptr == &tclDoubleType)
- || (t2Ptr == &tclDoubleType)) {
- /*
- * Compare as doubles.
- */
- if (t1Ptr == &tclDoubleType) {
- d1 = valuePtr->internalRep.doubleValue;
- if (t2Ptr == &tclIntType) {
- d2 = value2Ptr->internalRep.longValue;
- } else {
- d2 = value2Ptr->internalRep.doubleValue;
- }
- } else { /* t1Ptr is int, t2Ptr is double */
- d1 = valuePtr->internalRep.longValue;
- 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;
- }
+ goto divideByZero;
+ }
+ if (value2Ptr->typePtr == &tclIntType && i2 == 0) {
+ if (valuePtr->typePtr == &tclIntType) {
+ TRACE(("%ld %ld => DIVIDE BY ZERO\n", i, i2));
} else {
- /*
- * Compare as ints.
- */
- 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;
- }
+ LLTRACE((LLD" %ld => DIVIDE BY ZERO\n", w, i2));
}
-
+ goto divideByZero;
+ }
+#endif /* TCL_WIDE_INT_IS_LONG */
+ negative = 0;
+#ifndef TCL_WIDE_INT_IS_LONG
+ if (valuePtr->typePtr == &tclWideIntType
+ || value2Ptr->typePtr == &tclWideIntType) {
+ Tcl_WideInt wRemainder;
/*
- * Reuse the valuePtr object already on stack if possible.
+ * Promote to wide
*/
-
- if (Tcl_IsShared(valuePtr)) {
- PUSH_OBJECT(Tcl_NewLongObj(iResult));
- TRACE(("%.20s %.20s => %ld\n",
- O2S(valuePtr), O2S(value2Ptr), iResult));
- TclDecrRefCount(valuePtr);
- } else { /* reuse the valuePtr object */
- TRACE(("%.20s %.20s => %ld\n",
- O2S(valuePtr), O2S(value2Ptr), iResult));
- Tcl_SetLongObj(valuePtr, iResult);
- ++stackTop; /* valuePtr now on stk top has right r.c. */
+ if (valuePtr->typePtr == &tclIntType) {
+ w = Tcl_LongAsWide(i);
+ } else if (value2Ptr->typePtr == &tclIntType) {
+ w2 = Tcl_LongAsWide(i2);
}
- TclDecrRefCount(value2Ptr);
+ if (w2 < 0) {
+ w2 = -w2;
+ w = -w;
+ negative = 1;
+ }
+ wRemainder = w % w2;
+ if (wRemainder < 0) {
+ wRemainder += w2;
+ }
+ if (negative) {
+ wRemainder = -wRemainder;
+ }
+ wResult = wRemainder;
+ doWide = 1;
+ break;
}
- ADJUST_PC(1);
-
- case INST_MOD:
+#endif /* TCL_WIDE_INT_IS_LONG */
+ if (i2 < 0) {
+ i2 = -i2;
+ i = -i;
+ negative = 1;
+ }
+ rem = i % i2;
+ if (rem < 0) {
+ rem += i2;
+ }
+ if (negative) {
+ rem = -rem;
+ }
+ iResult = rem;
+ break;
case INST_LSHIFT:
+#ifndef TCL_WIDE_INT_IS_LONG
+ /*
+ * 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 << i2;
+ doWide = 1;
+ break;
+ }
+#endif /* TCL_WIDE_INT_IS_LONG */
+ 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.
+ */
+#ifndef TCL_WIDE_INT_IS_LONG
+ /*
+ * 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) >> i2);
+ } else {
+ wResult = w >> i2;
+ }
+ doWide = 1;
+ break;
+ }
+#endif /* TCL_WIDE_INT_IS_LONG */
+ if (i < 0) {
+ iResult = ~((~i) >> i2);
+ } else {
+ iResult = i >> i2;
+ }
+ break;
case INST_BITOR:
+#ifndef TCL_WIDE_INT_IS_LONG
+ 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);
+ }
+ wResult = w | w2;
+ doWide = 1;
+ break;
+ }
+#endif /* TCL_WIDE_INT_IS_LONG */
+ iResult = i | i2;
+ break;
case INST_BITXOR:
+#ifndef TCL_WIDE_INT_IS_LONG
+ 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);
+ }
+ wResult = w ^ w2;
+ doWide = 1;
+ break;
+ }
+#endif /* TCL_WIDE_INT_IS_LONG */
+ iResult = i ^ i2;
+ break;
case INST_BITAND:
- {
+#ifndef TCL_WIDE_INT_IS_LONG
+ if (valuePtr->typePtr == &tclWideIntType
+ || value2Ptr->typePtr == &tclWideIntType) {
/*
- * Only integers are allowed. We compute value op value2.
+ * Promote to wide
*/
+ if (valuePtr->typePtr == &tclIntType) {
+ w = Tcl_LongAsWide(i);
+ } else if (value2Ptr->typePtr == &tclIntType) {
+ w2 = Tcl_LongAsWide(i2);
+ }
+ wResult = w & w2;
+ doWide = 1;
+ break;
+ }
+#endif /* TCL_WIDE_INT_IS_LONG */
+ iResult = i & i2;
+ break;
+ }
- long i2, rem, negative;
- long iResult = 0; /* Init. avoids compiler warning. */
+ /*
+ * Reuse the valuePtr object already on stack if possible.
+ */
- value2Ptr = POP_OBJECT();
- valuePtr = POP_OBJECT();
- if (valuePtr->typePtr == &tclIntType) {
- i = valuePtr->internalRep.longValue;
- } else { /* try to convert to int */
- result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
- valuePtr, &i);
- 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);
- Tcl_DecrRefCount(valuePtr);
- Tcl_DecrRefCount(value2Ptr);
- goto checkForCatch;
+ if (Tcl_IsShared(valuePtr)) {
+#ifndef TCL_WIDE_INT_IS_LONG
+ if (doWide) {
+ objResultPtr = Tcl_NewWideIntObj(wResult);
+ LLTRACE((LLD" "LLD" => "LLD"\n", w, w2, wResult));
+ } else {
+#endif /* TCL_WIDE_INT_IS_LONG */
+ objResultPtr = Tcl_NewLongObj(iResult);
+ TRACE(("%ld %ld => %ld\n", i, i2, iResult));
+#ifndef TCL_WIDE_INT_IS_LONG
+ }
+#endif /* TCL_WIDE_INT_IS_LONG */
+ NEXT_INST_F(1, 2, 1);
+ } else { /* reuse the valuePtr object */
+#ifndef TCL_WIDE_INT_IS_LONG
+ if (doWide) {
+ LLTRACE((LLD" "LLD" => "LLD"\n", w, w2, wResult));
+ Tcl_SetWideIntObj(valuePtr, wResult);
+ } else {
+#endif /* TCL_WIDE_INT_IS_LONG */
+ TRACE(("%ld %ld => %ld\n", i, i2, iResult));
+ Tcl_SetLongObj(valuePtr, iResult);
+#ifndef TCL_WIDE_INT_IS_LONG
+ }
+#endif /* TCL_WIDE_INT_IS_LONG */
+ NEXT_INST_F(1, 1, 0);
+ }
+ }
+
+ case INST_ADD:
+ case INST_SUB:
+ case INST_MULT:
+ case INST_DIV:
+ {
+ /*
+ * Operands must be numeric and ints get converted to floats
+ * if necessary. We compute value op value2.
+ */
+
+ Tcl_ObjType *t1Ptr, *t2Ptr;
+ long i2 = 0, quot, rem; /* 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 */
+#ifndef TCL_WIDE_INT_IS_LONG
+ Tcl_WideInt w2, wquot, wrem;
+ Tcl_WideInt wResult = W0; /* Init. avoids compiler warning. */
+ int doWide = 0; /* 1 if doing wide arithmetic. */
+#endif /* TCL_WIDE_INT_IS_LONG */
+
+ value2Ptr = stackPtr[stackTop];
+ valuePtr = stackPtr[stackTop - 1];
+ t1Ptr = valuePtr->typePtr;
+ t2Ptr = value2Ptr->typePtr;
+
+ if (t1Ptr == &tclIntType) {
+ i = valuePtr->internalRep.longValue;
+#ifndef TCL_WIDE_INT_IS_LONG
+ } else if (t1Ptr == &tclWideIntType) {
+ w = valuePtr->internalRep.wideValue;
+#endif /* TCL_WIDE_INT_IS_LONG */
+ } else if ((t1Ptr == &tclDoubleType)
+ && (valuePtr->bytes == NULL)) {
+ /*
+ * 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.
+ */
+
+ 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;
+ }
+
+ if (t2Ptr == &tclIntType) {
+ i2 = value2Ptr->internalRep.longValue;
+#ifndef TCL_WIDE_INT_IS_LONG
+ } else if (t2Ptr == &tclWideIntType) {
+ w2 = value2Ptr->internalRep.wideValue;
+#endif /* TCL_WIDE_INT_IS_LONG */
+ } else if ((t2Ptr == &tclDoubleType)
+ && (value2Ptr->bytes == NULL)) {
+ /*
+ * 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.
+ */
+
+ 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;
+ }
+
+ 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 */
+#ifndef TCL_WIDE_INT_IS_LONG
+ } else if (t1Ptr == &tclWideIntType) {
+ d1 = Tcl_WideAsDouble(w);
+ } else if (t2Ptr == &tclWideIntType) {
+ d2 = Tcl_WideAsDouble(w2);
+#endif /* TCL_WIDE_INT_IS_LONG */
+ }
+ 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:
+ if (d2 == 0.0) {
+ TRACE(("%.6g %.6g => DIVIDE BY ZERO\n", d1, d2));
+ goto divideByZero;
}
- }
- if (value2Ptr->typePtr == &tclIntType) {
- i2 = value2Ptr->internalRep.longValue;
- } else {
- result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
- value2Ptr, &i2);
- 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);
- Tcl_DecrRefCount(valuePtr);
- Tcl_DecrRefCount(value2Ptr);
- goto checkForCatch;
+ dResult = d1 / d2;
+ break;
+ }
+
+ /*
+ * Check now for IEEE floating-point error.
+ */
+
+ if (IS_NAN(dResult) || IS_INF(dResult)) {
+ TRACE(("%.20s %.20s => IEEE FLOATING PT ERROR\n",
+ O2S(valuePtr), O2S(value2Ptr)));
+ TclExprFloatError(interp, dResult);
+ result = TCL_ERROR;
+ goto checkForCatch;
+ }
+#ifndef TCL_WIDE_INT_IS_LONG
+ } 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:
+ /*
+ * This code is tricky: C doesn't guarantee much
+ * about the quotient or remainder, but Tcl does.
+ * The remainder always has the same sign as the
+ * divisor and a smaller absolute value.
+ */
+ if (w2 == W0) {
+ LLTRACE((LLD" "LLD" => DIVIDE BY ZERO\n", w, w2));
+ goto divideByZero;
}
- }
-
- switch (*pc) {
- case INST_MOD:
+ if (w2 < 0) {
+ w2 = -w2;
+ w = -w;
+ }
+ wquot = w / w2;
+ wrem = w % w2;
+ if (wrem < W0) {
+ wquot -= 1;
+ }
+ wResult = wquot;
+ break;
+ }
+#endif /* TCL_WIDE_INT_IS_LONG */
+ } 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:
/*
- * This code is tricky: C doesn't guarantee much about
- * the quotient or remainder, but Tcl does. The
- * remainder always has the same sign as the divisor and
- * a smaller absolute value.
+ * This code is tricky: C doesn't guarantee much
+ * about the quotient or remainder, but Tcl does.
+ * The remainder always has the same sign as the
+ * divisor and a smaller absolute value.
*/
if (i2 == 0) {
TRACE(("%ld %ld => DIVIDE BY ZERO\n", i, i2));
- Tcl_DecrRefCount(valuePtr);
- Tcl_DecrRefCount(value2Ptr);
goto divideByZero;
}
- negative = 0;
if (i2 < 0) {
i2 = -i2;
i = -i;
- negative = 1;
}
+ quot = i / i2;
rem = i % i2;
if (rem < 0) {
- rem += i2;
- }
- if (negative) {
- rem = -rem;
+ quot -= 1;
}
- iResult = rem;
+ iResult = quot;
break;
- case INST_LSHIFT:
- 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.
- */
- if (i < 0) {
- iResult = ~((~i) >> i2);
- } else {
- iResult = i >> i2;
- }
- break;
- case INST_BITOR:
- iResult = i | i2;
- break;
- case INST_BITXOR:
- iResult = i ^ i2;
- break;
- case INST_BITAND:
- iResult = i & i2;
- break;
- }
+ }
+ }
- /*
- * Reuse the valuePtr object already on stack if possible.
- */
+ /*
+ * Reuse the valuePtr object already on stack if possible.
+ */
- if (Tcl_IsShared(valuePtr)) {
- PUSH_OBJECT(Tcl_NewLongObj(iResult));
- TRACE(("%ld %ld => %ld\n", i, i2, iResult));
- TclDecrRefCount(valuePtr);
- } else { /* reuse the valuePtr object */
- TRACE(("%ld %ld => %ld\n", i, i2, iResult));
- Tcl_SetLongObj(valuePtr, iResult);
- ++stackTop; /* valuePtr now on stk top has right r.c. */
- }
- TclDecrRefCount(value2Ptr);
+ if (Tcl_IsShared(valuePtr)) {
+ if (doDouble) {
+ objResultPtr = Tcl_NewDoubleObj(dResult);
+ TRACE(("%.6g %.6g => %.6g\n", d1, d2, dResult));
+#ifndef TCL_WIDE_INT_IS_LONG
+ } else if (doWide) {
+ objResultPtr = Tcl_NewWideIntObj(wResult);
+ LLTRACE((LLD" "LLD" => "LLD"\n", w, w2, wResult));
+#endif /* TCL_WIDE_INT_IS_LONG */
+ } else {
+ objResultPtr = Tcl_NewLongObj(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));
+ Tcl_SetDoubleObj(valuePtr, dResult);
+#ifndef TCL_WIDE_INT_IS_LONG
+ } else if (doWide) {
+ LLTRACE((LLD" "LLD" => "LLD"\n", w, w2, wResult));
+ Tcl_SetWideIntObj(valuePtr, wResult);
+#endif /* TCL_WIDE_INT_IS_LONG */
+ } else {
+ TRACE(("%ld %ld => %ld\n", i, i2, iResult));
+ Tcl_SetLongObj(valuePtr, iResult);
}
- ADJUST_PC(1);
-
- case INST_ADD:
- case INST_SUB:
- case INST_MULT:
- case INST_DIV:
- {
- /*
- * Operands must be numeric and ints get converted to floats
- * if necessary. We compute value op value2.
- */
+ NEXT_INST_F(1, 1, 0);
+ }
+ }
- Tcl_ObjType *t1Ptr, *t2Ptr;
- long i2, quot, rem;
- 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 */
-
- value2Ptr = POP_OBJECT();
- valuePtr = POP_OBJECT();
- t1Ptr = valuePtr->typePtr;
- t2Ptr = value2Ptr->typePtr;
+ case INST_UPLUS:
+ {
+ /*
+ * Operand must be numeric.
+ */
+
+ double d;
+ Tcl_ObjType *tPtr;
- if (t1Ptr == &tclIntType) {
- i = valuePtr->internalRep.longValue;
- } else if ((t1Ptr == &tclDoubleType)
- && (valuePtr->bytes == NULL)) {
- /*
- * 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.
- */
+ valuePtr = stackPtr[stackTop];
+ tPtr = valuePtr->typePtr;
+ if (!IS_INTEGER_TYPE(tPtr) && ((tPtr != &tclDoubleType)
+ || (valuePtr->bytes != NULL))) {
+ 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;
+ }
- d1 = valuePtr->internalRep.doubleValue;
+ /*
+ * 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) {
+ i = valuePtr->internalRep.longValue;
+ objResultPtr = Tcl_NewLongObj(i);
+#ifndef TCL_WIDE_INT_IS_LONG
+ } else if (tPtr == &tclWideIntType) {
+ w = valuePtr->internalRep.wideValue;
+ objResultPtr = Tcl_NewWideIntObj(w);
+#endif /* TCL_WIDE_INT_IS_LONG */
+ } else {
+ d = valuePtr->internalRep.doubleValue;
+ objResultPtr = Tcl_NewDoubleObj(d);
+ }
+ TRACE_WITH_OBJ(("%s => ", O2S(objResultPtr)), objResultPtr);
+ NEXT_INST_F(1, 1, 1);
+ } else {
+ Tcl_InvalidateStringRep(valuePtr);
+ TRACE_WITH_OBJ(("%s => ", O2S(valuePtr)), 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;
+ Tcl_ObjType *tPtr;
+
+ valuePtr = stackPtr[stackTop];
+ tPtr = valuePtr->typePtr;
+ if (!IS_INTEGER_TYPE(tPtr) && ((tPtr != &tclDoubleType)
+ || (valuePtr->bytes != NULL))) {
+ if ((tPtr == &tclBooleanType) && (valuePtr->bytes == NULL)) {
+ valuePtr->typePtr = &tclIntType;
+ } else {
+ char *s = Tcl_GetStringFromObj(valuePtr, &length);
+ if (TclLooksLikeInt(s, length)) {
+ GET_WIDE_OR_INT(result, valuePtr, i, w);
} else {
- char *s = Tcl_GetStringFromObj(valuePtr, &length);
- if (TclLooksLikeInt(s, length)) {
- result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
- valuePtr, &i);
- } 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);
- Tcl_DecrRefCount(valuePtr);
- Tcl_DecrRefCount(value2Ptr);
- goto checkForCatch;
- }
- t1Ptr = valuePtr->typePtr;
+ result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
+ valuePtr, &d);
}
-
- if (t2Ptr == &tclIntType) {
- i2 = value2Ptr->internalRep.longValue;
- } else if ((t2Ptr == &tclDoubleType)
- && (value2Ptr->bytes == NULL)) {
- /*
- * 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.
- */
+ if (result == TCL_ERROR && *pc == INST_LNOT) {
+ result = Tcl_GetBooleanFromObj((Tcl_Interp *)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;
+ }
- d2 = value2Ptr->internalRep.doubleValue;
+ if (Tcl_IsShared(valuePtr)) {
+ /*
+ * Create a new object.
+ */
+ if ((tPtr == &tclIntType) || (tPtr == &tclBooleanType)) {
+ i = valuePtr->internalRep.longValue;
+ objResultPtr = Tcl_NewLongObj(
+ (*pc == INST_UMINUS)? -i : !i);
+ TRACE_WITH_OBJ(("%ld => ", i), objResultPtr);
+#ifndef TCL_WIDE_INT_IS_LONG
+ } else if (tPtr == &tclWideIntType) {
+ w = valuePtr->internalRep.wideValue;
+ if (*pc == INST_UMINUS) {
+ objResultPtr = Tcl_NewWideIntObj(-w);
} else {
- char *s = Tcl_GetStringFromObj(value2Ptr, &length);
- if (TclLooksLikeInt(s, length)) {
- result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
- value2Ptr, &i2);
- } 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);
- Tcl_DecrRefCount(valuePtr);
- Tcl_DecrRefCount(value2Ptr);
- goto checkForCatch;
- }
- t2Ptr = value2Ptr->typePtr;
+ objResultPtr = Tcl_NewLongObj(w == W0);
}
-
- 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 */
- }
- 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:
- if (d2 == 0.0) {
- TRACE(("%.6g %.6g => DIVIDE BY ZERO\n", d1, d2));
- Tcl_DecrRefCount(valuePtr);
- Tcl_DecrRefCount(value2Ptr);
- goto divideByZero;
- }
- dResult = d1 / d2;
- break;
- }
-
+ LLTRACE_WITH_OBJ((LLD" => ", w), objResultPtr);
+#endif /* TCL_WIDE_INT_IS_LONG */
+ } else {
+ d = valuePtr->internalRep.doubleValue;
+ if (*pc == INST_UMINUS) {
+ objResultPtr = Tcl_NewDoubleObj(-d);
+ } else {
/*
- * Check now for IEEE floating-point error.
+ * Should be able to use "!d", but apparently
+ * some compilers can't handle it.
*/
-
- if (IS_NAN(dResult) || IS_INF(dResult)) {
- TRACE(("%.20s %.20s => IEEE FLOATING PT ERROR\n",
- O2S(valuePtr), O2S(value2Ptr)));
- TclExprFloatError(interp, dResult);
- result = TCL_ERROR;
- Tcl_DecrRefCount(valuePtr);
- Tcl_DecrRefCount(value2Ptr);
- goto checkForCatch;
- }
+ objResultPtr = Tcl_NewLongObj((d==0.0)? 1 : 0);
+ }
+ TRACE_WITH_OBJ(("%.6g => ", d), objResultPtr);
+ }
+ NEXT_INST_F(1, 1, 1);
+ } else {
+ /*
+ * valuePtr is unshared. Modify it directly.
+ */
+ if ((tPtr == &tclIntType) || (tPtr == &tclBooleanType)) {
+ i = valuePtr->internalRep.longValue;
+ Tcl_SetLongObj(valuePtr,
+ (*pc == INST_UMINUS)? -i : !i);
+ TRACE_WITH_OBJ(("%ld => ", i), valuePtr);
+#ifndef TCL_WIDE_INT_IS_LONG
+ } else if (tPtr == &tclWideIntType) {
+ w = valuePtr->internalRep.wideValue;
+ if (*pc == INST_UMINUS) {
+ Tcl_SetWideIntObj(valuePtr, -w);
+ } else {
+ Tcl_SetLongObj(valuePtr, w == W0);
+ }
+ LLTRACE_WITH_OBJ((LLD" => ", w), valuePtr);
+#endif /* TCL_WIDE_INT_IS_LONG */
+ } else {
+ d = valuePtr->internalRep.doubleValue;
+ if (*pc == INST_UMINUS) {
+ Tcl_SetDoubleObj(valuePtr, -d);
} else {
/*
- * Do integer arithmetic.
+ * Should be able to use "!d", but apparently
+ * some compilers can't handle it.
*/
- 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:
- /*
- * This code is tricky: C doesn't guarantee much
- * about the quotient or remainder, but Tcl does.
- * The remainder always has the same sign as the
- * divisor and a smaller absolute value.
- */
- if (i2 == 0) {
- TRACE(("%ld %ld => DIVIDE BY ZERO\n", i, i2));
- Tcl_DecrRefCount(valuePtr);
- Tcl_DecrRefCount(value2Ptr);
- goto divideByZero;
- }
- if (i2 < 0) {
- i2 = -i2;
- i = -i;
- }
- quot = i / i2;
- rem = i % i2;
- if (rem < 0) {
- quot -= 1;
- }
- iResult = quot;
- break;
- }
+ Tcl_SetLongObj(valuePtr, (d==0.0)? 1 : 0);
}
+ TRACE_WITH_OBJ(("%.6g => ", d), valuePtr);
+ }
+ NEXT_INST_F(1, 0, 0);
+ }
+ }
- /*
- * Reuse the valuePtr object already on stack if possible.
- */
+ case INST_BITNOT:
+ {
+ /*
+ * 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.
+ */
- if (Tcl_IsShared(valuePtr)) {
- if (doDouble) {
- PUSH_OBJECT(Tcl_NewDoubleObj(dResult));
- TRACE(("%.6g %.6g => %.6g\n", d1, d2, dResult));
- } else {
- PUSH_OBJECT(Tcl_NewLongObj(iResult));
- TRACE(("%ld %ld => %ld\n", i, i2, iResult));
- }
- TclDecrRefCount(valuePtr);
- } else { /* reuse the valuePtr object */
- if (doDouble) { /* NB: stack top is off by 1 */
- TRACE(("%.6g %.6g => %.6g\n", d1, d2, dResult));
- Tcl_SetDoubleObj(valuePtr, dResult);
- } else {
- TRACE(("%ld %ld => %ld\n", i, i2, iResult));
- Tcl_SetLongObj(valuePtr, iResult);
- }
- ++stackTop; /* valuePtr now on stk top has right r.c. */
- }
- TclDecrRefCount(value2Ptr);
+ Tcl_ObjType *tPtr;
+
+ valuePtr = stackPtr[stackTop];
+ 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")));
+ IllegalExprOperandType(interp, pc, valuePtr);
+ goto checkForCatch;
}
- ADJUST_PC(1);
-
- case INST_UPLUS:
- {
- /*
- * Operand must be numeric.
- */
-
- double d;
- Tcl_ObjType *tPtr;
+ }
- valuePtr = stackPtr[stackTop];
- tPtr = valuePtr->typePtr;
- if ((tPtr != &tclIntType) && ((tPtr != &tclDoubleType)
- || (valuePtr->bytes != NULL))) {
- char *s = Tcl_GetStringFromObj(valuePtr, &length);
- if (TclLooksLikeInt(s, length)) {
- result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
- valuePtr, &i);
- } 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;
- }
-
+#ifndef TCL_WIDE_INT_IS_LONG
+ if (valuePtr->typePtr == &tclWideIntType) {
+ w = valuePtr->internalRep.wideValue;
+ if (Tcl_IsShared(valuePtr)) {
+ objResultPtr = Tcl_NewWideIntObj(~w);
+ LLTRACE(("0x%llx => (%llu)\n", w, ~w));
+ NEXT_INST_F(1, 1, 1);
+ } else {
/*
- * 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.
+ * valuePtr is unshared. Modify it directly.
*/
-
- if (Tcl_IsShared(valuePtr)) {
- if (tPtr == &tclIntType) {
- i = valuePtr->internalRep.longValue;
- objPtr = Tcl_NewLongObj(i);
- } else {
- d = valuePtr->internalRep.doubleValue;
- objPtr = Tcl_NewDoubleObj(d);
- }
- Tcl_IncrRefCount(objPtr);
- Tcl_DecrRefCount(valuePtr);
- valuePtr = objPtr;
- stackPtr[stackTop] = valuePtr;
- } else {
- Tcl_InvalidateStringRep(valuePtr);
- }
- TRACE_WITH_OBJ(("%s => ", O2S(valuePtr)), valuePtr);
+ Tcl_SetWideIntObj(valuePtr, ~w);
+ LLTRACE(("0x%llx => (%llu)\n", w, ~w));
+ NEXT_INST_F(1, 0, 0);
}
- ADJUST_PC(1);
-
- case INST_UMINUS:
- case INST_LNOT:
- {
+ } else {
+#endif /* TCL_WIDE_INT_IS_LONG */
+ i = valuePtr->internalRep.longValue;
+ if (Tcl_IsShared(valuePtr)) {
+ objResultPtr = Tcl_NewLongObj(~i);
+ TRACE(("0x%lx => (%lu)\n", i, ~i));
+ NEXT_INST_F(1, 1, 1);
+ } else {
/*
- * The operand must be numeric. 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.
+ * valuePtr is unshared. Modify it directly.
*/
+ Tcl_SetLongObj(valuePtr, ~i);
+ TRACE(("0x%lx => (%lu)\n", i, ~i));
+ NEXT_INST_F(1, 0, 0);
+ }
+#ifndef TCL_WIDE_INT_IS_LONG
+ }
+#endif /* TCL_WIDE_INT_IS_LONG */
+ }
+
+ case INST_CALL_BUILTIN_FUNC1:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ {
+ /*
+ * Call one of the built-in Tcl math functions.
+ */
+
+ BuiltinFunc *mathFuncPtr;
+
+ if ((opnd < 0) || (opnd > LAST_BUILTIN_FUNC)) {
+ TRACE(("UNRECOGNIZED BUILTIN FUNC CODE %d\n", opnd));
+ panic("TclExecuteByteCode: unrecognized builtin function code %d", opnd);
+ }
+ mathFuncPtr = &(tclBuiltinFuncTable[opnd]);
+ DECACHE_STACK_INFO();
+ result = (*mathFuncPtr->proc)(interp, eePtr,
+ mathFuncPtr->clientData);
+ CACHE_STACK_INFO();
+ if (result != TCL_OK) {
+ goto checkForCatch;
+ }
+ TRACE_WITH_OBJ(("%d => ", opnd), stackPtr[stackTop]);
+ }
+ NEXT_INST_F(2, 0, 0);
+
+ case INST_CALL_FUNC1:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ {
+ /*
+ * Call a non-builtin Tcl math function previously
+ * registered by a call to Tcl_CreateMathFunc.
+ */
- double d;
- Tcl_ObjType *tPtr;
-
- valuePtr = POP_OBJECT();
- tPtr = valuePtr->typePtr;
- if ((tPtr != &tclIntType) && ((tPtr != &tclDoubleType)
- || (valuePtr->bytes != NULL))) {
- if ((tPtr == &tclBooleanType)
- && (valuePtr->bytes == NULL)) {
- valuePtr->typePtr = &tclIntType;
- } else {
- char *s = Tcl_GetStringFromObj(valuePtr, &length);
- if (TclLooksLikeInt(s, length)) {
- result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
- valuePtr, &i);
- } 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);
- Tcl_DecrRefCount(valuePtr);
- goto checkForCatch;
- }
- }
- tPtr = valuePtr->typePtr;
- }
+ int objc = opnd; /* Number of arguments. The function name
+ * is the 0-th argument. */
+ Tcl_Obj **objv; /* The array of arguments. The function
+ * name is objv[0]. */
+
+ objv = &(stackPtr[stackTop - (objc-1)]); /* "objv[0]" */
+ DECACHE_STACK_INFO();
+ result = ExprCallMathFunc(interp, eePtr, objc, objv);
+ CACHE_STACK_INFO();
+ if (result != TCL_OK) {
+ goto checkForCatch;
+ }
+ TRACE_WITH_OBJ(("%d => ", objc), stackPtr[stackTop]);
+ }
+ NEXT_INST_F(2, 0, 0);
+
+ 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.
+ */
- if (Tcl_IsShared(valuePtr)) {
- /*
- * Create a new object.
- */
- if (tPtr == &tclIntType) {
- i = valuePtr->internalRep.longValue;
- objPtr = Tcl_NewLongObj(
- (*pc == INST_UMINUS)? -i : !i);
- TRACE_WITH_OBJ(("%ld => ", i), objPtr);
- } else {
- d = valuePtr->internalRep.doubleValue;
- if (*pc == INST_UMINUS) {
- objPtr = Tcl_NewDoubleObj(-d);
- } else {
- /*
- * Should be able to use "!d", but apparently
- * some compilers can't handle it.
- */
- objPtr = Tcl_NewLongObj((d==0.0)? 1 : 0);
- }
- TRACE_WITH_OBJ(("%.6g => ", d), objPtr);
- }
- PUSH_OBJECT(objPtr);
- TclDecrRefCount(valuePtr);
+ double d;
+ char *s;
+ Tcl_ObjType *tPtr;
+ int converted, needNew;
+
+ valuePtr = stackPtr[stackTop];
+ tPtr = valuePtr->typePtr;
+ converted = 0;
+ if (!IS_INTEGER_TYPE(tPtr) && ((tPtr != &tclDoubleType)
+ || (valuePtr->bytes != NULL))) {
+ if ((tPtr == &tclBooleanType) && (valuePtr->bytes == NULL)) {
+ valuePtr->typePtr = &tclIntType;
+ converted = 1;
+ } else {
+ 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) {
+ 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.
+ */
+
+ objResultPtr = valuePtr;
+ needNew = 0;
+ if (IS_NUMERIC_TYPE(tPtr)) {
+ if (Tcl_IsShared(valuePtr)) {
+ if (valuePtr->bytes != NULL) {
/*
- * valuePtr is unshared. Modify it directly.
+ * 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;
- Tcl_SetLongObj(valuePtr,
- (*pc == INST_UMINUS)? -i : !i);
- TRACE_WITH_OBJ(("%ld => ", i), valuePtr);
+ objResultPtr = Tcl_NewLongObj(i);
+#ifndef TCL_WIDE_INT_IS_LONG
+ } else if (tPtr == &tclWideIntType) {
+ w = valuePtr->internalRep.wideValue;
+ objResultPtr = Tcl_NewWideIntObj(w);
+#endif /* TCL_WIDE_INT_IS_LONG */
} else {
d = valuePtr->internalRep.doubleValue;
- if (*pc == INST_UMINUS) {
- Tcl_SetDoubleObj(valuePtr, -d);
- } else {
- /*
- * Should be able to use "!d", but apparently
- * some compilers can't handle it.
- */
- Tcl_SetLongObj(valuePtr, (d==0.0)? 1 : 0);
- }
- TRACE_WITH_OBJ(("%.6g => ", d), valuePtr);
+ objResultPtr = Tcl_NewDoubleObj(d);
}
- ++stackTop; /* valuePtr now on stk top has right r.c. */
+ tPtr = objResultPtr->typePtr;
}
+ } else {
+ Tcl_InvalidateStringRep(valuePtr);
}
- ADJUST_PC(1);
-
- case INST_BITNOT:
- {
- /*
- * 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.
- */
-
- Tcl_ObjType *tPtr;
-
- valuePtr = POP_OBJECT();
- tPtr = valuePtr->typePtr;
- if (tPtr != &tclIntType) {
- result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
- valuePtr, &i);
- if (result != TCL_OK) { /* try to convert to double */
- TRACE(("\"%.20s\" => ILLEGAL TYPE %s\n",
- O2S(valuePtr), (tPtr? tPtr->name : "null")));
- IllegalExprOperandType(interp, pc, valuePtr);
- Tcl_DecrRefCount(valuePtr);
- goto checkForCatch;
- }
- }
-
- i = valuePtr->internalRep.longValue;
- if (Tcl_IsShared(valuePtr)) {
- PUSH_OBJECT(Tcl_NewLongObj(~i));
- TRACE(("0x%lx => (%lu)\n", i, ~i));
- TclDecrRefCount(valuePtr);
- } else {
- /*
- * valuePtr is unshared. Modify it directly.
- */
- Tcl_SetLongObj(valuePtr, ~i);
- ++stackTop; /* valuePtr now on stk top has right r.c. */
- TRACE(("0x%lx => (%lu)\n", i, ~i));
- }
- }
- ADJUST_PC(1);
-
- case INST_CALL_BUILTIN_FUNC1:
- opnd = TclGetUInt1AtPtr(pc+1);
- {
- /*
- * Call one of the built-in Tcl math functions.
- */
-
- BuiltinFunc *mathFuncPtr;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
- if ((opnd < 0) || (opnd > LAST_BUILTIN_FUNC)) {
- TRACE(("UNRECOGNIZED BUILTIN FUNC CODE %d\n", opnd));
- panic("TclExecuteByteCode: unrecognized builtin function code %d", opnd);
- }
- mathFuncPtr = &(builtinFuncTable[opnd]);
- DECACHE_STACK_INFO();
- tsdPtr->mathInProgress++;
- result = (*mathFuncPtr->proc)(interp, eePtr,
- mathFuncPtr->clientData);
- tsdPtr->mathInProgress--;
- CACHE_STACK_INFO();
- if (result != TCL_OK) {
- goto checkForCatch;
- }
- TRACE_WITH_OBJ(("%d => ", opnd), stackPtr[stackTop]);
- }
- ADJUST_PC(2);
-
- case INST_CALL_FUNC1:
- opnd = TclGetUInt1AtPtr(pc+1);
- {
- /*
- * Call a non-builtin Tcl math function previously
- * registered by a call to Tcl_CreateMathFunc.
- */
- int objc = opnd; /* Number of arguments. The function name
- * is the 0-th argument. */
- Tcl_Obj **objv; /* The array of arguments. The function
- * name is objv[0]. */
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
- objv = &(stackPtr[stackTop - (objc-1)]); /* "objv[0]" */
- DECACHE_STACK_INFO();
- tsdPtr->mathInProgress++;
- result = ExprCallMathFunc(interp, eePtr, objc, objv);
- tsdPtr->mathInProgress--;
- CACHE_STACK_INFO();
- if (result != TCL_OK) {
+ if (tPtr == &tclDoubleType) {
+ d = objResultPtr->internalRep.doubleValue;
+ if (IS_NAN(d) || IS_INF(d)) {
+ TRACE(("\"%.20s\" => IEEE FLOATING PT ERROR\n",
+ O2S(objResultPtr)));
+ TclExprFloatError(interp, d);
+ result = TCL_ERROR;
goto checkForCatch;
}
- TRACE_WITH_OBJ(("%d => ", objc), stackPtr[stackTop]);
- ADJUST_PC(2);
}
+ 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) {
+ NEXT_INST_F(1, 1, 1);
+ } else {
+ NEXT_INST_F(1, 0, 0);
+ }
+ }
+
+ case INST_BREAK:
+ Tcl_ResetResult(interp);
+ result = TCL_BREAK;
+ cleanup = 0;
+ goto processExceptionReturn;
- 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.
- */
-
- double d;
- char *s;
- Tcl_ObjType *tPtr;
- int converted, shared;
-
- valuePtr = stackPtr[stackTop];
- tPtr = valuePtr->typePtr;
- converted = 0;
- if ((tPtr != &tclIntType) && ((tPtr != &tclDoubleType)
- || (valuePtr->bytes != NULL))) {
- if ((tPtr == &tclBooleanType)
- && (valuePtr->bytes == NULL)) {
- valuePtr->typePtr = &tclIntType;
- converted = 1;
- } else {
- s = Tcl_GetStringFromObj(valuePtr, &length);
- if (TclLooksLikeInt(s, length)) {
- result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
- valuePtr, &i);
- } else {
- result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
- valuePtr, &d);
- }
- if (result == TCL_OK) {
- converted = 1;
- }
- result = TCL_OK; /* reset the result variable */
- }
- tPtr = valuePtr->typePtr;
- }
+ case INST_CONTINUE:
+ Tcl_ResetResult(interp);
+ result = TCL_CONTINUE;
+ cleanup = 0;
+ goto processExceptionReturn;
- /*
- * 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.
- */
+ case INST_FOREACH_START4:
+ opnd = TclGetUInt4AtPtr(pc+1);
+ {
+ /*
+ * Initialize the temporary local var that holds the count
+ * of the number of iterations of the loop body to -1.
+ */
- if ((tPtr == &tclIntType) || (tPtr == &tclDoubleType)) {
- shared = 0;
- if (Tcl_IsShared(valuePtr)) {
- shared = 1;
- if (valuePtr->bytes != NULL) {
- /*
- * We only need to make a copy of the object
- * when it already had a string rep
- */
- if (tPtr == &tclIntType) {
- i = valuePtr->internalRep.longValue;
- objPtr = Tcl_NewLongObj(i);
- } else {
- d = valuePtr->internalRep.doubleValue;
- objPtr = Tcl_NewDoubleObj(d);
- }
- Tcl_IncrRefCount(objPtr);
- TclDecrRefCount(valuePtr);
- valuePtr = objPtr;
- stackPtr[stackTop] = valuePtr;
- tPtr = valuePtr->typePtr;
- }
- } else {
- Tcl_InvalidateStringRep(valuePtr);
- }
-
- if (tPtr == &tclDoubleType) {
- d = valuePtr->internalRep.doubleValue;
- if (IS_NAN(d) || IS_INF(d)) {
- TRACE(("\"%.20s\" => IEEE FLOATING PT ERROR\n",
- O2S(valuePtr)));
- TclExprFloatError(interp, d);
- result = TCL_ERROR;
- goto checkForCatch;
- }
- }
- shared = shared; /* lint, shared not used. */
- converted = converted; /* lint, converted not used. */
- TRACE(("\"%.20s\" => numeric, %s, %s\n", O2S(valuePtr),
- (converted? "converted" : "not converted"),
- (shared? "shared" : "not shared")));
- } else {
- TRACE(("\"%.20s\" => not numeric\n", O2S(valuePtr)));
- }
+ ForeachInfo *infoPtr = (ForeachInfo *)
+ codePtr->auxDataArrayPtr[opnd].clientData;
+ int iterTmpIndex = infoPtr->loopCtTemp;
+ Var *compiledLocals = iPtr->varFramePtr->compiledLocals;
+ Var *iterVarPtr = &(compiledLocals[iterTmpIndex]);
+ Tcl_Obj *oldValuePtr = iterVarPtr->value.objPtr;
+
+ if (oldValuePtr == NULL) {
+ iterVarPtr->value.objPtr = Tcl_NewLongObj(-1);
+ Tcl_IncrRefCount(iterVarPtr->value.objPtr);
+ } else {
+ Tcl_SetLongObj(oldValuePtr, -1);
}
- ADJUST_PC(1);
+ TclSetVarScalar(iterVarPtr);
+ TclClearVarUndefined(iterVarPtr);
+ TRACE(("%u => loop iter count temp %d\n",
+ opnd, iterTmpIndex));
+ }
+
+#ifndef TCL_COMPILE_DEBUG
+ /*
+ * Remark that the compiler ALWAYS sets INST_FOREACH_STEP4
+ * immediately after INST_FOREACH_START4 - let us just fall
+ * through instead of jumping back to the top.
+ */
- case INST_BREAK:
+ pc += 5;
+#else
+ NEXT_INST_F(5, 0, 0);
+#endif
+ case INST_FOREACH_STEP4:
+ opnd = TclGetUInt4AtPtr(pc+1);
+ {
/*
- * First reset the interpreter's result. Then find the closest
- * enclosing loop or catch exception range, if any. If a loop is
- * found, terminate its execution. If the closest is a catch
- * exception range, jump to its catchOffset. If no enclosing
- * range is found, stop execution and return TCL_BREAK.
+ * "Step" a foreach loop (i.e., begin its next iteration) by
+ * assigning the next value list element to each loop var.
*/
- Tcl_ResetResult(interp);
- rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 0, codePtr);
- if (rangePtr == NULL) {
- TRACE(("=> no encl. loop or catch, returning TCL_BREAK\n"));
- result = TCL_BREAK;
- goto abnormalReturn; /* no catch exists to check */
- }
- switch (rangePtr->type) {
- case LOOP_EXCEPTION_RANGE:
- result = TCL_OK;
- TRACE(("=> range at %d, new pc %d\n",
- rangePtr->codeOffset, rangePtr->breakOffset));
- break;
- case CATCH_EXCEPTION_RANGE:
- result = TCL_BREAK;
- TRACE(("=> ...\n"));
- goto processCatch; /* it will use rangePtr */
- default:
- panic("TclExecuteByteCode: unrecognized ExceptionRange type %d\n", rangePtr->type);
- }
- pc = (codePtr->codeStart + rangePtr->breakOffset);
- continue; /* restart outer instruction loop at pc */
-
- case INST_CONTINUE:
- /*
- * Find the closest enclosing loop or catch exception range,
- * if any. If a loop is found, skip to its next iteration.
- * If the closest is a catch exception range, jump to its
- * catchOffset. If no enclosing range is found, stop
- * execution and return TCL_CONTINUE.
+ ForeachInfo *infoPtr = (ForeachInfo *)
+ codePtr->auxDataArrayPtr[opnd].clientData;
+ ForeachVarList *varListPtr;
+ int numLists = infoPtr->numLists;
+ Var *compiledLocals = iPtr->varFramePtr->compiledLocals;
+ Tcl_Obj *listPtr;
+ List *listRepPtr;
+ Var *iterVarPtr, *listVarPtr;
+ int iterNum, listTmpIndex, listLen, numVars;
+ int varIndex, valIndex, continueLoop, j;
+
+ /*
+ * Increment the temp holding the loop iteration number.
*/
- Tcl_ResetResult(interp);
- rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 0, codePtr);
- if (rangePtr == NULL) {
- TRACE(("=> no encl. loop or catch, returning TCL_CONTINUE\n"));
- result = TCL_CONTINUE;
- goto abnormalReturn;
- }
- switch (rangePtr->type) {
- case LOOP_EXCEPTION_RANGE:
- if (rangePtr->continueOffset == -1) {
- TRACE(("=> loop w/o continue, checking for catch\n"));
+ iterVarPtr = &(compiledLocals[infoPtr->loopCtTemp]);
+ valuePtr = iterVarPtr->value.objPtr;
+ iterNum = (valuePtr->internalRep.longValue + 1);
+ Tcl_SetLongObj(valuePtr, iterNum);
+
+ /*
+ * Check whether all value lists are exhausted and we should
+ * stop the loop.
+ */
+
+ continueLoop = 0;
+ listTmpIndex = infoPtr->firstValueTemp;
+ for (i = 0; i < numLists; i++) {
+ varListPtr = infoPtr->varLists[i];
+ numVars = varListPtr->numVars;
+
+ listVarPtr = &(compiledLocals[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;
- } else {
- result = TCL_OK;
- TRACE(("=> range at %d, new pc %d\n",
- rangePtr->codeOffset, rangePtr->continueOffset));
}
- break;
- case CATCH_EXCEPTION_RANGE:
- result = TCL_CONTINUE;
- TRACE(("=> ...\n"));
- goto processCatch; /* it will use rangePtr */
- default:
- panic("TclExecuteByteCode: unrecognized ExceptionRange type %d\n", rangePtr->type);
- }
- pc = (codePtr->codeStart + rangePtr->continueOffset);
- continue; /* restart outer instruction loop at pc */
-
- case INST_FOREACH_START4:
- opnd = TclGetUInt4AtPtr(pc+1);
- {
- /*
- * Initialize the temporary local var that holds the count
- * of the number of iterations of the loop body to -1.
- */
-
- ForeachInfo *infoPtr = (ForeachInfo *)
- codePtr->auxDataArrayPtr[opnd].clientData;
- int iterTmpIndex = infoPtr->loopCtTemp;
- Var *compiledLocals = iPtr->varFramePtr->compiledLocals;
- Var *iterVarPtr = &(compiledLocals[iterTmpIndex]);
- Tcl_Obj *oldValuePtr = iterVarPtr->value.objPtr;
-
- if (oldValuePtr == NULL) {
- iterVarPtr->value.objPtr = Tcl_NewLongObj(-1);
- Tcl_IncrRefCount(iterVarPtr->value.objPtr);
- } else {
- Tcl_SetLongObj(oldValuePtr, -1);
+ if (listLen > (iterNum * numVars)) {
+ continueLoop = 1;
}
- TclSetVarScalar(iterVarPtr);
- TclClearVarUndefined(iterVarPtr);
- TRACE(("%u => loop iter count temp %d\n",
- opnd, iterTmpIndex));
+ listTmpIndex++;
}
- ADJUST_PC(5);
-
- case INST_FOREACH_STEP4:
- opnd = TclGetUInt4AtPtr(pc+1);
- {
- /*
- * "Step" a foreach loop (i.e., begin its next iteration) by
- * assigning the next value list element to each loop var.
- */
-
- ForeachInfo *infoPtr = (ForeachInfo *)
- codePtr->auxDataArrayPtr[opnd].clientData;
- ForeachVarList *varListPtr;
- int numLists = infoPtr->numLists;
- Var *compiledLocals = iPtr->varFramePtr->compiledLocals;
- Tcl_Obj *listPtr;
- List *listRepPtr;
- Var *iterVarPtr, *listVarPtr;
- int iterNum, listTmpIndex, listLen, numVars;
- int varIndex, valIndex, continueLoop, j;
-
- /*
- * Increment the temp holding the loop iteration number.
- */
- iterVarPtr = &(compiledLocals[infoPtr->loopCtTemp]);
- valuePtr = iterVarPtr->value.objPtr;
- iterNum = (valuePtr->internalRep.longValue + 1);
- Tcl_SetLongObj(valuePtr, iterNum);
+ /*
+ * If some var in some var list still has a remaining list
+ * element iterate one more time. Assign to var the next
+ * element from its value list. We already checked above
+ * that each list temp holds a valid list object.
+ */
- /*
- * Check whether all value lists are exhausted and we should
- * stop the loop.
- */
-
- continueLoop = 0;
+ if (continueLoop) {
listTmpIndex = infoPtr->firstValueTemp;
for (i = 0; i < numLists; i++) {
varListPtr = infoPtr->varLists[i];
numVars = varListPtr->numVars;
-
+
listVarPtr = &(compiledLocals[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 (listLen > (iterNum * numVars)) {
- continueLoop = 1;
- }
- listTmpIndex++;
- }
-
- /*
- * If some var in some var list still has a remaining list
- * element iterate one more time. Assign to var the next
- * element from its value list. We already checked above
- * that each list temp holds a valid list object.
- */
-
- if (continueLoop) {
- listTmpIndex = infoPtr->firstValueTemp;
- for (i = 0; i < numLists; i++) {
- varListPtr = infoPtr->varLists[i];
- numVars = varListPtr->numVars;
-
- listVarPtr = &(compiledLocals[listTmpIndex]);
- listPtr = listVarPtr->value.objPtr;
- listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
- listLen = listRepPtr->elemCount;
+ listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
+ listLen = listRepPtr->elemCount;
- valIndex = (iterNum * numVars);
- for (j = 0; j < numVars; j++) {
- int setEmptyStr = 0;
- if (valIndex >= listLen) {
- setEmptyStr = 1;
- valuePtr = Tcl_NewObj();
- } else {
- valuePtr = listRepPtr->elements[valIndex];
- }
+ valIndex = (iterNum * numVars);
+ for (j = 0; j < numVars; j++) {
+ int setEmptyStr = 0;
+ if (valIndex >= listLen) {
+ setEmptyStr = 1;
+ TclNewObj(valuePtr);
+ } else {
+ valuePtr = listRepPtr->elements[valIndex];
+ }
- varIndex = varListPtr->varIndexes[j];
+ varIndex = varListPtr->varIndexes[j];
+ varPtr = &(varFramePtr->compiledLocals[varIndex]);
+ part1 = varPtr->name;
+ while (TclIsVarLink(varPtr)) {
+ varPtr = varPtr->value.linkPtr;
+ }
+ if (!((varPtr->flags & VAR_IN_HASHTABLE) && (varPtr->hPtr == NULL))
+ && (varPtr->tracePtr == NULL)
+ && (TclIsVarScalar(varPtr) || TclIsVarUndefined(varPtr))) {
+ value2Ptr = varPtr->value.objPtr;
+ 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 = TclSetIndexedScalar(interp,
- varIndex, valuePtr, /*leaveErrorMsg*/ 1);
+ 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));
+ opnd, varIndex),
+ Tcl_GetObjResult(interp));
if (setEmptyStr) {
- Tcl_DecrRefCount(valuePtr);
+ TclDecrRefCount(valuePtr);
}
result = TCL_ERROR;
goto checkForCatch;
}
- valIndex++;
}
- listTmpIndex++;
+ valIndex++;
}
+ listTmpIndex++;
}
-
- /*
- * Push 1 if at least one value list had a remaining element
- * and the loop should continue. Otherwise push 0.
- */
-
- PUSH_OBJECT(Tcl_NewLongObj(continueLoop));
- TRACE(("%u => %d lists, iter %d, %s loop\n",
- opnd, numLists, iterNum,
- (continueLoop? "continue" : "exit")));
}
- ADJUST_PC(5);
+ TRACE(("%u => %d lists, iter %d, %s loop\n", opnd, numLists,
+ iterNum, (continueLoop? "continue" : "exit")));
- case INST_BEGIN_CATCH4:
- /*
- * Record start of the catch command with exception range index
- * equal to the operand. Push the current stack depth onto the
- * special catch stack.
+ /*
+ * Run-time peep-hole optimisation: the compiler ALWAYS follows
+ * INST_FOREACH_STEP4 with an INST_JUMP_FALSE. We just skip that
+ * instruction and jump direct from here.
*/
- catchStackPtr[++catchTop] = stackTop;
- TRACE(("%u => catchTop=%d, stackTop=%d\n",
- TclGetUInt4AtPtr(pc+1), catchTop, stackTop));
- ADJUST_PC(5);
- case INST_END_CATCH:
- catchTop--;
- result = TCL_OK;
- TRACE(("=> catchTop=%d\n", catchTop));
- ADJUST_PC(1);
+ pc += 5;
+ if (*pc == INST_JUMP_FALSE1) {
+ NEXT_INST_F((continueLoop? 2 : TclGetInt1AtPtr(pc+1)), 0, 0);
+ } else {
+ NEXT_INST_F((continueLoop? 5 : TclGetInt4AtPtr(pc+1)), 0, 0);
+ }
+ }
- case INST_PUSH_RESULT:
- PUSH_OBJECT(Tcl_GetObjResult(interp));
- TRACE_WITH_OBJ(("=> "), Tcl_GetObjResult(interp));
- ADJUST_PC(1);
+ case INST_BEGIN_CATCH4:
+ /*
+ * Record start of the catch command with exception range index
+ * equal to the operand. Push the current stack depth onto the
+ * special catch stack.
+ */
+ catchStackPtr[++catchTop] = stackTop;
+ TRACE(("%u => catchTop=%d, stackTop=%d\n",
+ TclGetUInt4AtPtr(pc+1), catchTop, stackTop));
+ NEXT_INST_F(5, 0, 0);
+
+ case INST_END_CATCH:
+ catchTop--;
+ result = TCL_OK;
+ TRACE(("=> catchTop=%d\n", catchTop));
+ NEXT_INST_F(1, 0, 0);
+
+ case INST_PUSH_RESULT:
+ objResultPtr = Tcl_GetObjResult(interp);
+ TRACE_WITH_OBJ(("=> "), Tcl_GetObjResult(interp));
+ NEXT_INST_F(1, 0, 1);
- case INST_PUSH_RETURN_CODE:
- PUSH_OBJECT(Tcl_NewLongObj(result));
- TRACE(("=> %u\n", result));
- ADJUST_PC(1);
+ case INST_PUSH_RETURN_CODE:
+ objResultPtr = Tcl_NewLongObj(result);
+ TRACE(("=> %u\n", result));
+ NEXT_INST_F(1, 0, 1);
- default:
- panic("TclExecuteByteCode: unrecognized opCode %u", *pc);
- } /* end of switch on opCode */
+ default:
+ panic("TclExecuteByteCode: unrecognized opCode %u", *pc);
+ } /* end of switch on opCode */
- /*
- * Division by zero in an expression. Control only reaches this
- * point by "goto divideByZero".
- */
-
- divideByZero:
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp), "divide by zero", -1);
- Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero",
- (char *) NULL);
- result = TCL_ERROR;
+ /*
+ * Division by zero in an expression. Control only reaches this
+ * point by "goto divideByZero".
+ */
- /*
- * Execution has generated an "exception" such as TCL_ERROR. If the
- * exception is an error, record information about what was being
- * executed when the error occurred. Find the closest enclosing
- * catch range, if any. If no enclosing catch range is found, stop
- * execution and return the "exception" code.
- */
+ divideByZero:
+ Tcl_ResetResult(interp);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp), "divide by zero", -1);
+ Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero",
+ (char *) NULL);
+ result = TCL_ERROR;
+ goto checkForCatch;
- checkForCatch:
- if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
- bytes = GetSrcInfoForPc(pc, codePtr, &length);
- if (bytes != NULL) {
- Tcl_LogCommandInfo(interp, codePtr->source, bytes, length);
- iPtr->flags |= ERR_ALREADY_LOGGED;
- }
- }
- rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 1, codePtr);
+ /*
+ * An external evaluation (INST_INVOKE or INST_EVAL) returned
+ * something different from TCL_OK, or else INST_BREAK or
+ * INST_CONTINUE were called.
+ */
+
+ processExceptionReturn:
+#if TCL_COMPILE_DEBUG
+ switch (*pc) {
+ case INST_INVOKE_STK1:
+ case INST_INVOKE_STK4:
+ TRACE(("%u => ... after \"%.20s\": ", opnd, cmdNameBuf));
+ break;
+ case INST_EVAL_STK:
+ /*
+ * Note that the object at stacktop has to be used
+ * before doing the cleanup.
+ */
+
+ TRACE(("\"%.30s\" => ", O2S(stackPtr[stackTop])));
+ break;
+ default:
+ TRACE(("=> "));
+ }
+#endif
+ if ((result == TCL_CONTINUE) || (result == TCL_BREAK)) {
+ rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 0, codePtr);
if (rangePtr == NULL) {
-#ifdef TCL_COMPILE_DEBUG
- if (traceInstructions) {
- fprintf(stdout, " ... no enclosing catch, returning %s\n",
- StringForResultCode(result));
- }
-#endif
+ TRACE_APPEND(("no encl. loop or catch, returning %s\n",
+ StringForResultCode(result)));
goto abnormalReturn;
+ }
+ if (rangePtr->type == CATCH_EXCEPTION_RANGE) {
+ TRACE_APPEND(("%s ...\n", StringForResultCode(result)));
+ goto processCatch;
}
-
- /*
- * 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.
- */
-
- processCatch:
- while (stackTop > catchStackPtr[catchTop]) {
+ while (cleanup--) {
valuePtr = POP_OBJECT();
TclDecrRefCount(valuePtr);
}
+ if (result == TCL_BREAK) {
+ result = TCL_OK;
+ pc = (codePtr->codeStart + rangePtr->breakOffset);
+ TRACE_APPEND(("%s, range at %d, new pc %d\n",
+ 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)) {
+ objPtr = Tcl_GetObjResult(interp);
+ TRACE_APPEND(("OTHER RETURN CODE %d, result= \"%s\"\n ",
+ result, O2S(objPtr)));
+ } else {
+ objPtr = Tcl_GetObjResult(interp);
+ TRACE_APPEND(("%s, result= \"%s\"\n",
+ StringForResultCode(result), O2S(objPtr)));
+ }
+#endif
+ }
+
+ /*
+ * Execution has generated an "exception" such as TCL_ERROR. If the
+ * exception is an error, record information about what was being
+ * executed when the error occurred. Find the closest enclosing
+ * catch range, if any. If no enclosing catch range is found, stop
+ * execution and return the "exception" code.
+ */
+
+ checkForCatch:
+ if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
+ bytes = GetSrcInfoForPc(pc, codePtr, &length);
+ if (bytes != NULL) {
+ Tcl_LogCommandInfo(interp, codePtr->source, bytes, length);
+ iPtr->flags |= ERR_ALREADY_LOGGED;
+ }
+ }
+ if (catchTop == -1) {
+#ifdef TCL_COMPILE_DEBUG
+ if (traceInstructions) {
+ fprintf(stdout, " ... no enclosing catch, returning %s\n",
+ StringForResultCode(result));
+ }
+#endif
+ goto abnormalReturn;
+ }
+ rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 1, codePtr);
+ if (rangePtr == NULL) {
+ /*
+ * 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.
+ */
#ifdef TCL_COMPILE_DEBUG
if (traceInstructions) {
- fprintf(stdout, " ... found catch at %d, catchTop=%d, unwound to %d, new pc %u\n",
+ fprintf(stdout, " ... no enclosing catch, returning %s\n",
+ StringForResultCode(result));
+ }
+#endif
+ goto abnormalReturn;
+ }
+
+ /*
+ * 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.
+ */
+
+ processCatch:
+ while (stackTop > catchStackPtr[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, catchStackPtr[catchTop],
(unsigned int)(rangePtr->catchOffset));
- }
+ }
#endif
- pc = (codePtr->codeStart + rangePtr->catchOffset);
- continue; /* restart the execution loop at pc */
- } /* end of infinite loop dispatching on instructions */
+ pc = (codePtr->codeStart + rangePtr->catchOffset);
+ NEXT_INST_F(0, 0, 0); /* restart the execution loop at pc */
+
+ /*
+ * end of infinite loop dispatching on instructions.
+ */
/*
* Abnormal return code. Restore the stack to state it had when starting
- * to execute the ByteCode.
+ * to execute the ByteCode. Panic if the stack is below the initial level.
*/
- abnormalReturn:
+ abnormalReturn:
while (stackTop > initStackTop) {
valuePtr = POP_OBJECT();
- Tcl_DecrRefCount(valuePtr);
+ TclDecrRefCount(valuePtr);
}
-
+ if (stackTop < initStackTop) {
+ fprintf(stderr, "\nTclExecuteByteCode: abnormal return at pc %u: stack top %d < entry stack top %d\n",
+ (unsigned int)(pc - codePtr->codeStart),
+ (unsigned int) stackTop,
+ (unsigned int) initStackTop);
+ panic("TclExecuteByteCode execution failure: end stack top < start stack top");
+ }
+
/*
* Free the catch stack array if malloc'ed storage was used.
*/
- done:
if (catchStackPtr != catchStackStorage) {
ckfree((char *) catchStackPtr);
}
@@ -3004,8 +4301,7 @@ PrintByteCodeInfo(codePtr)
#ifdef TCL_COMPILE_DEBUG
static void
-ValidatePcAndStackTop(codePtr, pc, stackTop, stackLowerBound,
- stackUpperBound)
+ValidatePcAndStackTop(codePtr, pc, stackTop, stackLowerBound)
register ByteCode *codePtr; /* The bytecode whose summary is printed
* to stdout. */
unsigned char *pc; /* Points to first byte of a bytecode
@@ -3014,8 +4310,9 @@ ValidatePcAndStackTop(codePtr, pc, stackTop, stackLowerBound,
* stackLowerBound and stackUpperBound
* (inclusive). */
int stackLowerBound; /* Smallest legal value for stackTop. */
- int stackUpperBound; /* Greatest legal value for stackTop. */
{
+ int stackUpperBound = stackLowerBound + 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)
@@ -3030,15 +4327,15 @@ ValidatePcAndStackTop(codePtr, pc, stackTop, stackLowerBound,
if ((unsigned int) opCode > LAST_INST_OPCODE) {
fprintf(stderr, "\nBad opcode %d at pc %u in TclExecuteByteCode\n",
(unsigned int) opCode, relativePc);
- panic("TclExecuteByteCode execution failure: bad opcode");
+ panic("TclExecuteByteCode execution failure: bad opcode");
}
if ((stackTop < stackLowerBound) || (stackTop > stackUpperBound)) {
int numChars;
char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars);
char *ellipsis = "";
- fprintf(stderr, "\nBad stack top %d at pc %u in TclExecuteByteCode",
- stackTop, relativePc);
+ fprintf(stderr, "\nBad stack top %d at pc %u in TclExecuteByteCode (min %i, max %i)",
+ stackTop, relativePc, stackLowerBound, stackUpperBound);
if (cmd != NULL) {
if (numChars > 100) {
numChars = 100;
@@ -3090,27 +4387,101 @@ IllegalExprOperandType(interp, pc, opndPtr)
operatorStrings[opCode - INST_LOR], "\"", (char *) NULL);
} else {
char *msg = "non-numeric string";
- if (opndPtr->typePtr != &tclDoubleType) {
+ 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) {
/*
- * See if the operand can be interpreted as a double in order to
- * improve the error message.
+ * 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 (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);
+ }
+ } else {
+ /*
+ * See if the operand can be interpreted as a double in
+ * order to improve the error message.
*/
- char *s = Tcl_GetString(opndPtr);
double d;
if (Tcl_GetDouble((Tcl_Interp *) NULL, s, &d) == TCL_OK) {
- /*
- * Make sure that what appears to be a double
- * (ie 08) isn't really a bad octal
- */
- if (TclCheckBadOctal(NULL, Tcl_GetString(opndPtr))) {
- msg = "invalid octal number";
- } else {
- msg = "floating-point value";
- }
+ msg = "floating-point value";
}
}
+ makeErrorMessage:
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "can't use ",
msg, " as operand of \"", operatorStrings[opCode - INST_LOR],
"\"", (char *) NULL);
@@ -3120,74 +4491,6 @@ IllegalExprOperandType(interp, pc, opndPtr)
/*
*----------------------------------------------------------------------
*
- * CallTraceProcedure --
- *
- * Invokes a trace procedure registered with an interpreter. These
- * procedures trace command execution. Currently this trace procedure
- * is called with the address of the string-based Tcl_CmdProc for the
- * command, not the Tcl_ObjCmdProc.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Those side effects made by the trace procedure.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-CallTraceProcedure(interp, tracePtr, cmdPtr, command, numChars, objc, objv)
- Tcl_Interp *interp; /* The current interpreter. */
- register Trace *tracePtr; /* Describes the trace procedure to call. */
- Command *cmdPtr; /* Points to command's Command struct. */
- char *command; /* Points to the first character of the
- * command's source before substitutions. */
- int numChars; /* The number of characters in the
- * command's source. */
- register int objc; /* Number of arguments for the command. */
- Tcl_Obj *objv[]; /* Pointers to Tcl_Obj of each argument. */
-{
- Interp *iPtr = (Interp *) interp;
- register char **argv;
- register int i;
- int length;
- char *p;
-
- /*
- * Get the string rep from the objv argument objects and place their
- * pointers in argv. First make sure argv is large enough to hold the
- * objc args plus 1 extra word for the zero end-of-argv word.
- */
-
- argv = (char **) ckalloc((unsigned)(objc + 1) * sizeof(char *));
- for (i = 0; i < objc; i++) {
- argv[i] = Tcl_GetStringFromObj(objv[i], &length);
- }
- argv[objc] = 0;
-
- /*
- * Copy the command characters into a new string.
- */
-
- p = (char *) ckalloc((unsigned) (numChars + 1));
- memcpy((VOID *) p, (VOID *) command, (size_t) numChars);
- p[numChars] = '\0';
-
- /*
- * Call the trace procedure then free allocated storage.
- */
-
- (*tracePtr->proc)(tracePtr->clientData, interp, iPtr->numLevels,
- p, cmdPtr->proc, cmdPtr->clientData, objc, argv);
-
- ckfree((char *) argv);
- ckfree((char *) p);
-}
-
-/*
- *----------------------------------------------------------------------
- *
* GetSrcInfoForPc --
*
* Given a program counter value, finds the closest command in the
@@ -3349,25 +4652,28 @@ GetExceptRangeForPc(pc, catchOnly, codePtr)
int numRanges = codePtr->numExceptRanges;
register ExceptionRange *rangePtr;
int pcOffset = (pc - codePtr->codeStart);
- register int i, level;
+ register int start;
if (numRanges == 0) {
return NULL;
}
- rangeArrayPtr = codePtr->exceptArrayPtr;
- for (level = codePtr->maxExceptDepth; level >= 0; level--) {
- for (i = 0; i < numRanges; i++) {
- rangePtr = &(rangeArrayPtr[i]);
- if (rangePtr->nestingLevel == level) {
- int start = rangePtr->codeOffset;
- int end = (start + rangePtr->numCodeBytes);
- if ((start <= pcOffset) && (pcOffset < end)) {
- if ((!catchOnly)
- || (rangePtr->type == CATCH_EXCEPTION_RANGE)) {
- return rangePtr;
- }
- }
+ /*
+ * This exploits peculiarities of our compiler: nested ranges
+ * are always *after* their containing ranges, so that by scanning
+ * backwards we are sure that the first matching range is indeed
+ * the deepest.
+ */
+
+ rangeArrayPtr = codePtr->exceptArrayPtr;
+ rangePtr = rangeArrayPtr + numRanges;
+ while (--rangePtr >= rangeArrayPtr) {
+ start = rangePtr->codeOffset;
+ if ((start <= pcOffset) &&
+ (pcOffset < (start + rangePtr->numCodeBytes))) {
+ if ((!catchOnly)
+ || (rangePtr->type == CATCH_EXCEPTION_RANGE)) {
+ return rangePtr;
}
}
}
@@ -3400,7 +4706,7 @@ GetOpcodeName(pc)
{
unsigned char opCode = *pc;
- return instructionTable[opCode].name;
+ return tclInstructionTable[opCode].name;
}
#endif /* TCL_COMPILE_DEBUG */
@@ -3418,7 +4724,8 @@ GetOpcodeName(pc)
* TCL_OK if it was int or double, TCL_ERROR otherwise
*
* Side effects:
- * objPtr is ensured to be either tclIntType of tclDoubleType.
+ * objPtr is ensured to be of tclIntType, tclWideIntType or
+ * tclDoubleType.
*
*----------------------------------------------------------------------
*/
@@ -3429,16 +4736,20 @@ VerifyExprObjType(interp, objPtr)
* function. */
Tcl_Obj *objPtr; /* Points to the object to type check. */
{
- if ((objPtr->typePtr == &tclIntType) ||
- (objPtr->typePtr == &tclDoubleType)) {
+ if (IS_NUMERIC_TYPE(objPtr->typePtr)) {
return TCL_OK;
} else {
int length, result = TCL_OK;
char *s = Tcl_GetStringFromObj(objPtr, &length);
if (TclLooksLikeInt(s, length)) {
+#ifdef TCL_WIDE_INT_IS_LONG
long i;
result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, objPtr, &i);
+#else /* !TCL_WIDE_INT_IS_LONG */
+ Tcl_WideInt w;
+ result = Tcl_GetWideIntFromObj((Tcl_Interp *) NULL, objPtr, &w);
+#endif /* TCL_WIDE_INT_IS_LONG */
} else {
double d;
result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, objPtr, &d);
@@ -3515,12 +4826,8 @@ ExprUnaryFunc(interp, eePtr, clientData)
result = TCL_ERROR;
goto done;
}
-
- if (valuePtr->typePtr == &tclIntType) {
- d = (double) valuePtr->internalRep.longValue;
- } else {
- d = valuePtr->internalRep.doubleValue;
- }
+
+ GET_DOUBLE_VALUE(d, valuePtr, valuePtr->typePtr);
errno = 0;
dResult = (*func)(d);
@@ -3541,7 +4848,7 @@ ExprUnaryFunc(interp, eePtr, clientData)
*/
done:
- Tcl_DecrRefCount(valuePtr);
+ TclDecrRefCount(valuePtr);
DECACHE_STACK_INFO();
return result;
}
@@ -3586,17 +4893,8 @@ ExprBinaryFunc(interp, eePtr, clientData)
goto done;
}
- if (valuePtr->typePtr == &tclIntType) {
- d1 = (double) valuePtr->internalRep.longValue;
- } else {
- d1 = valuePtr->internalRep.doubleValue;
- }
-
- if (value2Ptr->typePtr == &tclIntType) {
- d2 = (double) value2Ptr->internalRep.longValue;
- } else {
- d2 = value2Ptr->internalRep.doubleValue;
- }
+ GET_DOUBLE_VALUE(d1, valuePtr, valuePtr->typePtr);
+ GET_DOUBLE_VALUE(d2, value2Ptr, value2Ptr->typePtr);
errno = 0;
dResult = (*func)(d1, d2);
@@ -3617,8 +4915,8 @@ ExprBinaryFunc(interp, eePtr, clientData)
*/
done:
- Tcl_DecrRefCount(valuePtr);
- Tcl_DecrRefCount(value2Ptr);
+ TclDecrRefCount(valuePtr);
+ TclDecrRefCount(value2Ptr);
DECACHE_STACK_INFO();
return result;
}
@@ -3676,6 +4974,25 @@ ExprAbsFunc(interp, eePtr, clientData)
iResult = i;
}
PUSH_OBJECT(Tcl_NewLongObj(iResult));
+#ifndef TCL_WIDE_INT_IS_LONG
+ } else if (valuePtr->typePtr == &tclWideIntType) {
+ Tcl_WideInt wResult, w = valuePtr->internalRep.wideValue;
+ if (w < W0) {
+ wResult = -w;
+ if (wResult < 0) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ "integer value too large to represent", -1);
+ Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
+ "integer value too large to represent", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ } else {
+ wResult = w;
+ }
+ PUSH_OBJECT(Tcl_NewWideIntObj(wResult));
+#endif /* TCL_WIDE_INT_IS_LONG */
} else {
d = valuePtr->internalRep.doubleValue;
if (d < 0.0) {
@@ -3696,7 +5013,7 @@ ExprAbsFunc(interp, eePtr, clientData)
*/
done:
- Tcl_DecrRefCount(valuePtr);
+ TclDecrRefCount(valuePtr);
DECACHE_STACK_INFO();
return result;
}
@@ -3733,11 +5050,7 @@ ExprDoubleFunc(interp, eePtr, clientData)
goto done;
}
- if (valuePtr->typePtr == &tclIntType) {
- dResult = (double) valuePtr->internalRep.longValue;
- } else {
- dResult = valuePtr->internalRep.doubleValue;
- }
+ GET_DOUBLE_VALUE(dResult, valuePtr, valuePtr->typePtr);
/*
* Push a Tcl object with the result.
@@ -3750,7 +5063,7 @@ ExprDoubleFunc(interp, eePtr, clientData)
*/
done:
- Tcl_DecrRefCount(valuePtr);
+ TclDecrRefCount(valuePtr);
DECACHE_STACK_INFO();
return result;
}
@@ -3790,6 +5103,10 @@ ExprIntFunc(interp, eePtr, clientData)
if (valuePtr->typePtr == &tclIntType) {
iResult = valuePtr->internalRep.longValue;
+#ifndef TCL_WIDE_INT_IS_LONG
+ } else if (valuePtr->typePtr == &tclWideIntType) {
+ iResult = Tcl_WideAsLong(valuePtr->internalRep.wideValue);
+#endif /* TCL_WIDE_INT_IS_LONG */
} else {
d = valuePtr->internalRep.doubleValue;
if (d < 0.0) {
@@ -3827,10 +5144,91 @@ ExprIntFunc(interp, eePtr, clientData)
*/
done:
- Tcl_DecrRefCount(valuePtr);
+ TclDecrRefCount(valuePtr);
+ DECACHE_STACK_INFO();
+ return result;
+}
+
+#ifndef TCL_WIDE_INT_IS_LONG
+static int
+ExprWideFunc(interp, eePtr, clientData)
+ Tcl_Interp *interp; /* The interpreter in which to execute the
+ * function. */
+ ExecEnv *eePtr; /* Points to the environment for executing
+ * the function. */
+ ClientData clientData; /* Ignored. */
+{
+ Tcl_Obj **stackPtr; /* Cached evaluation stack base pointer. */
+ register int stackTop; /* Cached top index of evaluation stack. */
+ register Tcl_Obj *valuePtr;
+ Tcl_WideInt wResult;
+ double d;
+ int result;
+
+ /*
+ * Set stackPtr and stackTop from eePtr.
+ */
+
+ result = TCL_OK;
+ CACHE_STACK_INFO();
+
+ /*
+ * Pop the argument from the evaluation stack.
+ */
+
+ valuePtr = POP_OBJECT();
+
+ if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+
+ if (valuePtr->typePtr == &tclWideIntType) {
+ wResult = valuePtr->internalRep.wideValue;
+ } else if (valuePtr->typePtr == &tclIntType) {
+ wResult = Tcl_LongAsWide(valuePtr->internalRep.longValue);
+ } else {
+ d = valuePtr->internalRep.doubleValue;
+ if (d < 0.0) {
+ if (d < Tcl_WideAsDouble(LLONG_MIN)) {
+ tooLarge:
+ Tcl_ResetResult(interp);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ "integer value too large to represent", -1);
+ Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
+ "integer value too large to represent", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ } else {
+ if (d > Tcl_WideAsDouble(LLONG_MAX)) {
+ goto tooLarge;
+ }
+ }
+ if (IS_NAN(d) || IS_INF(d)) {
+ TclExprFloatError(interp, d);
+ result = TCL_ERROR;
+ goto done;
+ }
+ wResult = Tcl_DoubleAsWide(d);
+ }
+
+ /*
+ * Push a Tcl object with the result.
+ */
+
+ PUSH_OBJECT(Tcl_NewWideIntObj(wResult));
+
+ /*
+ * Reflect the change to stackTop back in eePtr.
+ */
+
+ done:
+ TclDecrRefCount(valuePtr);
DECACHE_STACK_INFO();
return result;
}
+#endif /* TCL_WIDE_INT_IS_LONG */
static int
ExprRandFunc(interp, eePtr, clientData)
@@ -3844,11 +5242,27 @@ ExprRandFunc(interp, eePtr, clientData)
register int stackTop; /* Cached top index of evaluation stack. */
Interp *iPtr = (Interp *) interp;
double dResult;
- int tmp;
+ long tmp; /* Algorithm assumes at least 32 bits.
+ * Only long guarantees that. See below. */
if (!(iPtr->flags & RAND_SEED_INITIALIZED)) {
iPtr->flags |= RAND_SEED_INITIALIZED;
- iPtr->randSeed = TclpGetClicks();
+
+ /*
+ * Take into consideration the thread this interp is running in order
+ * to insure different seeds in different threads (bug #416643)
+ */
+
+ iPtr->randSeed = TclpGetClicks() + ((long)Tcl_GetCurrentThread()<<12);
+
+ /*
+ * Make sure 1 <= randSeed <= (2^31) - 2. See below.
+ */
+
+ iPtr->randSeed &= (unsigned long) 0x7fffffff;
+ if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7fffffff)) {
+ iPtr->randSeed ^= 123459876;
+ }
}
/*
@@ -3861,11 +5275,20 @@ ExprRandFunc(interp, eePtr, clientData)
* Generate the random number using the linear congruential
* generator defined by the following recurrence:
* seed = ( IA * seed ) mod IM
- * where IA is 16807 and IM is (2^31) - 1. In order to avoid
- * potential problems with integer overflow, the code uses
- * additional constants IQ and IR such that
+ * where IA is 16807 and IM is (2^31) - 1. The recurrence maps
+ * a seed in the range [1, IM - 1] to a new seed in that same range.
+ * The recurrence maps IM to 0, and maps 0 back to 0, so those two
+ * values must not be allowed as initial values of seed.
+ *
+ * In order to avoid potential problems with integer overflow, the
+ * recurrence is implemented in terms of additional constants
+ * IQ and IR such that
* IM = IA*IQ + IR
- * For details on how this algorithm works, refer to the following
+ * None of the operations in the implementation overflows a 32-bit
+ * signed integer, and the C type long is guaranteed to be at least
+ * 32 bits wide.
+ *
+ * For more details on how this algorithm works, refer to the following
* papers:
*
* S.K. Park & K.W. Miller, "Random number generators: good ones
@@ -3881,14 +5304,6 @@ ExprRandFunc(interp, eePtr, clientData)
#define RAND_IR 2836
#define RAND_MASK 123459876
- if (iPtr->randSeed == 0) {
- /*
- * Don't allow a 0 seed, since it breaks the generator. Shift
- * it to some other value.
- */
-
- iPtr->randSeed = 123459876;
- }
tmp = iPtr->randSeed/RAND_IQ;
iPtr->randSeed = RAND_IA*(iPtr->randSeed - tmp*RAND_IQ) - RAND_IR*tmp;
if (iPtr->randSeed < 0) {
@@ -3896,14 +5311,10 @@ ExprRandFunc(interp, eePtr, clientData)
}
/*
- * On 64-bit architectures we need to mask off the upper bits to
- * ensure we only have a 32-bit range. The constant has the
- * bizarre form below in order to make sure that it doesn't
- * get sign-extended (the rules for sign extension are very
- * concat, particularly on 64-bit machines).
+ * Since the recurrence keeps seed values in the range [1, RAND_IM - 1],
+ * dividing by RAND_IM yields a double in the range (0, 1).
*/
- iPtr->randSeed &= ((((unsigned long) 0xfffffff) << 4) | 0xf);
dResult = iPtr->randSeed * (1.0/RAND_IM);
/*
@@ -3955,6 +5366,11 @@ ExprRoundFunc(interp, eePtr, clientData)
if (valuePtr->typePtr == &tclIntType) {
iResult = valuePtr->internalRep.longValue;
+#ifndef TCL_WIDE_INT_IS_LONG
+ } else if (valuePtr->typePtr == &tclWideIntType) {
+ PUSH_OBJECT(Tcl_NewWideIntObj(valuePtr->internalRep.wideValue));
+ goto done;
+#endif /* TCL_WIDE_INT_IS_LONG */
} else {
d = valuePtr->internalRep.doubleValue;
if (d < 0.0) {
@@ -3995,7 +5411,7 @@ ExprRoundFunc(interp, eePtr, clientData)
*/
done:
- Tcl_DecrRefCount(valuePtr);
+ TclDecrRefCount(valuePtr);
DECACHE_STACK_INFO();
return result;
}
@@ -4035,6 +5451,10 @@ ExprSrandFunc(interp, eePtr, clientData)
if (valuePtr->typePtr == &tclIntType) {
i = valuePtr->internalRep.longValue;
+#ifndef TCL_WIDE_INT_IS_LONG
+ } else if (valuePtr->typePtr == &tclWideIntType) {
+ i = Tcl_WideAsLong(valuePtr->internalRep.wideValue);
+#endif /* TCL_WIDE_INT_IS_LONG */
} else {
/*
* At this point, the only other possible type is double
@@ -4044,17 +5464,22 @@ ExprSrandFunc(interp, eePtr, clientData)
"can't use floating-point value as argument to srand",
(char *) NULL);
badValue:
- Tcl_DecrRefCount(valuePtr);
+ TclDecrRefCount(valuePtr);
DECACHE_STACK_INFO();
return TCL_ERROR;
}
/*
- * Reset the seed.
+ * Reset the seed. Make sure 1 <= randSeed <= 2^31 - 2.
+ * See comments in ExprRandFunc() for more details.
*/
iPtr->flags |= RAND_SEED_INITIALIZED;
iPtr->randSeed = i;
+ iPtr->randSeed &= (unsigned long) 0x7fffffff;
+ if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7fffffff)) {
+ iPtr->randSeed ^= 123459876;
+ }
/*
* To avoid duplicating the random number generation code we simply
@@ -4062,7 +5487,7 @@ ExprSrandFunc(interp, eePtr, clientData)
* function will always succeed.
*/
- Tcl_DecrRefCount(valuePtr);
+ TclDecrRefCount(valuePtr);
DECACHE_STACK_INFO();
ExprRandFunc(interp, eePtr, clientData);
@@ -4113,7 +5538,6 @@ ExprCallMathFunc(interp, eePtr, objc, objv)
long i;
double d;
int j, k, result;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
Tcl_ResetResult(interp);
@@ -4127,7 +5551,7 @@ ExprCallMathFunc(interp, eePtr, objc, objv)
* Look up the MathFunc record for the function.
*/
- funcName = Tcl_GetString(objv[0]);
+ funcName = TclGetString(objv[0]);
hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, funcName);
if (hPtr == NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
@@ -4167,15 +5591,39 @@ ExprCallMathFunc(interp, eePtr, objc, objv)
if (mathFuncPtr->argTypes[k] == TCL_DOUBLE) {
args[k].type = TCL_DOUBLE;
args[k].doubleValue = i;
+#ifndef TCL_WIDE_INT_IS_LONG
+ } else if (mathFuncPtr->argTypes[k] == TCL_WIDE_INT) {
+ args[k].type = TCL_WIDE_INT;
+ args[k].wideValue = Tcl_LongAsWide(i);
+#endif /* !TCL_WIDE_INT_IS_LONG */
} else {
args[k].type = TCL_INT;
args[k].intValue = i;
}
+#ifndef TCL_WIDE_INT_IS_LONG
+ } else if (valuePtr->typePtr == &tclWideIntType) {
+ Tcl_WideInt w = valuePtr->internalRep.wideValue;
+ if (mathFuncPtr->argTypes[k] == TCL_DOUBLE) {
+ args[k].type = TCL_DOUBLE;
+ args[k].wideValue = (Tcl_WideInt) Tcl_WideAsDouble(w);
+ } else if (mathFuncPtr->argTypes[k] == TCL_INT) {
+ args[k].type = TCL_INT;
+ args[k].wideValue = Tcl_WideAsLong(w);
+ } else {
+ args[k].type = TCL_WIDE_INT;
+ args[k].wideValue = w;
+ }
+#endif /* !TCL_WIDE_INT_IS_LONG */
} else {
d = valuePtr->internalRep.doubleValue;
if (mathFuncPtr->argTypes[k] == TCL_INT) {
args[k].type = TCL_INT;
args[k].intValue = (long) d;
+#ifndef TCL_WIDE_INT_IS_LONG
+ } else if (mathFuncPtr->argTypes[k] == TCL_WIDE_INT) {
+ args[k].type = TCL_WIDE_INT;
+ args[k].wideValue = Tcl_DoubleAsWide(d);
+#endif /* !TCL_WIDE_INT_IS_LONG */
} else {
args[k].type = TCL_DOUBLE;
args[k].doubleValue = d;
@@ -4187,10 +5635,8 @@ ExprCallMathFunc(interp, eePtr, objc, objv)
* Invoke the function and copy its result back into valuePtr.
*/
- tsdPtr->mathInProgress++;
result = (*mathFuncPtr->proc)(mathFuncPtr->clientData, interp, args,
&funcResult);
- tsdPtr->mathInProgress--;
if (result != TCL_OK) {
goto done;
}
@@ -4198,14 +5644,12 @@ ExprCallMathFunc(interp, eePtr, objc, objv)
/*
* Pop the objc top stack elements and decrement their ref counts.
*/
-
- i = (stackTop - (objc-1));
- while (i <= stackTop) {
- valuePtr = stackPtr[i];
- Tcl_DecrRefCount(valuePtr);
- i++;
+
+ k = (stackTop - (objc-1));
+ while (stackTop >= k) {
+ valuePtr = POP_OBJECT();
+ TclDecrRefCount(valuePtr);
}
- stackTop -= objc;
/*
* Push the call's object result.
@@ -4213,6 +5657,10 @@ ExprCallMathFunc(interp, eePtr, objc, objv)
if (funcResult.type == TCL_INT) {
PUSH_OBJECT(Tcl_NewLongObj(funcResult.intValue));
+#ifndef TCL_WIDE_INT_IS_LONG
+ } else if (funcResult.type == TCL_WIDE_INT) {
+ PUSH_OBJECT(Tcl_NewWideIntObj(funcResult.wideValue));
+#endif /* !TCL_WIDE_INT_IS_LONG */
} else {
d = funcResult.doubleValue;
if (IS_NAN(d) || IS_INF(d)) {
@@ -4282,30 +5730,6 @@ TclExprFloatError(interp, value)
}
}
-/*
- *----------------------------------------------------------------------
- *
- * TclMathInProgress --
- *
- * This procedure is called to find out if Tcl is doing math
- * in this thread.
- *
- * Results:
- * 0 or 1.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclMathInProgress()
-{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- return tsdPtr->mathInProgress;
-}
-
#ifdef TCL_COMPILE_STATS
/*
*----------------------------------------------------------------------
@@ -4449,7 +5873,7 @@ EvalStatsCmd(unused, interp, argc, argv)
fprintf(stdout, " Mean code/source %.1f\n",
totalCodeBytes / statsPtr->totalSrcBytes);
- fprintf(stdout, "\nCurrent ByteCodes %ld\n",
+ fprintf(stdout, "\nCurrent (active) ByteCodes %ld\n",
numCurrentByteCodes);
fprintf(stdout, " Source bytes %.6g\n",
statsPtr->currentSrcBytes);
@@ -4472,6 +5896,29 @@ EvalStatsCmd(unused, interp, argc, argv)
(currentCodeBytes / statsPtr->currentSrcBytes) + 1.0);
/*
+ * Tcl_IsShared statistics check
+ *
+ * This gives the refcount of each obj as Tcl_IsShared was called
+ * for it. Shared objects must be duplicated before they can be
+ * modified.
+ */
+
+ numSharedMultX = 0;
+ fprintf(stdout, "\nTcl_IsShared object check (all objects):\n");
+ fprintf(stdout, " Object had refcount <=1 (not shared) %ld\n",
+ tclObjsShared[1]);
+ for (i = 2; i < TCL_MAX_SHARED_OBJ_STATS; i++) {
+ fprintf(stdout, " refcount ==%d %ld\n",
+ i, tclObjsShared[i]);
+ numSharedMultX += tclObjsShared[i];
+ }
+ fprintf(stdout, " refcount >=%d %ld\n",
+ i, tclObjsShared[0]);
+ numSharedMultX += tclObjsShared[0];
+ fprintf(stdout, " Total shared objects %d\n",
+ numSharedMultX);
+
+ /*
* Literal table statistics.
*/
@@ -4511,7 +5958,7 @@ EvalStatsCmd(unused, interp, argc, argv)
(tclObjsAlloced - tclObjsFreed));
fprintf(stdout, "Total literal objects %ld\n",
statsPtr->numLiteralsCreated);
-
+
fprintf(stdout, "\nCurrent literal objects %d (%0.1f%% of current objects)\n",
globalTablePtr->numEntries,
(globalTablePtr->numEntries * 100.0) / (tclObjsAlloced-tclObjsFreed));
@@ -4662,7 +6109,7 @@ EvalStatsCmd(unused, interp, argc, argv)
decadeHigh, (sum * 100.0) / statsPtr->numCompilations);
}
- fprintf(stdout, "\nByteCode longevity (excludes current ByteCodes):\n");
+ fprintf(stdout, "\nByteCode longevity (excludes Current ByteCodes):\n");
fprintf(stdout, " Up to ms Percentage\n");
minSizeDecade = maxSizeDecade = 0;
for (i = 0; i < 31; i++) {
@@ -4694,7 +6141,7 @@ EvalStatsCmd(unused, interp, argc, argv)
for (i = 0; i <= LAST_INST_OPCODE; i++) {
if (statsPtr->instructionCount[i]) {
fprintf(stdout, "%20s %8ld %6.1f%%\n",
- instructionTable[i].name,
+ tclInstructionTable[i].name,
statsPtr->instructionCount[i],
(statsPtr->instructionCount[i]*100.0) / numInstructions);
}
@@ -4703,8 +6150,7 @@ EvalStatsCmd(unused, interp, argc, argv)
fprintf(stdout, "\nInstructions NEVER executed:\n");
for (i = 0; i <= LAST_INST_OPCODE; i++) {
if (statsPtr->instructionCount[i] == 0) {
- fprintf(stdout, "%20s\n",
- instructionTable[i].name);
+ fprintf(stdout, "%20s\n", tclInstructionTable[i].name);
}
}
@@ -4717,345 +6163,6 @@ EvalStatsCmd(unused, interp, argc, argv)
}
#endif /* TCL_COMPILE_STATS */
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_GetCommandFromObj --
- *
- * Returns the command specified by the name in a Tcl_Obj.
- *
- * Results:
- * Returns a token for the command if it is found. Otherwise, if it
- * can't be found or there is an error, returns NULL.
- *
- * Side effects:
- * May update the internal representation for the object, caching
- * the command reference so that the next time this procedure 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
- * command and to report errors. */
- 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
- * if contextNsPtr is NULL, then in global
- * namespace. */
-{
- Interp *iPtr = (Interp *) interp;
- register ResolvedCmdName *resPtr;
- register Command *cmdPtr;
- Namespace *currNsPtr;
- int result;
-
- /*
- * Get the internal representation, converting to a command type if
- * needed. The internal representation is a ResolvedCmdName that points
- * to the actual command.
- */
-
- if (objPtr->typePtr != &tclCmdNameType) {
- result = tclCmdNameType.setFromAnyProc(interp, objPtr);
- if (result != TCL_OK) {
- return (Tcl_Command) NULL;
- }
- }
- resPtr = (ResolvedCmdName *) objPtr->internalRep.otherValuePtr;
-
- /*
- * Get the current namespace.
- */
-
- if (iPtr->varFramePtr != NULL) {
- currNsPtr = iPtr->varFramePtr->nsPtr;
- } else {
- currNsPtr = iPtr->globalNsPtr;
- }
-
- /*
- * 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.
- */
-
- 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 (cmdPtr == NULL) {
- result = tclCmdNameType.setFromAnyProc(interp, objPtr);
- if (result != TCL_OK) {
- return (Tcl_Command) NULL;
- }
- resPtr = (ResolvedCmdName *) objPtr->internalRep.otherValuePtr;
- if (resPtr != NULL) {
- cmdPtr = resPtr->cmdPtr;
- }
- }
- return (Tcl_Command) cmdPtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclSetCmdNameObj --
- *
- * Modify an object to be an CmdName object that refers to the argument
- * Command structure.
- *
- * Results:
- * None.
- *
- * Side effects:
- * 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.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclSetCmdNameObj(interp, objPtr, cmdPtr)
- 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 CmdName object. */
- Command *cmdPtr; /* Points to Command structure that the
- * CmdName object should refer to. */
-{
- Interp *iPtr = (Interp *) interp;
- register ResolvedCmdName *resPtr;
- Tcl_ObjType *oldTypePtr = objPtr->typePtr;
- register Namespace *currNsPtr;
-
- if (oldTypePtr == &tclCmdNameType) {
- return;
- }
-
- /*
- * 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;
-
- if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
- oldTypePtr->freeIntRepProc(objPtr);
- }
- objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) resPtr;
- objPtr->internalRep.twoPtrValue.ptr2 = NULL;
- objPtr->typePtr = &tclCmdNameType;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FreeCmdNameInternalRep --
- *
- * Frees the resources associated with a cmdName object's internal
- * representation.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Decrements the ref count of any cached ResolvedCmdName structure
- * pointed to by the cmdName's internal representation. If this is
- * the last use of the ResolvedCmdName, it is freed. This in turn
- * decrements the ref count of the Command structure pointed to by
- * the ResolvedSymbol, which may free the Command structure.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-FreeCmdNameInternalRep(objPtr)
- register Tcl_Obj *objPtr; /* CmdName object with internal
- * representation to free. */
-{
- register ResolvedCmdName *resPtr =
- (ResolvedCmdName *) objPtr->internalRep.otherValuePtr;
-
- if (resPtr != NULL) {
- /*
- * Decrement the reference count of the ResolvedCmdName structure.
- * If there are no more uses, free the ResolvedCmdName structure.
- */
-
- resPtr->refCount--;
- if (resPtr->refCount == 0) {
- /*
- * Now free the cached command, unless it is still in its
- * hash table or if there are other references to it
- * from other cmdName objects.
- */
-
- Command *cmdPtr = resPtr->cmdPtr;
- TclCleanupCommand(cmdPtr);
- ckfree((char *) resPtr);
- }
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * DupCmdNameInternalRep --
- *
- * Initialize the internal representation of an cmdName Tcl_Obj to a
- * copy of the internal representation of an existing cmdName object.
- *
- * Results:
- * None.
- *
- * Side effects:
- * "copyPtr"s internal rep is set to point to the ResolvedCmdName
- * structure corresponding to "srcPtr"s internal rep. Increments the
- * ref count of the ResolvedCmdName structure pointed to by the
- * cmdName's internal representation.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-DupCmdNameInternalRep(srcPtr, copyPtr)
- 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.otherValuePtr;
-
- copyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) resPtr;
- copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
- if (resPtr != NULL) {
- resPtr->refCount++;
- }
- copyPtr->typePtr = &tclCmdNameType;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SetCmdNameFromAny --
- *
- * Generate an cmdName internal form for the Tcl object "objPtr".
- *
- * Results:
- * The return value is a standard Tcl result. The conversion always
- * succeeds and TCL_OK is returned.
- *
- * Side effects:
- * A pointer to a ResolvedCmdName structure that holds a cached pointer
- * to the command with a name that matches objPtr's string rep is
- * stored as objPtr's internal representation. This ResolvedCmdName
- * pointer will be NULL if no matching command was found. The ref count
- * of the cached Command's structure (if any) is also incremented.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-SetCmdNameFromAny(interp, objPtr)
- 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;
- 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);
- }
-
- /*
- * Find the Command structure, if any, that describes the command called
- * "name". Build a ResolvedCmdName that holds a cached pointer to this
- * Command, and bump the reference count in the referenced Command
- * structure. A Command structure will not be deleted as long as it is
- * 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.
- */
-
- 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;
- } else {
- resPtr = NULL; /* no command named "name" was found */
- }
-
- /*
- * 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.
- */
-
- if ((objPtr->typePtr != NULL)
- && (objPtr->typePtr->freeIntRepProc != NULL)) {
- objPtr->typePtr->freeIntRepProc(objPtr);
- }
-
- objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) resPtr;
- objPtr->internalRep.twoPtrValue.ptr2 = NULL;
- objPtr->typePtr = &tclCmdNameType;
- return TCL_OK;
-}
-
#ifdef TCL_COMPILE_DEBUG
/*
*----------------------------------------------------------------------
@@ -5092,4 +6199,3 @@ StringForResultCode(result)
return buf;
}
#endif /* TCL_COMPILE_DEBUG */
-
diff --git a/tcl/generic/tclFCmd.c b/tcl/generic/tclFCmd.c
index 8e1d84a838a..f51b4d4a63a 100644
--- a/tcl/generic/tclFCmd.c
+++ b/tcl/generic/tclFCmd.c
@@ -20,14 +20,14 @@
*/
static int CopyRenameOneFile _ANSI_ARGS_((Tcl_Interp *interp,
- char *source, char *dest, int copyFlag,
- int force));
-static char * FileBasename _ANSI_ARGS_((Tcl_Interp *interp,
- char *path, Tcl_DString *bufferPtr));
+ 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 argc, char **argv, int copyFlag));
+ int objc, Tcl_Obj *CONST objv[], int copyFlag));
static int FileForceOption _ANSI_ARGS_((Tcl_Interp *interp,
- int argc, char **argv, int *forcePtr));
+ int objc, Tcl_Obj *CONST objv[], int *forcePtr));
/*
*---------------------------------------------------------------------------
@@ -49,12 +49,12 @@ static int FileForceOption _ANSI_ARGS_((Tcl_Interp *interp,
*/
int
-TclFileRenameCmd(interp, argc, argv)
+TclFileRenameCmd(interp, objc, objv)
Tcl_Interp *interp; /* Interp for error reporting. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings passed to Tcl_FileCmd. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument strings passed to Tcl_FileCmd. */
{
- return FileCopyRename(interp, argc, argv, 0);
+ return FileCopyRename(interp, objc, objv, 0);
}
/*
@@ -77,12 +77,12 @@ TclFileRenameCmd(interp, argc, argv)
*/
int
-TclFileCopyCmd(interp, argc, argv)
+TclFileCopyCmd(interp, objc, objv)
Tcl_Interp *interp; /* Used for error reporting */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings passed to Tcl_FileCmd. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument strings passed to Tcl_FileCmd. */
{
- return FileCopyRename(interp, argc, argv, 1);
+ return FileCopyRename(interp, objc, objv, 1);
}
/*
@@ -103,26 +103,26 @@ TclFileCopyCmd(interp, argc, argv)
*/
static int
-FileCopyRename(interp, argc, argv, copyFlag)
+FileCopyRename(interp, objc, objv, copyFlag)
Tcl_Interp *interp; /* Used for error reporting. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings passed to Tcl_FileCmd. */
+ 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;
- struct stat statBuf;
- Tcl_DString targetBuffer;
- char *target;
+ Tcl_StatBuf statBuf;
+ Tcl_Obj *target;
- i = FileForceOption(interp, argc - 2, argv + 2, &force);
+ i = FileForceOption(interp, objc - 2, objv + 2, &force);
if (i < 0) {
return TCL_ERROR;
}
i += 2;
- if ((argc - i) < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " ", argv[1], " ?options? source ?source ...? target\"",
+ if ((objc - i) < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ Tcl_GetString(objv[0]), " ", Tcl_GetString(objv[1]),
+ " ?options? source ?source ...? target\"",
(char *) NULL);
return TCL_ERROR;
}
@@ -133,38 +133,38 @@ FileCopyRename(interp, argc, argv, copyFlag)
* directory.
*/
- target = Tcl_TranslateFileName(interp, argv[argc - 1], &targetBuffer);
- if (target == NULL) {
+ target = objv[objc - 1];
+ if (Tcl_FSConvertToPathType(interp, target) != TCL_OK) {
return TCL_ERROR;
}
result = TCL_OK;
/*
- * Call TclStat() so that if target is a symlink that points to a
+ * Call Tcl_FSStat() so that if target is a symlink that points to a
* directory we will put the sources in that directory instead of
* overwriting the symlink.
*/
- if ((TclStat(target, &statBuf) != 0) || !S_ISDIR(statBuf.st_mode)) {
- if ((argc - i) > 2) {
+ if ((Tcl_FSStat(target, &statBuf) != 0) || !S_ISDIR(statBuf.st_mode)) {
+ if ((objc - i) > 2) {
errno = ENOTDIR;
Tcl_PosixError(interp);
Tcl_AppendResult(interp, "error ",
((copyFlag) ? "copying" : "renaming"), ": target \"",
- argv[argc - 1], "\" is not a directory", (char *) NULL);
+ Tcl_GetString(target), "\" is not a directory",
+ (char *) NULL);
result = TCL_ERROR;
} else {
/*
- * Even though already have target == translated(argv[i+1]),
+ * Even though already have target == translated(objv[i+1]),
* pass the original argument down, so if there's an error, the
* error message will reflect the original arguments.
*/
- result = CopyRenameOneFile(interp, argv[i], argv[i + 1], copyFlag,
+ result = CopyRenameOneFile(interp, objv[i], objv[i + 1], copyFlag,
force);
}
- Tcl_DStringFree(&targetBuffer);
return result;
}
@@ -173,30 +173,31 @@ FileCopyRename(interp, argc, argv, copyFlag)
* from each source, and append it to the end of the target path.
*/
- for ( ; i < argc - 1; i++) {
- char *jargv[2];
- char *source, *newFileName;
- Tcl_DString sourceBuffer, newFileNameBuffer;
-
- source = FileBasename(interp, argv[i], &sourceBuffer);
+ for ( ; i < objc - 1; i++) {
+ Tcl_Obj *jargv[2];
+ Tcl_Obj *source, *newFileName;
+ Tcl_Obj *temp;
+
+ source = FileBasename(interp, objv[i]);
if (source == NULL) {
result = TCL_ERROR;
break;
}
- jargv[0] = argv[argc - 1];
+ jargv[0] = objv[objc - 1];
jargv[1] = source;
- Tcl_DStringInit(&newFileNameBuffer);
- newFileName = Tcl_JoinPath(2, jargv, &newFileNameBuffer);
- result = CopyRenameOneFile(interp, argv[i], newFileName, copyFlag,
+ temp = Tcl_NewListObj(2, jargv);
+ newFileName = Tcl_FSJoinPath(temp, -1);
+ Tcl_IncrRefCount(newFileName);
+ result = CopyRenameOneFile(interp, objv[i], newFileName, copyFlag,
force);
- Tcl_DStringFree(&sourceBuffer);
- Tcl_DStringFree(&newFileNameBuffer);
+ Tcl_DecrRefCount(newFileName);
+ Tcl_DecrRefCount(temp);
+ Tcl_DecrRefCount(source);
if (result == TCL_ERROR) {
break;
}
}
- Tcl_DStringFree(&targetBuffer);
return result;
}
@@ -219,74 +220,72 @@ FileCopyRename(interp, argc, argv, copyFlag)
*----------------------------------------------------------------------
*/
int
-TclFileMakeDirsCmd(interp, argc, argv)
+TclFileMakeDirsCmd(interp, objc, objv)
Tcl_Interp *interp; /* Used for error reporting. */
- int argc; /* Number of arguments */
- char **argv; /* Argument strings passed to Tcl_FileCmd. */
+ int objc; /* Number of arguments */
+ Tcl_Obj *CONST objv[]; /* Argument strings passed to Tcl_FileCmd. */
{
- Tcl_DString nameBuffer, targetBuffer;
- char *errfile;
- int result, i, j, pargc;
- char **pargv;
- struct stat statBuf;
+ Tcl_Obj *errfile;
+ int result, i, j, pobjc;
+ Tcl_Obj *split = NULL;
+ Tcl_Obj *target = NULL;
+ Tcl_StatBuf statBuf;
- pargv = NULL;
errfile = NULL;
- Tcl_DStringInit(&nameBuffer);
- Tcl_DStringInit(&targetBuffer);
result = TCL_OK;
- for (i = 2; i < argc; i++) {
- char *name = Tcl_TranslateFileName(interp, argv[i], &nameBuffer);
- if (name == NULL) {
+ for (i = 2; i < objc; i++) {
+ if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) {
result = TCL_ERROR;
break;
}
- Tcl_SplitPath(name, &pargc, &pargv);
- if (pargc == 0) {
+ split = Tcl_FSSplitPath(objv[i],&pobjc);
+ if (pobjc == 0) {
errno = ENOENT;
- errfile = argv[i];
+ errfile = objv[i];
break;
}
- for (j = 0; j < pargc; j++) {
- char *target = Tcl_JoinPath(j + 1, pargv, &targetBuffer);
-
+ for (j = 0; j < pobjc; j++) {
+ target = Tcl_FSJoinPath(split, j + 1);
+ Tcl_IncrRefCount(target);
/*
- * Call TclStat() so that if target is a symlink that points
- * to a directory we will create subdirectories in that
- * directory.
+ * Call Tcl_FSStat() so that if target is a symlink that
+ * points to a directory we will create subdirectories in
+ * that directory.
*/
- if (TclStat(target, &statBuf) == 0) {
+ if (Tcl_FSStat(target, &statBuf) == 0) {
if (!S_ISDIR(statBuf.st_mode)) {
errno = EEXIST;
errfile = target;
goto done;
}
} else if ((errno != ENOENT)
- || (TclpCreateDirectory(target) != TCL_OK)) {
+ || (Tcl_FSCreateDirectory(target) != TCL_OK)) {
errfile = target;
goto done;
}
- Tcl_DStringFree(&targetBuffer);
+ /* Forget about this sub-path */
+ Tcl_DecrRefCount(target);
+ target = NULL;
}
- ckfree((char *) pargv);
- pargv = NULL;
- Tcl_DStringFree(&nameBuffer);
+ Tcl_DecrRefCount(split);
+ split = NULL;
}
done:
if (errfile != NULL) {
Tcl_AppendResult(interp, "can't create directory \"",
- errfile, "\": ", Tcl_PosixError(interp), (char *) NULL);
+ Tcl_GetString(errfile), "\": ", Tcl_PosixError(interp),
+ (char *) NULL);
result = TCL_ERROR;
}
-
- Tcl_DStringFree(&nameBuffer);
- Tcl_DStringFree(&targetBuffer);
- if (pargv != NULL) {
- ckfree((char *) pargv);
+ if (split != NULL) {
+ Tcl_DecrRefCount(split);
+ }
+ if (target != NULL) {
+ Tcl_DecrRefCount(target);
}
return result;
}
@@ -309,39 +308,35 @@ TclFileMakeDirsCmd(interp, argc, argv)
*/
int
-TclFileDeleteCmd(interp, argc, argv)
+TclFileDeleteCmd(interp, objc, objv)
Tcl_Interp *interp; /* Used for error reporting */
- int argc; /* Number of arguments */
- char **argv; /* Argument strings passed to Tcl_FileCmd. */
+ int objc; /* Number of arguments */
+ Tcl_Obj *CONST objv[]; /* Argument strings passed to Tcl_FileCmd. */
{
- Tcl_DString nameBuffer, errorBuffer;
int i, force, result;
- char *errfile;
+ Tcl_Obj *errfile;
+ Tcl_Obj *errorBuffer = NULL;
- i = FileForceOption(interp, argc - 2, argv + 2, &force);
+ i = FileForceOption(interp, objc - 2, objv + 2, &force);
if (i < 0) {
return TCL_ERROR;
}
i += 2;
- if ((argc - i) < 1) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " ", argv[1], " ?options? file ?file ...?\"", (char *) NULL);
+ if ((objc - i) < 1) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ Tcl_GetString(objv[0]), " ", Tcl_GetString(objv[1]),
+ " ?options? file ?file ...?\"", (char *) NULL);
return TCL_ERROR;
}
errfile = NULL;
result = TCL_OK;
- Tcl_DStringInit(&errorBuffer);
- Tcl_DStringInit(&nameBuffer);
- for ( ; i < argc; i++) {
- struct stat statBuf;
- char *name;
+ for ( ; i < objc; i++) {
+ Tcl_StatBuf statBuf;
- errfile = argv[i];
- Tcl_DStringSetLength(&nameBuffer, 0);
- name = Tcl_TranslateFileName(interp, argv[i], &nameBuffer);
- if (name == NULL) {
+ errfile = objv[i];
+ if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) {
result = TCL_ERROR;
goto done;
}
@@ -350,7 +345,7 @@ TclFileDeleteCmd(interp, argc, argv)
* Call lstat() to get info so can delete symbolic link itself.
*/
- if (TclpLstat(name, &statBuf) != 0) {
+ if (Tcl_FSLstat(objv[i], &statBuf) != 0) {
/*
* Trying to delete a file that does not exist is not
* considered an error, just a no-op
@@ -360,10 +355,15 @@ TclFileDeleteCmd(interp, argc, argv)
result = TCL_ERROR;
}
} else if (S_ISDIR(statBuf.st_mode)) {
- result = TclpRemoveDirectory(name, force, &errorBuffer);
+ /*
+ * We own a reference count on errorBuffer, if it was set
+ * as a result of this call.
+ */
+ result = Tcl_FSRemoveDirectory(objv[i], force, &errorBuffer);
if (result != TCL_OK) {
if ((force == 0) && (errno == EEXIST)) {
- Tcl_AppendResult(interp, "error deleting \"", argv[i],
+ Tcl_AppendResult(interp, "error deleting \"",
+ Tcl_GetString(objv[i]),
"\": directory not empty", (char *) NULL);
Tcl_PosixError(interp);
goto done;
@@ -373,26 +373,44 @@ TclFileDeleteCmd(interp, argc, argv)
* If possible, use the untranslated name for the file.
*/
- errfile = Tcl_DStringValue(&errorBuffer);
- if (strcmp(name, errfile) == 0) {
- errfile = argv[i];
+ errfile = errorBuffer;
+ /* FS supposed to check between translated objv and errfile */
+ if (Tcl_FSEqualPaths(objv[i], errfile)) {
+ errfile = objv[i];
}
}
} else {
- result = TclpDeleteFile(name);
+ result = Tcl_FSDeleteFile(objv[i]);
}
- if (result == TCL_ERROR) {
+ if (result != TCL_OK) {
+ result = TCL_ERROR;
+ /*
+ * It is important that we break on error, otherwise we
+ * might end up owning reference counts on numerous
+ * errorBuffers.
+ */
break;
}
}
if (result != TCL_OK) {
- Tcl_AppendResult(interp, "error deleting \"", errfile,
- "\": ", Tcl_PosixError(interp), (char *) NULL);
+ if (errfile == NULL) {
+ /*
+ * We try to accomodate poor error results from our
+ * Tcl_FS calls
+ */
+ Tcl_AppendResult(interp, "error deleting unknown file: ",
+ Tcl_PosixError(interp), (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp, "error deleting \"",
+ Tcl_GetString(errfile), "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
+ }
}
done:
- Tcl_DStringFree(&errorBuffer);
- Tcl_DStringFree(&nameBuffer);
+ if (errorBuffer != NULL) {
+ Tcl_DecrRefCount(errorBuffer);
+ }
return result;
}
@@ -418,9 +436,9 @@ TclFileDeleteCmd(interp, argc, argv)
static int
CopyRenameOneFile(interp, source, target, copyFlag, force)
Tcl_Interp *interp; /* Used for error reporting. */
- char *source; /* Pathname of file to copy. May need to
+ Tcl_Obj *source; /* Pathname of file to copy. May need to
* be translated. */
- char *target; /* Pathname of file to create/overwrite.
+ Tcl_Obj *target; /* Pathname of file to create/overwrite.
* May need to be translated. */
int copyFlag; /* If non-zero, copy files. Otherwise,
* rename them. */
@@ -429,23 +447,21 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
* exists. */
{
int result;
- Tcl_DString sourcePath, targetPath, errorBuffer;
- char *targetName, *sourceName, *errfile;
- struct stat sourceStatBuf, targetStatBuf;
+ Tcl_Obj *errfile, *errorBuffer;
+ /* If source is a link, then this is the real file/directory */
+ Tcl_Obj *actualSource = NULL;
+ Tcl_StatBuf sourceStatBuf, targetStatBuf;
- sourceName = Tcl_TranslateFileName(interp, source, &sourcePath);
- if (sourceName == NULL) {
+ if (Tcl_FSConvertToPathType(interp, source) != TCL_OK) {
return TCL_ERROR;
}
- targetName = Tcl_TranslateFileName(interp, target, &targetPath);
- if (targetName == NULL) {
- Tcl_DStringFree(&sourcePath);
+ if (Tcl_FSConvertToPathType(interp, target) != TCL_OK) {
return TCL_ERROR;
}
errfile = NULL;
+ errorBuffer = NULL;
result = TCL_ERROR;
- Tcl_DStringInit(&errorBuffer);
/*
* We want to copy/rename links and not the files they point to, so we
@@ -454,11 +470,11 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
* target.
*/
- if (TclpLstat(sourceName, &sourceStatBuf) != 0) {
+ if (Tcl_FSLstat(source, &sourceStatBuf) != 0) {
errfile = source;
goto done;
}
- if (TclpLstat(targetName, &targetStatBuf) != 0) {
+ if (Tcl_FSLstat(target, &targetStatBuf) != 0) {
if (errno != ENOENT) {
errfile = target;
goto done;
@@ -495,28 +511,31 @@ 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 \"", target,
- "\" with directory \"", source, "\"", (char *) NULL);
+ Tcl_AppendResult(interp, "can't overwrite file \"",
+ Tcl_GetString(target), "\" with directory \"",
+ Tcl_GetString(source), "\"", (char *) NULL);
goto done;
}
if (!S_ISDIR(sourceStatBuf.st_mode)
&& S_ISDIR(targetStatBuf.st_mode)) {
errno = EISDIR;
- Tcl_AppendResult(interp, "can't overwrite directory \"", target,
- "\" with file \"", source, "\"", (char *) NULL);
+ Tcl_AppendResult(interp, "can't overwrite directory \"",
+ Tcl_GetString(target), "\" with file \"",
+ Tcl_GetString(source), "\"", (char *) NULL);
goto done;
}
}
if (copyFlag == 0) {
- result = TclpRenameFile(sourceName, targetName);
+ result = Tcl_FSRenameFile(source, target);
if (result == TCL_OK) {
goto done;
}
if (errno == EINVAL) {
- Tcl_AppendResult(interp, "error renaming \"", source, "\" to \"",
- target, "\": trying to rename a volume or ",
+ Tcl_AppendResult(interp, "error renaming \"",
+ Tcl_GetString(source), "\" to \"",
+ Tcl_GetString(target), "\": trying to rename a volume or ",
"move a directory into itself", (char *) NULL);
goto done;
} else if (errno != EXDEV) {
@@ -527,50 +546,138 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
/*
* The rename failed because the move was across file systems.
* Fall through to copy file and then remove original. Note that
- * the low-level TclpRenameFile is allowed to implement
- * cross-filesystem moves itself.
+ * the low-level Tcl_FSRenameFileProc in the filesystem is allowed
+ * to implement cross-filesystem moves itself, if it desires.
+ */
+ }
+
+ actualSource = source;
+ Tcl_IncrRefCount(actualSource);
+#if 0
+#ifdef S_ISLNK
+ /*
+ * To add a flag to make 'copy' copy links instead of files, we could
+ * add a condition to ignore this 'if' here.
+ */
+ if (copyFlag && S_ISLNK(sourceStatBuf.st_mode)) {
+ /*
+ * We want to copy files not links. Therefore we must follow the
+ * link. There are two purposes to this 'stat' call here. First
+ * we want to know if the linked-file/dir actually exists, and
+ * second, in the block of code which follows, some 20 lines
+ * down, we want to check if the thing is a file or directory.
*/
+ if (Tcl_FSStat(source, &sourceStatBuf) != 0) {
+ /* Actual file doesn't exist */
+ Tcl_AppendResult(interp,
+ "error copying \"", Tcl_GetString(source),
+ "\": the target of this link doesn't exist",
+ (char *) NULL);
+ goto done;
+ } else {
+ int counter = 0;
+ while (1) {
+ Tcl_Obj *path = Tcl_FSLink(actualSource, NULL, 0);
+ if (path == NULL) {
+ break;
+ }
+ Tcl_DecrRefCount(actualSource);
+ actualSource = path;
+ counter++;
+ /* Arbitrary limit of 20 links to follow */
+ if (counter > 20) {
+ /* Too many links */
+ Tcl_SetErrno(EMLINK);
+ errfile = source;
+ goto done;
+ }
+ }
+ /* Now 'actualSource' is the correct file */
+ }
}
+#endif
+#endif
if (S_ISDIR(sourceStatBuf.st_mode)) {
- result = TclpCopyDirectory(sourceName, targetName, &errorBuffer);
+ result = Tcl_FSCopyDirectory(actualSource, target, &errorBuffer);
if (result != TCL_OK) {
- errfile = Tcl_DStringValue(&errorBuffer);
- if (strcmp(errfile, sourceName) == 0) {
- errfile = source;
- } else if (strcmp(errfile, targetName) == 0) {
- errfile = target;
+ if (errno == EXDEV) {
+ /*
+ * The copy failed because we're trying to do a
+ * cross-filesystem copy. We do this through our Tcl
+ * library.
+ */
+ Tcl_SavedResult savedResult;
+ Tcl_Obj *copyCommand = Tcl_NewListObj(0,NULL);
+ Tcl_IncrRefCount(copyCommand);
+ Tcl_ListObjAppendElement(interp, copyCommand,
+ Tcl_NewStringObj("::tcl::CopyDirectory",-1));
+ if (copyFlag) {
+ Tcl_ListObjAppendElement(interp, copyCommand,
+ Tcl_NewStringObj("copying",-1));
+ } else {
+ Tcl_ListObjAppendElement(interp, copyCommand,
+ Tcl_NewStringObj("renaming",-1));
+ }
+ Tcl_ListObjAppendElement(interp, copyCommand, source);
+ Tcl_ListObjAppendElement(interp, copyCommand, target);
+ Tcl_SaveResult(interp, &savedResult);
+ result = Tcl_EvalObjEx(interp, copyCommand,
+ TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT);
+ Tcl_DecrRefCount(copyCommand);
+ if (result != TCL_OK) {
+ /*
+ * There was an error in the Tcl-level copy.
+ * We will pass on the Tcl error message and
+ * can ensure this by setting errfile to NULL
+ */
+ Tcl_DiscardResult(&savedResult);
+ errfile = NULL;
+ } else {
+ /* The copy was successful */
+ Tcl_RestoreResult(interp, &savedResult);
+ }
+ } else {
+ errfile = errorBuffer;
+ if (Tcl_FSEqualPaths(errfile, source)) {
+ errfile = source;
+ } else if (Tcl_FSEqualPaths(errfile, target)) {
+ errfile = target;
+ }
}
}
} else {
- result = TclpCopyFile(sourceName, targetName);
+ result = Tcl_FSCopyFile(actualSource, target);
+ if ((result != TCL_OK) && (errno == EXDEV)) {
+ result = TclCrossFilesystemCopy(interp, source, target);
+ }
if (result != TCL_OK) {
- /*
- * Well, there really shouldn't be a problem with source,
- * because up there we checked to see if it was ok to copy it.
+ /*
+ * We could examine 'errno' to double-check if the problem
+ * was with the target, but we checked the source above,
+ * so it should be quite clear
*/
-
errfile = target;
}
}
if ((copyFlag == 0) && (result == TCL_OK)) {
if (S_ISDIR(sourceStatBuf.st_mode)) {
- result = TclpRemoveDirectory(sourceName, 1, &errorBuffer);
+ result = Tcl_FSRemoveDirectory(source, 1, &errorBuffer);
if (result != TCL_OK) {
- errfile = Tcl_DStringValue(&errorBuffer);
- if (strcmp(errfile, sourceName) == 0) {
+ if (Tcl_FSEqualPaths(errfile, source) == 0) {
errfile = source;
}
}
} else {
- result = TclpDeleteFile(sourceName);
+ result = Tcl_FSDeleteFile(source);
if (result != TCL_OK) {
errfile = source;
}
}
if (result != TCL_OK) {
- Tcl_AppendResult(interp, "can't unlink \"", errfile, "\": ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_AppendResult(interp, "can't unlink \"",
+ Tcl_GetString(errfile), "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
errfile = NULL;
}
}
@@ -579,19 +686,24 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
if (errfile != NULL) {
Tcl_AppendResult(interp,
((copyFlag) ? "error copying \"" : "error renaming \""),
- source, (char *) NULL);
+ Tcl_GetString(source), (char *) NULL);
if (errfile != source) {
- Tcl_AppendResult(interp, "\" to \"", target, (char *) NULL);
+ Tcl_AppendResult(interp, "\" to \"", Tcl_GetString(target),
+ (char *) NULL);
if (errfile != target) {
- Tcl_AppendResult(interp, "\": \"", errfile, (char *) NULL);
+ Tcl_AppendResult(interp, "\": \"", Tcl_GetString(errfile),
+ (char *) NULL);
}
}
Tcl_AppendResult(interp, "\": ", Tcl_PosixError(interp),
(char *) NULL);
}
- Tcl_DStringFree(&errorBuffer);
- Tcl_DStringFree(&sourcePath);
- Tcl_DStringFree(&targetPath);
+ if (errorBuffer != NULL) {
+ Tcl_DecrRefCount(errorBuffer);
+ }
+ if (actualSource != NULL) {
+ Tcl_DecrRefCount(actualSource);
+ }
return result;
}
@@ -616,10 +728,10 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
*/
static int
-FileForceOption(interp, argc, argv, forcePtr)
+FileForceOption(interp, objc, objv, forcePtr)
Tcl_Interp *interp; /* Interp, for error return. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. First command line
+ 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 filled with 1, otherwise with 0. */
@@ -627,17 +739,17 @@ FileForceOption(interp, argc, argv, forcePtr)
int force, i;
force = 0;
- for (i = 0; i < argc; i++) {
- if (argv[i][0] != '-') {
+ for (i = 0; i < objc; i++) {
+ if (Tcl_GetString(objv[i])[0] != '-') {
break;
}
- if (strcmp(argv[i], "-force") == 0) {
+ if (strcmp(Tcl_GetString(objv[i]), "-force") == 0) {
force = 1;
- } else if (strcmp(argv[i], "--") == 0) {
+ } else if (strcmp(Tcl_GetString(objv[i]), "--") == 0) {
i++;
break;
} else {
- Tcl_AppendResult(interp, "bad option \"", argv[i],
+ Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[i]),
"\": should be -force or --", (char *)NULL);
return -1;
}
@@ -656,10 +768,9 @@ FileForceOption(interp, argc, argv, forcePtr)
* if path is the root directory, returns no characters.
*
* Results:
- * Appends the string that represents the basename to the end of
- * the specified initialized DString, returning a pointer to the
- * resulting string. If there is an error, an error message is left
- * in interp, NULL is returned, and the Tcl_DString is unmodified.
+ * Returns the string object that represents the basename. If there
+ * is an error, an error message is left in interp, and NULL is
+ * returned.
*
* Side effects:
* None.
@@ -667,47 +778,45 @@ FileForceOption(interp, argc, argv, forcePtr)
*---------------------------------------------------------------------------
*/
-static char *
-FileBasename(interp, path, bufferPtr)
+static Tcl_Obj *
+FileBasename(interp, pathPtr)
Tcl_Interp *interp; /* Interp, for error return. */
- char *path; /* Path whose basename to extract. */
- Tcl_DString *bufferPtr; /* Initialized DString that receives
- * basename. */
+ Tcl_Obj *pathPtr; /* Path whose basename to extract. */
{
- int argc;
- char **argv;
+ int objc;
+ Tcl_Obj *splitPtr;
+ Tcl_Obj *resultPtr = NULL;
- Tcl_SplitPath(path, &argc, &argv);
- if (argc == 0) {
- Tcl_DStringInit(bufferPtr);
- } else {
- if ((argc == 1) && (*path == '~')) {
- Tcl_DString buffer;
-
- ckfree((char *) argv);
- path = Tcl_TranslateFileName(interp, path, &buffer);
- if (path == NULL) {
+ splitPtr = Tcl_FSSplitPath(pathPtr, &objc);
+
+ if (objc != 0) {
+ if ((objc == 1) && (*Tcl_GetString(pathPtr) == '~')) {
+ Tcl_DecrRefCount(splitPtr);
+ if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) {
return NULL;
}
- Tcl_SplitPath(path, &argc, &argv);
- Tcl_DStringFree(&buffer);
+ splitPtr = Tcl_FSSplitPath(pathPtr, &objc);
}
- Tcl_DStringInit(bufferPtr);
/*
* Return the last component, unless it is the only component, and it
* is the root of an absolute path.
*/
- if (argc > 0) {
- if ((argc > 1)
- || (Tcl_GetPathType(argv[0]) == TCL_PATH_RELATIVE)) {
- Tcl_DStringAppend(bufferPtr, argv[argc - 1], -1);
+ if (objc > 0) {
+ Tcl_ListObjIndex(NULL, splitPtr, objc-1, &resultPtr);
+ if ((objc == 1) &&
+ (Tcl_FSGetPathType(resultPtr) != TCL_PATH_RELATIVE)) {
+ resultPtr = NULL;
}
}
}
- ckfree((char *) argv);
- return Tcl_DStringValue(bufferPtr);
+ if (resultPtr == NULL) {
+ resultPtr = Tcl_NewObj();
+ }
+ Tcl_IncrRefCount(resultPtr);
+ Tcl_DecrRefCount(splitPtr);
+ return resultPtr;
}
/*
@@ -715,15 +824,15 @@ FileBasename(interp, path, bufferPtr)
*
* TclFileAttrsCmd --
*
- * Sets or gets the platform-specific attributes of a file. The objc-objv
- * points to the file name with the rest of the command line following.
- * This routine uses platform-specific tables of option strings
- * and callbacks. The callback to get the attributes take three
- * parameters:
+ * Sets or gets the platform-specific attributes of a file. The
+ * objc-objv points to the file name with the rest of the command
+ * line following. This routine uses platform-specific tables of
+ * option strings and callbacks. The callback to get the
+ * attributes take three parameters:
* 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.
+ * the object form of the result should
+ * be used.
* CONST char *fileName; This is extracted using
* Tcl_TranslateFileName.
* TclObj **attrObjPtrPtr; A new object to hold the attribute
@@ -751,46 +860,80 @@ TclFileAttrsCmd(interp, objc, objv)
int objc; /* Number of command line arguments. */
Tcl_Obj *CONST objv[]; /* The command line objects. */
{
- char *fileName;
int result;
- Tcl_DString buffer;
-
+ CONST char ** attributeStrings;
+ Tcl_Obj* objStrings = NULL;
+ int numObjStrings = -1;
+ Tcl_Obj *filePtr;
+
if (objc < 3) {
Tcl_WrongNumArgs(interp, 2, objv,
"name ?option? ?value? ?option value ...?");
return TCL_ERROR;
}
- fileName = Tcl_GetString(objv[2]);
- fileName = Tcl_TranslateFileName(interp, fileName, &buffer);
- if (fileName == NULL) {
+ filePtr = objv[2];
+ if (Tcl_FSConvertToPathType(interp, filePtr) != TCL_OK) {
return TCL_ERROR;
}
objc -= 3;
objv += 3;
result = TCL_ERROR;
-
+ Tcl_SetErrno(0);
+ attributeStrings = Tcl_FSFileAttrStrings(filePtr, &objStrings);
+ if (attributeStrings == NULL) {
+ int index;
+ Tcl_Obj *objPtr;
+ if (objStrings == NULL) {
+ if (Tcl_GetErrno() != 0) {
+ /*
+ * There was an error, probably that the filePtr is
+ * not accepted by any filesystem
+ */
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "could not read \"", Tcl_GetString(filePtr),
+ "\": ", Tcl_PosixError(interp),
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ goto end;
+ }
+ /* We own the object now */
+ Tcl_IncrRefCount(objStrings);
+ /* Use objStrings as a list object */
+ if (Tcl_ListObjLength(interp, objStrings, &numObjStrings) != TCL_OK) {
+ goto end;
+ }
+ attributeStrings = (CONST char **)
+ ckalloc ((1+numObjStrings) * sizeof(char*));
+ for (index = 0; index < numObjStrings; index++) {
+ Tcl_ListObjIndex(interp, objStrings, index, &objPtr);
+ attributeStrings[index] = Tcl_GetString(objPtr);
+ }
+ attributeStrings[index] = NULL;
+ }
if (objc == 0) {
/*
* Get all attributes.
*/
int index;
- Tcl_Obj *listPtr, *objPtr;
+ Tcl_Obj *listPtr;
listPtr = Tcl_NewListObj(0, NULL);
- for (index = 0; tclpFileAttrStrings[index] != NULL; index++) {
- objPtr = Tcl_NewStringObj(tclpFileAttrStrings[index], -1);
+ for (index = 0; attributeStrings[index] != NULL; index++) {
+ Tcl_Obj *objPtr = Tcl_NewStringObj(attributeStrings[index], -1);
Tcl_ListObjAppendElement(interp, listPtr, objPtr);
-
- if ((*tclpFileAttrProcs[index].getProc)(interp, index, fileName,
- &objPtr) != TCL_OK) {
+ /* We now forget about objPtr, it is in the list */
+ objPtr = NULL;
+ if (Tcl_FSFileAttrsGet(interp, index, filePtr,
+ &objPtr) != TCL_OK) {
Tcl_DecrRefCount(listPtr);
goto end;
}
Tcl_ListObjAppendElement(interp, listPtr, objPtr);
- }
+ }
Tcl_SetObjResult(interp, listPtr);
} else if (objc == 1) {
/*
@@ -798,13 +941,20 @@ TclFileAttrsCmd(interp, objc, objv)
*/
int index;
- Tcl_Obj *objPtr;
-
- if (Tcl_GetIndexFromObj(interp, objv[0], tclpFileAttrStrings,
+ Tcl_Obj *objPtr = NULL;
+
+ if (numObjStrings == 0) {
+ Tcl_AppendResult(interp, "bad option \"",
+ Tcl_GetString(objv[0]), "\", there are no file attributes"
+ " in this filesystem.", (char *) NULL);
+ goto end;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[0], attributeStrings,
"option", 0, &index) != TCL_OK) {
goto end;
- }
- if ((*tclpFileAttrProcs[index].getProc)(interp, index, fileName,
+ }
+ if (Tcl_FSFileAttrsGet(interp, index, filePtr,
&objPtr) != TCL_OK) {
goto end;
}
@@ -816,8 +966,15 @@ TclFileAttrsCmd(interp, objc, objv)
int i, index;
+ if (numObjStrings == 0) {
+ Tcl_AppendResult(interp, "bad option \"",
+ Tcl_GetString(objv[0]), "\", there are no file attributes"
+ " in this filesystem.", (char *) NULL);
+ goto end;
+ }
+
for (i = 0; i < objc ; i += 2) {
- if (Tcl_GetIndexFromObj(interp, objv[i], tclpFileAttrStrings,
+ if (Tcl_GetIndexFromObj(interp, objv[i], attributeStrings,
"option", 0, &index) != TCL_OK) {
goto end;
}
@@ -827,7 +984,7 @@ TclFileAttrsCmd(interp, objc, objv)
(char *) NULL);
goto end;
}
- if ((*tclpFileAttrProcs[index].setProc)(interp, index, fileName,
+ if (Tcl_FSFileAttrsSet(interp, index, filePtr,
objv[i + 1]) != TCL_OK) {
goto end;
}
@@ -836,6 +993,16 @@ TclFileAttrsCmd(interp, objc, objv)
result = TCL_OK;
end:
- Tcl_DStringFree(&buffer);
+ if (numObjStrings != -1) {
+ /* Free up the array we allocated */
+ ckfree((char*)attributeStrings);
+ /*
+ * We don't need this object that was passed to us
+ * any more.
+ */
+ if (objStrings != NULL) {
+ Tcl_DecrRefCount(objStrings);
+ }
+ }
return result;
}
diff --git a/tcl/generic/tclFileName.c b/tcl/generic/tclFileName.c
index 32e9495c6df..431dad49047 100644
--- a/tcl/generic/tclFileName.c
+++ b/tcl/generic/tclFileName.c
@@ -17,18 +17,27 @@
#include "tclPort.h"
#include "tclRegexp.h"
-/*
- * The following regular expression matches the root portion of a Windows
- * absolute or volume relative path. It will match both UNC and drive relative
- * paths.
+/*
+ * This define is used to activate Tcl's interpretation of Unix-style
+ * paths (containing forward slashes, '.' and '..') on MacOS. A
+ * side-effect of this is that some paths become ambiguous.
*/
+#define MAC_UNDERSTANDS_UNIX_PATHS
-#define WIN_ROOT_PATTERN "^(([a-zA-Z]:)|[/\\\\][/\\\\]+([^/\\\\]+)[/\\\\]+([^/\\\\]+)|([/\\\\]))([/\\\\])*"
-
+#ifdef MAC_UNDERSTANDS_UNIX_PATHS
/*
* The following regular expression matches the root portion of a Macintosh
* absolute path. It will match degenerate Unix-style paths, tilde paths,
- * Unix-style paths, and Mac paths.
+ * Unix-style paths, and Mac paths. The various subexpressions in this
+ * can be summarised as follows: ^(/..|~user/unix|~user:mac|/unix|mac:dir).
+ * The subexpression indices which match the root portions, are as follows:
+ *
+ * degenerate unix-style: 2
+ * unix-tilde: 5
+ * mac-tilde: 7
+ * unix-style: 9 (or 10 to cut off the irrelevant header).
+ * mac: 12
+ *
*/
#define MAC_ROOT_PATTERN "^((/+([.][.]?/+)*([.][.]?)?)|(~[^:/]*)(/[^:]*)?|(~[^:]*)(:.*)?|/+([.][.]?/+)*([^:/]+)(/[^:]*)?|([^:]+):.*)$"
@@ -45,6 +54,11 @@ typedef struct ThreadSpecificData {
static Tcl_ThreadDataKey dataKey;
+static void FileNameCleanup _ANSI_ARGS_((ClientData clientData));
+static void FileNameInit _ANSI_ARGS_((void));
+
+#endif
+
/*
* The following variable is set in the TclPlatformInit call to one
* of: TCL_PLATFORM_UNIX, TCL_PLATFORM_MAC, or TCL_PLATFORM_WINDOWS.
@@ -53,32 +67,20 @@ static Tcl_ThreadDataKey dataKey;
TclPlatformType tclPlatform = TCL_PLATFORM_UNIX;
/*
- * The "globParameters" argument of the globbing functions is an
- * or'ed combination of the following values:
- */
-
-#define GLOBMODE_NO_COMPLAIN 1
-#define GLOBMODE_JOIN 2
-#define GLOBMODE_DIR 4
-
-/*
* Prototypes for local procedures defined in this file:
*/
-static char * DoTildeSubst _ANSI_ARGS_((Tcl_Interp *interp,
+static CONST char * DoTildeSubst _ANSI_ARGS_((Tcl_Interp *interp,
CONST char *user, Tcl_DString *resultPtr));
static CONST char * ExtractWinRoot _ANSI_ARGS_((CONST char *path,
- Tcl_DString *resultPtr, int offset, Tcl_PathType *typePtr));
-static void FileNameCleanup _ANSI_ARGS_((ClientData clientData));
-static void FileNameInit _ANSI_ARGS_((void));
+ Tcl_DString *resultPtr, int offset,
+ Tcl_PathType *typePtr));
static int SkipToChar _ANSI_ARGS_((char **stringPtr,
char *match));
-static char * SplitMacPath _ANSI_ARGS_((CONST char *path,
- Tcl_DString *bufPtr));
-static char * SplitWinPath _ANSI_ARGS_((CONST char *path,
- Tcl_DString *bufPtr));
-static char * SplitUnixPath _ANSI_ARGS_((CONST char *path,
- Tcl_DString *bufPtr));
+static Tcl_Obj* SplitMacPath _ANSI_ARGS_((CONST char *path));
+static Tcl_Obj* SplitWinPath _ANSI_ARGS_((CONST char *path));
+static Tcl_Obj* SplitUnixPath _ANSI_ARGS_((CONST char *path));
+#ifdef MAC_UNDERSTANDS_UNIX_PATHS
/*
*----------------------------------------------------------------------
@@ -132,6 +134,7 @@ FileNameCleanup(clientData)
Tcl_DecrRefCount(tsdPtr->macRootPatternPtr);
tsdPtr->initialized = 0;
}
+#endif
/*
*----------------------------------------------------------------------
@@ -161,22 +164,19 @@ ExtractWinRoot(path, resultPtr, offset, typePtr)
* stored. */
Tcl_PathType *typePtr; /* Where to store pathType result */
{
- FileNameInit();
-
-
if (path[0] == '/' || path[0] == '\\') {
/* Might be a UNC or Vol-Relative path */
- char *host, *share, *tail;
+ CONST char *host, *share, *tail;
int hlen, slen;
if (path[1] != '/' && path[1] != '\\') {
Tcl_DStringSetLength(resultPtr, offset);
*typePtr = TCL_PATH_VOLUME_RELATIVE;
Tcl_DStringAppend(resultPtr, "/", 1);
return &path[1];
- }
- host = (char *)&path[2];
+ }
+ host = &path[2];
- /* Skip seperators */
+ /* Skip separators */
while (host[0] == '/' || host[0] == '\\') host++;
for (hlen = 0; host[hlen];hlen++) {
@@ -184,6 +184,18 @@ ExtractWinRoot(path, resultPtr, offset, typePtr)
break;
}
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
+ * 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 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);
return &path[2];
@@ -191,7 +203,7 @@ ExtractWinRoot(path, resultPtr, offset, typePtr)
Tcl_DStringSetLength(resultPtr, offset);
share = &host[hlen];
- /* Skip seperators */
+ /* Skip separators */
while (share[0] == '/' || share[0] == '\\') share++;
for (slen = 0; share[slen];slen++) {
@@ -205,12 +217,12 @@ ExtractWinRoot(path, resultPtr, offset, typePtr)
tail = &share[slen];
- /* Skip seperators */
+ /* Skip separators */
while (tail[0] == '/' || tail[0] == '\\') tail++;
*typePtr = TCL_PATH_ABSOLUTE;
return tail;
- } else if (path[1] == ':') {
+ } else if (*path && path[1] == ':') {
/* Might be a drive sep */
Tcl_DStringSetLength(resultPtr, offset);
@@ -218,17 +230,17 @@ ExtractWinRoot(path, resultPtr, offset, typePtr)
*typePtr = TCL_PATH_VOLUME_RELATIVE;
Tcl_DStringAppend(resultPtr, path, 2);
return &path[2];
- } else {
+ } else {
char *tail = (char*)&path[3];
- /* Skip seperators */
- while (tail[0] == '/' || tail[0] == '\\') tail++;
+ /* Skip separators */
+ while (*tail && (tail[0] == '/' || tail[0] == '\\')) tail++;
*typePtr = TCL_PATH_ABSOLUTE;
Tcl_DStringAppend(resultPtr, path, 2);
- Tcl_DStringAppend(resultPtr, "/", 1);
+ Tcl_DStringAppend(resultPtr, "/", 1);
- return tail;
+ return tail;
}
} else {
*typePtr = TCL_PATH_RELATIVE;
@@ -243,6 +255,10 @@ ExtractWinRoot(path, resultPtr, offset, typePtr)
*
* Determines whether a given path is relative to the current
* directory, relative to the current volume, or absolute.
+ *
+ * The objectified Tcl_FSGetPathType should be used in
+ * preference to this function (as you can see below, this
+ * is just a wrapper around that other function).
*
* Results:
* Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or
@@ -256,65 +272,258 @@ ExtractWinRoot(path, resultPtr, offset, typePtr)
Tcl_PathType
Tcl_GetPathType(path)
- char *path;
+ CONST char *path;
{
- ThreadSpecificData *tsdPtr;
- Tcl_PathType type = TCL_PATH_ABSOLUTE;
- Tcl_RegExp re;
-
- switch (tclPlatform) {
- case TCL_PLATFORM_UNIX:
- /*
- * Paths that begin with / or ~ are absolute.
- */
+ Tcl_PathType type;
+ Tcl_Obj *tempObj = Tcl_NewStringObj(path,-1);
+ Tcl_IncrRefCount(tempObj);
+ type = Tcl_FSGetPathType(tempObj);
+ Tcl_DecrRefCount(tempObj);
+ return type;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpGetNativePathType --
+ *
+ * Determines whether a given path is relative to the current
+ * directory, 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 extensions.
+ *
+ * Results:
+ * Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or
+ * TCL_PATH_VOLUME_RELATIVE.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
- if ((path[0] != '/') && (path[0] != '~')) {
- type = TCL_PATH_RELATIVE;
+Tcl_PathType
+TclpGetNativePathType(pathObjPtr, driveNameLengthPtr, driveNameRef)
+ Tcl_Obj *pathObjPtr;
+ int *driveNameLengthPtr;
+ Tcl_Obj **driveNameRef;
+{
+ Tcl_PathType type = TCL_PATH_ABSOLUTE;
+ int pathLen;
+ char *path = Tcl_GetStringFromObj(pathObjPtr, &pathLen);
+
+ if (path[0] == '~') {
+ /*
+ * This case is common to all platforms.
+ * Paths that begin with ~ are absolute.
+ */
+ if (driveNameLengthPtr != NULL) {
+ char *end = path + 1;
+ while ((*end != '\0') && (*end != '/')) {
+ end++;
}
- break;
-
- case TCL_PLATFORM_MAC:
- if (path[0] == ':') {
- type = TCL_PATH_RELATIVE;
- } else if (path[0] != '~') {
- tsdPtr = TCL_TSD_INIT(&dataKey);
-
+ *driveNameLengthPtr = end - path;
+ }
+ } else {
+ switch (tclPlatform) {
+ case TCL_PLATFORM_UNIX: {
+ char *origPath = path;
+
/*
- * Since we have eliminated the easy cases, use the
- * root pattern to look for the other types.
+ * Paths that begin with / are absolute.
*/
- FileNameInit();
- re = Tcl_GetRegExpFromObj(NULL, tsdPtr->macRootPatternPtr,
- REG_ADVANCED);
-
- if (!Tcl_RegExpExec(NULL, re, path, path)) {
+#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;
+ }
+ }
+#endif
+ if (path[0] == '/') {
+ if (driveNameLengthPtr != NULL) {
+ /*
+ * We need this addition in case the QNX code
+ * was used
+ */
+ *driveNameLengthPtr = (1 + path - origPath);
+ }
+ } else {
+ type = TCL_PATH_RELATIVE;
+ }
+ break;
+ }
+ case TCL_PLATFORM_MAC:
+ if (path[0] == ':') {
type = TCL_PATH_RELATIVE;
} else {
- char *unixRoot, *dummy;
+#ifdef MAC_UNDERSTANDS_UNIX_PATHS
+ ThreadSpecificData *tsdPtr;
+ Tcl_RegExp re;
- Tcl_RegExpRange(re, 2, &unixRoot, &dummy);
- if (unixRoot) {
+ tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ /*
+ * Since we have eliminated the easy cases, use the
+ * root pattern to look for the other types.
+ */
+
+ FileNameInit();
+ re = Tcl_GetRegExpFromObj(NULL, tsdPtr->macRootPatternPtr,
+ REG_ADVANCED);
+
+ if (!Tcl_RegExpExec(NULL, re, path, path)) {
+ type = TCL_PATH_RELATIVE;
+ } else {
+ CONST char *root, *end;
+ Tcl_RegExpRange(re, 2, &root, &end);
+ if (root != NULL) {
+ type = TCL_PATH_RELATIVE;
+ } else {
+ if (driveNameLengthPtr != NULL) {
+ Tcl_RegExpRange(re, 0, &root, &end);
+ *driveNameLengthPtr = end - root;
+ }
+ if (driveNameRef != NULL) {
+ if (*root == '/') {
+ char *c;
+ int gotColon = 0;
+ *driveNameRef = Tcl_NewStringObj(root + 1,
+ end - root -1);
+ c = Tcl_GetString(*driveNameRef);
+ while (*c != '\0') {
+ if (*c == '/') {
+ gotColon++;
+ *c = ':';
+ }
+ c++;
+ }
+ /*
+ * If there is no colon, we have just a
+ * volume name so we must add a colon so
+ * it is an absolute path.
+ */
+ if (gotColon == 0) {
+ Tcl_AppendToObj(*driveNameRef, ":", 1);
+ } else if ((gotColon > 1) &&
+ (*(c-1) == ':')) {
+ /* We have an extra colon */
+ Tcl_SetObjLength(*driveNameRef,
+ c - Tcl_GetString(*driveNameRef) - 1);
+ }
+ }
+ }
+ }
+ }
+#else
+ if (path[0] == '~') {
+ } else if (path[0] == ':') {
type = TCL_PATH_RELATIVE;
+ } else {
+ char *colonPos = strchr(path,':');
+ if (colonPos == NULL) {
+ type = TCL_PATH_RELATIVE;
+ } else {
+ }
}
+ if (type == TCL_PATH_ABSOLUTE) {
+ if (driveNameLengthPtr != NULL) {
+ *driveNameLengthPtr = strlen(path);
+ }
+ }
+#endif
}
- }
- break;
-
- case TCL_PLATFORM_WINDOWS:
- if (path[0] != '~') {
+ break;
+
+ case TCL_PLATFORM_WINDOWS: {
Tcl_DString ds;
-
+ CONST char *rootEnd;
+
Tcl_DStringInit(&ds);
- (VOID)ExtractWinRoot(path, &ds, 0, &type);
+ 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));
+ Tcl_IncrRefCount(*driveNameRef);
+ }
+ }
Tcl_DStringFree(&ds);
+ break;
}
- break;
+ }
}
return type;
}
/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpNativeSplitPath --
+ *
+ * This function takes the given Tcl_Obj, which should be a valid
+ * path, and returns a Tcl List object containing each segment
+ * of that path as an element.
+ *
+ * Note this function currently calls the older Split(Plat)Path
+ * functions, which require more memory allocation than is
+ * desirable.
+ *
+ * Results:
+ * 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.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tcl_Obj*
+TclpNativeSplitPath(pathPtr, lenPtr)
+ 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. */
+
+ /*
+ * Perform platform specific splitting.
+ */
+
+ switch (tclPlatform) {
+ case TCL_PLATFORM_UNIX:
+ resultPtr = SplitUnixPath(Tcl_GetString(pathPtr));
+ break;
+
+ case TCL_PLATFORM_WINDOWS:
+ resultPtr = SplitWinPath(Tcl_GetString(pathPtr));
+ break;
+
+ case TCL_PLATFORM_MAC:
+ resultPtr = SplitMacPath(Tcl_GetString(pathPtr));
+ break;
+ }
+
+ /*
+ * Compute the number of elements in the result.
+ */
+
+ if (lenPtr != NULL) {
+ Tcl_ListObjLength(NULL, resultPtr, lenPtr);
+ }
+ return resultPtr;
+}
+
+/*
*----------------------------------------------------------------------
*
* Tcl_SplitPath --
@@ -345,75 +554,70 @@ Tcl_SplitPath(path, argcPtr, argvPtr)
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. */
- 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. */
{
- int i, size;
- char *p;
- Tcl_DString buffer;
-
- Tcl_DStringInit(&buffer);
+ Tcl_Obj *resultPtr = NULL; /* Needed only to prevent gcc warnings. */
+ Tcl_Obj *tmpPtr, *eltPtr;
+ int i, size, len;
+ char *p, *str;
/*
- * Perform platform specific splitting. These routines will leave the
- * result in the specified buffer. Individual elements are terminated
- * with a null character.
+ * Perform the splitting, using objectified, vfs-aware code.
*/
- p = NULL; /* Needed only to prevent gcc warnings. */
- switch (tclPlatform) {
- case TCL_PLATFORM_UNIX:
- p = SplitUnixPath(path, &buffer);
- break;
-
- case TCL_PLATFORM_WINDOWS:
- p = SplitWinPath(path, &buffer);
- break;
-
- case TCL_PLATFORM_MAC:
- p = SplitMacPath(path, &buffer);
- break;
- }
-
- /*
- * Compute the number of elements in the result.
- */
+ tmpPtr = Tcl_NewStringObj(path, -1);
+ Tcl_IncrRefCount(tmpPtr);
+ resultPtr = Tcl_FSSplitPath(tmpPtr, argcPtr);
+ Tcl_DecrRefCount(tmpPtr);
- size = Tcl_DStringLength(&buffer);
- *argcPtr = 0;
- for (i = 0; i < size; i++) {
- if (p[i] == '\0') {
- (*argcPtr)++;
- }
+ /* Calculate space required for the result */
+
+ size = 1;
+ for (i = 0; i < *argcPtr; i++) {
+ Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr);
+ Tcl_GetStringFromObj(eltPtr, &len);
+ size += len + 1;
}
/*
- * Allocate a buffer large enough to hold the contents of the
- * DString plus the argv pointers and the terminating NULL pointer.
+ * Allocate a buffer large enough to hold the contents of all of
+ * the list plus the argv pointers and the terminating NULL pointer.
*/
- *argvPtr = (char **) ckalloc((unsigned)
+ *argvPtr = (CONST char **) ckalloc((unsigned)
((((*argcPtr) + 1) * sizeof(char *)) + size));
/*
* Position p after the last argv pointer and copy the contents of
- * the DString.
+ * the list in, piece by piece.
*/
p = (char *) &(*argvPtr)[(*argcPtr) + 1];
- memcpy((VOID *) p, (VOID *) Tcl_DStringValue(&buffer), (size_t) size);
-
+ 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);
+ p += len+1;
+ }
+
/*
* Now set up the argv pointers.
*/
+ p = (char *) &(*argvPtr)[(*argcPtr) + 1];
+
for (i = 0; i < *argcPtr; i++) {
(*argvPtr)[i] = p;
while ((*p++) != '\0') {}
}
(*argvPtr)[i] = NULL;
- Tcl_DStringFree(&buffer);
+ /*
+ * Free the result ptr given to us by Tcl_FSSplitPath
+ */
+
+ Tcl_DecrRefCount(resultPtr);
}
/*
@@ -421,12 +625,11 @@ Tcl_SplitPath(path, argcPtr, argvPtr)
*
* SplitUnixPath --
*
- * This routine is used by Tcl_SplitPath to handle splitting
+ * This routine is used by Tcl_(FS)SplitPath to handle splitting
* Unix paths.
*
* Results:
- * Stores a null separated array of strings in the specified
- * Tcl_DString.
+ * Returns a newly allocated Tcl list object.
*
* Side effects:
* None.
@@ -434,13 +637,13 @@ Tcl_SplitPath(path, argcPtr, argvPtr)
*----------------------------------------------------------------------
*/
-static char *
-SplitUnixPath(path, bufPtr)
+static Tcl_Obj*
+SplitUnixPath(path)
CONST char *path; /* Pointer to string containing a path. */
- Tcl_DString *bufPtr; /* Pointer to DString to use for the result. */
{
int length;
CONST char *p, *elementStart;
+ Tcl_Obj *result = Tcl_NewObj();
/*
* Deal with the root directory as a special case.
@@ -460,7 +663,7 @@ SplitUnixPath(path, bufPtr)
#endif
if (path[0] == '/') {
- Tcl_DStringAppend(bufPtr, "/", 2);
+ Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj("/",1));
p = path+1;
} else {
p = path;
@@ -478,30 +681,33 @@ SplitUnixPath(path, bufPtr)
}
length = p - elementStart;
if (length > 0) {
+ Tcl_Obj *nextElt;
if ((elementStart[0] == '~') && (elementStart != path)) {
- Tcl_DStringAppend(bufPtr, "./", 2);
+ nextElt = Tcl_NewStringObj("./",2);
+ Tcl_AppendToObj(nextElt, elementStart, length);
+ } else {
+ nextElt = Tcl_NewStringObj(elementStart, length);
}
- Tcl_DStringAppend(bufPtr, elementStart, length);
- Tcl_DStringAppend(bufPtr, "", 1);
+ Tcl_ListObjAppendElement(NULL, result, nextElt);
}
if (*p++ == '\0') {
break;
}
}
- return Tcl_DStringValue(bufPtr);
+ return result;
}
+
/*
*----------------------------------------------------------------------
*
* SplitWinPath --
*
- * This routine is used by Tcl_SplitPath to handle splitting
+ * This routine is used by Tcl_(FS)SplitPath to handle splitting
* Windows paths.
*
* Results:
- * Stores a null separated array of strings in the specified
- * Tcl_DString.
+ * Returns a newly allocated Tcl list object.
*
* Side effects:
* None.
@@ -509,25 +715,30 @@ SplitUnixPath(path, bufPtr)
*----------------------------------------------------------------------
*/
-static char *
-SplitWinPath(path, bufPtr)
+static Tcl_Obj*
+SplitWinPath(path)
CONST char *path; /* Pointer to string containing a path. */
- Tcl_DString *bufPtr; /* Pointer to DString to use for the result. */
{
int length;
CONST char *p, *elementStart;
Tcl_PathType type = TCL_PATH_ABSOLUTE;
-
- p = ExtractWinRoot(path, bufPtr, 0, &type);
+ Tcl_DString buf;
+ Tcl_Obj *result = Tcl_NewObj();
+ Tcl_DStringInit(&buf);
+
+ p = ExtractWinRoot(path, &buf, 0, &type);
/*
* Terminate the root portion, if we matched something.
*/
if (p != path) {
- Tcl_DStringAppend(bufPtr, "", 1);
+ Tcl_ListObjAppendElement(NULL, result,
+ Tcl_NewStringObj(Tcl_DStringValue(&buf),
+ Tcl_DStringLength(&buf)));
}
-
+ Tcl_DStringFree(&buf);
+
/*
* Split on slashes. Embedded elements that start with tilde will be
* prefixed with "./" so they are not affected by tilde substitution.
@@ -540,15 +751,18 @@ SplitWinPath(path, bufPtr)
}
length = p - elementStart;
if (length > 0) {
+ Tcl_Obj *nextElt;
if ((elementStart[0] == '~') && (elementStart != path)) {
- Tcl_DStringAppend(bufPtr, "./", 2);
+ nextElt = Tcl_NewStringObj("./",2);
+ Tcl_AppendToObj(nextElt, elementStart, length);
+ } else {
+ nextElt = Tcl_NewStringObj(elementStart, length);
}
- Tcl_DStringAppend(bufPtr, elementStart, length);
- Tcl_DStringAppend(bufPtr, "", 1);
+ Tcl_ListObjAppendElement(NULL, result, nextElt);
}
} while (*p++ != '\0');
- return Tcl_DStringValue(bufPtr);
+ return result;
}
/*
@@ -556,11 +770,11 @@ SplitWinPath(path, bufPtr)
*
* SplitMacPath --
*
- * This routine is used by Tcl_SplitPath to handle splitting
+ * This routine is used by Tcl_(FS)SplitPath to handle splitting
* Macintosh paths.
*
* Results:
- * Returns a newly allocated argv array.
+ * Returns a newly allocated Tcl list object.
*
* Side effects:
* None.
@@ -568,17 +782,23 @@ SplitWinPath(path, bufPtr)
*----------------------------------------------------------------------
*/
-static char *
-SplitMacPath(path, bufPtr)
+static Tcl_Obj*
+SplitMacPath(path)
CONST char *path; /* Pointer to string containing a path. */
- Tcl_DString *bufPtr; /* Pointer to DString to use for the result. */
{
int isMac = 0; /* 1 if is Mac-style, 0 if Unix-style path. */
- int i, length;
+ int length;
CONST char *p, *elementStart;
+ Tcl_Obj *result;
+#ifdef MAC_UNDERSTANDS_UNIX_PATHS
Tcl_RegExp re;
+ int i;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
+#endif
+
+ result = Tcl_NewObj();
+
+#ifdef MAC_UNDERSTANDS_UNIX_PATHS
/*
* Initialize the path name parser for Macintosh path names.
*/
@@ -594,7 +814,8 @@ SplitMacPath(path, bufPtr)
re = Tcl_GetRegExpFromObj(NULL, tsdPtr->macRootPatternPtr, REG_ADVANCED);
if (Tcl_RegExpExec(NULL, re, path, path) == 1) {
- char *start, *end;
+ CONST char *start, *end;
+ Tcl_Obj *nextElt;
/*
* Treat degenerate absolute paths like / and /../.. as
@@ -603,10 +824,11 @@ SplitMacPath(path, bufPtr)
Tcl_RegExpRange(re, 2, &start, &end);
if (start) {
- Tcl_DStringAppend(bufPtr, ":", 1);
+ Tcl_Obj *elt = Tcl_NewStringObj(":", 1);
Tcl_RegExpRange(re, 0, &start, &end);
- Tcl_DStringAppend(bufPtr, path, end - start + 1);
- return Tcl_DStringValue(bufPtr);
+ Tcl_AppendToObj(elt, path, end - start);
+ Tcl_ListObjAppendElement(NULL, result, elt);
+ return result;
}
Tcl_RegExpRange(re, 5, &start, &end);
@@ -629,7 +851,6 @@ SplitMacPath(path, bufPtr)
} else {
Tcl_RegExpRange(re, 10, &start, &end);
if (start) {
-
/*
* Normal Unix style paths.
*/
@@ -639,7 +860,6 @@ SplitMacPath(path, bufPtr)
} else {
Tcl_RegExpRange(re, 12, &start, &end);
if (start) {
-
/*
* Normal Mac style paths.
*/
@@ -650,36 +870,70 @@ SplitMacPath(path, bufPtr)
}
}
}
-
Tcl_RegExpRange(re, i, &start, &end);
length = end - start;
/*
- * Append the element and terminate it with a : and a null. Note that
- * we are forcing the DString to contain an extra null at the end.
+ * Append the element and terminate it with a :
*/
- Tcl_DStringAppend(bufPtr, start, length);
- Tcl_DStringAppend(bufPtr, ":", 2);
+ nextElt = Tcl_NewStringObj(start, length);
+ Tcl_AppendToObj(nextElt, ":", 1);
+ Tcl_ListObjAppendElement(NULL, result, nextElt);
p = end;
} else {
isMac = (strchr(path, ':') != NULL);
p = path;
}
+#else
+ if ((path[0] != ':') && (path[0] == '~' || (strchr(path,':') != NULL))) {
+ CONST char *end;
+ Tcl_Obj *nextElt;
+
+ isMac = 1;
+
+ end = strchr(path,':');
+ if (end == NULL) {
+ length = strlen(path);
+ } else {
+ length = end - path;
+ }
+
+ /*
+ * Append the element and terminate it with a :
+ */
+
+ nextElt = Tcl_NewStringObj(path, length);
+ Tcl_AppendToObj(nextElt, ":", 1);
+ Tcl_ListObjAppendElement(NULL, result, nextElt);
+ p = path + length;
+ } else {
+ isMac = (strchr(path, ':') != NULL);
+ isMac = 1;
+ p = path;
+ }
+#endif
if (isMac) {
/*
* p is pointing at the first colon in the path. There
* will always be one, since this is a Mac-style path.
+ * (This is no longer true if MAC_UNDERSTANDS_UNIX_PATHS
+ * is false, so we must check whether 'p' points to the
+ * end of the string.)
*/
-
- elementStart = p++;
+ elementStart = p;
+ if (*p == ':') {
+ p++;
+ }
+
while ((p = strchr(p, ':')) != NULL) {
length = p - elementStart;
if (length == 1) {
while (*p == ':') {
- Tcl_DStringAppend(bufPtr, "::", 3);
+ Tcl_ListObjAppendElement(NULL, result,
+ Tcl_NewStringObj("::", 2));
elementStart = p++;
}
} else {
@@ -692,18 +946,25 @@ SplitMacPath(path, bufPtr)
elementStart++;
length--;
}
- Tcl_DStringAppend(bufPtr, elementStart, length);
- Tcl_DStringAppend(bufPtr, "", 1);
+ Tcl_ListObjAppendElement(NULL, result,
+ Tcl_NewStringObj(elementStart, length));
elementStart = p++;
}
}
- if (elementStart[1] != '\0' || elementStart == path) {
- if ((elementStart[1] != '~') && (elementStart[1] != '\0')
+ if (elementStart[0] != ':') {
+ if (elementStart[0] != '\0') {
+ Tcl_ListObjAppendElement(NULL, result,
+ Tcl_NewStringObj(elementStart, -1));
+ }
+ } else {
+ if (elementStart[1] != '\0' || elementStart == path) {
+ if ((elementStart[1] != '~') && (elementStart[1] != '\0')
&& (strchr(elementStart+1, '/') == NULL)) {
elementStart++;
+ }
+ Tcl_ListObjAppendElement(NULL, result,
+ Tcl_NewStringObj(elementStart, -1));
}
- Tcl_DStringAppend(bufPtr, elementStart, -1);
- Tcl_DStringAppend(bufPtr, "", 1);
}
} else {
@@ -719,16 +980,21 @@ SplitMacPath(path, bufPtr)
length = p - elementStart;
if (length > 0) {
if ((length == 1) && (elementStart[0] == '.')) {
- Tcl_DStringAppend(bufPtr, ":", 2);
+ Tcl_ListObjAppendElement(NULL, result,
+ Tcl_NewStringObj(":", 1));
} else if ((length == 2) && (elementStart[0] == '.')
&& (elementStart[1] == '.')) {
- Tcl_DStringAppend(bufPtr, "::", 3);
+ Tcl_ListObjAppendElement(NULL, result,
+ Tcl_NewStringObj("::", 2));
} else {
+ Tcl_Obj *nextElt;
if (*elementStart == '~') {
- Tcl_DStringAppend(bufPtr, ":", 1);
+ nextElt = Tcl_NewStringObj(":",1);
+ Tcl_AppendToObj(nextElt, elementStart, length);
+ } else {
+ nextElt = Tcl_NewStringObj(elementStart, length);
}
- Tcl_DStringAppend(bufPtr, elementStart, length);
- Tcl_DStringAppend(bufPtr, "", 1);
+ Tcl_ListObjAppendElement(NULL, result, nextElt);
}
}
if (*p++ == '\0') {
@@ -736,239 +1002,301 @@ SplitMacPath(path, bufPtr)
}
}
}
- return Tcl_DStringValue(bufPtr);
+ return result;
}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
- * Tcl_JoinPath --
+ * Tcl_FSJoinToPath --
*
- * Combine a list of paths in a platform specific manner.
+ * This function takes the given object, which should usually be a
+ * valid path or NULL, and joins onto it the array of paths
+ * segments given.
*
* Results:
- * Appends the joined path to the end of the specified
- * returning a pointer to the resulting string. Note that
- * the Tcl_DString must already be initialized.
+ * Returns object with refCount of zero
*
* Side effects:
- * Modifies the Tcl_DString.
+ * None.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
-char *
-Tcl_JoinPath(argc, argv, resultPtr)
- int argc;
- char **argv;
- Tcl_DString *resultPtr; /* Pointer to previously initialized DString. */
+Tcl_Obj*
+Tcl_FSJoinToPath(basePtr, objc, objv)
+ Tcl_Obj *basePtr;
+ int objc;
+ Tcl_Obj *CONST objv[];
{
- int oldLength, length, i, needsSep;
- Tcl_DString buffer;
- char c, *dest;
- CONST char *p;
- Tcl_PathType type = TCL_PATH_ABSOLUTE;
-
- Tcl_DStringInit(&buffer);
- oldLength = Tcl_DStringLength(resultPtr);
+ int i;
+ Tcl_Obj *lobj, *ret;
- switch (tclPlatform) {
- case TCL_PLATFORM_UNIX:
- for (i = 0; i < argc; i++) {
- p = argv[i];
- /*
- * If the path is absolute, reset the result buffer.
- * Consume any duplicate leading slashes or a ./ in
- * front of a tilde prefixed path that isn't at the
- * beginning of the path.
- */
+ if (basePtr == NULL) {
+ lobj = Tcl_NewListObj(0, NULL);
+ } else {
+ lobj = Tcl_NewListObj(1, &basePtr);
+ }
+
+ for (i = 0; i<objc;i++) {
+ Tcl_ListObjAppendElement(NULL, lobj, objv[i]);
+ }
+ ret = Tcl_FSJoinPath(lobj, -1);
+ Tcl_DecrRefCount(lobj);
+ return ret;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpNativeJoinPath --
+ *
+ * 'prefix' is absolute, 'joining' is relative to prefix.
+ *
+ * Results:
+ * modifies prefix
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
-#ifdef __QNX__
- /*
- * Check for QNX //<node id> prefix
- */
- if (*p && (strlen(p) > 3) && (p[0] == '/') && (p[1] == '/')
- && isdigit(UCHAR(p[2]))) { /* INTL: digit */
- p += 3;
- while (isdigit(UCHAR(*p))) { /* INTL: digit */
- ++p;
- }
- }
-#endif
- if (*p == '/') {
- Tcl_DStringSetLength(resultPtr, oldLength);
- Tcl_DStringAppend(resultPtr, "/", 1);
- while (*p == '/') {
- p++;
- }
- } else if (*p == '~') {
- Tcl_DStringSetLength(resultPtr, oldLength);
- } else if ((Tcl_DStringLength(resultPtr) != oldLength)
- && (p[0] == '.') && (p[1] == '/')
- && (p[2] == '~')) {
- p += 2;
- }
+void
+TclpNativeJoinPath(prefix, joining)
+ Tcl_Obj *prefix;
+ char* joining;
+{
+ int length, needsSep;
+ char *dest, *p, *start;
+
+ start = Tcl_GetStringFromObj(prefix, &length);
- if (*p == '\0') {
- continue;
- }
+ /*
+ * Remove the ./ from tilde prefixed elements unless
+ * it is the first component.
+ */
+
+ p = joining;
+
+ if (length != 0) {
+ if ((p[0] == '.') && (p[1] == '/') && (p[2] == '~')) {
+ p += 2;
+ }
+ }
+
+ if (*p == '\0') {
+ return;
+ }
- /*
- * Append a separator if needed.
- */
- length = Tcl_DStringLength(resultPtr);
- if ((length != oldLength)
- && (Tcl_DStringValue(resultPtr)[length-1] != '/')) {
- Tcl_DStringAppend(resultPtr, "/", 1);
- length++;
- }
+ switch (tclPlatform) {
+ case TCL_PLATFORM_UNIX:
+ /*
+ * Append a separator if needed.
+ */
- /*
- * Append the element, eliminating duplicate and trailing
- * slashes.
- */
+ if (length > 0 && (start[length-1] != '/')) {
+ Tcl_AppendToObj(prefix, "/", 1);
+ length++;
+ }
+ needsSep = 0;
+
+ /*
+ * Append the element, eliminating duplicate and trailing
+ * slashes.
+ */
- Tcl_DStringSetLength(resultPtr, (int) (length + strlen(p)));
- dest = Tcl_DStringValue(resultPtr) + length;
- for (; *p != '\0'; p++) {
- if (*p == '/') {
- while (p[1] == '/') {
- p++;
- }
- if (p[1] != '\0') {
+ Tcl_SetObjLength(prefix, length + (int) strlen(p));
+
+ dest = Tcl_GetString(prefix) + length;
+ for (; *p != '\0'; p++) {
+ if (*p == '/') {
+ while (p[1] == '/') {
+ p++;
+ }
+ if (p[1] != '\0') {
+ if (needsSep) {
*dest++ = '/';
}
- } else {
- *dest++ = *p;
}
+ } else {
+ *dest++ = *p;
+ needsSep = 1;
}
- length = dest - Tcl_DStringValue(resultPtr);
- Tcl_DStringSetLength(resultPtr, length);
}
+ length = dest - Tcl_GetString(prefix);
+ Tcl_SetObjLength(prefix, length);
break;
case TCL_PLATFORM_WINDOWS:
/*
- * Iterate over all of the components. If a component is
- * absolute, then reset the result and start building the
- * path from the current component on.
+ * Check to see if we need to append a separator.
*/
- for (i = 0; i < argc; i++) {
- p = ExtractWinRoot(argv[i], resultPtr, oldLength, &type);
- length = Tcl_DStringLength(resultPtr);
-
- /*
- * If the pointer didn't move, then this is a relative path
- * or a tilde prefixed path.
- */
-
- if (p == argv[i]) {
- /*
- * Remove the ./ from tilde prefixed elements unless
- * it is the first component.
- */
+ if ((length > 0) &&
+ (start[length-1] != '/') && (start[length-1] != ':')) {
+ Tcl_AppendToObj(prefix, "/", 1);
+ length++;
+ }
+ needsSep = 0;
+
+ /*
+ * Append the element, eliminating duplicate and
+ * trailing slashes.
+ */
- if ((length != oldLength)
- && (p[0] == '.')
- && ((p[1] == '/') || (p[1] == '\\'))
- && (p[2] == '~')) {
- p += 2;
- } else if (*p == '~') {
- Tcl_DStringSetLength(resultPtr, oldLength);
- length = oldLength;
+ Tcl_SetObjLength(prefix, length + (int) strlen(p));
+ dest = Tcl_GetString(prefix) + length;
+ for (; *p != '\0'; p++) {
+ if ((*p == '/') || (*p == '\\')) {
+ while ((p[1] == '/') || (p[1] == '\\')) {
+ p++;
}
+ if ((p[1] != '\0') && needsSep) {
+ *dest++ = '/';
+ }
+ } else {
+ *dest++ = *p;
+ needsSep = 1;
}
+ }
+ length = dest - Tcl_GetString(prefix);
+ Tcl_SetObjLength(prefix, length);
+ break;
- if (*p != '\0') {
- /*
- * Check to see if we need to append a separator.
- */
+ case TCL_PLATFORM_MAC: {
+ int newLength;
+
+ /*
+ * Sort out separators. We basically add the object we've
+ * been given, but we have to make sure that there is
+ * exactly one separator inbetween (unless the object we're
+ * adding contains multiple contiguous colons, all of which
+ * we must add). Also if an object is just ':' we don't
+ * bother to add it unless it's the very first element.
+ */
-
- if (length != oldLength) {
- c = Tcl_DStringValue(resultPtr)[length-1];
- if ((c != '/') && (c != ':')) {
- Tcl_DStringAppend(resultPtr, "/", 1);
- }
+#ifdef MAC_UNDERSTANDS_UNIX_PATHS
+ int adjustedPath = 0;
+ if ((strchr(p, ':') == NULL) && (strchr(p, '/') != NULL)) {
+ char *start = p;
+ adjustedPath = 1;
+ while (*start != '\0') {
+ if (*start == '/') {
+ *start = ':';
}
-
- /*
- * Append the element, eliminating duplicate and
- * trailing slashes.
- */
-
- length = Tcl_DStringLength(resultPtr);
- Tcl_DStringSetLength(resultPtr, (int) (length + strlen(p)));
- dest = Tcl_DStringValue(resultPtr) + length;
- for (; *p != '\0'; p++) {
- if ((*p == '/') || (*p == '\\')) {
- while ((p[1] == '/') || (p[1] == '\\')) {
- p++;
- }
- if (p[1] != '\0') {
- *dest++ = '/';
- }
- } else {
- *dest++ = *p;
- }
+ start++;
+ }
+ }
+#endif
+ if (length > 0) {
+ if ((p[0] == ':') && (p[1] == '\0')) {
+ return;
+ }
+ if (start[length-1] != ':') {
+ if (*p != '\0' && *p != ':') {
+ Tcl_AppendToObj(prefix, ":", 1);
+ length++;
}
- length = dest - Tcl_DStringValue(resultPtr);
- Tcl_DStringSetLength(resultPtr, length);
+ } else if (*p == ':') {
+ p++;
+ }
+ } else {
+ if (*p != '\0' && *p != ':') {
+ Tcl_AppendToObj(prefix, ":", 1);
+ length++;
}
}
- break;
+
+ /*
+ * Append the element
+ */
- case TCL_PLATFORM_MAC:
- needsSep = 1;
- for (i = 0; i < argc; i++) {
- Tcl_DStringSetLength(&buffer, 0);
- p = SplitMacPath(argv[i], &buffer);
- if ((*p != ':') && (*p != '\0')
- && (strchr(p, ':') != NULL)) {
- Tcl_DStringSetLength(resultPtr, oldLength);
- length = strlen(p);
- Tcl_DStringAppend(resultPtr, p, length);
- needsSep = 0;
- p += length+1;
+ newLength = strlen(p);
+ /*
+ * It may not be good to just do 'Tcl_AppendToObj(prefix,
+ * p, newLength)' because the object may contain duplicate
+ * colons which we want to get rid of.
+ */
+ Tcl_AppendToObj(prefix, p, newLength);
+
+ /* Remove spurious trailing single ':' */
+ dest = Tcl_GetString(prefix) + length + newLength;
+ if (*(dest-1) == ':') {
+ if (dest-1 > Tcl_GetString(prefix)) {
+ if (*(dest-2) != ':') {
+ Tcl_SetObjLength(prefix, length + newLength -1);
+ }
}
-
- /*
- * Now append the rest of the path elements, skipping
- * : unless it is the first element of the path, and
- * watching out for :: et al. so we don't end up with
- * too many colons in the result.
- */
-
- for (; *p != '\0'; p += length+1) {
- if (p[0] == ':' && p[1] == '\0') {
- if (Tcl_DStringLength(resultPtr) != oldLength) {
- p++;
- } else {
- needsSep = 0;
- }
- } else {
- c = p[1];
- if (*p == ':') {
- if (!needsSep) {
- p++;
- }
- } else {
- if (needsSep) {
- Tcl_DStringAppend(resultPtr, ":", 1);
- }
- }
- needsSep = (c == ':') ? 0 : 1;
+ }
+#ifdef MAC_UNDERSTANDS_UNIX_PATHS
+ /* Revert the path to what it was */
+ if (adjustedPath) {
+ char *start = joining;
+ while (*start != '\0') {
+ if (*start == ':') {
+ *start = '/';
}
- length = strlen(p);
- Tcl_DStringAppend(resultPtr, p, length);
+ start++;
}
}
+#endif
break;
-
+ }
}
- Tcl_DStringFree(&buffer);
+ return;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_JoinPath --
+ *
+ * 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 Tcl_DString must already be initialized.
+ *
+ * Side effects:
+ * Modifies the Tcl_DString.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_JoinPath(argc, argv, resultPtr)
+ 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;
+
+ /* Build the list of paths */
+ for (i = 0; i < argc; i++) {
+ Tcl_ListObjAppendElement(NULL, listObj,
+ Tcl_NewStringObj(argv[i], -1));
+ }
+
+ /* Ask the objectified code to join the paths */
+ Tcl_IncrRefCount(listObj);
+ resultObj = Tcl_FSJoinPath(listObj, argc);
+ Tcl_IncrRefCount(resultObj);
+ Tcl_DecrRefCount(listObj);
+
+ /* Store the result */
+ resultStr = Tcl_GetStringFromObj(resultObj, &len);
+ Tcl_DStringAppend(resultPtr, resultStr, len);
+ Tcl_DecrRefCount(resultObj);
+
+ /* Return a pointer to the result */
return Tcl_DStringValue(resultPtr);
}
@@ -1002,51 +1330,25 @@ char *
Tcl_TranslateFileName(interp, name, bufferPtr)
Tcl_Interp *interp; /* Interpreter in which to store error
* message (if necessary). */
- 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 name after tilde substitution. */
{
- register char *p;
-
- /*
- * Handle tilde substitutions, if needed.
- */
-
- if (name[0] == '~') {
- int argc, length;
- char **argv;
- Tcl_DString temp;
-
- Tcl_SplitPath(name, &argc, (char ***) &argv);
-
- /*
- * Strip the trailing ':' off of a Mac path before passing the user
- * name to DoTildeSubst.
- */
-
- if (tclPlatform == TCL_PLATFORM_MAC) {
- length = strlen(argv[0]);
- argv[0][length-1] = '\0';
- }
-
- Tcl_DStringInit(&temp);
- argv[0] = DoTildeSubst(interp, argv[0]+1, &temp);
- if (argv[0] == NULL) {
- Tcl_DStringFree(&temp);
- ckfree((char *)argv);
- return NULL;
- }
- Tcl_DStringInit(bufferPtr);
- Tcl_JoinPath(argc, (char **) argv, bufferPtr);
- Tcl_DStringFree(&temp);
- ckfree((char*)argv);
- } else {
- Tcl_DStringInit(bufferPtr);
- Tcl_JoinPath(1, (char **) &name, bufferPtr);
+ Tcl_Obj *path = Tcl_NewStringObj(name, -1);
+ CONST char *result;
+
+ Tcl_IncrRefCount(path);
+ result = Tcl_FSGetTranslatedStringPath(interp, path);
+ if (result == NULL) {
+ Tcl_DecrRefCount(path);
+ return NULL;
}
+ Tcl_DStringInit(bufferPtr);
+ Tcl_DStringAppend(bufferPtr, result, -1);
+ Tcl_DecrRefCount(path);
/*
* Convert forward slashes to backslashes in Windows paths because
@@ -1054,6 +1356,7 @@ Tcl_TranslateFileName(interp, name, bufferPtr)
*/
if (tclPlatform == TCL_PLATFORM_WINDOWS) {
+ register char *p;
for (p = Tcl_DStringValue(bufferPtr); *p != '\0'; p++) {
if (*p == '/') {
*p = '\\';
@@ -1098,11 +1401,15 @@ TclGetExtension(name)
break;
case TCL_PLATFORM_MAC:
+#ifdef MAC_UNDERSTANDS_UNIX_PATHS
if (strchr(name, ':') == NULL) {
lastSep = strrchr(name, '/');
} else {
lastSep = strrchr(name, ':');
}
+#else
+ lastSep = strrchr(name, ':');
+#endif
break;
case TCL_PLATFORM_WINDOWS:
@@ -1115,8 +1422,7 @@ TclGetExtension(name)
break;
}
p = strrchr(name, '.');
- if ((p != NULL) && (lastSep != NULL)
- && (lastSep > p)) {
+ if ((p != NULL) && (lastSep != NULL) && (lastSep > p)) {
p = NULL;
}
@@ -1152,7 +1458,7 @@ TclGetExtension(name)
*----------------------------------------------------------------------
*/
-static char *
+static CONST char *
DoTildeSubst(interp, user, resultPtr)
Tcl_Interp *interp; /* Interpreter in which to store error
* message (if necessary). */
@@ -1161,7 +1467,7 @@ DoTildeSubst(interp, user, resultPtr)
Tcl_DString *resultPtr; /* Initialized DString filled with name
* after tilde substitution. */
{
- char *dir;
+ CONST char *dir;
if (*user == '\0') {
Tcl_DString dirString;
@@ -1187,7 +1493,7 @@ DoTildeSubst(interp, user, resultPtr)
return NULL;
}
}
- return resultPtr->string;
+ return Tcl_DStringValue(resultPtr);
}
/*
@@ -1215,23 +1521,25 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- int index, i, globFlags, pathlength, length, join, dir, result;
- char *string, *pathOrDir, *separators;
+ int index, i, globFlags, length, join, dir, result;
+ char *string, *separators;
Tcl_Obj *typePtr, *resultPtr, *look;
- Tcl_DString prefix, directory;
- static char *options[] = {
- "-directory", "-join", "-nocomplain", "-path", "-types", "--", NULL
+ Tcl_Obj *pathOrDir = NULL;
+ Tcl_DString prefix;
+ static CONST char *options[] = {
+ "-directory", "-join", "-nocomplain", "-path", "-tails",
+ "-types", "--", NULL
};
enum options {
- GLOB_DIR, GLOB_JOIN, GLOB_NOCOMPLAIN, GLOB_PATH, GLOB_TYPE, GLOB_LAST
+ GLOB_DIR, GLOB_JOIN, GLOB_NOCOMPLAIN, GLOB_PATH, GLOB_TAILS,
+ GLOB_TYPE, GLOB_LAST
};
enum pathDirOptions {PATH_NONE = -1 , PATH_GENERAL = 0, PATH_DIR = 1};
- GlobTypeData *globTypes = NULL;
+ Tcl_GlobTypeData *globTypes = NULL;
globFlags = 0;
join = 0;
dir = PATH_NONE;
- pathOrDir = NULL;
typePtr = NULL;
resultPtr = Tcl_GetObjResult(interp);
for (i = 1; i < objc; i++) {
@@ -1255,7 +1563,7 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
}
switch (index) {
case GLOB_NOCOMPLAIN: /* -nocomplain */
- globFlags |= GLOBMODE_NO_COMPLAIN;
+ globFlags |= TCL_GLOBMODE_NO_COMPLAIN;
break;
case GLOB_DIR: /* -dir */
if (i == (objc-1)) {
@@ -1263,34 +1571,37 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
"missing argument to \"-directory\"", -1);
return TCL_ERROR;
}
- if (dir != -1) {
+ if (dir != PATH_NONE) {
Tcl_AppendToObj(resultPtr,
"\"-directory\" cannot be used with \"-path\"",
-1);
return TCL_ERROR;
}
dir = PATH_DIR;
- globFlags |= GLOBMODE_DIR;
- pathOrDir = Tcl_GetStringFromObj(objv[i+1], &pathlength);
+ globFlags |= TCL_GLOBMODE_DIR;
+ pathOrDir = objv[i+1];
i++;
break;
case GLOB_JOIN: /* -join */
join = 1;
break;
+ case GLOB_TAILS: /* -tails */
+ globFlags |= TCL_GLOBMODE_TAILS;
+ break;
case GLOB_PATH: /* -path */
if (i == (objc-1)) {
Tcl_AppendToObj(resultPtr,
"missing argument to \"-path\"", -1);
return TCL_ERROR;
}
- if (dir != -1) {
+ if (dir != PATH_NONE) {
Tcl_AppendToObj(resultPtr,
"\"-path\" cannot be used with \"-directory\"",
-1);
return TCL_ERROR;
}
dir = PATH_GENERAL;
- pathOrDir = Tcl_GetStringFromObj(objv[i+1], &pathlength);
+ pathOrDir = objv[i+1];
i++;
break;
case GLOB_TYPE: /* -types */
@@ -1316,7 +1627,13 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
Tcl_WrongNumArgs(interp, 1, objv, "?switches? name ?name ...?");
return TCL_ERROR;
}
-
+ if ((globFlags & TCL_GLOBMODE_TAILS) && (pathOrDir == NULL)) {
+ Tcl_AppendToObj(resultPtr,
+ "\"-tails\" must be used with either \"-directory\" or \"-path\"",
+ -1);
+ return TCL_ERROR;
+ }
+
separators = NULL; /* lint. */
switch (tclPlatform) {
case TCL_PLATFORM_UNIX:
@@ -1330,34 +1647,34 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
break;
}
if (dir == PATH_GENERAL) {
+ int pathlength;
char *last;
+ char *first = Tcl_GetStringFromObj(pathOrDir,&pathlength);
/*
* Find the last path separator in the path
*/
- last = pathOrDir + pathlength;
- for (; last != pathOrDir; last--) {
+ last = first + pathlength;
+ for (; last != first; last--) {
if (strchr(separators, *(last-1)) != NULL) {
break;
}
}
- if (last == pathOrDir + pathlength) {
+ if (last == first + pathlength) {
/* It's really a directory */
- dir = 1;
+ dir = PATH_DIR;
} else {
Tcl_DString pref;
char *search, *find;
Tcl_DStringInit(&pref);
- Tcl_DStringInit(&directory);
- if (last == pathOrDir) {
+ if (last == first) {
/* The whole thing is a prefix */
- Tcl_DStringAppend(&pref, pathOrDir, -1);
+ Tcl_DStringAppend(&pref, first, -1);
pathOrDir = NULL;
} else {
/* Have to split off the end */
- Tcl_DStringAppend(&pref, last, pathOrDir+pathlength-last);
- Tcl_DStringAppend(&directory, pathOrDir, last-pathOrDir-1);
- pathOrDir = Tcl_DStringValue(&directory);
+ Tcl_DStringAppend(&pref, last, first+pathlength-last);
+ pathOrDir = Tcl_NewStringObj(first, last-first-1);
}
/* Need to quote 'prefix' */
Tcl_DStringInit(&prefix);
@@ -1377,7 +1694,11 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
Tcl_DStringFree(&pref);
}
}
-
+
+ if (pathOrDir != NULL) {
+ Tcl_IncrRefCount(pathOrDir);
+ }
+
if (typePtr != NULL) {
/*
* The rest of the possible type arguments (except 'd') are
@@ -1385,7 +1706,7 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
* on an incompatible platform.
*/
Tcl_ListObjLength(interp, typePtr, &length);
- globTypes = (GlobTypeData*) ckalloc(sizeof(GlobTypeData));
+ globTypes = (Tcl_GlobTypeData*) ckalloc(sizeof(Tcl_GlobTypeData));
globTypes->type = 0;
globTypes->perm = 0;
globTypes->macType = NULL;
@@ -1468,17 +1789,25 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
}
}
/*
- * Error cases
+ * Error cases. We re-get the interpreter's result,
+ * just to be sure it hasn't changed, and we reset
+ * the 'join' flag to zero, since we haven't yet
+ * made use of it.
*/
badTypesArg:
+ resultPtr = Tcl_GetObjResult(interp);
Tcl_AppendToObj(resultPtr, "bad argument to \"-types\": ", -1);
Tcl_AppendObjToObj(resultPtr, look);
result = TCL_ERROR;
+ join = 0;
goto endOfGlob;
badMacTypesArg:
+ resultPtr = Tcl_GetObjResult(interp);
Tcl_AppendToObj(resultPtr,
- "only one MacOS type or creator argument to \"-types\" allowed", -1);
+ "only one MacOS type or creator argument"
+ " to \"-types\" allowed", -1);
result = TCL_ERROR;
+ join = 0;
goto endOfGlob;
}
}
@@ -1544,7 +1873,7 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
}
}
}
- if ((globFlags & GLOBMODE_NO_COMPLAIN) == 0) {
+ if ((globFlags & TCL_GLOBMODE_NO_COMPLAIN) == 0) {
if (Tcl_ListObjLength(interp, Tcl_GetObjResult(interp),
&length) != TCL_OK) {
/* This should never happen. Maybe we should be more dramatic */
@@ -1572,9 +1901,9 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
endOfGlob:
if (join || (dir == PATH_GENERAL)) {
Tcl_DStringFree(&prefix);
- if (dir == PATH_GENERAL) {
- Tcl_DStringFree(&directory);
- }
+ }
+ if (pathOrDir != NULL) {
+ Tcl_DecrRefCount(pathOrDir);
}
if (globTypes != NULL) {
if (globTypes->macType != NULL) {
@@ -1596,16 +1925,24 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
* This procedure prepares arguments for the TclDoGlob call.
* It sets the separator string based on the platform, performs
* tilde substitution, and calls TclDoGlob.
+ *
+ * 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 fail to do anything very meaningful.
*
* 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 by TclDoGlob) holds all of the file names
- * given by the dir and rem arguments. After an error the
- * result in interp will hold an error message.
+ * given by the pattern and unquotedPrefix 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.
*
* Side effects:
- * The currentArgString is written to.
+ * The 'pattern' is written to.
*
*----------------------------------------------------------------------
*/
@@ -1617,17 +1954,19 @@ TclGlob(interp, pattern, unquotedPrefix, globFlags, types)
* or appending list of matching file names. */
char *pattern; /* Glob pattern to match. Must not refer
* to a static string. */
- char *unquotedPrefix; /* Prefix to glob pattern, if non-null, which
- * is considered literally. May be static. */
+ Tcl_Obj *unquotedPrefix; /* Prefix to glob pattern, if non-null, which
+ * is considered literally. */
int globFlags; /* Stores or'ed combination of flags */
- GlobTypeData *types; /* Struct containing acceptable types.
+ Tcl_GlobTypeData *types; /* Struct containing acceptable types.
* May be NULL. */
{
char *separators;
- char *head, *tail, *start;
+ CONST char *head;
+ char *tail, *start;
char c;
- int result;
+ int result, prefixLen;
Tcl_DString buffer;
+ Tcl_Obj *oldResult;
separators = NULL; /* lint. */
switch (tclPlatform) {
@@ -1638,17 +1977,21 @@ TclGlob(interp, pattern, unquotedPrefix, globFlags, types)
separators = "/\\:";
break;
case TCL_PLATFORM_MAC:
+#ifdef MAC_UNDERSTANDS_UNIX_PATHS
if (unquotedPrefix == NULL) {
separators = (strchr(pattern, ':') == NULL) ? "/" : ":";
} else {
separators = ":";
}
+#else
+ separators = ":";
+#endif
break;
}
Tcl_DStringInit(&buffer);
if (unquotedPrefix != NULL) {
- start = unquotedPrefix;
+ start = Tcl_GetString(unquotedPrefix);
} else {
start = pattern;
}
@@ -1673,44 +2016,23 @@ TclGlob(interp, pattern, unquotedPrefix, globFlags, types)
}
/*
- * Determine the home directory for the specified user. Note that
- * we don't allow special characters in the user name.
+ * Determine the home directory for the specified user.
*/
c = *tail;
*tail = '\0';
- /*
- * I don't think we need to worry about special characters in
- * the user name anymore (Vince Darley, June 1999), since the
- * new code is designed to handle special chars.
- */
-#ifndef NOT_NEEDED_ANYMORE
- head = DoTildeSubst(interp, start+1, &buffer);
-#else
-
- if (strpbrk(start+1, "\\[]*?{}") == NULL) {
- head = DoTildeSubst(interp, start+1, &buffer);
+ 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 {
- if (!(globFlags & GLOBMODE_NO_COMPLAIN)) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "globbing characters not ",
- "supported in user names", (char *) NULL);
- }
- head = NULL;
+ head = DoTildeSubst(interp, start+1, &buffer);
}
-#endif
*tail = c;
if (head == NULL) {
- if (globFlags & GLOBMODE_NO_COMPLAIN) {
- /*
- * We should in fact pass down the nocomplain flag
- * or save the interp result or use another mechanism
- * so the interp result is not mangled on errors in that case.
- * but that would a bigger change than reasonable for a patch
- * release.
- * (see fileName.test 15.2-15.4 for expected behaviour)
- */
- Tcl_ResetResult(interp);
+ if (globFlags & TCL_GLOBMODE_NO_COMPLAIN) {
return TCL_OK;
} else {
return TCL_ERROR;
@@ -1726,30 +2048,113 @@ TclGlob(interp, pattern, unquotedPrefix, globFlags, types)
} else {
tail = pattern;
if (unquotedPrefix != NULL) {
- Tcl_DStringAppend(&buffer,unquotedPrefix,-1);
+ Tcl_DStringAppend(&buffer,Tcl_GetString(unquotedPrefix),-1);
}
}
+
/*
- * If the prefix is a directory, make sure it ends in a directory
- * separator.
+ * We want to remember the length of the current prefix,
+ * in case we are using TCL_GLOBMODE_TAILS. Also if we
+ * are using TCL_GLOBMODE_DIR, we must make sure the
+ * prefix ends in a directory separator.
*/
- if (unquotedPrefix != NULL) {
- if (globFlags & GLOBMODE_DIR) {
- c = Tcl_DStringValue(&buffer)[Tcl_DStringLength(&buffer)-1];
- if (strchr(separators, c) == NULL) {
+ prefixLen = Tcl_DStringLength(&buffer);
+
+ if (prefixLen > 0) {
+ c = Tcl_DStringValue(&buffer)[prefixLen-1];
+ if (strchr(separators, c) == NULL) {
+ /*
+ * If the prefix is a directory, make sure it ends in a
+ * directory separator.
+ */
+ if (globFlags & TCL_GLOBMODE_DIR) {
Tcl_DStringAppend(&buffer,separators,1);
}
+ prefixLen++;
}
}
+ /*
+ * We need to get the old result, in case it is over-written
+ * below when we still need it.
+ */
+ oldResult = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(oldResult);
+ Tcl_ResetResult(interp);
+
result = TclDoGlob(interp, separators, &buffer, tail, types);
- Tcl_DStringFree(&buffer);
+
if (result != TCL_OK) {
- if (globFlags & GLOBMODE_NO_COMPLAIN) {
- Tcl_ResetResult(interp);
- return TCL_OK;
+ if (globFlags & TCL_GLOBMODE_NO_COMPLAIN) {
+ /* Put back the old result and reset the return code */
+ Tcl_SetObjResult(interp, oldResult);
+ result = TCL_OK;
+ }
+ } else {
+ /*
+ * Now we must concatenate the 'oldResult' and the current
+ * result, and then place that into the interpreter.
+ *
+ * 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
+ * TclDoGlob, 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 slower (when
+ * the -tails flag is given), but much simpler to code.
+ */
+ int objc, i;
+ Tcl_Obj **objv;
+
+ /* Ensure sole ownership */
+ if (Tcl_IsShared(oldResult)) {
+ Tcl_DecrRefCount(oldResult);
+ oldResult = Tcl_DuplicateObj(oldResult);
+ Tcl_IncrRefCount(oldResult);
+ }
+
+ Tcl_ListObjGetElements(NULL, Tcl_GetObjResult(interp),
+ &objc, &objv);
+#ifdef MAC_TCL
+ /* adjust prefixLen if TclDoGlob prepended a ':' */
+ if ((prefixLen > 0) && (objc > 0)
+ && (Tcl_DStringValue(&buffer)[0] != ':')) {
+ char *str = Tcl_GetStringFromObj(objv[0],NULL);
+ if (str[0] == ':') {
+ prefixLen++;
+ }
+ }
+#endif
+ for (i = 0; i< objc; i++) {
+ Tcl_Obj* elt;
+ if (globFlags & TCL_GLOBMODE_TAILS) {
+ int len;
+ char *oldStr = Tcl_GetStringFromObj(objv[i],&len);
+ if (len == prefixLen) {
+ if ((pattern[0] == '\0')
+ || (strchr(separators, pattern[0]) == NULL)) {
+ elt = Tcl_NewStringObj(".",1);
+ } else {
+ elt = Tcl_NewStringObj("/",1);
+ }
+ } else {
+ elt = Tcl_NewStringObj(oldStr + prefixLen,
+ len - prefixLen);
+ }
+ } else {
+ elt = objv[i];
+ }
+ /* Assumption that 'oldResult' is a valid list */
+ Tcl_ListObjAppendElement(interp, oldResult, elt);
}
+ Tcl_SetObjResult(interp, oldResult);
}
+ /*
+ * Release our temporary copy. All code paths above must
+ * end here so we free our reference.
+ */
+ Tcl_DecrRefCount(oldResult);
+ Tcl_DStringFree(&buffer);
return result;
}
@@ -1842,8 +2247,8 @@ TclDoGlob(interp, separators, headPtr, tail, types)
Tcl_DString *headPtr; /* Completely expanded prefix. */
char *tail; /* The unexpanded remainder of the path.
* Must not be a pointer to a static string. */
- GlobTypeData *types; /* List object containing list of acceptable types.
- * May be NULL. */
+ Tcl_GlobTypeData *types; /* List object containing list of acceptable
+ * types. May be NULL. */
{
int baseLength, quoted, count;
int result = TCL_OK;
@@ -1880,12 +2285,14 @@ TclDoGlob(interp, separators, headPtr, tail, types)
switch (tclPlatform) {
case TCL_PLATFORM_MAC:
+#ifdef MAC_UNDERSTANDS_UNIX_PATHS
if (*separators == '/') {
if (((length == 0) && (count == 0))
|| ((length > 0) && (lastChar != ':'))) {
Tcl_DStringAppend(headPtr, ":", 1);
}
} else {
+#endif
if (count == 0) {
if ((length > 0) && (lastChar != ':')) {
Tcl_DStringAppend(headPtr, ":", 1);
@@ -1898,7 +2305,9 @@ TclDoGlob(interp, separators, headPtr, tail, types)
Tcl_DStringAppend(headPtr, ":", 1);
}
}
+#ifdef MAC_UNDERSTANDS_UNIX_PATHS
}
+#endif
break;
case TCL_PLATFORM_WINDOWS:
/*
@@ -2000,8 +2409,8 @@ TclDoGlob(interp, separators, headPtr, tail, types)
Tcl_DStringSetLength(&newName, baseLength);
Tcl_DStringAppend(&newName, element, p-element);
Tcl_DStringAppend(&newName, closeBrace+1, -1);
- result = TclDoGlob(interp, separators,
- headPtr, Tcl_DStringValue(&newName), types);
+ result = TclDoGlob(interp, separators, headPtr,
+ Tcl_DStringValue(&newName), types);
if (result != TCL_OK) {
break;
}
@@ -2026,107 +2435,230 @@ TclDoGlob(interp, separators, headPtr, tail, types)
* if the string is a static.
*/
- savedChar = *p;
- *p = '\0';
- firstSpecialChar = strpbrk(tail, "*[]?\\");
- *p = savedChar;
+ savedChar = *p;
+ *p = '\0';
+ firstSpecialChar = strpbrk(tail, "*[]?\\");
+ *p = savedChar;
} else {
firstSpecialChar = strpbrk(tail, "*[]?\\");
}
if (firstSpecialChar != NULL) {
+ int ret;
+ Tcl_Obj *head = Tcl_NewStringObj(Tcl_DStringValue(headPtr),-1);
+ Tcl_IncrRefCount(head);
/*
- * Look for matching files in the current directory. The
- * implementation of this function is platform specific, but may
- * recursively call TclDoGlob. For each file that matches, it will
- * add the match onto the interp's result, or call TclDoGlob if there
- * are more characters to be processed.
+ * Look for matching files in the given directory. The
+ * implementation of this function is platform specific. For
+ * each file that matches, it will add the match onto the
+ * resultPtr given.
*/
+ if (*p == '\0') {
+ ret = Tcl_FSMatchInDirectory(interp, Tcl_GetObjResult(interp),
+ head, tail, types);
+ } else {
+ Tcl_Obj* resultPtr;
- return TclpMatchFilesTypes(interp, separators, headPtr, tail, p, types);
+ /*
+ * We do the recursion ourselves. This makes implementing
+ * Tcl_FSMatchInDirectory for each filesystem much easier.
+ */
+ Tcl_GlobTypeData dirOnly = { TCL_GLOB_TYPE_DIR, 0, NULL, NULL };
+ char save = *p;
+
+ *p = '\0';
+ resultPtr = Tcl_NewListObj(0, NULL);
+ ret = Tcl_FSMatchInDirectory(interp, resultPtr,
+ head, tail, &dirOnly);
+ *p = save;
+ if (ret == TCL_OK) {
+ int resLength;
+ ret = Tcl_ListObjLength(interp, resultPtr, &resLength);
+ if (ret == TCL_OK) {
+ int i;
+ for (i =0; i< resLength; i++) {
+ Tcl_Obj *elt;
+ Tcl_DString ds;
+ Tcl_ListObjIndex(interp, resultPtr, i, &elt);
+ Tcl_DStringInit(&ds);
+ Tcl_DStringAppend(&ds, Tcl_GetString(elt), -1);
+ if(tclPlatform == TCL_PLATFORM_MAC) {
+ Tcl_DStringAppend(&ds, ":",1);
+ } else {
+ Tcl_DStringAppend(&ds, "/",1);
+ }
+ ret = TclDoGlob(interp, separators, &ds, p+1, types);
+ Tcl_DStringFree(&ds);
+ if (ret != TCL_OK) {
+ break;
+ }
+ }
+ }
+ }
+ Tcl_DecrRefCount(resultPtr);
+ }
+ Tcl_DecrRefCount(head);
+ return ret;
}
Tcl_DStringAppend(headPtr, tail, p-tail);
if (*p != '\0') {
return TclDoGlob(interp, separators, headPtr, p, types);
- }
+ } else {
+ /*
+ * This is the code path reached by a command like 'glob foo'.
+ *
+ * There are no more wildcards in the pattern and no more
+ * unprocessed characters in the tail, so now we can construct
+ * the path, and pass it to Tcl_FSMatchInDirectory with an
+ * empty pattern to verify the existence of the file and check
+ * it is of the correct type (if a 'types' flag it given -- if
+ * no such flag was given, we could just use 'Tcl_FSLStat', but
+ * for simplicity we keep to a common approach).
+ */
- /*
- * There are no more wildcards in the pattern and no more unprocessed
- * characters in the tail, so now we can construct the path and verify
- * the existence of the file.
- */
+ Tcl_Obj *nameObj;
+ /* Used to deal with one special case pertinent to MacOS */
+ int macSpecialCase = 0;
- switch (tclPlatform) {
- case TCL_PLATFORM_MAC: {
- if (strchr(Tcl_DStringValue(headPtr), ':') == NULL) {
- Tcl_DStringAppend(headPtr, ":", 1);
- }
- name = Tcl_DStringValue(headPtr);
- if (TclpAccess(name, F_OK) == 0) {
- if ((name[1] != '\0') && (strchr(name+1, ':') == NULL)) {
- Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp),
- Tcl_NewStringObj(name + 1,-1));
- } else {
- Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp),
- Tcl_NewStringObj(name,-1));
+ switch (tclPlatform) {
+ case TCL_PLATFORM_MAC: {
+ if (strchr(Tcl_DStringValue(headPtr), ':') == NULL) {
+ Tcl_DStringAppend(headPtr, ":", 1);
}
+ macSpecialCase = 1;
+ break;
}
- break;
- }
- case TCL_PLATFORM_WINDOWS: {
- int exists;
-
- /*
- * We need to convert slashes to backslashes before checking
- * for the existence of the file. Once we are done, we need
- * to convert the slashes back.
- */
-
- if (Tcl_DStringLength(headPtr) == 0) {
- if (((*name == '\\') && (name[1] == '/' || name[1] == '\\'))
- || (*name == '/')) {
- Tcl_DStringAppend(headPtr, "\\", 1);
- } else {
- Tcl_DStringAppend(headPtr, ".", 1);
+ case TCL_PLATFORM_WINDOWS: {
+ if (Tcl_DStringLength(headPtr) == 0) {
+ if (((*name == '\\') && (name[1] == '/' || name[1] == '\\'))
+ || (*name == '/')) {
+ Tcl_DStringAppend(headPtr, "\\", 1);
+ } else {
+ Tcl_DStringAppend(headPtr, ".", 1);
+ }
}
- } else {
+ /*
+ * Convert to forward slashes. This is required to pass
+ * some Tcl tests. We should probably remove the conversions
+ * here and in tclWinFile.c, since they aren't needed since
+ * the dropping of support for Win32s.
+ */
for (p = Tcl_DStringValue(headPtr); *p != '\0'; p++) {
- if (*p == '/') {
- *p = '\\';
+ if (*p == '\\') {
+ *p = '/';
}
}
+ break;
}
- name = Tcl_DStringValue(headPtr);
- exists = (TclpAccess(name, F_OK) == 0);
-
- for (p = name; *p != '\0'; p++) {
- if (*p == '\\') {
- *p = '/';
+ case TCL_PLATFORM_UNIX: {
+ if (Tcl_DStringLength(headPtr) == 0) {
+ if ((*name == '\\' && name[1] == '/') || (*name == '/')) {
+ Tcl_DStringAppend(headPtr, "/", 1);
+ } else {
+ Tcl_DStringAppend(headPtr, ".", 1);
+ }
}
+ break;
}
- if (exists) {
- Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp),
- Tcl_NewStringObj(name,-1));
- }
- break;
}
- case TCL_PLATFORM_UNIX: {
- if (Tcl_DStringLength(headPtr) == 0) {
- if ((*name == '\\' && name[1] == '/') || (*name == '/')) {
- Tcl_DStringAppend(headPtr, "/", 1);
- } else {
- Tcl_DStringAppend(headPtr, ".", 1);
- }
- }
- name = Tcl_DStringValue(headPtr);
- if (TclpAccess(name, F_OK) == 0) {
- Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp),
- Tcl_NewStringObj(name,-1));
- }
- break;
+ /* Common for all platforms */
+ name = Tcl_DStringValue(headPtr);
+ nameObj = Tcl_NewStringObj(name, Tcl_DStringLength(headPtr));
+
+ Tcl_IncrRefCount(nameObj);
+ Tcl_FSMatchInDirectory(interp, Tcl_GetObjResult(interp), nameObj,
+ NULL, types);
+ Tcl_DecrRefCount(nameObj);
+ return TCL_OK;
+ }
+}
+
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclFileDirname
+ *
+ * This procedure calculates the directory above a given
+ * path: basically 'file dirname'. It is used both by
+ * the 'dirname' subcommand of file and by code in tclIOUtil.c.
+ *
+ * Results:
+ * NULL if an error occurred, otherwise a Tcl_Obj owned by
+ * the caller (i.e. most likely with refCount 1).
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tcl_Obj*
+TclFileDirname(interp, pathPtr)
+ Tcl_Interp *interp; /* Used for error reporting */
+ Tcl_Obj *pathPtr; /* Path to take dirname of */
+{
+ int splitElements;
+ Tcl_Obj *splitPtr;
+ Tcl_Obj *splitResultPtr = NULL;
+
+ /*
+ * The behaviour we want here is slightly different to
+ * the standard Tcl_FSSplitPath in the handling of home
+ * directories; Tcl_FSSplitPath preserves the "~" while
+ * this code computes the actual full path name, if we
+ * had just a single component.
+ */
+ splitPtr = Tcl_FSSplitPath(pathPtr, &splitElements);
+ if ((splitElements == 1) && (Tcl_GetString(pathPtr)[0] == '~')) {
+ Tcl_DecrRefCount(splitPtr);
+ splitPtr = Tcl_FSGetNormalizedPath(interp, pathPtr);
+ if (splitPtr == NULL) {
+ return NULL;
}
+ splitPtr = Tcl_FSSplitPath(splitPtr, &splitElements);
}
- return TCL_OK;
+ /*
+ * Return all but the last component. If there is only one
+ * component, return it if the path was non-relative, otherwise
+ * return the current directory.
+ */
+
+ if (splitElements > 1) {
+ splitResultPtr = Tcl_FSJoinPath(splitPtr, splitElements - 1);
+ } else if (splitElements == 0 ||
+ (Tcl_FSGetPathType(pathPtr) == TCL_PATH_RELATIVE)) {
+ splitResultPtr = Tcl_NewStringObj(
+ ((tclPlatform == TCL_PLATFORM_MAC) ? ":" : "."), 1);
+ } else {
+ Tcl_ListObjIndex(NULL, splitPtr, 0, &splitResultPtr);
+ }
+ Tcl_IncrRefCount(splitResultPtr);
+ Tcl_DecrRefCount(splitPtr);
+ return splitResultPtr;
}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_AllocStatBuf
+ *
+ * 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.
+ *
+ * Results:
+ * A pointer to a Tcl_StatBuf which may be deallocated by being
+ * passed to ckfree().
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+Tcl_StatBuf *
+Tcl_AllocStatBuf() {
+ return (Tcl_StatBuf *) ckalloc(sizeof(Tcl_StatBuf));
+}
diff --git a/tcl/generic/tclGet.c b/tcl/generic/tclGet.c
index 72edad8d981..98e7308c015 100644
--- a/tcl/generic/tclGet.c
+++ b/tcl/generic/tclGet.c
@@ -41,11 +41,12 @@
int
Tcl_GetInt(interp, string, intPtr)
Tcl_Interp *interp; /* Interpreter to use for error reporting. */
- char *string; /* String containing a (possibly signed)
+ CONST char *string; /* String containing a (possibly signed)
* integer in a form acceptable to strtol. */
int *intPtr; /* Place to store converted result. */
{
- char *end, *p;
+ char *end;
+ CONST char *p;
long i;
/*
@@ -128,12 +129,13 @@ int
TclGetLong(interp, string, longPtr)
Tcl_Interp *interp; /* Interpreter used for error reporting
* if not NULL. */
- char *string; /* String containing a (possibly signed)
+ CONST char *string; /* String containing a (possibly signed)
* long integer in a form acceptable to
* strtoul. */
long *longPtr; /* Place to store converted long result. */
{
- char *end, *p;
+ char *end;
+ CONST char *p;
long i;
/*
@@ -205,7 +207,7 @@ TclGetLong(interp, string, longPtr)
int
Tcl_GetDouble(interp, string, doublePtr)
Tcl_Interp *interp; /* Interpreter used for error reporting. */
- char *string; /* String containing a floating-point number
+ CONST char *string; /* String containing a floating-point number
* in a form acceptable to strtod. */
double *doublePtr; /* Place to store converted result. */
{
@@ -262,7 +264,7 @@ Tcl_GetDouble(interp, string, doublePtr)
int
Tcl_GetBoolean(interp, string, boolPtr)
Tcl_Interp *interp; /* Interpreter used for error reporting. */
- char *string; /* String containing a boolean number
+ CONST char *string; /* String containing a boolean number
* specified either as 1/0 or true/false or
* yes/no. */
int *boolPtr; /* Place to store converted result, which
@@ -321,4 +323,3 @@ Tcl_GetBoolean(interp, string, boolPtr)
}
return TCL_OK;
}
-
diff --git a/tcl/generic/tclGetDate.y b/tcl/generic/tclGetDate.y
index 33eff627aad..d7f30f17a08 100644
--- a/tcl/generic/tclGetDate.y
+++ b/tcl/generic/tclGetDate.y
@@ -33,7 +33,7 @@
#include "tclInt.h"
#include "tclPort.h"
-#ifdef MAC_TCL
+#if defined(MAC_TCL) && !defined(TCL_MAC_USE_MSL_EPOCH)
# define EPOCH 1904
# define START_OF_TIME 1904
# define END_OF_TIME 2039
@@ -798,6 +798,23 @@ RelativeMonth(Start, RelMonth, TimePtr)
result = Convert(Month, (time_t) tm->tm_mday, Year,
(time_t) tm->tm_hour, (time_t) tm->tm_min, (time_t) tm->tm_sec,
MER24, DSTmaybe, &Julian);
+
+ /*
+ * The Julian time returned above is behind by one day, if "month"
+ * or "year" is used to specify relative time and the GMT flag is true.
+ * This problem occurs only when the current time is closer to
+ * midnight, the difference being not more than its time difference
+ * with GMT. For example, in US/Pacific time zone, the problem occurs
+ * whenever the current time is between midnight to 8:00am or 7:00amDST.
+ * See Bug# 413397 for more details and sample script.
+ * To resolve this bug, we simply add the number of seconds corresponding
+ * to timezone difference with GMT to Julian time, if GMT flag is true.
+ */
+
+ if (TclDateTimezone == 0) {
+ Julian += TclpGetTimeZone((unsigned long) Start) * 60L;
+ }
+
/*
* The following iteration takes into account the case were we jump
* into a "short month". Far example, "one month from Jan 31" will
@@ -1137,4 +1154,3 @@ TclGetDate(p, now, zone, timePtr)
*timePtr = Start;
return 0;
}
-
diff --git a/tcl/generic/tclHash.c b/tcl/generic/tclHash.c
index cc1dcf2e627..277609c2d78 100644
--- a/tcl/generic/tclHash.c
+++ b/tcl/generic/tclHash.c
@@ -16,13 +16,21 @@
#include "tclInt.h"
/*
+ * Prevent macros from clashing with function definitions.
+ */
+
+#if TCL_PRESERVE_BINARY_COMPATABILITY
+# undef Tcl_FindHashEntry
+# undef Tcl_CreateHashEntry
+#endif
+
+/*
* When there are this many entries per bucket, on average, rebuild
* the hash table to make it larger.
*/
#define REBUILD_MULTIPLIER 3
-
/*
* The following macro takes a preliminary integer hash value and
* produces an index into a hash tables bucket list. The idea is
@@ -35,27 +43,86 @@
(((((long) (i))*1103515245) >> (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));
+
+/*
+ * Prototypes for the one word hash key methods.
+ */
+
+#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));
+#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));
+
+/*
* Procedure prototypes for static procedures in this file:
*/
-static Tcl_HashEntry * ArrayFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
- CONST char *key));
-static Tcl_HashEntry * ArrayCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
- CONST char *key, int *newPtr));
+#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));
-static unsigned int HashString _ANSI_ARGS_((CONST char *string));
+#endif
+
static void RebuildTable _ANSI_ARGS_((Tcl_HashTable *tablePtr));
-static Tcl_HashEntry * StringFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
- CONST char *key));
-static Tcl_HashEntry * StringCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
- CONST char *key, int *newPtr));
-static Tcl_HashEntry * OneWordFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
- CONST char *key));
-static Tcl_HashEntry * OneWordCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
- CONST char *key, int *newPtr));
+
+Tcl_HashKeyType tclArrayHashKeyType = {
+ TCL_HASH_KEY_TYPE_VERSION, /* version */
+ TCL_HASH_KEY_RANDOMIZE_HASH, /* flags */
+ HashArrayKey, /* hashKeyProc */
+ CompareArrayKeys, /* compareKeysProc */
+ AllocArrayEntry, /* allocEntryProc */
+ NULL /* freeEntryProc */
+};
+
+Tcl_HashKeyType tclOneWordHashKeyType = {
+ TCL_HASH_KEY_TYPE_VERSION, /* version */
+ 0, /* flags */
+ NULL, /* HashOneWordKey, */ /* hashProc */
+ NULL, /* CompareOneWordKey, */ /* compareProc */
+ NULL, /* AllocOneWordKey, */ /* allocEntryProc */
+ NULL /* FreeOneWordKey, */ /* freeEntryProc */
+};
+
+Tcl_HashKeyType tclStringHashKeyType = {
+ TCL_HASH_KEY_TYPE_VERSION, /* version */
+ 0, /* flags */
+ HashStringKey, /* hashKeyProc */
+ CompareStringKeys, /* compareKeysProc */
+ AllocStringEntry, /* allocEntryProc */
+ NULL /* freeEntryProc */
+};
+
/*
*----------------------------------------------------------------------
@@ -75,6 +142,7 @@ static Tcl_HashEntry * OneWordCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
*----------------------------------------------------------------------
*/
+#undef Tcl_InitHashTable
void
Tcl_InitHashTable(tablePtr, keyType)
register Tcl_HashTable *tablePtr; /* Pointer to table record, which
@@ -83,8 +151,48 @@ Tcl_InitHashTable(tablePtr, keyType)
* TCL_STRING_KEYS, TCL_ONE_WORD_KEYS,
* or an integer >= 2. */
{
+ /*
+ * Use a special value to inform the extended version that it must
+ * not access any of the new fields in the Tcl_HashTable. If an
+ * extension is rebuilt then any calls to this function will be
+ * redirected to the extended version by a macro.
+ */
+ Tcl_InitCustomHashTable(tablePtr, keyType, (Tcl_HashKeyType *) -1);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_InitCustomHashTable --
+ *
+ * Given storage for a hash table, set up the fields to prepare
+ * the hash table for use. This is an extended version of
+ * Tcl_InitHashTable which supports user defined keys.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * TablePtr is now ready to be passed to Tcl_FindHashEntry and
+ * Tcl_CreateHashEntry.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+{
#if (TCL_SMALL_HASH_TABLE != 4)
- panic("Tcl_InitHashTable: TCL_SMALL_HASH_TABLE is %d, not 4\n",
+ panic("Tcl_InitCustomHashTable: TCL_SMALL_HASH_TABLE is %d, not 4\n",
TCL_SMALL_HASH_TABLE);
#endif
@@ -97,16 +205,280 @@ Tcl_InitHashTable(tablePtr, keyType)
tablePtr->downShift = 28;
tablePtr->mask = 3;
tablePtr->keyType = keyType;
- if (keyType == TCL_STRING_KEYS) {
- tablePtr->findProc = StringFind;
- tablePtr->createProc = StringCreate;
- } else if (keyType == TCL_ONE_WORD_KEYS) {
- tablePtr->findProc = OneWordFind;
- tablePtr->createProc = OneWordCreate;
+#if TCL_PRESERVE_BINARY_COMPATABILITY
+ tablePtr->findProc = Tcl_FindHashEntry;
+ tablePtr->createProc = Tcl_CreateHashEntry;
+
+ if (typePtr == NULL) {
+ /*
+ * The caller has been rebuilt so the hash table is an extended
+ * version.
+ */
+ } else if (typePtr != (Tcl_HashKeyType *) -1) {
+ /*
+ * The caller is requesting a customized hash table so it must be
+ * an extended version.
+ */
+ tablePtr->typePtr = typePtr;
+ } else {
+ /*
+ * 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
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FindHashEntry --
+ *
+ * Given a hash table find the entry with a matching key.
+ *
+ * Results:
+ * The return value is a token for the matching entry in the
+ * hash table, or NULL if there was no matching entry.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+{
+ 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.
+ */
+
+ if (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 (typePtr->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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateHashEntry --
+ *
+ * Given a hash table with string keys, and a string key, find
+ * the entry with a matching key. If there is no matching entry,
+ * then create a new entry that does match.
+ *
+ * Results:
+ * The return value is a pointer to the matching entry. If this
+ * is a newly-created entry, then *newPtr will be set to a non-zero
+ * value; otherwise *newPtr will be set to 0. If this is a new
+ * entry the value stored in the entry will initially be 0.
+ *
+ * Side effects:
+ * A new entry may be added to the hash table.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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
+ * entry. */
+ int *newPtr; /* Store info here telling whether a new
+ * entry was created. */
+{
+ 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_CreateHashEntry 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.
+ */
+
+ if (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 (typePtr->compareKeysProc ((VOID *) key, hPtr)) {
+ *newPtr = 0;
+ 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) {
+ *newPtr = 0;
+ return hPtr;
+ }
+ }
+ }
+
+ /*
+ * Entry not found. Add a new one to the bucket.
+ */
+
+ *newPtr = 1;
+ if (typePtr->allocEntryProc) {
+ hPtr = typePtr->allocEntryProc (tablePtr, (VOID *) key);
} else {
- tablePtr->findProc = ArrayFind;
- tablePtr->createProc = ArrayCreate;
- };
+ hPtr = (Tcl_HashEntry *) ckalloc((unsigned) sizeof(Tcl_HashEntry));
+ hPtr->key.oneWordValue = (char *) key;
+ }
+
+ hPtr->tablePtr = tablePtr;
+#if TCL_HASH_KEY_STORE_HASH
+# if TCL_PRESERVE_BINARY_COMPATABILITY
+ hPtr->hash = (VOID *) hash;
+# else
+ hPtr->hash = hash;
+# endif
+ hPtr->nextPtr = tablePtr->buckets[index];
+ tablePtr->buckets[index] = hPtr;
+#else
+ hPtr->bucketPtr = &(tablePtr->buckets[index]);
+ hPtr->nextPtr = *hPtr->bucketPtr;
+ *hPtr->bucketPtr = hPtr;
+#endif
+ hPtr->clientData = 0;
+ tablePtr->numEntries++;
+
+ /*
+ * If the table has exceeded a decent size, rebuild it with many
+ * more buckets.
+ */
+
+ if (tablePtr->numEntries >= tablePtr->rebuildSize) {
+ RebuildTable(tablePtr);
+ }
+ return hPtr;
}
/*
@@ -133,11 +505,47 @@ Tcl_DeleteHashEntry(entryPtr)
Tcl_HashEntry *entryPtr;
{
register Tcl_HashEntry *prevPtr;
+ Tcl_HashKeyType *typePtr;
+ Tcl_HashTable *tablePtr;
+ Tcl_HashEntry **bucketPtr;
+#if TCL_HASH_KEY_STORE_HASH
+ int index;
+#endif
+
+ tablePtr = entryPtr->tablePtr;
- if (*entryPtr->bucketPtr == entryPtr) {
- *entryPtr->bucketPtr = entryPtr->nextPtr;
+#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;
+#endif
+
+#if TCL_HASH_KEY_STORE_HASH
+ if (typePtr->hashKeyProc == NULL
+ || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
+ index = RANDOM_INDEX (tablePtr, entryPtr->hash);
+ } else {
+ index = ((unsigned int) entryPtr->hash) & tablePtr->mask;
+ }
+
+ bucketPtr = &(tablePtr->buckets[index]);
+#else
+ bucketPtr = entryPtr->bucketPtr;
+#endif
+
+ if (*bucketPtr == entryPtr) {
+ *bucketPtr = entryPtr->nextPtr;
} else {
- for (prevPtr = *entryPtr->bucketPtr; ; prevPtr = prevPtr->nextPtr) {
+ for (prevPtr = *bucketPtr; ; prevPtr = prevPtr->nextPtr) {
if (prevPtr == NULL) {
panic("malformed bucket chain in Tcl_DeleteHashEntry");
}
@@ -147,8 +555,13 @@ Tcl_DeleteHashEntry(entryPtr)
}
}
}
- entryPtr->tablePtr->numEntries--;
- ckfree((char *) entryPtr);
+
+ tablePtr->numEntries--;
+ if (typePtr->freeEntryProc) {
+ typePtr->freeEntryProc (entryPtr);
+ } else {
+ ckfree((char *) entryPtr);
+ }
}
/*
@@ -173,8 +586,24 @@ Tcl_DeleteHashTable(tablePtr)
register Tcl_HashTable *tablePtr; /* Table to delete. */
{
register Tcl_HashEntry *hPtr, *nextPtr;
+ 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) {
+ 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;
+#endif
+
/*
* Free up all the entries in the table.
*/
@@ -183,7 +612,11 @@ Tcl_DeleteHashTable(tablePtr)
hPtr = tablePtr->buckets[i];
while (hPtr != NULL) {
nextPtr = hPtr->nextPtr;
- ckfree((char *) hPtr);
+ if (typePtr->freeEntryProc) {
+ typePtr->freeEntryProc (hPtr);
+ } else {
+ ckfree((char *) hPtr);
+ }
hPtr = nextPtr;
}
}
@@ -201,8 +634,12 @@ Tcl_DeleteHashTable(tablePtr)
* re-initialization.
*/
+#if TCL_PRESERVE_BINARY_COMPATABILITY
tablePtr->findProc = BogusFind;
tablePtr->createProc = BogusCreate;
+#else
+ tablePtr->typePtr = NULL;
+#endif
}
/*
@@ -299,7 +736,7 @@ Tcl_NextHashEntry(searchPtr)
*----------------------------------------------------------------------
*/
-char *
+CONST char *
Tcl_HashStats(tablePtr)
Tcl_HashTable *tablePtr; /* Table for which to produce stats. */
{
@@ -355,14 +792,12 @@ Tcl_HashStats(tablePtr)
/*
*----------------------------------------------------------------------
*
- * HashString --
+ * AllocArrayEntry --
*
- * Compute a one-word summary of a text string, which can be
- * used to generate a hash index.
+ * Allocate space for a Tcl_HashEntry containing the array key.
*
* Results:
- * The return value is a one-word summary of the information in
- * string.
+ * The return value is a pointer to the created entry.
*
* Side effects:
* None.
@@ -370,52 +805,42 @@ Tcl_HashStats(tablePtr)
*----------------------------------------------------------------------
*/
-static unsigned int
-HashString(string)
- register CONST char *string;/* String from which to compute hash value. */
+static Tcl_HashEntry *
+AllocArrayEntry(tablePtr, keyPtr)
+ Tcl_HashTable *tablePtr; /* Hash table. */
+ VOID *keyPtr; /* Key to store in the hash table entry. */
{
- register unsigned int result;
- register int c;
-
- /*
- * 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 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.
- */
+ int *array = (int *) keyPtr;
+ register int *iPtr1, *iPtr2;
+ Tcl_HashEntry *hPtr;
+ int count;
+ unsigned int size;
- result = 0;
- while (1) {
- c = *string;
- string++;
- if (c == 0) {
- break;
- }
- result += (result<<3) + c;
+ count = tablePtr->keyType;
+
+ size = sizeof(Tcl_HashEntry) + (count*sizeof(int)) - sizeof(hPtr->key);
+ if (size < sizeof(Tcl_HashEntry))
+ size = sizeof(Tcl_HashEntry);
+ hPtr = (Tcl_HashEntry *) ckalloc(size);
+
+ for (iPtr1 = array, iPtr2 = hPtr->key.words;
+ count > 0; count--, iPtr1++, iPtr2++) {
+ *iPtr2 = *iPtr1;
}
- return result;
+
+ return hPtr;
}
/*
*----------------------------------------------------------------------
*
- * StringFind --
+ * CompareArrayKeys --
*
- * Given a hash table with string keys, and a string key, find
- * the entry with a matching key.
+ * Compares two array keys.
*
* Results:
- * The return value is a token for the matching entry in the
- * hash table, or NULL if there was no matching entry.
+ * The return value is 0 if they are different and 1 if they are
+ * the same.
*
* Side effects:
* None.
@@ -423,124 +848,38 @@ HashString(string)
*----------------------------------------------------------------------
*/
-static Tcl_HashEntry *
-StringFind(tablePtr, key)
- Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */
- CONST char *key; /* Key to use to find matching entry. */
+static int
+CompareArrayKeys(keyPtr, hPtr)
+ VOID *keyPtr; /* New key to compare. */
+ Tcl_HashEntry *hPtr; /* Existing key to compare. */
{
- register Tcl_HashEntry *hPtr;
- register CONST char *p1, *p2;
- int index;
-
- index = HashString(key) & tablePtr->mask;
-
- /*
- * Search all of the entries in the appropriate bucket.
- */
-
- for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
- hPtr = hPtr->nextPtr) {
- for (p1 = key, p2 = hPtr->key.string; ; p1++, p2++) {
- if (*p1 != *p2) {
- break;
- }
- if (*p1 == '\0') {
- return hPtr;
- }
+ register CONST int *iPtr1 = (CONST int *) keyPtr;
+ register CONST int *iPtr2 = (CONST int *) hPtr->key.words;
+ Tcl_HashTable *tablePtr = hPtr->tablePtr;
+ int count;
+
+ for (count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) {
+ if (count == 0) {
+ return 1;
}
- }
- return NULL;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * StringCreate --
- *
- * Given a hash table with string keys, and a string key, find
- * the entry with a matching key. If there is no matching entry,
- * then create a new entry that does match.
- *
- * Results:
- * The return value is a pointer to the matching entry. If this
- * is a newly-created entry, then *newPtr will be set to a non-zero
- * value; otherwise *newPtr will be set to 0. If this is a new
- * entry the value stored in the entry will initially be 0.
- *
- * Side effects:
- * A new entry may be added to the hash table.
- *
- *----------------------------------------------------------------------
- */
-
-static Tcl_HashEntry *
-StringCreate(tablePtr, key, newPtr)
- 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 was created. */
-{
- register Tcl_HashEntry *hPtr;
- register CONST char *p1, *p2;
- int index;
-
- index = HashString(key) & tablePtr->mask;
-
- /*
- * Search all of the entries in this bucket.
- */
-
- for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
- hPtr = hPtr->nextPtr) {
- for (p1 = key, p2 = hPtr->key.string; ; p1++, p2++) {
- if (*p1 != *p2) {
- break;
- }
- if (*p1 == '\0') {
- *newPtr = 0;
- return hPtr;
- }
+ if (*iPtr1 != *iPtr2) {
+ break;
}
}
-
- /*
- * Entry not found. Add a new one to the bucket.
- */
-
- *newPtr = 1;
- hPtr = (Tcl_HashEntry *) ckalloc((unsigned)
- (sizeof(Tcl_HashEntry) + strlen(key) - (sizeof(hPtr->key) -1)));
- hPtr->tablePtr = tablePtr;
- hPtr->bucketPtr = &(tablePtr->buckets[index]);
- hPtr->nextPtr = *hPtr->bucketPtr;
- hPtr->clientData = 0;
- strcpy(hPtr->key.string, key);
- *hPtr->bucketPtr = hPtr;
- tablePtr->numEntries++;
-
- /*
- * If the table has exceeded a decent size, rebuild it with many
- * more buckets.
- */
-
- if (tablePtr->numEntries >= tablePtr->rebuildSize) {
- RebuildTable(tablePtr);
- }
- return hPtr;
+ return 0;
}
/*
*----------------------------------------------------------------------
*
- * OneWordFind --
+ * HashArrayKey --
*
- * Given a hash table with one-word keys, and a one-word key, find
- * the entry with a matching key.
+ * Compute a one-word summary of an array, which can be
+ * used to generate a hash index.
*
* Results:
- * The return value is a token for the matching entry in the
- * hash table, or NULL if there was no matching entry.
+ * The return value is a one-word summary of the information in
+ * string.
*
* Side effects:
* None.
@@ -548,111 +887,66 @@ StringCreate(tablePtr, key, newPtr)
*----------------------------------------------------------------------
*/
-static Tcl_HashEntry *
-OneWordFind(tablePtr, key)
- Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */
- register CONST char *key; /* Key to use to find matching entry. */
+static unsigned int
+HashArrayKey(tablePtr, keyPtr)
+ Tcl_HashTable *tablePtr; /* Hash table. */
+ VOID *keyPtr; /* Key from which to compute hash value. */
{
- register Tcl_HashEntry *hPtr;
- int index;
-
- index = RANDOM_INDEX(tablePtr, key);
-
- /*
- * Search all of the entries in the appropriate bucket.
- */
+ register CONST int *array = (CONST int *) keyPtr;
+ register unsigned int result;
+ int count;
- for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
- hPtr = hPtr->nextPtr) {
- if (hPtr->key.oneWordValue == key) {
- return hPtr;
- }
+ for (result = 0, count = tablePtr->keyType; count > 0;
+ count--, array++) {
+ result += *array;
}
- return NULL;
+ return result;
}
/*
*----------------------------------------------------------------------
*
- * OneWordCreate --
+ * AllocStringEntry --
*
- * Given a hash table with one-word keys, and a one-word key, find
- * the entry with a matching key. If there is no matching entry,
- * then create a new entry that does match.
+ * Allocate space for a Tcl_HashEntry containing the string key.
*
* Results:
- * The return value is a pointer to the matching entry. If this
- * is a newly-created entry, then *newPtr will be set to a non-zero
- * value; otherwise *newPtr will be set to 0. If this is a new
- * entry the value stored in the entry will initially be 0.
+ * The return value is a pointer to the created entry.
*
* Side effects:
- * A new entry may be added to the hash table.
+ * None.
*
*----------------------------------------------------------------------
*/
static Tcl_HashEntry *
-OneWordCreate(tablePtr, key, newPtr)
- Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */
- register CONST char *key; /* Key to use to find or create matching
- * entry. */
- int *newPtr; /* Store info here telling whether a new
- * entry was created. */
+AllocStringEntry(tablePtr, keyPtr)
+ Tcl_HashTable *tablePtr; /* Hash table. */
+ VOID *keyPtr; /* Key to store in the hash table entry. */
{
- register Tcl_HashEntry *hPtr;
- int index;
-
- index = RANDOM_INDEX(tablePtr, key);
-
- /*
- * Search all of the entries in this bucket.
- */
-
- for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
- hPtr = hPtr->nextPtr) {
- if (hPtr->key.oneWordValue == key) {
- *newPtr = 0;
- return hPtr;
- }
- }
-
- /*
- * Entry not found. Add a new one to the bucket.
- */
-
- *newPtr = 1;
- hPtr = (Tcl_HashEntry *) ckalloc(sizeof(Tcl_HashEntry));
- hPtr->tablePtr = tablePtr;
- hPtr->bucketPtr = &(tablePtr->buckets[index]);
- hPtr->nextPtr = *hPtr->bucketPtr;
- hPtr->clientData = 0;
- hPtr->key.oneWordValue = (char *) key; /* CONST XXXX */
- *hPtr->bucketPtr = hPtr;
- tablePtr->numEntries++;
+ CONST char *string = (CONST char *) keyPtr;
+ Tcl_HashEntry *hPtr;
+ unsigned int size;
- /*
- * If the table has exceeded a decent size, rebuild it with many
- * more buckets.
- */
+ size = sizeof(Tcl_HashEntry) + strlen(string) + 1 - sizeof(hPtr->key);
+ if (size < sizeof(Tcl_HashEntry))
+ size = sizeof(Tcl_HashEntry);
+ hPtr = (Tcl_HashEntry *) ckalloc(size);
+ strcpy(hPtr->key.string, string);
- if (tablePtr->numEntries >= tablePtr->rebuildSize) {
- RebuildTable(tablePtr);
- }
return hPtr;
}
/*
*----------------------------------------------------------------------
*
- * ArrayFind --
+ * CompareStringKeys --
*
- * Given a hash table with array-of-int keys, and a key, find
- * the entry with a matching key.
+ * Compares two string keys.
*
* Results:
- * The return value is a token for the matching entry in the
- * hash table, or NULL if there was no matching entry.
+ * The return value is 0 if they are different and 1 if they are
+ * the same.
*
* Side effects:
* None.
@@ -660,128 +954,81 @@ OneWordCreate(tablePtr, key, newPtr)
*----------------------------------------------------------------------
*/
-static Tcl_HashEntry *
-ArrayFind(tablePtr, key)
- Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */
- CONST char *key; /* Key to use to find matching entry. */
+static int
+CompareStringKeys(keyPtr, hPtr)
+ VOID *keyPtr; /* New key to compare. */
+ Tcl_HashEntry *hPtr; /* Existing key to compare. */
{
- register Tcl_HashEntry *hPtr;
- int *arrayPtr = (int *) key;
- register int *iPtr1, *iPtr2;
- int index, count;
-
- for (index = 0, count = tablePtr->keyType, iPtr1 = arrayPtr;
- count > 0; count--, iPtr1++) {
- index += *iPtr1;
- }
- index = RANDOM_INDEX(tablePtr, index);
-
- /*
- * Search all of the entries in the appropriate bucket.
- */
+ register CONST char *p1 = (CONST char *) keyPtr;
+ register CONST char *p2 = (CONST char *) hPtr->key.string;
- for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
- hPtr = hPtr->nextPtr) {
- for (iPtr1 = arrayPtr, iPtr2 = hPtr->key.words,
- count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) {
- if (count == 0) {
- return hPtr;
- }
- if (*iPtr1 != *iPtr2) {
- break;
- }
+ for (;; p1++, p2++) {
+ if (*p1 != *p2) {
+ break;
+ }
+ if (*p1 == '\0') {
+ return 1;
}
}
- return NULL;
+ return 0;
}
/*
*----------------------------------------------------------------------
*
- * ArrayCreate --
+ * HashStringKey --
*
- * Given a hash table with one-word keys, and a one-word key, find
- * the entry with a matching key. If there is no matching entry,
- * then create a new entry that does match.
+ * Compute a one-word summary of a text string, which can be
+ * used to generate a hash index.
*
* Results:
- * The return value is a pointer to the matching entry. If this
- * is a newly-created entry, then *newPtr will be set to a non-zero
- * value; otherwise *newPtr will be set to 0. If this is a new
- * entry the value stored in the entry will initially be 0.
+ * The return value is a one-word summary of the information in
+ * string.
*
* Side effects:
- * A new entry may be added to the hash table.
+ * None.
*
*----------------------------------------------------------------------
*/
-static Tcl_HashEntry *
-ArrayCreate(tablePtr, key, newPtr)
- Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */
- register CONST char *key; /* Key to use to find or create matching
- * entry. */
- int *newPtr; /* Store info here telling whether a new
- * entry was created. */
+static unsigned int
+HashStringKey(tablePtr, keyPtr)
+ Tcl_HashTable *tablePtr; /* Hash table. */
+ VOID *keyPtr; /* Key from which to compute hash value. */
{
- register Tcl_HashEntry *hPtr;
- int *arrayPtr = (int *) key;
- register int *iPtr1, *iPtr2;
- int index, count;
-
- for (index = 0, count = tablePtr->keyType, iPtr1 = arrayPtr;
- count > 0; count--, iPtr1++) {
- index += *iPtr1;
- }
- index = RANDOM_INDEX(tablePtr, index);
+ register CONST char *string = (CONST char *) keyPtr;
+ register unsigned int result;
+ register int c;
/*
- * Search all of the entries in the appropriate bucket.
+ * 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 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.
*/
- for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
- hPtr = hPtr->nextPtr) {
- for (iPtr1 = arrayPtr, iPtr2 = hPtr->key.words,
- count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) {
- if (count == 0) {
- *newPtr = 0;
- return hPtr;
- }
- if (*iPtr1 != *iPtr2) {
- break;
- }
+ result = 0;
+ while (1) {
+ c = *string;
+ string++;
+ if (c == 0) {
+ break;
}
+ result += (result<<3) + c;
}
-
- /*
- * Entry not found. Add a new one to the bucket.
- */
-
- *newPtr = 1;
- hPtr = (Tcl_HashEntry *) ckalloc((unsigned) (sizeof(Tcl_HashEntry)
- + (tablePtr->keyType*sizeof(int)) - 4));
- hPtr->tablePtr = tablePtr;
- hPtr->bucketPtr = &(tablePtr->buckets[index]);
- hPtr->nextPtr = *hPtr->bucketPtr;
- hPtr->clientData = 0;
- for (iPtr1 = arrayPtr, iPtr2 = hPtr->key.words, count = tablePtr->keyType;
- count > 0; count--, iPtr1++, iPtr2++) {
- *iPtr2 = *iPtr1;
- }
- *hPtr->bucketPtr = hPtr;
- tablePtr->numEntries++;
-
- /*
- * If the table has exceeded a decent size, rebuild it with many
- * more buckets.
- */
-
- if (tablePtr->numEntries >= tablePtr->rebuildSize) {
- RebuildTable(tablePtr);
- }
- return hPtr;
+ return result;
}
+#if TCL_PRESERVE_BINARY_COMPATABILITY
/*
*----------------------------------------------------------------------
*
@@ -840,6 +1087,7 @@ BogusCreate(tablePtr, key, newPtr)
panic("called Tcl_CreateHashEntry on deleted table");
return NULL;
}
+#endif
/*
*----------------------------------------------------------------------
@@ -869,6 +1117,8 @@ RebuildTable(tablePtr)
Tcl_HashEntry **oldBuckets;
register Tcl_HashEntry **oldChainPtr, **newChainPtr;
register Tcl_HashEntry *hPtr;
+ Tcl_HashKeyType *typePtr;
+ VOID *key;
oldSize = tablePtr->numBuckets;
oldBuckets = tablePtr->buckets;
@@ -889,6 +1139,21 @@ RebuildTable(tablePtr)
tablePtr->downShift -= 2;
tablePtr->mask = (tablePtr->mask << 2) + 3;
+#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;
+#endif
+
/*
* Rehash all of the existing entries into the new bucket array.
*/
@@ -896,23 +1161,35 @@ RebuildTable(tablePtr)
for (oldChainPtr = oldBuckets; oldSize > 0; oldSize--, oldChainPtr++) {
for (hPtr = *oldChainPtr; hPtr != NULL; hPtr = *oldChainPtr) {
*oldChainPtr = hPtr->nextPtr;
- if (tablePtr->keyType == TCL_STRING_KEYS) {
- index = HashString(hPtr->key.string) & tablePtr->mask;
- } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
- index = RANDOM_INDEX(tablePtr, hPtr->key.oneWordValue);
- } else {
- register int *iPtr;
- int count;
- for (index = 0, count = tablePtr->keyType,
- iPtr = hPtr->key.words; count > 0; count--, iPtr++) {
- index += *iPtr;
+ key = (VOID *) Tcl_GetHashKey (tablePtr, hPtr);
+
+#if TCL_HASH_KEY_STORE_HASH
+ if (typePtr->hashKeyProc == NULL
+ || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
+ index = RANDOM_INDEX (tablePtr, hPtr->hash);
+ } else {
+ index = ((unsigned int) hPtr->hash) & tablePtr->mask;
+ }
+ hPtr->nextPtr = tablePtr->buckets[index];
+ tablePtr->buckets[index] = hPtr;
+#else
+ if (typePtr->hashKeyProc) {
+ unsigned int hash;
+ hash = typePtr->hashKeyProc (tablePtr, (VOID *) key);
+ if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
+ index = RANDOM_INDEX (tablePtr, hash);
+ } else {
+ index = hash & tablePtr->mask;
}
- index = RANDOM_INDEX(tablePtr, index);
+ } else {
+ index = RANDOM_INDEX (tablePtr, key);
}
+
hPtr->bucketPtr = &(tablePtr->buckets[index]);
hPtr->nextPtr = *hPtr->bucketPtr;
*hPtr->bucketPtr = hPtr;
+#endif
}
}
diff --git a/tcl/generic/tclHistory.c b/tcl/generic/tclHistory.c
index e69f8ca28e7..5ac7bc70748 100644
--- a/tcl/generic/tclHistory.c
+++ b/tcl/generic/tclHistory.c
@@ -42,7 +42,7 @@ int
Tcl_RecordAndEval(interp, cmd, flags)
Tcl_Interp *interp; /* Token for interpreter in which command
* will be executed. */
- char *cmd; /* Command to record. */
+ 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
diff --git a/tcl/generic/tclIO.c b/tcl/generic/tclIO.c
index ab37a1b003d..997d21701c5 100644
--- a/tcl/generic/tclIO.c
+++ b/tcl/generic/tclIO.c
@@ -92,8 +92,7 @@ static int CopyAndTranslateBuffer _ANSI_ARGS_((
ChannelState *statePtr, char *result,
int space));
static int CopyBuffer _ANSI_ARGS_((
- Channel *chanPtr, char *result,
- int space));
+ Channel *chanPtr, char *result, int space));
static int CopyData _ANSI_ARGS_((CopyState *csPtr, int mask));
static void CopyEventProc _ANSI_ARGS_((ClientData clientData,
int mask));
@@ -104,28 +103,36 @@ 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, char *src,
+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));
+ 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,
@@ -134,11 +141,11 @@ 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));
+ 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));
+ 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));
@@ -683,6 +690,38 @@ 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.
+ *
+ * Results:
+ * Returns 1 if true, 0 if false.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+Tcl_IsStandardChannel(chan)
+ Tcl_Channel chan; /* Channel to check. */
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if ((chan == tsdPtr->stdinChannel)
+ || (chan == tsdPtr->stdoutChannel)
+ || (chan == tsdPtr->stderrChannel)) {
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_RegisterChannel --
*
* Adds an already-open channel to the channel table of an interpreter.
@@ -718,7 +757,7 @@ Tcl_RegisterChannel(interp, chan)
chanPtr = ((Channel *) chan)->state->bottomChanPtr;
statePtr = chanPtr->state;
- if (statePtr->channelName == (char *) NULL) {
+ if (statePtr->channelName == (CONST char *) NULL) {
panic("Tcl_RegisterChannel: channel without name");
}
if (interp != (Tcl_Interp *) NULL) {
@@ -743,13 +782,21 @@ 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.
+ * reference count. (This all happens in the Tcl_DetachChannel helper
+ * function).
+ *
+ * Finally, if the reference count of the channel drops to zero,
+ * it is deleted.
*
* Results:
* A standard Tcl result.
*
* Side effects:
- * Deletes the hash entry for a channel associated with an interpreter.
+ * Calls Tcl_DetachChannel which deletes the hash entry for a channel
+ * associated with an interpreter.
+ *
+ * May delete the channel, which can have a variety of consequences,
+ * especially if we are forced to close the channel.
*
*----------------------------------------------------------------------
*/
@@ -759,46 +806,14 @@ Tcl_UnregisterChannel(interp, chan)
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. */
- Channel *chanPtr; /* The real IO channel. */
ChannelState *statePtr; /* State of the real channel. */
- /*
- * 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.
- */
- 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) {
- return TCL_OK;
- }
- hPtr = Tcl_FindHashEntry(hTblPtr, statePtr->channelName);
- if (hPtr == (Tcl_HashEntry *) NULL) {
- return TCL_OK;
- }
- if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) {
- return TCL_OK;
- }
- Tcl_DeleteHashEntry(hPtr);
-
- /*
- * Remove channel handlers that refer to this interpreter, so that they
- * will not be present if the actual close is delayed and more events
- * happen on the channel. This may occur if the channel is shared
- * between several interpreters, or if the channel has async
- * flushing active.
- */
-
- CleanupChannelHandlers(interp, chanPtr);
+ if (DetachChannel(interp, chan) != TCL_OK) {
+ return TCL_OK;
}
-
- statePtr->refCount--;
+ statePtr = ((Channel *) chan)->state->bottomChanPtr->state;
+
/*
* Perform special handling for standard channels being closed. If the
* refCount is now 1 it means that the last reference to the standard
@@ -825,15 +840,145 @@ Tcl_UnregisterChannel(interp, chan)
statePtr->curOutPtr->nextRemoved)) {
statePtr->flags |= BUFFER_READY;
}
- statePtr->flags |= CHANNEL_CLOSED;
+ Tcl_Preserve((ClientData)statePtr);
if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
- if (Tcl_Close(interp, chan) != TCL_OK) {
- return TCL_ERROR;
- }
+ /* We don't want to re-enter Tcl_Close */
+ if (!(statePtr->flags & CHANNEL_CLOSED)) {
+ if (Tcl_Close(interp, chan) != TCL_OK) {
+ statePtr->flags |= CHANNEL_CLOSED;
+ Tcl_Release((ClientData)statePtr);
+ return TCL_ERROR;
+ }
+ }
}
+ statePtr->flags |= CHANNEL_CLOSED;
+ Tcl_Release((ClientData)statePtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DetachChannel --
+ *
+ * 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 originally returned by 'Tcl_OpenFileChannel',
+ * for example.
+ *
+ * This function cannot be used on the standard channels, and
+ * will return TCL_ERROR if that is attempted.
+ *
+ * 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 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. However no error messages are left in the interp's result.
+ *
+ * Side effects:
+ * Deletes the hash entry for a channel associated with an
+ * interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_DetachChannel(interp, chan)
+ Tcl_Interp *interp; /* Interpreter in which channel is defined. */
+ Tcl_Channel chan; /* Channel to delete. */
+{
+ if (Tcl_IsStandardChannel(chan)) {
+ return TCL_ERROR;
+ }
+
+ return DetachChannel(interp, chan);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DetachChannel --
+ *
+ * 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 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. However no error messages are left in the interp's result.
+ *
+ * Side effects:
+ * Deletes the hash entry for a channel associated with an
+ * interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DetachChannel(interp, chan)
+ 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. */
+ Channel *chanPtr; /* The real IO channel. */
+ ChannelState *statePtr; /* State of the real channel. */
+
+ /*
+ * 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.
+ */
+ 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) {
+ return TCL_ERROR;
+ }
+ hPtr = Tcl_FindHashEntry(hTblPtr, statePtr->channelName);
+ if (hPtr == (Tcl_HashEntry *) NULL) {
+ return TCL_ERROR;
+ }
+ if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) {
+ return TCL_ERROR;
+ }
+ Tcl_DeleteHashEntry(hPtr);
+
+ /*
+ * Remove channel handlers that refer to this interpreter, so that they
+ * will not be present if the actual close is delayed and more events
+ * happen on the channel. This may occur if the channel is shared
+ * between several interpreters, or if the channel has async
+ * flushing active.
+ */
+
+ CleanupChannelHandlers(interp, chanPtr);
}
+
+ statePtr->refCount--;
+
return TCL_OK;
}
+
/*
*---------------------------------------------------------------------------
@@ -859,7 +1004,7 @@ Tcl_Channel
Tcl_GetChannel(interp, chanName, modePtr)
Tcl_Interp *interp; /* Interpreter in which to find or create
* the channel. */
- char *chanName; /* The name of the channel. */
+ 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
@@ -868,7 +1013,7 @@ Tcl_GetChannel(interp, chanName, modePtr)
Channel *chanPtr; /* The actual channel. */
Tcl_HashTable *hTblPtr; /* Hash table of channels. */
Tcl_HashEntry *hPtr; /* Search variable. */
- char *name; /* Translated name. */
+ CONST char *name; /* Translated name. */
/*
* Substitute "stdin", etc. Note that even though we immediately
@@ -937,7 +1082,7 @@ Tcl_GetChannel(interp, chanName, modePtr)
Tcl_Channel
Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
Tcl_ChannelType *typePtr; /* The channel type record. */
- char *chanName; /* Name of channel to 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. */
@@ -960,6 +1105,10 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
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->state = statePtr;
@@ -973,8 +1122,9 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
*/
if (chanName != (char *) NULL) {
- statePtr->channelName = ckalloc((unsigned) (strlen(chanName) + 1));
- strcpy(statePtr->channelName, chanName);
+ char *tmp = ckalloc((unsigned) (strlen(chanName) + 1));
+ statePtr->channelName = tmp;
+ strcpy(tmp, chanName);
} else {
panic("Tcl_CreateChannel: NULL channel name");
}
@@ -1044,10 +1194,20 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
* Link the channel into the list of all channels; create an on-exit
* handler if there is not one already, to close off all the channels
* in the list on exit.
+ *
+ * JH: Could call Tcl_SpliceChannel, but need to avoid NULL check.
+ */
+
+ statePtr->nextCSPtr = tsdPtr->firstCSPtr;
+ tsdPtr->firstCSPtr = statePtr;
+
+ /*
+ * TIP #10. Mark the current thread as the one managing the new
+ * channel. Note: 'Tcl_GetCurrentThread' returns sensible
+ * values even for a non-threaded core.
*/
- statePtr->nextCSPtr = tsdPtr->firstCSPtr;
- tsdPtr->firstCSPtr = statePtr;
+ statePtr->managingThread = Tcl_GetCurrentThread ();
/*
* Install this channel in the first empty standard channel slot, if
@@ -1465,6 +1625,32 @@ Tcl_GetChannelInstanceData(chan)
/*
*----------------------------------------------------------------------
*
+ * Tcl_GetChannelThread --
+ *
+ * Given a channel structure, returns the thread managing it.
+ * TIP #10
+ *
+ * Results:
+ * Returns the id of the thread managing the channel.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_ThreadId
+Tcl_GetChannelThread(chan)
+ Tcl_Channel chan; /* The channel to return managing thread for. */
+{
+ Channel *chanPtr = (Channel *) chan; /* The actual channel. */
+
+ return chanPtr->state->managingThread;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_GetChannelType --
*
* Given a channel structure, returns the channel type structure.
@@ -1533,7 +1719,7 @@ Tcl_GetChannelMode(chan)
*----------------------------------------------------------------------
*/
-char *
+CONST char *
Tcl_GetChannelName(chan)
Tcl_Channel chan; /* The channel for which to return the name. */
{
@@ -1657,6 +1843,17 @@ RecycleBuffer(statePtr, bufPtr, mustDiscard)
}
/*
+ * Only save buffers which are at least as big as the requested
+ * buffersize for the channel. This is to honor dynamic changes
+ * of the buffersize made by the user.
+ */
+
+ if ((bufPtr->bufLength - BUFFER_PADDING) < statePtr->bufSize) {
+ ckfree((char *) bufPtr);
+ return;
+ }
+
+ /*
* Only save buffers for the input queue if the channel is readable.
*/
@@ -1865,7 +2062,7 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
toWrite = bufPtr->nextAdded - bufPtr->nextRemoved;
written = (chanPtr->typePtr->outputProc) (chanPtr->instanceData,
- (char *) bufPtr->buf + bufPtr->nextRemoved, toWrite,
+ bufPtr->buf + bufPtr->nextRemoved, toWrite,
&errorCode);
/*
@@ -1916,8 +2113,15 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
} else {
Tcl_SetErrno(errorCode);
if (interp != NULL) {
+
+ /*
+ * Casting away CONST here is safe because the
+ * TCL_VOLATILE flag guarantees CONST treatment
+ * of the Posix error string.
+ */
+
Tcl_SetResult(interp,
- Tcl_PosixError(interp), TCL_VOLATILE);
+ (char *) Tcl_PosixError(interp), TCL_VOLATILE);
}
}
@@ -2012,9 +2216,6 @@ CloseChannel(interp, chanPtr, errorCode)
{
int result = 0; /* Of calling driver close
* operation. */
- ChannelState *prevCSPtr; /* Preceding channel state in list of
- * all states - used to splice a
- * channel out of the list on close. */
ChannelState *statePtr; /* state of the channel stack. */
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -2059,38 +2260,11 @@ CloseChannel(interp, chanPtr, errorCode)
c = (char) statePtr->outEofChar;
(chanPtr->typePtr->outputProc) (chanPtr->instanceData, &c, 1, &dummy);
}
-#if 0
- /*
- * Remove TCL_READABLE and TCL_WRITABLE from statePtr->flags, so
- * that close callbacks can not do input or output (assuming they
- * squirreled the channel away in their clientData). This also
- * prevents infinite loops if the callback calls any C API that
- * could call FlushChannel.
- */
/*
- * This prevents any data from being flushed from stacked channels.
+ * Remove this channel from of the list of all channels.
*/
- statePtr->flags &= (~(TCL_READABLE|TCL_WRITABLE));
-#endif
-
- /*
- * Splice this channel out of the list of all channels.
- */
-
- if (tsdPtr->firstCSPtr && (statePtr == tsdPtr->firstCSPtr)) {
- tsdPtr->firstCSPtr = statePtr->nextCSPtr;
- } else {
- for (prevCSPtr = tsdPtr->firstCSPtr;
- prevCSPtr && (prevCSPtr->nextCSPtr != statePtr);
- prevCSPtr = prevCSPtr->nextCSPtr) {
- /* Empty loop body. */
- }
- if (prevCSPtr == (ChannelState *) NULL) {
- panic("FlushChannel: damaged channel list");
- }
- prevCSPtr->nextCSPtr = statePtr->nextCSPtr;
- }
+ Tcl_CutChannel((Tcl_Channel) chanPtr);
/*
* Close and free the channel driver state.
@@ -2111,7 +2285,7 @@ CloseChannel(interp, chanPtr, errorCode)
if (chanPtr == statePtr->bottomChanPtr) {
if (statePtr->channelName != (char *) NULL) {
- ckfree(statePtr->channelName);
+ ckfree((char *) statePtr->channelName);
statePtr->channelName = NULL;
}
@@ -2148,23 +2322,6 @@ CloseChannel(interp, chanPtr, errorCode)
*/
if (chanPtr->downChanPtr != (Channel *) NULL) {
-#if 0
- int code = TCL_OK;
-
- while (chanPtr->downChanPtr != (Channel *) NULL) {
- /*
- * Unwind the state of the transformation, and then restore the
- * state of (unstack) the underlying channel into the TOP channel
- * structure.
- */
- code = Tcl_UnstackChannel(interp, (Tcl_Channel) chanPtr);
- if (code == TCL_ERROR) {
- errorCode = Tcl_GetErrno();
- break;
- }
- chanPtr = chanPtr->downChanPtr;
- }
-#else
Channel *downChanPtr = chanPtr->downChanPtr;
statePtr->nextCSPtr = tsdPtr->firstCSPtr;
@@ -2176,15 +2333,18 @@ CloseChannel(interp, chanPtr, errorCode)
Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);
return Tcl_Close(interp, (Tcl_Channel) downChanPtr);
-#endif
}
/*
* There is only the TOP Channel, so we free the remaining
- * pointers we have and then ourselves.
+ * pointers we 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
*/
chanPtr->typePtr = NULL;
+ Tcl_EventuallyFree((ClientData) statePtr, TCL_DYNAMIC);
Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);
return errorCode;
@@ -2193,6 +2353,118 @@ CloseChannel(interp, chanPtr, errorCode)
/*
*----------------------------------------------------------------------
*
+ * Tcl_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.
+ *
+ * Results:
+ * Nothing.
+ *
+ * Side effects:
+ * Resets the field 'nextCSPtr' of the specified channel state to NULL.
+ *
+ * NOTE:
+ * The channel to splice out of the list must not be referenced
+ * in any interpreter. This is something this procedure cannot
+ * check (despite the refcount) because the caller usually wants
+ * fiddle with the channel (like transfering it to a different
+ * thread) and thus keeps the refcount artifically high to prevent
+ * its destruction.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_CutChannel(chan)
+ 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 *statePtr = ((Channel *) chan)->state;
+ /* state of the channel stack. */
+
+ /*
+ * Remove this channel from of the list of all channels
+ * (in the current thread).
+ */
+
+ if (tsdPtr->firstCSPtr && (statePtr == tsdPtr->firstCSPtr)) {
+ tsdPtr->firstCSPtr = statePtr->nextCSPtr;
+ } else {
+ for (prevCSPtr = tsdPtr->firstCSPtr;
+ prevCSPtr && (prevCSPtr->nextCSPtr != statePtr);
+ prevCSPtr = prevCSPtr->nextCSPtr) {
+ /* Empty loop body. */
+ }
+ if (prevCSPtr == (ChannelState *) NULL) {
+ panic("FlushChannel: damaged channel list");
+ }
+ prevCSPtr->nextCSPtr = statePtr->nextCSPtr;
+ }
+
+ statePtr->nextCSPtr = (ChannelState *) NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SpliceChannel --
+ *
+ * Adds a channel to the (thread-)global list of all channels
+ * (in that thread). Expects that the field 'nextChanPtr' in
+ * the channel is set to NULL.
+ *
+ * Results:
+ * Nothing.
+ *
+ * Side effects:
+ * Nothing.
+ *
+ * NOTE:
+ * The channel to add to the list must not be referenced in any
+ * interpreter. This is something this procedure cannot check
+ * (despite the refcount) because the caller usually wants figgle
+ * with the channel (like transfering it to a different thread)
+ * and thus keeps the refcount artifically high to prevent its
+ * destruction.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SpliceChannel(chan)
+ 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;
+
+ if (statePtr->nextCSPtr != (ChannelState *) NULL) {
+ panic("Tcl_SpliceChannel: trying to add channel used in different list");
+ }
+
+ statePtr->nextCSPtr = tsdPtr->firstCSPtr;
+ tsdPtr->firstCSPtr = statePtr;
+
+ /*
+ * TIP #10. Mark the current thread as the new one managing this
+ * channel. Note: 'Tcl_GetCurrentThread' returns sensible
+ * values even for a non-threaded core.
+ */
+
+ statePtr->managingThread = Tcl_GetCurrentThread ();
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_Close --
*
* Closes a channel.
@@ -2220,15 +2492,11 @@ Tcl_Close(interp, chan)
* not be referenced in any
* interpreter. */
{
- ChannelHandler *chPtr, *chNext; /* Iterate over channel handlers. */
CloseCallback *cbPtr; /* Iterate over close callbacks
* for this channel. */
- EventScriptRecord *ePtr, *eNextPtr; /* Iterate over eventscript records. */
Channel *chanPtr; /* The real IO channel. */
ChannelState *statePtr; /* State of real IO channel. */
int result; /* Of calling FlushChannel. */
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- NextChannelHandler *nhPtr;
if (chan == (Tcl_Channel) NULL) {
return TCL_OK;
@@ -2257,6 +2525,100 @@ Tcl_Close(interp, chan)
}
/*
+ * 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)
+ && (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) {
+ statePtr->outputEncodingFlags |= TCL_ENCODING_END;
+ WriteChars(chanPtr, "", 0);
+ }
+
+ Tcl_ClearChannelHandlers(chan);
+
+ /*
+ * Invoke the registered close callbacks and delete their records.
+ */
+
+ while (statePtr->closeCbPtr != (CloseCallback *) NULL) {
+ cbPtr = statePtr->closeCbPtr;
+ statePtr->closeCbPtr = cbPtr->nextPtr;
+ (cbPtr->proc) (cbPtr->clientData);
+ ckfree((char *) cbPtr);
+ }
+
+ /*
+ * 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 this channel supports it, close the read side, since we don't need it
+ * anymore and this will help avoid deadlocks on some channel types.
+ */
+
+ if (chanPtr->typePtr->closeProc == TCL_CLOSE2PROC) {
+ result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp,
+ TCL_CLOSE_READ);
+ } else {
+ result = 0;
+ }
+
+ /*
+ * 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.
+ */
+
+ statePtr->flags |= CHANNEL_CLOSED;
+ if ((FlushChannel(interp, chanPtr, 0) != 0) || (result != 0)) {
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ClearChannelHandlers --
+ *
+ * Removes all channel handlers and event scripts from the channel,
+ * cancels all background copies involving the channel and any interest
+ * in events.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * See above. Deallocates memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_ClearChannelHandlers (channel)
+ Tcl_Channel channel;
+{
+ ChannelHandler *chPtr, *chNext; /* Iterate over channel handlers. */
+ EventScriptRecord *ePtr, *eNextPtr; /* Iterate over eventscript records. */
+ Channel *chanPtr; /* The real IO channel. */
+ ChannelState *statePtr; /* State of real IO channel. */
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ NextChannelHandler *nhPtr;
+
+ /*
+ * This operation should occur at the top of a channel stack.
+ */
+
+ chanPtr = (Channel *) channel;
+ statePtr = chanPtr->state;
+ chanPtr = statePtr->topChanPtr;
+
+ /*
* Remove any references to channel handlers for this channel that
* may be about to be invoked.
*/
@@ -2310,50 +2672,6 @@ Tcl_Close(interp, chan)
ckfree((char *) ePtr);
}
statePtr->scriptRecordPtr = (EventScriptRecord *) NULL;
-
- /*
- * Invoke the registered close callbacks and delete their records.
- */
-
- while (statePtr->closeCbPtr != (CloseCallback *) NULL) {
- cbPtr = statePtr->closeCbPtr;
- statePtr->closeCbPtr = cbPtr->nextPtr;
- (cbPtr->proc) (cbPtr->clientData);
- ckfree((char *) cbPtr);
- }
-
- /*
- * 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 this channel supports it, close the read side, since we don't need it
- * anymore and this will help avoid deadlocks on some channel types.
- */
-
- if (chanPtr->typePtr->closeProc == TCL_CLOSE2PROC) {
- result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp,
- TCL_CLOSE_READ);
- } else {
- result = 0;
- }
-
- /*
- * 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.
- */
-
- statePtr->flags |= CHANNEL_CLOSED;
- if ((FlushChannel(interp, chanPtr, 0) != 0) || (result != 0)) {
- return TCL_ERROR;
- }
- return TCL_OK;
}
/*
@@ -2364,7 +2682,10 @@ Tcl_Close(interp, chan)
* Puts 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.
+ * line buffering mode. Compensates stacking, i.e. will redirect the
+ * data from the specified channel to the topmost channel in a stack.
+ *
+ * No encoding conversions are applied to the bytes being read.
*
* Results:
* The number of bytes written or -1 in case of error. If -1,
@@ -2380,7 +2701,7 @@ Tcl_Close(interp, chan)
int
Tcl_Write(chan, src, srcLen)
Tcl_Channel chan; /* The channel to buffer output for. */
- char *src; /* Data to queue in output buffer. */
+ CONST char *src; /* Data to queue in output buffer. */
int srcLen; /* Length of data in bytes, or < 0 for
* strlen(). */
{
@@ -2411,7 +2732,10 @@ Tcl_Write(chan, src, srcLen)
* Puts 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.
+ * line buffering mode. Writes directly to the driver of the channel,
+ * does not compensate for stacking.
+ *
+ * No encoding conversions are applied to the bytes being read.
*
* Results:
* The number of bytes written or -1 in case of error. If -1,
@@ -2427,7 +2751,7 @@ Tcl_Write(chan, src, srcLen)
int
Tcl_WriteRaw(chan, src, srcLen)
Tcl_Channel chan; /* The channel to buffer output for. */
- char *src; /* Data to queue in output buffer. */
+ CONST char *src; /* Data to queue in output buffer. */
int srcLen; /* Length of data in bytes, or < 0 for
* strlen(). */
{
@@ -2467,7 +2791,8 @@ Tcl_WriteRaw(chan, src, srcLen)
* 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.
+ * 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,
@@ -2487,18 +2812,55 @@ Tcl_WriteChars(chan, src, len)
int len; /* Length of string in bytes, or < 0 for
* strlen(). */
{
- /*
- * Always use the topmost channel of the stack
- */
- Channel *chanPtr;
ChannelState *statePtr; /* state info for channel */
statePtr = ((Channel *) chan)->state;
- chanPtr = statePtr->topChanPtr;
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);
}
@@ -2603,7 +2965,7 @@ WriteBytes(chanPtr, src, srcLen)
ChannelState *statePtr = chanPtr->state; /* state info for channel */
ChannelBuffer *bufPtr;
char *dst;
- int dstLen, dstMax, sawLF, savedLF, total, toWrite;
+ int dstMax, sawLF, savedLF, total, dstLen, toWrite;
total = 0;
sawLF = 0;
@@ -2691,8 +3053,9 @@ WriteChars(chanPtr, src, srcLen)
ChannelState *statePtr = chanPtr->state; /* state info for channel */
ChannelBuffer *bufPtr;
char *dst, *stage;
- int saved, savedLF, sawLF, total, toWrite, flags;
- int dstWrote, dstLen, stageLen, stageMax, stageRead;
+ int saved, savedLF, sawLF, total, dstLen, stageMax, dstWrote;
+ int stageLen, toWrite, stageRead, endEncoding, result;
+ int consumedSomething;
Tcl_Encoding encoding;
char safe[BUFFER_PADDING];
@@ -2703,11 +3066,19 @@ WriteChars(chanPtr, src, srcLen)
encoding = statePtr->encoding;
/*
+ * Write the terminated escape sequence even if srcLen is 0.
+ */
+
+ endEncoding = ((statePtr->outputEncodingFlags & TCL_ENCODING_END) != 0);
+
+ /*
* Loop over all UTF-8 characters in src, storing them in staging buffer
* with proper EOL translation.
*/
- while (srcLen + savedLF > 0) {
+ consumedSomething = 1;
+ while (consumedSomething && (srcLen + savedLF + endEncoding > 0)) {
+ consumedSomething = 0;
stage = statePtr->outputStage;
stageMax = statePtr->bufSize;
stageLen = stageMax;
@@ -2742,17 +3113,12 @@ WriteChars(chanPtr, src, srcLen)
src += toWrite;
srcLen -= toWrite;
- flags = statePtr->outputEncodingFlags;
- if (srcLen == 0) {
- flags |= TCL_ENCODING_END;
- }
-
/*
* Loop over all UTF-8 characters in staging buffer, converting them
* to external encoding, storing them in output buffer.
*/
- while (stageLen + saved > 0) {
+ while (stageLen + saved + endEncoding > 0) {
bufPtr = statePtr->curOutPtr;
if (bufPtr == NULL) {
bufPtr = AllocChannelBuffer(statePtr->bufSize);
@@ -2775,10 +3141,31 @@ WriteChars(chanPtr, src, srcLen)
saved = 0;
}
- Tcl_UtfToExternal(NULL, encoding, stage, stageLen, flags,
+ result = Tcl_UtfToExternal(NULL, encoding, stage, stageLen,
+ statePtr->outputEncodingFlags,
&statePtr->outputEncodingState, dst,
dstLen + BUFFER_PADDING, &stageRead, &dstWrote, NULL);
- if (stageRead + dstWrote == 0) {
+
+ /* 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;
+ /*
+ * The following code must be executed only when result is not 0.
+ */
+ if (result && ((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
@@ -2814,8 +3201,29 @@ WriteChars(chanPtr, src, srcLen)
stage += stageRead;
stageLen -= stageRead;
sawLF = 0;
+
+ consumedSomething = 1;
+
+ /*
+ * If all translated characters are written to the buffer,
+ * endEncoding is set to 0 because the escape sequence may be
+ * output.
+ */
+
+ if ((stageLen + saved == 0) && (result == 0)) {
+ endEncoding = 0;
+ }
}
}
+
+ /* 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;
}
@@ -3075,11 +3483,10 @@ Tcl_GetsObj(chan, objPtr)
Channel *chanPtr = (Channel *) chan;
ChannelState *statePtr = chanPtr->state; /* state info for channel */
ChannelBuffer *bufPtr;
- int inEofChar, skip, copiedTotal;
+ int inEofChar, skip, copiedTotal, oldLength, oldFlags, oldRemoved;
Tcl_Encoding encoding;
char *dst, *dstEnd, *eol, *eof;
Tcl_EncodingState oldState;
- int oldLength, oldFlags, oldRemoved;
/*
* This operation should occur at the top of a channel stack.
@@ -3288,13 +3695,13 @@ Tcl_GetsObj(chan, objPtr)
if (statePtr->flags & CHANNEL_EOF) {
skip = 0;
eol = dstEnd;
- if (eol == objPtr->bytes) {
+ if (eol == objPtr->bytes + oldLength) {
/*
- * If we didn't produce any bytes before encountering EOF,
+ * If we didn't append any bytes before encountering EOF,
* caller needs to see -1.
*/
- Tcl_SetObjLength(objPtr, 0);
+ Tcl_SetObjLength(objPtr, oldLength);
CommonGetsCleanup(chanPtr, encoding);
copiedTotal = -1;
goto done;
@@ -3317,8 +3724,9 @@ Tcl_GetsObj(chan, objPtr)
statePtr->inputEncodingState = gs.state;
Tcl_ExternalToUtf(NULL, gs.encoding, bufPtr->buf + bufPtr->nextRemoved,
gs.rawRead, statePtr->inputEncodingFlags,
- &statePtr->inputEncodingState, dst, eol - dst + skip + TCL_UTF_MAX,
- &gs.rawRead, NULL, &gs.charsWrote);
+ &statePtr->inputEncodingState, dst,
+ eol - dst + skip + TCL_UTF_MAX, &gs.rawRead, NULL,
+ &gs.charsWrote);
bufPtr->nextRemoved += gs.rawRead;
/*
@@ -3409,7 +3817,7 @@ FilterInputBytes(chanPtr, gsPtr)
char *dst;
int offset, toRead, dstNeeded, spaceLeft, result, rawLen, length;
Tcl_Obj *objPtr;
-#define ENCODING_LINESIZE 30 /* Lower bound on how many bytes to convert
+#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
@@ -3438,7 +3846,7 @@ FilterInputBytes(chanPtr, gsPtr)
* seen 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) {
@@ -3491,7 +3899,14 @@ FilterInputBytes(chanPtr, gsPtr)
result = Tcl_ExternalToUtf(NULL, gsPtr->encoding, raw, rawLen,
statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
dst, spaceLeft, &gsPtr->rawRead, &gsPtr->bytesWrote,
- &gsPtr->charsWrote);
+ &gsPtr->charsWrote);
+
+ /*
+ * Make sure that if we go through 'gets', that we reset the
+ * TCL_ENCODING_START flag still. [Bug #523988]
+ */
+ statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
+
if (result == TCL_CONVERT_MULTIBYTE) {
/*
* The last few bytes in this channel buffer were the start of a
@@ -3762,7 +4177,7 @@ 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. */
+ char *bufPtr; /* Where to store input read. */
int bytesToRead; /* Maximum number of bytes to read. */
{
Channel *chanPtr = (Channel *) chan;
@@ -3806,17 +4221,23 @@ Tcl_ReadRaw(chan, bufPtr, bytesToRead)
statePtr->flags &= (~(CHANNEL_BLOCKED));
}
- /*
- * 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).
- *
- * The case of 'bytesToRead == 0' at this point cannot happen.
- */
-
- nread = (chanPtr->typePtr->inputProc)(chanPtr->instanceData,
+ if ((statePtr->flags & CHANNEL_TIMER_FEV) &&
+ (statePtr->flags & CHANNEL_NONBLOCKING)) {
+ nread = -1;
+ result = EWOULDBLOCK;
+ } else {
+ /*
+ * 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).
+ *
+ * The case of 'bytesToRead == 0' at this point cannot happen.
+ */
+
+ nread = (chanPtr->typePtr->inputProc)(chanPtr->instanceData,
bufPtr + copied, bytesToRead - copied, &result);
+ }
if (nread > 0) {
/*
* If we get a short read, signal up that we may be
@@ -3893,12 +4314,8 @@ Tcl_ReadChars(chan, objPtr, toRead, appendFlag)
* of the object. */
{
- Channel *chanPtr = (Channel *) chan;
- ChannelState *statePtr = chanPtr->state; /* state info for channel */
- ChannelBuffer *bufPtr;
- int offset, factor, copied, copiedNow, result;
- Tcl_Encoding encoding;
-#define UTF_EXPANSION_FACTOR 1024
+ Channel* chanPtr = (Channel *) chan;
+ ChannelState* statePtr = chanPtr->state; /* state info for channel */
/*
* This operation should occur at the top of a channel stack.
@@ -3907,12 +4324,64 @@ Tcl_ReadChars(chan, objPtr, toRead, appendFlag)
chanPtr = statePtr->topChanPtr;
if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
- copied = -1;
- goto done;
+ /*
+ * Update the notifier state so we don't block while there is still
+ * data in the buffers.
+ */
+ UpdateInterest(chanPtr);
+ return -1;
}
+ return DoReadChars (chanPtr, 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.
+ *
+ * Results:
+ * The number of characters read, or -1 on error. Use Tcl_GetErrno()
+ * to retrieve the error code for the error that occurred.
+ *
+ * Side effects:
+ * May cause input to be buffered.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+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 -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,
+ * the data will replace the existing contents
+ * of the object. */
+
+{
+ ChannelState *statePtr = chanPtr->state; /* state info for channel */
+ ChannelBuffer *bufPtr;
+ int offset, factor, copied, copiedNow, result;
+ Tcl_Encoding encoding;
+#define UTF_EXPANSION_FACTOR 1024
+
+ /*
+ * This operation should occur at the top of a channel stack.
+ */
+
+ chanPtr = statePtr->topChanPtr;
encoding = statePtr->encoding;
- factor = UTF_EXPANSION_FACTOR;
+ factor = UTF_EXPANSION_FACTOR;
if (appendFlag == 0) {
if (encoding == NULL) {
@@ -3951,7 +4420,7 @@ Tcl_ReadChars(chan, objPtr, toRead, appendFlag)
RecycleBuffer(statePtr, bufPtr, 0);
statePtr->inQueueHead = nextPtr;
if (nextPtr == NULL) {
- statePtr->inQueueTail = nextPtr;
+ statePtr->inQueueTail = NULL;
}
}
}
@@ -4023,25 +4492,25 @@ Tcl_ReadChars(chan, objPtr, toRead, appendFlag)
static int
ReadBytes(statePtr, objPtr, bytesToRead, offsetPtr)
ChannelState *statePtr; /* State of the channel to read. */
- int bytesToRead; /* Maximum number of characters to store,
- * or < 0 to get all available characters.
- * Characters are obtained from the first
- * buffer in the queue -- even if this number
- * is larger than the number of characters
- * available in the first buffer, only the
- * characters from the first buffer are
- * returned. */
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 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, filled with how many bytes are now
* being used. */
{
- int toRead, srcLen, srcRead, dstWrote, offset, length;
+ int toRead, srcLen, offset, length, srcRead, dstWrote;
ChannelBuffer *bufPtr;
char *src, *dst;
@@ -4127,6 +4596,10 @@ 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.
+ * 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 -1 to get all available characters.
* Characters are obtained from the first
@@ -4135,10 +4608,6 @@ ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr)
* available in the first buffer, only the
* characters from the first buffer are
* returned. */
- 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 *offsetPtr; /* On input, contains how many bytes of
* objPtr have been used to hold data. On
* output, filled with how many bytes are now
@@ -4149,8 +4618,8 @@ ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr)
* UTF-8. On output, contains another guess
* based on the data seen so far. */
{
- int toRead, factor, offset, spaceLeft, length;
- int srcLen, srcRead, dstNeeded, dstRead, dstWrote, numChars;
+ int toRead, factor, offset, spaceLeft, length, srcLen, dstNeeded;
+ int srcRead, dstWrote, numChars, dstRead;
ChannelBuffer *bufPtr;
char *src, *dst;
Tcl_EncodingState oldState;
@@ -4163,7 +4632,7 @@ ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr)
srcLen = bufPtr->nextAdded - bufPtr->nextRemoved;
toRead = charsToRead;
- if ((unsigned) toRead > (unsigned) srcLen) {
+ if ((unsigned)toRead > (unsigned)srcLen) {
toRead = srcLen;
}
@@ -4245,13 +4714,23 @@ ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr)
nextPtr = bufPtr->nextPtr;
if (nextPtr == NULL) {
- /*
- * 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.
- */
+ if (srcLen > 0) {
+ /*
+ * 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.
+ *
+ * The exception to this is if the input buffer was
+ * completely empty before we tried to convert its
+ * contents. Nothing in, nothing out, and no incomplete
+ * character data. The conversion before the current one
+ * was complete.
+ */
- statePtr->flags |= CHANNEL_NEED_MORE_DATA;
+ statePtr->flags |= CHANNEL_NEED_MORE_DATA;
+ }
return -1;
}
nextPtr->nextRemoved -= srcLen;
@@ -4266,7 +4745,9 @@ ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr)
if (TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead) != 0) {
/*
* Hit EOF char. How many bytes of src correspond to where the
- * EOF was located in dst?
+ * EOF was located in dst? Run the conversion again with an
+ * output buffer just big enough to hold the data so we can
+ * get the correct value for srcRead.
*/
if (dstWrote == 0) {
@@ -4292,7 +4773,7 @@ ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr)
* Got too many chars.
*/
- char *eof;
+ CONST char *eof;
eof = Tcl_UtfAtIndex(dst, toRead);
statePtr->inputEncodingState = oldState;
@@ -4505,7 +4986,7 @@ TranslateInputEOL(statePtr, dstStart, srcStart, dstLenPtr, srcLenPtr)
int
Tcl_Ungets(chan, str, len, atEnd)
Tcl_Channel chan; /* The channel for which to add the input. */
- char *str; /* The input itself. */
+ 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. */
@@ -4754,12 +5235,39 @@ GetInput(chanPtr)
} 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.
+ */
+
+ if ((bufPtr != NULL) && ((bufPtr->bufLength - BUFFER_PADDING) < statePtr->bufSize)) {
+ ckfree((char *) bufPtr);
+ bufPtr = NULL;
+ }
+
if (bufPtr == NULL) {
bufPtr = AllocChannelBuffer(statePtr->bufSize);
}
bufPtr->nextPtr = (ChannelBuffer *) NULL;
- toRead = statePtr->bufSize;
+ /* SF #427196: Use the actual size of the buffer to determine
+ * the number of bytes to read from the channel and not the
+ * size for new buffers. They can be different if the
+ * buffersize was changed between reads.
+ *
+ * Note: This affects performance negatively if the buffersize
+ * was extended but this small buffer is reused for all
+ * subsequent reads. The system never uses buffers with the
+ * requested bigger size in that case. An adjunct patch could
+ * try and delete all unused buffers it encounters and which
+ * are smaller than the formally requested buffersize.
+ */
+
+ toRead = bufPtr->bufLength - bufPtr->nextAdded;
+
if (statePtr->inQueueTail == NULL) {
statePtr->inQueueHead = bufPtr;
} else {
@@ -4767,7 +5275,7 @@ GetInput(chanPtr)
}
statePtr->inQueueTail = bufPtr;
}
-
+
/*
* If EOF is set, we should avoid calling the driver because on some
* platforms it is impossible to read from a device after EOF.
@@ -4777,8 +5285,14 @@ GetInput(chanPtr)
return 0;
}
- nread = (chanPtr->typePtr->inputProc)(chanPtr->instanceData,
- bufPtr->buf + bufPtr->nextAdded, toRead, &result);
+ if ((statePtr->flags & CHANNEL_TIMER_FEV) &&
+ (statePtr->flags & CHANNEL_NONBLOCKING)) {
+ nread = -1;
+ result = EWOULDBLOCK;
+ } else {
+ nread = (chanPtr->typePtr->inputProc)(chanPtr->instanceData,
+ bufPtr->buf + bufPtr->nextAdded, toRead, &result);
+ }
if (nread > 0) {
bufPtr->nextAdded += nread;
@@ -4803,7 +5317,7 @@ GetInput(chanPtr)
}
Tcl_SetErrno(result);
return result;
- }
+ }
return 0;
}
@@ -4825,24 +5339,24 @@ GetInput(chanPtr)
*----------------------------------------------------------------------
*/
-int
+Tcl_WideInt
Tcl_Seek(chan, offset, mode)
Tcl_Channel chan; /* The channel on which to seek. */
- int offset; /* Offset to seek to. */
+ 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 */
- ChannelBuffer *bufPtr;
int inputBuffered, outputBuffered;
+ /* # bytes held in buffers. */
int result; /* Of device driver operations. */
- int curPos; /* Position on the device. */
+ Tcl_WideInt curPos; /* Position on the device. */
int wasAsync; /* Was the channel nonblocking before the
* seek operation? If so, must restore to
* nonblocking mode after the seek. */
if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) {
- return -1;
+ return Tcl_LongAsWide(-1);
}
/*
@@ -4852,7 +5366,9 @@ Tcl_Seek(chan, offset, mode)
* registered in an interpreter.
*/
- if (CheckForDeadChannel(NULL, statePtr)) return -1;
+ if (CheckForDeadChannel(NULL, statePtr)) {
+ return Tcl_LongAsWide(-1);
+ }
/*
* This operation should occur at the top of a channel stack.
@@ -4867,7 +5383,7 @@ Tcl_Seek(chan, offset, mode)
if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) NULL) {
Tcl_SetErrno(EINVAL);
- return -1;
+ return Tcl_LongAsWide(-1);
}
/*
@@ -4875,37 +5391,12 @@ Tcl_Seek(chan, offset, mode)
* output is buffered, cannot compute the current position.
*/
- for (bufPtr = statePtr->inQueueHead, inputBuffered = 0;
- bufPtr != (ChannelBuffer *) NULL;
- bufPtr = bufPtr->nextPtr) {
- inputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
- }
-
- /*
- * Don't forget the bytes in the topmost pushback area.
- */
-
- for (bufPtr = statePtr->topChanPtr->inQueueHead;
- bufPtr != (ChannelBuffer *) NULL;
- bufPtr = bufPtr->nextPtr) {
- inputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
- }
-
- for (bufPtr = statePtr->outQueueHead, outputBuffered = 0;
- bufPtr != (ChannelBuffer *) NULL;
- bufPtr = bufPtr->nextPtr) {
- outputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
- }
- if ((statePtr->curOutPtr != (ChannelBuffer *) NULL) &&
- (statePtr->curOutPtr->nextAdded > statePtr->curOutPtr->nextRemoved)) {
- statePtr->flags |= BUFFER_READY;
- outputBuffered +=
- (statePtr->curOutPtr->nextAdded - statePtr->curOutPtr->nextRemoved);
- }
+ inputBuffered = Tcl_InputBuffered(chan);
+ outputBuffered = Tcl_OutputBuffered(chan);
if ((inputBuffered != 0) && (outputBuffered != 0)) {
Tcl_SetErrno(EFAULT);
- return -1;
+ return Tcl_LongAsWide(-1);
}
/*
@@ -4944,7 +5435,7 @@ Tcl_Seek(chan, offset, mode)
wasAsync = 1;
result = StackSetBlockMode(chanPtr, TCL_MODE_BLOCKING);
if (result != 0) {
- return -1;
+ return Tcl_LongAsWide(-1);
}
statePtr->flags &= (~(CHANNEL_NONBLOCKING));
if (statePtr->flags & BG_FLUSH_SCHEDULED) {
@@ -4966,14 +5457,26 @@ Tcl_Seek(chan, offset, mode)
/*
* Now seek to the new position in the channel as requested by the
- * caller.
+ * caller. Note that we prefer the wideSeekProc if that is
+ * available and non-NULL...
*/
- curPos = (chanPtr->typePtr->seekProc) (chanPtr->instanceData,
- (long) offset, mode, &result);
- if (curPos == -1) {
- Tcl_SetErrno(result);
- }
+ 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)) {
+ Tcl_SetErrno(EOVERFLOW);
+ curPos = Tcl_LongAsWide(-1);
+ } else {
+ curPos = Tcl_LongAsWide((chanPtr->typePtr->seekProc) (
+ chanPtr->instanceData, Tcl_WideAsLong(offset), mode,
+ &result));
+ if (curPos == Tcl_LongAsWide(-1)) {
+ Tcl_SetErrno(result);
+ }
+ }
}
/*
@@ -4987,7 +5490,7 @@ Tcl_Seek(chan, offset, mode)
statePtr->flags |= CHANNEL_NONBLOCKING;
result = StackSetBlockMode(chanPtr, TCL_MODE_NONBLOCKING);
if (result != 0) {
- return -1;
+ return Tcl_LongAsWide(-1);
}
}
@@ -5013,19 +5516,18 @@ Tcl_Seek(chan, offset, mode)
*----------------------------------------------------------------------
*/
-int
+Tcl_WideInt
Tcl_Tell(chan)
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 */
- ChannelBuffer *bufPtr;
- int inputBuffered, outputBuffered;
+ int inputBuffered, outputBuffered; /* # bytes held in buffers. */
int result; /* Of calling device driver. */
- int curPos; /* Position on device. */
+ Tcl_WideInt curPos; /* Position on device. */
if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) {
- return -1;
+ return Tcl_LongAsWide(-1);
}
/*
@@ -5036,7 +5538,7 @@ Tcl_Tell(chan)
*/
if (CheckForDeadChannel(NULL, statePtr)) {
- return -1;
+ return Tcl_LongAsWide(-1);
}
/*
@@ -5052,7 +5554,7 @@ Tcl_Tell(chan)
if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) NULL) {
Tcl_SetErrno(EINVAL);
- return -1;
+ return Tcl_LongAsWide(-1);
}
/*
@@ -5060,43 +5562,78 @@ Tcl_Tell(chan)
* output is buffered, cannot compute the current position.
*/
- for (bufPtr = statePtr->inQueueHead, inputBuffered = 0;
- bufPtr != (ChannelBuffer *) NULL;
- bufPtr = bufPtr->nextPtr) {
- inputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
- }
- for (bufPtr = statePtr->outQueueHead, outputBuffered = 0;
- bufPtr != (ChannelBuffer *) NULL;
- bufPtr = bufPtr->nextPtr) {
- outputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
- }
- if ((statePtr->curOutPtr != (ChannelBuffer *) NULL) &&
- (statePtr->curOutPtr->nextAdded > statePtr->curOutPtr->nextRemoved)) {
- statePtr->flags |= BUFFER_READY;
- outputBuffered +=
- (statePtr->curOutPtr->nextAdded - statePtr->curOutPtr->nextRemoved);
- }
+ inputBuffered = Tcl_InputBuffered(chan);
+ outputBuffered = Tcl_OutputBuffered(chan);
if ((inputBuffered != 0) && (outputBuffered != 0)) {
Tcl_SetErrno(EFAULT);
- return -1;
+ return Tcl_LongAsWide(-1);
}
/*
* Get the current position in the device and compute the position
- * where the next character will be read or written.
+ * where the next character will be read or written. Note that we
+ * prefer the wideSeekProc if that is available and non-NULL...
*/
- curPos = (chanPtr->typePtr->seekProc) (chanPtr->instanceData,
- (long) 0, SEEK_CUR, &result);
- if (curPos == -1) {
+ 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));
+ }
+ if (curPos == Tcl_LongAsWide(-1)) {
Tcl_SetErrno(result);
- return -1;
+ return Tcl_LongAsWide(-1);
}
if (inputBuffered != 0) {
- return (curPos - inputBuffered);
+ return curPos - inputBuffered;
}
- return (curPos + outputBuffered);
+ return curPos + outputBuffered;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * 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 to be supported indefinitely.
+ *
+ * Results:
+ * As for Tcl_Seek and Tcl_Tell respectively, except truncated to
+ * whatever value will fit in an 'int'.
+ *
+ * Side effects:
+ * As for Tcl_Seek and Tcl_Tell respectively.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+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_WideInt wOffset, wResult;
+
+ wOffset = Tcl_LongAsWide((long)offset);
+ wResult = Tcl_Seek(chan, wOffset, mode);
+ return (int)Tcl_WideAsLong(wResult);
+}
+
+int
+Tcl_TellOld(chan)
+ Tcl_Channel chan; /* The channel to return pos for. */
+{
+ Tcl_WideInt wResult;
+
+ wResult = Tcl_Tell(chan);
+ return (int)Tcl_WideAsLong(wResult);
}
/*
@@ -5177,7 +5714,7 @@ CheckChannelErrors(statePtr, flags)
* reading beyond the eofChar). Also, always clear the BLOCKED bit.
* We want to discover these conditions anew in each operation.
*/
-
+
if ((statePtr->flags & CHANNEL_STICKY_EOF) == 0) {
statePtr->flags &= ~CHANNEL_EOF;
}
@@ -5290,6 +5827,48 @@ Tcl_InputBuffered(chan)
/*
*----------------------------------------------------------------------
*
+ * Tcl_OutputBuffered --
+ *
+ * Returns the number of bytes of output currently buffered in the
+ * common internal buffer of a channel.
+ *
+ * Results:
+ * The number of output bytes buffered, or zero if the channel is not
+ * open for writing.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_OutputBuffered(chan)
+ 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);
+ }
+ if ((statePtr->curOutPtr != (ChannelBuffer *) NULL) &&
+ (statePtr->curOutPtr->nextAdded > statePtr->curOutPtr->nextRemoved)) {
+ statePtr->flags |= BUFFER_READY;
+ bytesBuffered +=
+ (statePtr->curOutPtr->nextAdded - statePtr->curOutPtr->nextRemoved);
+ }
+
+ return bytesBuffered;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_ChannelBuffered --
*
* Returns the number of bytes of input currently buffered in the
@@ -5431,8 +6010,8 @@ Tcl_GetChannelBufferSize(chan)
int
Tcl_BadChannelOption(interp, optionName, optionList)
Tcl_Interp *interp; /* Current interpreter. (can be NULL)*/
- char *optionName; /* 'bad option' name */
- char *optionList; /* Specific options list to append
+ 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.
@@ -5441,12 +6020,12 @@ Tcl_BadChannelOption(interp, optionName, optionList)
if (interp) {
CONST char *genericopt =
"blocking buffering buffersize encoding eofchar translation";
- char **argv;
+ CONST char **argv;
int argc, i;
Tcl_DString ds;
Tcl_DStringInit(&ds);
- Tcl_DStringAppend(&ds, (char *) genericopt, -1);
+ Tcl_DStringAppend(&ds, genericopt, -1);
if (optionList && (*optionList)) {
Tcl_DStringAppend(&ds, " ", 1);
Tcl_DStringAppend(&ds, optionList, -1);
@@ -5494,7 +6073,7 @@ 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. */
- char *optionName; /* Option to get. */
+ CONST char *optionName; /* Option to get. */
Tcl_DString *dsPtr; /* Where to store value(s). */
{
size_t len; /* Length of optionName string. */
@@ -5629,6 +6208,10 @@ Tcl_GetChannelOption(interp, chan, optionName, dsPtr)
Tcl_DStringAppendElement(dsPtr, buf);
}
}
+ if ( !(flags & (TCL_READABLE|TCL_WRITABLE))) {
+ /* Not readable or writable (server socket) */
+ Tcl_DStringAppendElement(dsPtr, "");
+ }
if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
(TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
Tcl_DStringEndSublist(dsPtr);
@@ -5669,6 +6252,10 @@ Tcl_GetChannelOption(interp, chan, optionName, dsPtr)
Tcl_DStringAppendElement(dsPtr, "lf");
}
}
+ if ( !(flags & (TCL_READABLE|TCL_WRITABLE))) {
+ /* Not readable or writable (server socket) */
+ Tcl_DStringAppendElement(dsPtr, "auto");
+ }
if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
(TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
Tcl_DStringEndSublist(dsPtr);
@@ -5718,15 +6305,14 @@ 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. */
- char *optionName; /* Which option to set? */
- char *newValue; /* New value for option. */
+ CONST char *optionName; /* Which option to set? */
+ CONST char *newValue; /* New value for option. */
{
- int newMode; /* New (numeric) mode to sert. */
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;
- char **argv;
+ CONST char **argv;
/*
* If the channel is in the middle of a background copy, fail.
@@ -5762,6 +6348,7 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
if ((len > 2) && (optionName[1] == 'b') &&
(strncmp(optionName, "-blocking", len) == 0)) {
+ int newMode;
if (Tcl_GetBoolean(interp, newValue, &newMode) == TCL_ERROR) {
return TCL_ERROR;
}
@@ -5812,6 +6399,15 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
return TCL_ERROR;
}
}
+ /*
+ * 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)
+ && (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) {
+ statePtr->outputEncodingFlags |= TCL_ENCODING_END;
+ WriteChars(chanPtr, "", 0);
+ }
Tcl_FreeEncoding(statePtr->encoding);
statePtr->encoding = encoding;
statePtr->inputEncodingState = NULL;
@@ -5838,8 +6434,8 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
} else if (argc != 2) {
if (interp) {
Tcl_AppendResult(interp,
- "bad value for -eofchar: should be a list of one or",
- " two elements", (char *) NULL);
+ "bad value for -eofchar: should be a list of zero,",
+ " one, or two elements", (char *) NULL);
}
ckfree((char *) argv);
return TCL_ERROR;
@@ -5851,13 +6447,13 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
statePtr->outEofChar = (int) argv[1][0];
}
}
- if (argv != (char **) NULL) {
+ if (argv != NULL) {
ckfree((char *) argv);
}
return TCL_OK;
} else if ((len > 1) && (optionName[1] == 't') &&
(strncmp(optionName, "-translation", len) == 0)) {
- char *readMode, *writeMode;
+ CONST char *readMode, *writeMode;
if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
return TCL_ERROR;
@@ -5880,23 +6476,24 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
}
if (readMode) {
+ TclEolTranslation translation;
if (*readMode == '\0') {
- newMode = statePtr->inputTranslation;
+ translation = statePtr->inputTranslation;
} else if (strcmp(readMode, "auto") == 0) {
- newMode = TCL_TRANSLATE_AUTO;
+ translation = TCL_TRANSLATE_AUTO;
} else if (strcmp(readMode, "binary") == 0) {
- newMode = TCL_TRANSLATE_LF;
+ translation = TCL_TRANSLATE_LF;
statePtr->inEofChar = 0;
Tcl_FreeEncoding(statePtr->encoding);
statePtr->encoding = NULL;
} else if (strcmp(readMode, "lf") == 0) {
- newMode = TCL_TRANSLATE_LF;
+ translation = TCL_TRANSLATE_LF;
} else if (strcmp(readMode, "cr") == 0) {
- newMode = TCL_TRANSLATE_CR;
+ translation = TCL_TRANSLATE_CR;
} else if (strcmp(readMode, "crlf") == 0) {
- newMode = TCL_TRANSLATE_CRLF;
+ translation = TCL_TRANSLATE_CRLF;
} else if (strcmp(readMode, "platform") == 0) {
- newMode = TCL_PLATFORM_TRANSLATION;
+ translation = TCL_PLATFORM_TRANSLATION;
} else {
if (interp) {
Tcl_AppendResult(interp,
@@ -5914,8 +6511,8 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
* complete the line.
*/
- if (newMode != statePtr->inputTranslation) {
- statePtr->inputTranslation = (Tcl_EolTranslation) newMode;
+ if (translation != statePtr->inputTranslation) {
+ statePtr->inputTranslation = translation;
statePtr->flags &= ~(INPUT_SAW_CR);
statePtr->flags &= ~(CHANNEL_NEED_MORE_DATA);
UpdateInterest(chanPtr);
@@ -5932,7 +6529,7 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
* coded later.
*/
- if (strcmp(chanPtr->typePtr->typeName, "tcp") == 0) {
+ if (strcmp(Tcl_ChannelName(chanPtr->typePtr), "tcp") == 0) {
statePtr->outputTranslation = TCL_TRANSLATE_CRLF;
} else {
statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
@@ -6090,7 +6687,6 @@ Tcl_NotifyChannel(channel, mask)
ChannelHandler *chPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
NextChannelHandler nh;
-#ifdef TCL_CHANNEL_VERSION_2
Channel* upChanPtr;
Tcl_ChannelType* upTypePtr;
@@ -6107,17 +6703,13 @@ Tcl_NotifyChannel(channel, mask)
*/
while (mask && (chanPtr->upChanPtr != ((Channel*) NULL))) {
+ Tcl_DriverHandlerProc* upHandlerProc;
+
upChanPtr = chanPtr->upChanPtr;
upTypePtr = upChanPtr->typePtr;
-
- if ((Tcl_ChannelVersion(upTypePtr) == TCL_CHANNEL_VERSION_2) &&
- (Tcl_ChannelHandlerProc(upTypePtr) !=
- ((Tcl_DriverHandlerProc *) NULL))) {
-
- Tcl_DriverHandlerProc* handlerProc =
- Tcl_ChannelHandlerProc(upTypePtr);
-
- mask = (*handlerProc) (upChanPtr->instanceData, mask);
+ upHandlerProc = Tcl_ChannelHandlerProc(upTypePtr);
+ if (upHandlerProc != NULL) {
+ mask = (*upHandlerProc) (upChanPtr->instanceData, mask);
}
/* ELSE:
@@ -6148,6 +6740,7 @@ Tcl_NotifyChannel(channel, mask)
*/
Tcl_Preserve((ClientData) channel);
+ Tcl_Preserve((ClientData) statePtr);
/*
* If we are flushing in the background, be sure to call FlushChannel
@@ -6157,8 +6750,8 @@ Tcl_NotifyChannel(channel, mask)
*/
if ((statePtr->flags & BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) {
- FlushChannel(NULL, chanPtr, 1);
- mask &= ~TCL_WRITABLE;
+ FlushChannel(NULL, chanPtr, 1);
+ mask &= ~TCL_WRITABLE;
}
/*
@@ -6171,19 +6764,18 @@ Tcl_NotifyChannel(channel, mask)
tsdPtr->nestedHandlerPtr = &nh;
for (chPtr = statePtr->chPtr; chPtr != (ChannelHandler *) NULL; ) {
+ /*
+ * If this channel handler is interested in any of the events that
+ * have occurred on the channel, invoke its procedure.
+ */
- /*
- * If this channel handler is interested in any of the events that
- * have occurred on the channel, invoke its procedure.
- */
-
- if ((chPtr->mask & mask) != 0) {
- nh.nextHandlerPtr = chPtr->nextPtr;
- (*(chPtr->proc))(chPtr->clientData, mask);
- chPtr = nh.nextHandlerPtr;
- } else {
- chPtr = chPtr->nextPtr;
- }
+ if ((chPtr->mask & mask) != 0) {
+ nh.nextHandlerPtr = chPtr->nextPtr;
+ (*(chPtr->proc))(chPtr->clientData, mask);
+ chPtr = nh.nextHandlerPtr;
+ } else {
+ chPtr = chPtr->nextPtr;
+ }
}
/*
@@ -6196,82 +6788,10 @@ Tcl_NotifyChannel(channel, mask)
UpdateInterest(chanPtr);
}
+ Tcl_Release((ClientData) statePtr);
Tcl_Release((ClientData) channel);
tsdPtr->nestedHandlerPtr = nh.nestedHandlerPtr;
-#else
- /* Walk all channels in a stack ! and notify them in order.
- */
-
- while (chanPtr != (Channel *) NULL) {
- /*
- * Preserve the channel struct in case the script closes it.
- */
-
- Tcl_Preserve((ClientData) channel);
-
- /*
- * 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 don't call any write handlers before the flush is
- * complete.
- */
-
- if ((statePtr->flags & BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) {
- FlushChannel(NULL, chanPtr, 1);
- mask &= ~TCL_WRITABLE;
- }
-
- /*
- * Add this invocation to the list of recursive invocations of
- * ChannelHandlerEventProc.
- */
-
- nh.nextHandlerPtr = (ChannelHandler *) NULL;
- nh.nestedHandlerPtr = tsdPtr->nestedHandlerPtr;
- tsdPtr->nestedHandlerPtr = &nh;
-
- for (chPtr = statePtr->chPtr; chPtr != (ChannelHandler *) NULL; ) {
-
- /*
- * If this channel handler is interested in any of the events that
- * have occurred on the channel, invoke its procedure.
- */
-
- if ((chPtr->mask & mask) != 0) {
- nh.nextHandlerPtr = chPtr->nextPtr;
- (*(chPtr->proc))(chPtr->clientData, mask);
- chPtr = nh.nextHandlerPtr;
- } else {
- chPtr = chPtr->nextPtr;
- }
- }
-
- /*
- * Update the notifier interest, since it may have changed after
- * invoking event handlers. Skip that if the channel was deleted
- * in the call to the channel handler.
- */
-
- if (chanPtr->typePtr != NULL) {
- UpdateInterest(chanPtr);
-
- /* Walk down the stack.
- */
- chanPtr = chanPtr->downChanPtr;
- } else {
- /* Stop walking the chain, the whole stack was destroyed!
- */
- chanPtr = (Channel *) NULL;
- }
-
- Tcl_Release((ClientData) channel);
-
- tsdPtr->nestedHandlerPtr = nh.nestedHandlerPtr;
-
- channel = (Tcl_Channel) chanPtr;
- }
-#endif
}
/*
@@ -6365,8 +6885,23 @@ ChannelTimerProc(clientData)
statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,
(ClientData) chanPtr);
+
+ /* Set the TIMER flag to notify the higher levels that the
+ * driver might have no data for us. We do this only if we are
+ * in non-blocking mode and the driver has no BlockModeProc
+ * because only then we really don't know if the driver will
+ * block or not. A similar test is done in "PeekAhead".
+ */
+
+ if ((statePtr->flags & CHANNEL_NONBLOCKING) &&
+ (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL)) {
+ statePtr->flags |= CHANNEL_TIMER_FEV;
+ }
+ Tcl_Preserve((ClientData) statePtr);
Tcl_NotifyChannel((Tcl_Channel)chanPtr, TCL_READABLE);
-
+
+ statePtr->flags &= ~CHANNEL_TIMER_FEV;
+ Tcl_Release((ClientData) statePtr);
} else {
statePtr->timer = NULL;
UpdateInterest(chanPtr);
@@ -6756,7 +7291,7 @@ Tcl_FileEventObjCmd(clientData, interp, objc, objv)
char *chanName;
int modeIndex; /* Index of mode argument. */
int mask;
- static char *modeOptions[] = {"readable", "writable", NULL};
+ static CONST char *modeOptions[] = {"readable", "writable", NULL};
static int maskArray[] = {TCL_READABLE, TCL_WRITABLE};
if ((objc != 3) && (objc != 4)) {
@@ -6889,7 +7424,7 @@ TclCopyChannel(interp, inChan, outChan, toRead, cmdPtr)
if (inPtr != outPtr) {
if (nonBlocking != (writeFlags & CHANNEL_NONBLOCKING)) {
if (SetBlockMode(NULL, outPtr,
- nonBlocking ? TCL_MODE_BLOCKING : TCL_MODE_NONBLOCKING)
+ nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING)
!= TCL_OK) {
if (nonBlocking != (readFlags & CHANNEL_NONBLOCKING)) {
SetBlockMode(NULL, inPtr,
@@ -6960,12 +7495,14 @@ CopyData(csPtr, mask)
int mask; /* Current channel event flags. */
{
Tcl_Interp *interp;
- Tcl_Obj *cmdPtr, *errObj = NULL;
+ Tcl_Obj *cmdPtr, *errObj = NULL, *bufObj = NULL;
Tcl_Channel inChan, outChan;
ChannelState *inStatePtr, *outStatePtr;
- int result = TCL_OK;
- int size;
- int total;
+ int result = TCL_OK, size, total, sizeb;
+ char* buffer;
+
+ int inBinary, outBinary, sameEncoding; /* Encoding control */
+ int underflow; /* input underflow */
inChan = (Tcl_Channel) csPtr->readPtr;
outChan = (Tcl_Channel) csPtr->writePtr;
@@ -6982,8 +7519,16 @@ CopyData(csPtr, mask)
* thus gets the bottom of the stack.
*/
- while (csPtr->toRead != 0) {
+ inBinary = (inStatePtr->encoding == NULL);
+ outBinary = (outStatePtr->encoding == NULL);
+ sameEncoding = (inStatePtr->encoding == outStatePtr->encoding);
+
+ if (!(inBinary || sameEncoding)) {
+ bufObj = Tcl_NewObj ();
+ Tcl_IncrRefCount (bufObj);
+ }
+ while (csPtr->toRead != 0) {
/*
* Check for unreported background errors.
*/
@@ -7004,11 +7549,17 @@ CopyData(csPtr, mask)
*/
if ((csPtr->toRead == -1) || (csPtr->toRead > csPtr->bufSize)) {
- size = csPtr->bufSize;
+ sizeb = csPtr->bufSize;
} else {
- size = csPtr->toRead;
+ sizeb = csPtr->toRead;
}
- size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, size);
+
+ if (inBinary || sameEncoding) {
+ size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb);
+ } else {
+ size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb, 0 /* No append */);
+ }
+ underflow = (size >= 0) && (size < sizeb); /* input underflow */
if (size < 0) {
readError:
@@ -7017,16 +7568,17 @@ CopyData(csPtr, mask)
Tcl_GetChannelName(inChan), "\": ",
Tcl_PosixError(interp), (char *) NULL);
break;
- } else if (size == 0) {
+ } 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.
*/
- if (Tcl_Eof(inChan)) {
+ if ((size == 0) && Tcl_Eof(inChan)) {
break;
- } else if (!(mask & TCL_READABLE)) {
+ }
+ if (! Tcl_Eof(inChan) && !(mask & TCL_READABLE)) {
if (mask & TCL_WRITABLE) {
Tcl_DeleteChannelHandler(outChan, CopyEventProc,
(ClientData) csPtr);
@@ -7034,15 +7586,38 @@ CopyData(csPtr, mask)
Tcl_CreateChannelHandler(inChan, TCL_READABLE,
CopyEventProc, (ClientData) csPtr);
}
- return TCL_OK;
+ if (size == 0) {
+ if (bufObj != (Tcl_Obj*) NULL) {
+ Tcl_DecrRefCount (bufObj);
+ bufObj = (Tcl_Obj*) NULL;
+ }
+ return TCL_OK;
+ }
}
/*
* Now write the buffer out.
*/
- size = DoWrite(outStatePtr->topChanPtr, csPtr->buffer, size);
- if (size < 0) {
+ if (inBinary || sameEncoding) {
+ buffer = csPtr->buffer;
+ sizeb = size;
+ } else {
+ buffer = Tcl_GetStringFromObj (bufObj, &sizeb);
+ }
+
+ if (outBinary || sameEncoding) {
+ sizeb = DoWrite(outStatePtr->topChanPtr, buffer, sizeb);
+ } else {
+ sizeb = DoWriteChars(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 */
+
+ if (sizeb < 0) {
writeError:
errObj = Tcl_NewObj();
Tcl_AppendStringsToObj(errObj, "error writing \"",
@@ -7052,32 +7627,49 @@ CopyData(csPtr, mask)
}
/*
+ * Update the current byte count. Do it now so the count is
+ * valid before a return or break takes us out of the loop.
+ * The invariant at the top of the loop should be that
+ * csPtr->toRead holds the number of bytes left to copy.
+ */
+
+ if (csPtr->toRead != -1) {
+ csPtr->toRead -= size;
+ }
+ csPtr->total += size;
+
+ /*
+ * Break loop if EOF && (size>0)
+ */
+
+ if (Tcl_Eof(inChan)) {
+ break;
+ }
+
+ /*
* 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 (outStatePtr->flags & BG_FLUSH_SCHEDULED) {
+ if ( ! underflow && (outStatePtr->flags & BG_FLUSH_SCHEDULED) ) {
if (!(mask & TCL_WRITABLE)) {
if (mask & TCL_READABLE) {
- Tcl_DeleteChannelHandler(outChan, CopyEventProc,
+ Tcl_DeleteChannelHandler(inChan, CopyEventProc,
(ClientData) csPtr);
}
Tcl_CreateChannelHandler(outChan, TCL_WRITABLE,
CopyEventProc, (ClientData) csPtr);
}
+ if (bufObj != (Tcl_Obj*) NULL) {
+ Tcl_DecrRefCount (bufObj);
+ bufObj = (Tcl_Obj*) NULL;
+ }
return TCL_OK;
}
/*
- * Update the current byte count if we care.
- */
-
- if (csPtr->toRead != -1) {
- csPtr->toRead -= size;
- }
- csPtr->total += size;
-
- /*
* For background copies, we only do one buffer per invocation so
* we don't starve the rest of the system.
*/
@@ -7092,8 +7684,17 @@ CopyData(csPtr, mask)
Tcl_CreateChannelHandler(outChan, TCL_WRITABLE,
CopyEventProc, (ClientData) csPtr);
}
+ if (bufObj != (Tcl_Obj*) NULL) {
+ Tcl_DecrRefCount (bufObj);
+ bufObj = (Tcl_Obj*) NULL;
+ }
return TCL_OK;
}
+ } /* while */
+
+ if (bufObj != (Tcl_Obj*) NULL) {
+ Tcl_DecrRefCount (bufObj);
+ bufObj = (Tcl_Obj*) NULL;
}
/*
@@ -7144,6 +7745,8 @@ CopyData(csPtr, mask)
*
* 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 retrieve the error code for the error that occurred.
@@ -7568,14 +8171,14 @@ CopyBuffer(chanPtr, result, space)
static int
DoWrite(chanPtr, src, srcLen)
Channel *chanPtr; /* The channel to buffer output for. */
- char *src; /* Data to write. */
+ 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;
- char *sPtr; /* Search variables for newline. */
+ 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
@@ -7769,6 +8372,7 @@ StopCopy(csPtr)
nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
}
if (csPtr->readPtr != csPtr->writePtr) {
+ nonBlocking = (csPtr->writeFlags & CHANNEL_NONBLOCKING);
if (nonBlocking != (outStatePtr->flags & CHANNEL_NONBLOCKING)) {
SetBlockMode(NULL, csPtr->writePtr,
nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
@@ -7926,17 +8530,32 @@ Tcl_GetChannelNames(interp)
int
Tcl_GetChannelNamesEx(interp, pattern)
Tcl_Interp *interp; /* Interp for error reporting. */
- char *pattern; /* pattern to filter on. */
+ CONST char *pattern; /* pattern to filter on. */
{
- ChannelState *statePtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- char *name;
- Tcl_Obj *resultPtr;
+ ChannelState *statePtr;
+ 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. */
- resultPtr = Tcl_GetObjResult(interp);
- for (statePtr = tsdPtr->firstCSPtr;
- statePtr != NULL;
- statePtr = statePtr->nextCSPtr) {
+ if (interp == (Tcl_Interp *) NULL) {
+ return TCL_OK;
+ }
+
+ /*
+ * Get the channel table that stores the channels registered
+ * for this interpreter.
+ */
+ hTblPtr = GetChannelTable(interp);
+ resultPtr = Tcl_GetObjResult(interp);
+
+ for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
+ hPtr != (Tcl_HashEntry *) 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) {
@@ -7944,8 +8563,13 @@ Tcl_GetChannelNamesEx(interp, pattern)
} else if (statePtr->topChanPtr == (Channel *) tsdPtr->stderrChannel) {
name = "stderr";
} else {
+ /*
+ * This is also stored in Tcl_GetHashKey(hTblPtr, hPtr),
+ * but it's simpler to just grab the name from the statePtr.
+ */
name = statePtr->channelName;
}
+
if (((pattern == NULL) || Tcl_StringMatch(name, pattern)) &&
(Tcl_ListObjAppendElement(interp, resultPtr,
Tcl_NewStringObj(name, -1)) != TCL_OK)) {
@@ -7958,6 +8582,131 @@ Tcl_GetChannelNamesEx(interp, pattern)
/*
*----------------------------------------------------------------------
*
+ * Tcl_IsChannelRegistered --
+ *
+ * Checks whether the channel is associated with the interp.
+ * See also Tcl_RegisterChannel and Tcl_UnregisterChannel.
+ *
+ * Results:
+ * 0 if the channel is not registered in the interpreter, 1 else.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_IsChannelRegistered (interp, chan)
+ 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. */
+
+ /*
+ * 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) {
+ return 0;
+ }
+ hPtr = Tcl_FindHashEntry(hTblPtr, statePtr->channelName);
+ if (hPtr == (Tcl_HashEntry *) NULL) {
+ return 0;
+ }
+ if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) {
+ return 0;
+ }
+
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_IsChannelShared --
+ *
+ * Checks whether the channel is shared by multiple interpreters.
+ *
+ * Results:
+ * A boolean value (0 = Not shared, 1 = Shared).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_IsChannelShared (chan)
+ Tcl_Channel chan; /* The channel to query */
+{
+ ChannelState *statePtr = ((Channel *) chan)->state;
+ /* State of real channel structure. */
+
+ return ((statePtr->refCount > 1) ? 1 : 0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_IsChannelExisting --
+ *
+ * Checks whether a channel of the given name exists in the
+ * (thread)-global list of all channels.
+ * See Tcl_GetChannelNamesEx for function exposed at the Tcl level.
+ *
+ * Results:
+ * A boolean value (0 = Does not exist, 1 = Does exist).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_IsChannelExisting(chanName)
+ CONST char* chanName; /* The name of the channel to look for. */
+{
+ ChannelState *statePtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ CONST char *name;
+ int chanNameLen;
+
+ chanNameLen = strlen(chanName);
+ for (statePtr = tsdPtr->firstCSPtr;
+ statePtr != NULL;
+ statePtr = statePtr->nextCSPtr) {
+ if (statePtr->topChanPtr == (Channel *) tsdPtr->stdinChannel) {
+ name = "stdin";
+ } else if (statePtr->topChanPtr == (Channel *) tsdPtr->stdoutChannel) {
+ name = "stdout";
+ } else if (statePtr->topChanPtr == (Channel *) tsdPtr->stderrChannel) {
+ name = "stderr";
+ } else {
+ name = statePtr->channelName;
+ }
+
+ if ((*chanName == *name) &&
+ (memcmp(name, chanName, (size_t) chanNameLen) == 0)) {
+ return 1;
+ }
+ }
+
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_ChannelName --
*
* Return the name of the channel type.
@@ -7971,11 +8720,11 @@ Tcl_GetChannelNamesEx(interp, pattern)
*----------------------------------------------------------------------
*/
-char *
+CONST char *
Tcl_ChannelName(chanTypePtr)
Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
{
- return (chanTypePtr->typeName);
+ return chanTypePtr->typeName;
}
/*
@@ -7986,7 +8735,7 @@ Tcl_ChannelName(chanTypePtr)
* Return the of version of the channel type.
*
* Results:
- * TCL_CHANNEL_VERSION_2 or TCL_CHANNEL_VERSION_1.
+ * One of the TCL_CHANNEL_VERSION_* constants from tcl.h
*
* Side effects:
* None.
@@ -8000,6 +8749,8 @@ Tcl_ChannelVersion(chanTypePtr)
{
if (chanTypePtr->version == TCL_CHANNEL_VERSION_2) {
return TCL_CHANNEL_VERSION_2;
+ } else if (chanTypePtr->version == TCL_CHANNEL_VERSION_3) {
+ return TCL_CHANNEL_VERSION_3;
} else {
/*
* In <v2 channel versions, the version field is occupied
@@ -8012,6 +8763,33 @@ Tcl_ChannelVersion(chanTypePtr)
/*
*----------------------------------------------------------------------
*
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+HaveVersion(chanTypePtr, minimumVersion)
+ Tcl_ChannelType *chanTypePtr;
+ Tcl_ChannelTypeVersion minimumVersion;
+{
+ Tcl_ChannelTypeVersion actualVersion = Tcl_ChannelVersion(chanTypePtr);
+
+ return ((int)actualVersion) >= ((int)minimumVersion);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_ChannelBlockModeProc --
*
* Return the Tcl_DriverBlockModeProc of the channel type.
@@ -8022,16 +8800,18 @@ Tcl_ChannelVersion(chanTypePtr)
* Side effects:
* None.
*
- *----------------------------------------------------------------------
- */
+ *---------------------------------------------------------------------- */
Tcl_DriverBlockModeProc *
Tcl_ChannelBlockModeProc(chanTypePtr)
Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
{
- if (chanTypePtr->version == TCL_CHANNEL_VERSION_2) {
- return (chanTypePtr->blockModeProc);
+ 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);
}
}
@@ -8056,7 +8836,7 @@ Tcl_DriverCloseProc *
Tcl_ChannelCloseProc(chanTypePtr)
Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
{
- return (chanTypePtr->closeProc);
+ return chanTypePtr->closeProc;
}
/*
@@ -8079,7 +8859,7 @@ Tcl_DriverClose2Proc *
Tcl_ChannelClose2Proc(chanTypePtr)
Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
{
- return (chanTypePtr->close2Proc);
+ return chanTypePtr->close2Proc;
}
/*
@@ -8102,7 +8882,7 @@ Tcl_DriverInputProc *
Tcl_ChannelInputProc(chanTypePtr)
Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
{
- return (chanTypePtr->inputProc);
+ return chanTypePtr->inputProc;
}
/*
@@ -8125,7 +8905,7 @@ Tcl_DriverOutputProc *
Tcl_ChannelOutputProc(chanTypePtr)
Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
{
- return (chanTypePtr->outputProc);
+ return chanTypePtr->outputProc;
}
/*
@@ -8148,7 +8928,7 @@ Tcl_DriverSeekProc *
Tcl_ChannelSeekProc(chanTypePtr)
Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
{
- return (chanTypePtr->seekProc);
+ return chanTypePtr->seekProc;
}
/*
@@ -8171,7 +8951,7 @@ Tcl_DriverSetOptionProc *
Tcl_ChannelSetOptionProc(chanTypePtr)
Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
{
- return (chanTypePtr->setOptionProc);
+ return chanTypePtr->setOptionProc;
}
/*
@@ -8194,7 +8974,7 @@ Tcl_DriverGetOptionProc *
Tcl_ChannelGetOptionProc(chanTypePtr)
Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
{
- return (chanTypePtr->getOptionProc);
+ return chanTypePtr->getOptionProc;
}
/*
@@ -8217,7 +8997,7 @@ Tcl_DriverWatchProc *
Tcl_ChannelWatchProc(chanTypePtr)
Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
{
- return (chanTypePtr->watchProc);
+ return chanTypePtr->watchProc;
}
/*
@@ -8240,7 +9020,7 @@ Tcl_DriverGetHandleProc *
Tcl_ChannelGetHandleProc(chanTypePtr)
Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
{
- return (chanTypePtr->getHandleProc);
+ return chanTypePtr->getHandleProc;
}
/*
@@ -8263,7 +9043,11 @@ Tcl_DriverFlushProc *
Tcl_ChannelFlushProc(chanTypePtr)
Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
{
- return (chanTypePtr->flushProc);
+ if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
+ return chanTypePtr->flushProc;
+ } else {
+ return NULL;
+ }
}
/*
@@ -8286,6 +9070,36 @@ Tcl_DriverHandlerProc *
Tcl_ChannelHandlerProc(chanTypePtr)
Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
{
- return (chanTypePtr->handlerProc);
+ if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
+ return chanTypePtr->handlerProc;
+ } else {
+ return NULL;
+ }
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ChannelWideSeekProc --
+ *
+ * Return the Tcl_DriverWideSeekProc of the channel type.
+ *
+ * Results:
+ * A pointer to the proc.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+Tcl_DriverWideSeekProc *
+Tcl_ChannelWideSeekProc(chanTypePtr)
+ Tcl_ChannelType *chanTypePtr; /* Pointer to channel type. */
+{
+ if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_3)) {
+ return chanTypePtr->wideSeekProc;
+ } else {
+ return NULL;
+ }
+}
diff --git a/tcl/generic/tclIO.h b/tcl/generic/tclIO.h
index 6d93a9c290a..179b56d92b4 100644
--- a/tcl/generic/tclIO.h
+++ b/tcl/generic/tclIO.h
@@ -158,7 +158,7 @@ typedef struct Channel {
*/
typedef struct ChannelState {
- char *channelName; /* The name of the channel instance in Tcl
+ 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
@@ -182,10 +182,10 @@ typedef struct ChannelState {
* data bytes. May be TCL_ENCODING_START
* before converting first byte and
* TCL_ENCODING_END when EOF is seen. */
- Tcl_EolTranslation inputTranslation;
+ TclEolTranslation inputTranslation;
/* What translation to apply for end of line
* sequences on input? */
- Tcl_EolTranslation outputTranslation;
+ 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
@@ -233,6 +233,8 @@ typedef struct ChannelState {
* 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. */
} ChannelState;
/*
@@ -294,6 +296,17 @@ typedef struct ChannelState {
* the state of the channel changes. */
#define CHANNEL_RAW_MODE (1<<16) /* When set, notes that the Raw API is
* being used. */
+#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) */
/*
* For each channel handler registered in a call to Tcl_CreateChannelHandler,
diff --git a/tcl/generic/tclIOCmd.c b/tcl/generic/tclIOCmd.c
index 0e6b7bf81a3..76ca6d1662e 100644
--- a/tcl/generic/tclIOCmd.c
+++ b/tcl/generic/tclIOCmd.c
@@ -63,45 +63,62 @@ Tcl_PutsObjCmd(dummy, interp, objc, objv)
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
Tcl_Channel chan; /* The channel to puts on. */
- int i; /* Counter. */
+ Tcl_Obj *string; /* String to write. */
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. */
- char *arg;
- int length;
- i = 1;
- newline = 1;
- if ((objc >= 2) && (strcmp(Tcl_GetString(objv[1]), "-nonewline") == 0)) {
- newline = 0;
- i++;
- }
- if ((i < (objc-3)) || (i >= objc)) {
- Tcl_WrongNumArgs(interp, 1, objv, "?-nonewline? ?channelId? string");
- return TCL_ERROR;
- }
+ switch (objc) {
+ case 2: /* puts $x */
+ string = objv[1];
+ newline = 1;
+ channelId = "stdout";
+ break;
- /*
- * The code below provides backwards compatibility with an old
- * form of the command that is no longer recommended or documented.
- */
+ case 3: /* puts -nonewline $x or puts $chan $x */
+ if (strcmp(Tcl_GetString(objv[1]), "-nonewline") == 0) {
+ newline = 0;
+ channelId = "stdout";
+ } else {
+ newline = 1;
+ channelId = Tcl_GetString(objv[1]);
+ }
+ string = objv[2];
+ break;
- if (i == (objc-3)) {
- arg = Tcl_GetStringFromObj(objv[i + 2], &length);
- if (strncmp(arg, "nonewline", (size_t) length) != 0) {
- Tcl_AppendResult(interp, "bad argument \"", arg,
- "\": should be \"nonewline\"", (char *) NULL);
- return TCL_ERROR;
+ case 4: /* puts -nonewline $chan $x or puts $chan $x nonewline */
+ if (strcmp(Tcl_GetString(objv[1]), "-nonewline") == 0) {
+ channelId = Tcl_GetString(objv[2]);
+ string = objv[3];
+ } else {
+ /*
+ * The code below provides backwards compatibility with an
+ * old form of the command that is no longer recommended
+ * or documented.
+ */
+
+ char *arg;
+ int length;
+
+ arg = Tcl_GetStringFromObj(objv[3], &length);
+ if (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]);
+ string = objv[2];
}
newline = 0;
+ break;
+
+ default: /* puts or puts some bad number of arguments... */
+ Tcl_WrongNumArgs(interp, 1, objv, "?-nonewline? ?channelId? string");
+ return TCL_ERROR;
}
- if (i == (objc - 1)) {
- channelId = "stdout";
- } else {
- channelId = Tcl_GetString(objv[i]);
- i++;
- }
+
chan = Tcl_GetChannel(interp, channelId, &mode);
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
@@ -112,7 +129,7 @@ Tcl_PutsObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
- result = Tcl_WriteObj(chan, objv[i]);
+ result = Tcl_WriteObj(chan, string);
if (result < 0) {
goto error;
}
@@ -228,22 +245,12 @@ Tcl_GetsObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
- resultPtr = Tcl_GetObjResult(interp);
- linePtr = resultPtr;
- if (objc == 3) {
- /*
- * Variable gets line, interp get bytecount.
- */
-
- linePtr = Tcl_NewObj();
- }
+ linePtr = Tcl_NewObj();
lineLen = Tcl_GetsObj(chan, linePtr);
if (lineLen < 0) {
if (!Tcl_Eof(chan) && !Tcl_InputBlocked(chan)) {
- if (linePtr != resultPtr) {
- Tcl_DecrRefCount(linePtr);
- }
+ Tcl_DecrRefCount(linePtr);
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "error reading \"", name, "\": ",
Tcl_PosixError(interp), (char *) NULL);
@@ -257,8 +264,11 @@ Tcl_GetsObjCmd(dummy, interp, objc, objv)
Tcl_DecrRefCount(linePtr);
return TCL_ERROR;
}
+ resultPtr = Tcl_GetObjResult(interp);
Tcl_SetIntObj(resultPtr, lineLen);
return TCL_OK;
+ } else {
+ Tcl_SetObjResult(interp, linePtr);
}
return TCL_OK;
}
@@ -406,11 +416,14 @@ Tcl_SeekObjCmd(clientData, interp, objc, objv)
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
Tcl_Channel chan; /* The channel to tell on. */
- int offset, mode; /* Where to seek? */
- int result; /* Of calling Tcl_Seek. */
+ Tcl_WideInt offset; /* Where to seek? */
+ int mode; /* How to seek? */
+ Tcl_WideInt result; /* Of calling Tcl_Seek. */
char *chanName;
int optionIndex;
- static char *originOptions[] = {"start", "current", "end", (char *) NULL};
+ static CONST char *originOptions[] = {
+ "start", "current", "end", (char *) NULL
+ };
static int modeArray[] = {SEEK_SET, SEEK_CUR, SEEK_END};
if ((objc != 3) && (objc != 4)) {
@@ -422,7 +435,7 @@ Tcl_SeekObjCmd(clientData, interp, objc, objv)
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
- if (Tcl_GetIntFromObj(interp, objv[2], &offset) != TCL_OK) {
+ if (Tcl_GetWideIntFromObj(interp, objv[2], &offset) != TCL_OK) {
return TCL_ERROR;
}
mode = SEEK_SET;
@@ -435,7 +448,7 @@ Tcl_SeekObjCmd(clientData, interp, objc, objv)
}
result = Tcl_Seek(chan, offset, mode);
- if (result == -1) {
+ if (result == Tcl_LongAsWide(-1)) {
Tcl_AppendResult(interp, "error during seek on \"",
chanName, "\": ", Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
@@ -485,7 +498,7 @@ Tcl_TellObjCmd(clientData, interp, objc, objv)
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
- Tcl_SetIntObj(Tcl_GetObjResult(interp), Tcl_Tell(chan));
+ Tcl_SetWideIntObj(Tcl_GetObjResult(interp), Tcl_Tell(chan));
return TCL_OK;
}
@@ -712,12 +725,12 @@ Tcl_ExecObjCmd(dummy, interp, objc, objv)
#define NUM_ARGS 20
Tcl_Obj *resultPtr;
- char **argv;
+ CONST char **argv;
char *string;
Tcl_Channel chan;
- char *argStorage[NUM_ARGS];
+ CONST char *argStorage[NUM_ARGS];
int argc, background, i, index, keepNewline, result, skip, length;
- static char *options[] = {
+ static CONST char *options[] = {
"-keepnewline", "--", NULL
};
enum options {
@@ -770,7 +783,7 @@ Tcl_ExecObjCmd(dummy, interp, objc, objv)
argv = argStorage;
argc = objc - skip;
if ((argc + 1) > sizeof(argv) / sizeof(argv[0])) {
- argv = (char **) ckalloc((unsigned)(argc + 1) * sizeof(char *));
+ argv = (CONST char **) ckalloc((unsigned)(argc + 1) * sizeof(char *));
}
/*
@@ -953,7 +966,7 @@ Tcl_OpenObjCmd(notUsed, interp, objc, objv)
*/
if (!pipeline) {
- chan = Tcl_OpenFileChannel(interp, what, modeString, prot);
+ chan = Tcl_FSOpenFileChannel(interp, objv[1], modeString, prot);
} else {
#ifdef MAC_TCL
Tcl_AppendResult(interp,
@@ -962,7 +975,7 @@ Tcl_OpenObjCmd(notUsed, interp, objc, objv)
return TCL_ERROR;
#else
int mode, seekFlag, cmdObjc;
- char **cmdArgv;
+ CONST char **cmdArgv;
if (Tcl_SplitList(interp, what+1, &cmdObjc, &cmdArgv) != TCL_OK) {
return TCL_ERROR;
@@ -1286,7 +1299,7 @@ Tcl_SocketObjCmd(notUsed, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- static char *socketOptions[] = {
+ static CONST char *socketOptions[] = {
"-async", "-myaddr", "-myport","-server", (char *) NULL
};
enum socketOptions {
@@ -1481,7 +1494,7 @@ Tcl_FcopyObjCmd(dummy, interp, objc, objv)
int mode, i;
int toRead, index;
Tcl_Obj *cmdPtr;
- static char* switches[] = { "-size", "-command", NULL };
+ static CONST char* switches[] = { "-size", "-command", NULL };
enum { FcopySize, FcopyCommand };
if ((objc < 3) || (objc > 7) || (objc == 4) || (objc == 6)) {
diff --git a/tcl/generic/tclIOGT.c b/tcl/generic/tclIOGT.c
index 73a902221f4..e63349aa61d 100644
--- a/tcl/generic/tclIOGT.c
+++ b/tcl/generic/tclIOGT.c
@@ -31,17 +31,17 @@ static int TransformInputProc _ANSI_ARGS_ ((
ClientData instanceData,
char* buf, int toRead, int* errorCodePtr));
static int TransformOutputProc _ANSI_ARGS_ ((
- ClientData instanceData,
- char* buf, int toWrite, int* errorCodePtr));
+ 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,
- char *optionName, char *value));
+ CONST char *optionName, CONST char *value));
static int TransformGetOptionProc _ANSI_ARGS_((
ClientData instanceData, Tcl_Interp *interp,
- char *optionName, Tcl_DString *dsPtr));
+ CONST char *optionName, Tcl_DString *dsPtr));
static void TransformWatchProc _ANSI_ARGS_ ((
ClientData instanceData, int mask));
static int TransformGetFileHandleProc _ANSI_ARGS_ ((
@@ -49,6 +49,9 @@ static int TransformGetFileHandleProc _ANSI_ARGS_ ((
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));
/*
* Forward declarations of internal procedures.
@@ -141,6 +144,7 @@ static Tcl_ChannelType transformChannelType = {
TransformBlockModeProc, /* Set blocking/nonblocking mode.*/
NULL, /* Flush proc. */
TransformNotifyProc, /* Handling of events bubbling up */
+ TransformWideSeekProc, /* Wide seek proc */
};
/*
@@ -156,8 +160,8 @@ static Tcl_ChannelType transformChannelType = {
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 */
+ int allocated; /* Allocated size of the buffer area */
+ int used; /* Number of bytes in the buffer, <= allocated */
};
/*
@@ -171,7 +175,7 @@ struct ResultBuffer {
* out information waiting in buffers (fileevent support).
*/
-#define DELAY (5)
+#define FLUSH_DELAY (5)
/*
* Convenience macro to make some casts easier to use.
@@ -357,11 +361,11 @@ TclChannelTransform(interp, chan, cmdObjPtr)
static int
ExecuteCallback (dataPtr, interp, op, buf, bufLen, transmit, preserve)
- TransformChannelData* dataPtr; /* Transformation with the callback */
+ 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; /* Ands its length */
+ int bufLen; /* Ands its length */
int transmit; /* Flag, determines whether the result
* of the callback is sent to the
* underlying channel or not. */
@@ -377,16 +381,14 @@ 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_Obj* resObj; /* See below, switch (transmit) */
+ int resLen;
+ unsigned char* resBuf;
Tcl_SavedResult ciSave;
-
int res = TCL_OK;
Tcl_Obj* command = Tcl_DuplicateObj (dataPtr->command);
Tcl_Obj* temp;
-
if (preserve) {
Tcl_SaveResult (dataPtr->interp, &ciSave);
}
@@ -641,7 +643,7 @@ static int
TransformInputProc (instanceData, buf, toRead, errorCodePtr)
ClientData instanceData;
char* buf;
- int toRead;
+ int toRead;
int* errorCodePtr;
{
TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
@@ -764,8 +766,7 @@ TransformInputProc (instanceData, buf, toRead, errorCodePtr)
*/
res = ExecuteCallback (dataPtr, NO_INTERP, A_READ,
- UCHARP (buf), read, TRANSMIT_IBUF,
- P_PRESERVE);
+ UCHARP (buf), read, TRANSMIT_IBUF, P_PRESERVE);
if (res != TCL_OK) {
*errorCodePtr = EINVAL;
@@ -796,7 +797,7 @@ TransformInputProc (instanceData, buf, toRead, errorCodePtr)
static int
TransformOutputProc (instanceData, buf, toWrite, errorCodePtr)
ClientData instanceData;
- char* buf;
+ CONST char* buf;
int toWrite;
int* errorCodePtr;
{
@@ -848,12 +849,11 @@ 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. */
+ ClientData instanceData; /* The channel to manipulate */
+ long offset; /* Size of movement. */
+ int mode; /* How to move */
+ int* errorCodePtr; /* Location of error flag. */
{
- int result;
TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self);
Tcl_ChannelType* parentType = Tcl_GetChannelType(parent);
@@ -864,9 +864,8 @@ TransformSeekProc (instanceData, offset, mode, errorCodePtr)
* location. Simply pass the request down.
*/
- result = (*parentSeekProc) (Tcl_GetChannelInstanceData(parent),
+ return (*parentSeekProc) (Tcl_GetChannelInstanceData(parent),
offset, mode, errorCodePtr);
- return result;
}
/*
@@ -887,9 +886,104 @@ TransformSeekProc (instanceData, offset, mode, errorCodePtr)
dataPtr->readIsFlushed = 0;
}
- result = (*parentSeekProc) (Tcl_GetChannelInstanceData(parent),
+ return (*parentSeekProc) (Tcl_GetChannelInstanceData(parent),
offset, mode, errorCodePtr);
- return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TransformWideSeekProc --
+ *
+ * This procedure is called by the generic IO level to move the
+ * access point in a channel, with a (potentially) 64-bit offset.
+ *
+ * Side effects:
+ * Moves the location at which the channel will be accessed in
+ * future operations. Flushes all transformation buffers, then
+ * forwards it to the underlying channel.
+ *
+ * Result:
+ * -1 if failed, the new position if successful. An output
+ * argument contains the POSIX error code if an error occurred,
+ * or zero.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+{
+ TransformChannelData* dataPtr =
+ (TransformChannelData*) instanceData;
+ Tcl_Channel parent =
+ Tcl_GetStackedChannel(dataPtr->self);
+ 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 Tcl_LongAsWide((*parentSeekProc) (parentData, 0, mode,
+ errorCodePtr));
+ }
+
+ /*
+ * It is a real request to change the position. Flush all data waiting
+ * for output and discard everything in the input buffers. Then pass
+ * the request down, unchanged.
+ */
+
+ if (dataPtr->mode & TCL_WRITABLE) {
+ ExecuteCallback (dataPtr, NO_INTERP, 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);
+ ResultClear(&dataPtr->result);
+ dataPtr->readIsFlushed = 0;
+ }
+
+ /*
+ * If we have a wide seek capability, we should stick with that.
+ */
+ if (parentWideSeekProc != NULL) {
+ 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 to go out of the representable range.
+ */
+ if (offset<Tcl_LongAsWide(LONG_MIN) || offset>Tcl_LongAsWide(LONG_MAX)) {
+ *errorCodePtr = EOVERFLOW;
+ return Tcl_LongAsWide(-1);
+ }
+ return Tcl_LongAsWide((*parentSeekProc) (parentData,
+ Tcl_WideAsLong(offset), mode, errorCodePtr));
}
/*
@@ -915,8 +1009,8 @@ static int
TransformSetOptionProc (instanceData, interp, optionName, value)
ClientData instanceData;
Tcl_Interp *interp;
- char *optionName;
- char *value;
+ CONST char *optionName;
+ CONST char *value;
{
TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
Tcl_Channel downChan = Tcl_GetStackedChannel(dataPtr->self);
@@ -953,7 +1047,7 @@ static int
TransformGetOptionProc (instanceData, interp, optionName, dsPtr)
ClientData instanceData;
Tcl_Interp* interp;
- char* optionName;
+ CONST char* optionName;
Tcl_DString* dsPtr;
{
TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
@@ -964,7 +1058,7 @@ TransformGetOptionProc (instanceData, interp, optionName, dsPtr)
if (getOptionProc != NULL) {
return (*getOptionProc)(Tcl_GetChannelInstanceData(downChan),
interp, optionName, dsPtr);
- } else if (optionName == (char*) NULL) {
+ } else if (optionName == (CONST char*) NULL) {
/*
* Request is query for all options, this is ok.
*/
@@ -1046,7 +1140,7 @@ TransformWatchProc (instanceData, mask)
* to flush that.
*/
- dataPtr->timer = Tcl_CreateTimerHandler (DELAY,
+ dataPtr->timer = Tcl_CreateTimerHandler (FLUSH_DELAY,
TransformChannelHandlerTimer, (ClientData) dataPtr);
}
}
@@ -1274,7 +1368,7 @@ 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 */
+ int toRead; /* Number of requested bytes */
{
if (r->used == 0) {
/* Nothing to copy in the case of an empty buffer.
@@ -1337,7 +1431,7 @@ 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' */
+ int toWrite; /* The number of bytes in 'buf' */
{
if ((r->used + toWrite) > r->allocated) {
/* Extension of the internal buffer is required.
diff --git a/tcl/generic/tclIOSock.c b/tcl/generic/tclIOSock.c
index 031db7856dc..11228793149 100644
--- a/tcl/generic/tclIOSock.c
+++ b/tcl/generic/tclIOSock.c
@@ -43,7 +43,7 @@ TclSockGetPort(interp, string, proto, portPtr)
{
struct servent *sp; /* Protocol info for named services */
Tcl_DString ds;
- char *native;
+ CONST char *native;
if (Tcl_GetInt(NULL, string, portPtr) != TCL_OK) {
/*
@@ -91,10 +91,7 @@ TclSockMinimumBuffers(sock, size)
int size; /* Minimum buffer size */
{
int current;
- /*
- * Should be socklen_t, but HP10.20 (g)cc chokes
- */
- size_t len;
+ socklen_t len;
len = sizeof(int);
getsockopt(sock, SOL_SOCKET, SO_SNDBUF, (char *)&current, &len);
@@ -110,4 +107,3 @@ TclSockMinimumBuffers(sock, size)
}
return TCL_OK;
}
-
diff --git a/tcl/generic/tclIOUtil.c b/tcl/generic/tclIOUtil.c
index 445a29d7108..af1bd03a837 100644
--- a/tcl/generic/tclIOUtil.c
+++ b/tcl/generic/tclIOUtil.c
@@ -1,8 +1,12 @@
/*
* tclIOUtil.c --
*
- * This file contains a collection of utility procedures that
- * are shared by the platform specific IO drivers.
+ * This file contains the implementation of Tcl's generic
+ * filesystem 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.
*
* Parts of this file are based on code contributed by Karl
* Lehenbauer, Mark Diekhans and Peter da Silva.
@@ -18,7 +22,237 @@
#include "tclInt.h"
#include "tclPort.h"
+#ifdef MAC_TCL
+#include "tclMacInt.h"
+#endif
+#ifdef __WIN32__
+/* for tclWinProcs->useWide */
+#include "tclWinInt.h"
+#endif
+
+/*
+ * Prototypes for procedures defined later in this file.
+ */
+
+static void DupFsPathInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
+ Tcl_Obj *copyPtr));
+static void FreeFsPathInternalRep _ANSI_ARGS_((Tcl_Obj *listPtr));
+static int SetFsPathFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr));
+static Tcl_Obj* FSNormalizeAbsolutePath
+ _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj *pathPtr));
+static int TclNormalizeToUniquePath
+ _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *pathPtr));
+static int SetFsPathFromAbsoluteNormalized
+ _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr));
+static int FindSplitPos _ANSI_ARGS_((char *path, char *separator));
+static Tcl_PathType FSGetPathType _ANSI_ARGS_((Tcl_Obj *pathObjPtr,
+ Tcl_Filesystem **filesystemPtrPtr,
+ int *driveNameLengthPtr));
+static Tcl_PathType GetPathType _ANSI_ARGS_((Tcl_Obj *pathObjPtr,
+ Tcl_Filesystem **filesystemPtrPtr,
+ int *driveNameLengthPtr, Tcl_Obj **driveNameRef));
+
+/*
+ * Define the 'path' object type, which Tcl uses to represent
+ * file paths internally.
+ */
+Tcl_ObjType tclFsPathType = {
+ "path", /* name */
+ FreeFsPathInternalRep, /* freeIntRepProc */
+ DupFsPathInternalRep, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ SetFsPathFromAny /* setFromAnyProc */
+};
+
+/*
+ * 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 mac/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.
+ */
+extern CONST char * tclpFileAttrStrings[];
+extern CONST TclFileAttrProcs tclpFileAttrProcs[];
+
+/*
+ * 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. */
+{
+ int ret;
+ Tcl_StatBuf buf;
+ Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);
+
+ Tcl_IncrRefCount(pathPtr);
+ ret = Tcl_FSStat(pathPtr, &buf);
+ Tcl_DecrRefCount(pathPtr);
+ if (ret != -1) {
+#ifndef TCL_WIDE_INT_IS_LONG
+# 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(buf.st_ino) || OUT_OF_RANGE(buf.st_size)
+#ifdef HAVE_ST_BLOCKS
+ || OUT_OF_RANGE(buf.st_blocks)
+#endif
+ ) {
+#ifdef EFBIG
+ errno = EFBIG;
+#else
+# ifdef EOVERFLOW
+ errno = EOVERFLOW;
+# else
+# error "What status should be returned for file size out of range?"
+# endif
+#endif
+ return -1;
+ }
+
+# undef OUT_OF_RANGE
+# undef OUT_OF_URANGE
+#endif /* !TCL_WIDE_INT_IS_LONG */
+
+ /*
+ * 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 using an obsolete interface.
+ */
+
+ oldStyleBuf->st_mode = buf.st_mode;
+ oldStyleBuf->st_ino = (ino_t) buf.st_ino;
+ oldStyleBuf->st_dev = buf.st_dev;
+ oldStyleBuf->st_rdev = buf.st_rdev;
+ oldStyleBuf->st_nlink = buf.st_nlink;
+ oldStyleBuf->st_uid = buf.st_uid;
+ oldStyleBuf->st_gid = buf.st_gid;
+ oldStyleBuf->st_size = (off_t) buf.st_size;
+ oldStyleBuf->st_atime = buf.st_atime;
+ oldStyleBuf->st_mtime = buf.st_mtime;
+ oldStyleBuf->st_ctime = buf.st_ctime;
+#ifdef HAVE_ST_BLOCKS
+ oldStyleBuf->st_blksize = buf.st_blksize;
+ oldStyleBuf->st_blocks = (blkcnt_t) buf.st_blocks;
+#endif
+ }
+ return ret;
+}
+
+/* Obsolete */
+int
+Tcl_Access(path, mode)
+ CONST char *path; /* Path of file to access (in current CP). */
+ int mode; /* Permission setting. */
+{
+ int ret;
+ Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);
+ Tcl_IncrRefCount(pathPtr);
+ ret = Tcl_FSAccess(pathPtr,mode);
+ Tcl_DecrRefCount(pathPtr);
+ return ret;
+}
+
+/* Obsolete */
+Tcl_Channel
+Tcl_OpenFileChannel(interp, path, modeString, permissions)
+ 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 as "rw". */
+ int permissions; /* If the open involves creating a
+ * file, with what modes to create
+ * it? */
+{
+ Tcl_Channel ret;
+ Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);
+ Tcl_IncrRefCount(pathPtr);
+ ret = Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions);
+ Tcl_DecrRefCount(pathPtr);
+ return ret;
+
+}
+
+/* Obsolete */
+int
+Tcl_Chdir(dirName)
+ CONST char *dirName;
+{
+ int ret;
+ Tcl_Obj *pathPtr = Tcl_NewStringObj(dirName,-1);
+ Tcl_IncrRefCount(pathPtr);
+ ret = Tcl_FSChdir(pathPtr);
+ Tcl_DecrRefCount(pathPtr);
+ return ret;
+}
+
+/* Obsolete */
+char *
+Tcl_GetCwd(interp, cwdPtr)
+ Tcl_Interp *interp;
+ Tcl_DString *cwdPtr;
+{
+ Tcl_Obj *cwd;
+ 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);
+ }
+}
+
+/* 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
+ * 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);
+ return ret;
+}
+
+
+/*
+ * 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(...)' &
@@ -45,10 +279,10 @@ typedef struct OpenFileChannelProc {
} OpenFileChannelProc;
/*
- * For each type of 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.
+ * 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.
@@ -56,26 +290,829 @@ typedef struct OpenFileChannelProc {
* This method avoids the need to call any sort of "initialization"
* function.
*
- * All three lists are protected by a global hookMutex.
+ * All three lists are protected by a global obsoleteFsHookMutex.
*/
-static StatProc defaultStatProc = {
- &TclpStat, NULL
-};
-static StatProc *statProcList = &defaultStatProc;
+static StatProc *statProcList = NULL;
+static AccessProc *accessProcList = NULL;
+static OpenFileChannelProc *openFileChannelProcList = NULL;
+
+TCL_DECLARE_MUTEX(obsoleteFsHookMutex)
+
+#endif /* USE_OBSOLETE_FS_HOOKS */
-static AccessProc defaultAccessProc = {
- &TclpAccess, NULL
+/*
+ * A filesystem record is used to keep track of each
+ * filesystem currently registered with the core,
+ * in a linked list.
+ */
+typedef struct FilesystemRecord {
+ ClientData clientData; /* Client specific data for the new
+ * filesystem (can be NULL) */
+ 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. */
+} FilesystemRecord;
+
+static FilesystemRecord* GetFilesystemRecord
+ _ANSI_ARGS_((Tcl_Filesystem *fromFilesystem, int *epoch));
+
+/*
+ * 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_FSPathInFilesystemProc NativePathInFilesystem;
+static Tcl_FSFilesystemSeparatorProc NativeFilesystemSeparator;
+static Tcl_FSFreeInternalRepProc NativeFreeInternalRep;
+static Tcl_FSDupInternalRepProc NativeDupInternalRep;
+static Tcl_FSCreateInternalRepProc NativeCreateNativeRep;
+static Tcl_FSFileAttrStringsProc NativeFileAttrStrings;
+static Tcl_FSFileAttrsGetProc NativeFileAttrsGet;
+static Tcl_FSFileAttrsSetProc NativeFileAttrsSet;
+static Tcl_FSUtimeProc NativeUtime;
+
+/*
+ * The only reason these functions are not static is that they
+ * are either called by code in the native (win/unix/mac) 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_FSGetCwdProc TclpObjGetCwd;
+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!
+ */
+static Tcl_Filesystem tclNativeFilesystem = {
+ "native",
+ sizeof(Tcl_Filesystem),
+ TCL_FILESYSTEM_VERSION_1,
+ &NativePathInFilesystem,
+ &NativeDupInternalRep,
+ &NativeFreeInternalRep,
+ &TclpNativeToNormalized,
+ &NativeCreateNativeRep,
+ &TclpObjNormalizePath,
+ &TclpFilesystemPathType,
+ &NativeFilesystemSeparator,
+ &TclpObjStat,
+ &TclpObjAccess,
+ &TclpOpenFileChannel,
+ &TclpMatchInDirectory,
+ &NativeUtime,
+#ifndef S_IFLNK
+ NULL,
+#else
+ &TclpObjLink,
+#endif /* S_IFLNK */
+ &TclpObjListVolumes,
+ &NativeFileAttrStrings,
+ &NativeFileAttrsGet,
+ &NativeFileAttrsSet,
+ &TclpObjCreateDirectory,
+ &TclpObjRemoveDirectory,
+ &TclpObjDeleteFile,
+ &TclpObjCopyFile,
+ &TclpObjRenameFile,
+ &TclpObjCopyDirectory,
+ &TclpObjLstat,
+ &TclpDlopen,
+ &TclpObjGetCwd,
+ &TclpObjChdir
};
-static AccessProc *accessProcList = &defaultAccessProc;
-static OpenFileChannelProc defaultOpenFileChannelProc = {
- &TclpOpenFileChannel, NULL
+/*
+ * 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
};
-static OpenFileChannelProc *openFileChannelProcList =
- &defaultOpenFileChannelProc;
-TCL_DECLARE_MUTEX(hookMutex)
+/*
+ * The following few variables are protected by the
+ * filesystemMutex just below.
+ */
+
+/*
+ * 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.
+ */
+static int theFilesystemEpoch = 0;
+
+/*
+ * Stores the linked list of filesystems.
+ */
+static FilesystemRecord *filesystemList = &nativeFilesystemRecord;
+
+/*
+ * The number of loops which are currently iterating over the linked
+ * list. If this is greater than zero, we can't modify the list.
+ */
+static int filesystemIteratorsInProgress = 0;
+
+/*
+ * Someone wants to modify the list of filesystems if this is set.
+ */
+static int filesystemWantToModify = 0;
+
+#ifdef TCL_THREADS
+static Tcl_Condition filesystemOkToModify = NULL;
+#endif
+
+TCL_DECLARE_MUTEX(filesystemMutex)
+
+/*
+ * struct FsPath --
+ *
+ * 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.
+ *
+ * Note that 'normPathPtr' can be a circular reference to the
+ * container Tcl_Obj of this FsPath.
+ */
+typedef struct FsPath {
+ 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 translated
+ * and normalized. */
+ Tcl_Obj *normPathPtr; /* Normalized absolute path, without
+ * ., .. or ~user sequences. If the
+ * Tcl_Obj containing
+ * this FsPath is already normalized,
+ * this may be a circular reference back
+ * to the 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 have a refCount
+ * on the object. */
+ 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. */
+} FsPath;
+
+/*
+ * Used to implement Tcl_FSGetCwd in a file-system independent way.
+ * This is protected by the cwdMutex below.
+ */
+static Tcl_Obj* cwdPathPtr = NULL;
+TCL_DECLARE_MUTEX(cwdMutex)
+
+/*
+ * 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 */
+
+
+static int
+FsCwdPointerEquals(objPtr)
+ Tcl_Obj* objPtr;
+{
+ Tcl_MutexLock(&cwdMutex);
+ if (cwdPathPtr == objPtr) {
+ Tcl_MutexUnlock(&cwdMutex);
+ return 1;
+ } else {
+ Tcl_MutexUnlock(&cwdMutex);
+ return 0;
+ }
+}
+
+
+static FilesystemRecord*
+FsGetIterator(void) {
+ Tcl_MutexLock(&filesystemMutex);
+ filesystemIteratorsInProgress++;
+ Tcl_MutexUnlock(&filesystemMutex);
+ /* Now we know the list of filesystems cannot be modified */
+ return filesystemList;
+}
+
+static void
+FsReleaseIterator(void) {
+ Tcl_MutexLock(&filesystemMutex);
+ filesystemIteratorsInProgress--;
+ if (filesystemIteratorsInProgress == 0) {
+ /* Notify any waiting threads that things are ok now */
+ if (filesystemWantToModify > 0) {
+ Tcl_ConditionNotify(&filesystemOkToModify);
+ }
+ }
+ Tcl_MutexUnlock(&filesystemMutex);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFinalizeFilesystem --
+ *
+ * Clean up the filesystem. After this, calls to all Tcl_FS...
+ * functions will fail.
+ *
+ * Note that, since 'TclFinalizeLoad' may unload extensions
+ * which implement other filesystems, and which may therefore
+ * contain a 'freeProc' for those filesystems, at this stage
+ * we _must_ have freed all objects of "path" type, or we may
+ * end up with segfaults if we try to free them later.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees any memory allocated by the filesystem. Unloads any
+ * extensions which have been loaded.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFinalizeFilesystem() {
+ /*
+ * Assumption that only one thread is active now. Otherwise
+ * we would need to put various mutexes around this code.
+ */
+
+ if (cwdPathPtr != NULL) {
+ Tcl_DecrRefCount(cwdPathPtr);
+ cwdPathPtr = NULL;
+ }
+
+ /*
+ * 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.
+ */
+
+ TclFinalizeLoad();
+
+ /* Remove all filesystems, freeing any allocated memory */
+ while (filesystemList != NULL) {
+ FilesystemRecord *tmpFsRecPtr = filesystemList->nextPtr;
+ if (filesystemList->fileRefCount > 1) {
+ /*
+ * We are freeing a filesystem which actually has
+ * path objects still around which belong to it.
+ * This is probably bad, but since we are exiting,
+ * we don't do anything about it.
+ */
+ }
+ /* The native filesystem is static, so we don't free it */
+ if (filesystemList != &nativeFilesystemRecord) {
+ ckfree((char *)filesystemList);
+ }
+ filesystemList = tmpFsRecPtr;
+ }
+ /* Now filesystemList is NULL */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FSRegister --
+ *
+ * Insert the filesystem function table at the head of the list of
+ * functions which are used during calls to all file-system
+ * operations. The filesystem will be added even if it is
+ * already in the list. (You 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 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.
+ *
+ * In particular this means if you want to add a diagnostic
+ * filesystem (which simply reports all fs activity), it must be
+ * at the head of the list: i.e. it must be the last registered.
+ *
+ * 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 filesystems.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_FSRegister(clientData, fsPtr)
+ ClientData clientData; /* Client specific data for this fs */
+ Tcl_Filesystem *fsPtr; /* The filesystem record for the new fs. */
+{
+ FilesystemRecord *newFilesystemPtr;
+
+ if (fsPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ newFilesystemPtr = (FilesystemRecord *) ckalloc(sizeof(FilesystemRecord));
+
+ newFilesystemPtr->clientData = clientData;
+ newFilesystemPtr->fsPtr = fsPtr;
+ /*
+ * We start with a refCount of 1. If this drops to zero, then
+ * anyone is welcome to ckfree us.
+ */
+ newFilesystemPtr->fileRefCount = 1;
+
+ /*
+ * Is this lock and wait strictly speaking necessary? Since any
+ * iterators out there will have grabbed a copy of the head of
+ * the list and be iterating away from that, if we add a new
+ * element to the head of the 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.
+ *
+ * However, since registering and unregistering filesystems is
+ * a very rare action, this is not a very important point.
+ */
+ Tcl_MutexLock(&filesystemMutex);
+ if (filesystemIteratorsInProgress) {
+ filesystemWantToModify++;
+ Tcl_ConditionWait(&filesystemOkToModify, &filesystemMutex, NULL);
+ filesystemWantToModify--;
+ }
+
+ newFilesystemPtr->nextPtr = filesystemList;
+ filesystemList = newFilesystemPtr;
+ /*
+ * Increment the filesystem epoch counter, since existing paths
+ * might conceivably now belong to different filesystems.
+ */
+ theFilesystemEpoch++;
+ Tcl_MutexUnlock(&filesystemMutex);
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FSUnregister --
+ *
+ * Remove the passed filesystem from the list of filesystem
+ * function 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 otherwise.
+ *
+ * Side effects:
+ * Memory may be deallocated (or will be later, once no "path"
+ * objects refer to this filesystem), but the list of registered
+ * filesystems is updated immediately.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_FSUnregister(fsPtr)
+ Tcl_Filesystem *fsPtr; /* The filesystem record to remove. */
+{
+ int retVal = TCL_ERROR;
+ FilesystemRecord *tmpFsRecPtr;
+ FilesystemRecord *prevFsRecPtr = NULL;
+
+ Tcl_MutexLock(&filesystemMutex);
+ if (filesystemIteratorsInProgress) {
+ filesystemWantToModify++;
+ Tcl_ConditionWait(&filesystemOkToModify, &filesystemMutex, NULL);
+ filesystemWantToModify--;
+ }
+ tmpFsRecPtr = filesystemList;
+ /*
+ * Traverse the 'filesystemList' looking for the particular node
+ * whose 'fsPtr' member matches 'fsPtr' and remove that one from
+ * the list. Ensure that the "default" node cannot be removed.
+ */
+
+ while ((retVal == TCL_ERROR) && (tmpFsRecPtr != &nativeFilesystemRecord)) {
+ if (tmpFsRecPtr->fsPtr == fsPtr) {
+ if (prevFsRecPtr == NULL) {
+ filesystemList = filesystemList->nextPtr;
+ } else {
+ prevFsRecPtr->nextPtr = tmpFsRecPtr->nextPtr;
+ }
+ /*
+ * Increment the filesystem epoch counter, since existing
+ * paths 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).
+ */
+ theFilesystemEpoch++;
+
+ tmpFsRecPtr->fileRefCount--;
+ if (tmpFsRecPtr->fileRefCount <= 0) {
+ ckfree((char *)tmpFsRecPtr);
+ }
+
+ retVal = TCL_OK;
+ } else {
+ prevFsRecPtr = tmpFsRecPtr;
+ tmpFsRecPtr = tmpFsRecPtr->nextPtr;
+ }
+ }
+
+ Tcl_MutexUnlock(&filesystemMutex);
+ return (retVal);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FSMountsChanged --
+ *
+ * Notify the filesystem that the available mounted filesystems
+ * (or within any one filesystem type, the number or location of
+ * mount points) have changed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The global filesystem variable 'theFilesystemEpoch' is
+ * incremented. The effect of this is to make all cached
+ * path representations invalid. 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 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 'pathInFilesystem' proc will always fail). However,
+ * for safety, Tcl always calls this for you in these circumstances.
+ *
+ * (2) when additional mount points are established inside any
+ * existing filesystem (except the native fs)
+ *
+ * (3) when any filesystem (except the native fs) changes the list
+ * of available volumes.
+ *
+ * (4) when the mapping from a string representation of a file to
+ * a full, normalized path changes. For example, if 'env(HOME)'
+ * is modified, then any path containing '~' will map to a different
+ * filesystem location. Therefore all such paths need to have
+ * their internal representation invalidated.
+ *
+ * Tcl has no control over (2) and (3), so any registered filesystem
+ * must make sure it calls this function when those situations
+ * occur.
+ *
+ * (Note: the reason for the exception in 2,3 for the native
+ * filesystem is that the native filesystem by default claims all
+ * unknown files even if it really doesn't understand them or if
+ * they don't exist).
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_FSMountsChanged(fsPtr)
+ Tcl_Filesystem *fsPtr;
+{
+ /*
+ * 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.
+ */
+ (void)fsPtr;
+ /*
+ * Increment the filesystem epoch counter, since existing paths
+ * might now belong to different filesystems.
+ */
+ Tcl_MutexLock(&filesystemMutex);
+ theFilesystemEpoch++;
+ Tcl_MutexUnlock(&filesystemMutex);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FSData --
+ *
+ * Retrieve the clientData field for the filesystem given,
+ * or NULL if that filesystem is not registered.
+ *
+ * Results:
+ * A clientData value, or NULL. Note that if the filesystem
+ * was registered with a NULL clientData field, this function
+ * will return that NULL value.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ClientData
+Tcl_FSData(fsPtr)
+ Tcl_Filesystem *fsPtr; /* The filesystem record to query. */
+{
+ ClientData retVal = NULL;
+ FilesystemRecord *tmpFsRecPtr;
+
+ tmpFsRecPtr = FsGetIterator();
+ /*
+ * Traverse the 'filesystemList' looking for the particular node
+ * whose 'fsPtr' member matches 'fsPtr' and remove that one from
+ * the list. Ensure that the "default" node cannot be removed.
+ */
+
+ while ((retVal == NULL) && (tmpFsRecPtr != NULL)) {
+ if (tmpFsRecPtr->fsPtr == fsPtr) {
+ retVal = tmpFsRecPtr->clientData;
+ }
+ tmpFsRecPtr = tmpFsRecPtr->nextPtr;
+ }
+
+ FsReleaseIterator();
+ return (retVal);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FSNormalizeAbsolutePath --
+ *
+ * Description:
+ * 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 MacOS, 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).
+ *
+ * The behaviour of this function if passed a non-absolute path
+ * is NOT defined.
+ *
+ * Results:
+ * The result is returned in a Tcl_Obj with a refCount of 1,
+ * which is therefore owned by the caller. It must be
+ * freed (with Tcl_DecrRefCount) by the caller when no longer needed.
+ *
+ * Side effects:
+ * None (beyond the memory allocation for the result).
+ *
+ * Special note:
+ * This code is based on code from Matt Newman and Jean-Claude
+ * Wippler, with additions from Vince Darley and is copyright
+ * those respective authors.
+ *
+ *---------------------------------------------------------------------------
+ */
+static Tcl_Obj*
+FSNormalizeAbsolutePath(interp, pathPtr)
+ Tcl_Interp* interp; /* Interpreter to use */
+ Tcl_Obj *pathPtr; /* Absolute path to normalize */
+{
+ int splen = 0, nplen, i;
+ Tcl_Obj *retVal;
+ Tcl_Obj *split;
+
+ /* Split has refCount zero */
+ split = Tcl_FSSplitPath(pathPtr, &splen);
+
+ /*
+ * Modify the list of entries in place, by removing '.', and
+ * removing '..' and the entry before -- unless that entry before
+ * is the top-level entry, i.e. the name of a volume.
+ */
+ nplen = 0;
+ for (i = 0;i < splen;i++) {
+ Tcl_Obj *elt;
+ Tcl_ListObjIndex(NULL, split, nplen, &elt);
+
+ if (strcmp(Tcl_GetString(elt), ".") == 0) {
+ Tcl_ListObjReplace(NULL, split, nplen, 1, 0, NULL);
+ } else if (strcmp(Tcl_GetString(elt), "..") == 0) {
+ if (nplen > 1) {
+ nplen--;
+ Tcl_ListObjReplace(NULL, split, nplen, 2, 0, NULL);
+ } else {
+ Tcl_ListObjReplace(NULL, split, nplen, 1, 0, NULL);
+ }
+ } else {
+ nplen++;
+ }
+ }
+ if (nplen > 0) {
+ retVal = Tcl_FSJoinPath(split, nplen);
+ /*
+ * Now we have an absolute path, with no '..', '.' sequences,
+ * but it still 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). MacOS is case-insensitive.
+ *
+ * Virtual file systems which may be registered may have
+ * other criteria for normalizing a path.
+ */
+ Tcl_IncrRefCount(retVal);
+ TclNormalizeToUniquePath(interp, retVal);
+ /*
+ * Since we know it is a normalized path, we can
+ * actually convert this object into an FsPath for
+ * greater efficiency
+ */
+ SetFsPathFromAbsoluteNormalized(interp, retVal);
+ } else {
+ /* Init to an empty string */
+ retVal = Tcl_NewStringObj("",0);
+ Tcl_IncrRefCount(retVal);
+ }
+ /*
+ * We increment and then decrement the refCount of split to free
+ * it. We do this right at the end, in case there are
+ * optimisations in Tcl_FSJoinPath(split, nplen) above which would
+ * let it make use of split more effectively if it has a refCount
+ * of zero. Also we can't just decrement the ref count, in case
+ * 'split' was actually returned by the join call above, in a
+ * single-element optimisation when nplen == 1.
+ */
+ Tcl_IncrRefCount(split);
+ Tcl_DecrRefCount(split);
+
+ /* This has a refCount of 1 for the caller */
+ return retVal;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclNormalizeToUniquePath --
+ *
+ * Description:
+ * Takes a path specification containing no ../, ./ sequences,
+ * and converts it into a unique path for the given platform.
+ * On MacOS, 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 result is returned in a Tcl_Obj with a refCount of 1,
+ * which is therefore owned by the caller. It must be
+ * freed (with Tcl_DecrRefCount) by the caller when no longer needed.
+ *
+ * Side effects:
+ * None (beyond the memory allocation for the result).
+ *
+ * Special note:
+ * This is only used by the above function. Also 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/macos.
+ *
+ *---------------------------------------------------------------------------
+ */
+static int
+TclNormalizeToUniquePath(interp, pathPtr)
+ Tcl_Interp *interp;
+ Tcl_Obj *pathPtr;
+{
+ FilesystemRecord *fsRecPtr;
+ int retVal = 0;
+
+ /*
+ * 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 native filesystem (i.e. '/' on unix is native).
+ */
+
+ fsRecPtr = FsGetIterator();
+ while (fsRecPtr != NULL) {
+ if (fsRecPtr == &nativeFilesystemRecord) {
+ Tcl_FSNormalizePathProc *proc = fsRecPtr->fsPtr->normalizePathProc;
+ if (proc != NULL) {
+ retVal = (*proc)(interp, pathPtr, retVal);
+ }
+ break;
+ }
+ fsRecPtr = fsRecPtr->nextPtr;
+ }
+ FsReleaseIterator();
+
+ fsRecPtr = FsGetIterator();
+ while (fsRecPtr != NULL) {
+ /* Skip the native system next time through */
+ if (fsRecPtr != &nativeFilesystemRecord) {
+ Tcl_FSNormalizePathProc *proc = fsRecPtr->fsPtr->normalizePathProc;
+ if (proc != NULL) {
+ retVal = (*proc)(interp, pathPtr, retVal);
+ }
+ /*
+ * We could add an efficiency check like this:
+ *
+ * if (retVal == length-of(pathPtr)) {break;}
+ *
+ * but there's not much benefit.
+ */
+ }
+ fsRecPtr = fsRecPtr->nextPtr;
+ }
+ FsReleaseIterator();
+
+ return (retVal);
+}
/*
*---------------------------------------------------------------------------
@@ -107,14 +1144,14 @@ int
TclGetOpenMode(interp, string, seekFlagPtr)
Tcl_Interp *interp; /* Interpreter to use for error
* reporting - may be NULL. */
- char *string; /* Mode string, e.g. "r+" or
+ CONST char *string; /* 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 mode, modeArgc, c, i, gotRW;
- char **modeArgv, *flag;
+ CONST char **modeArgv, *flag;
#define RW_MODES (O_RDONLY|O_WRONLY|O_RDWR)
/*
@@ -255,7 +1292,7 @@ TclGetOpenMode(interp, string, seekFlagPtr)
/*
*----------------------------------------------------------------------
*
- * Tcl_EvalFile --
+ * Tcl_FSEvalFile --
*
* Read in a file and process the entire file as one gigantic
* Tcl command.
@@ -265,50 +1302,60 @@ TclGetOpenMode(interp, string, seekFlagPtr)
* the file or an error indicating why the file couldn't be read.
*
* Side effects:
- * Depends on the commands in the file.
+ * 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).
*
*----------------------------------------------------------------------
*/
int
-Tcl_EvalFile(interp, fileName)
+Tcl_FSEvalFile(interp, pathPtr)
Tcl_Interp *interp; /* Interpreter in which to process file. */
- char *fileName; /* Name of file to process. Tilde-substitution
+ Tcl_Obj *pathPtr; /* Path of file to process. Tilde-substitution
* will be performed on this name. */
{
int result, length;
- struct stat statBuf;
- char *oldScriptFile;
+ Tcl_StatBuf statBuf;
+ Tcl_Obj *oldScriptFile;
Interp *iPtr;
- Tcl_DString nameString;
- char *name, *string;
+ char *string;
Tcl_Channel chan;
Tcl_Obj *objPtr;
- name = Tcl_TranslateFileName(interp, fileName, &nameString);
- if (name == NULL) {
+ if (Tcl_FSGetTranslatedPath(interp, pathPtr) == NULL) {
return TCL_ERROR;
}
result = TCL_ERROR;
objPtr = Tcl_NewObj();
- if (TclStat(name, &statBuf) == -1) {
+ if (Tcl_FSStat(pathPtr, &statBuf) == -1) {
Tcl_SetErrno(errno);
- Tcl_AppendResult(interp, "couldn't read file \"", fileName,
+ Tcl_AppendResult(interp, "couldn't read file \"",
+ Tcl_GetString(pathPtr),
"\": ", Tcl_PosixError(interp), (char *) NULL);
goto end;
}
- chan = Tcl_OpenFileChannel(interp, name, "r", 0644);
+ chan = Tcl_FSOpenFileChannel(interp, pathPtr, "r", 0644);
if (chan == (Tcl_Channel) NULL) {
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't read file \"", fileName,
+ Tcl_AppendResult(interp, "couldn't read file \"",
+ Tcl_GetString(pathPtr),
"\": ", Tcl_PosixError(interp), (char *) NULL);
goto end;
}
+ /*
+ * 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 (Tcl_ReadChars(chan, objPtr, -1, 0) < 0) {
Tcl_Close(interp, chan);
- Tcl_AppendResult(interp, "couldn't read file \"", fileName,
+ Tcl_AppendResult(interp, "couldn't read file \"",
+ Tcl_GetString(pathPtr),
"\": ", Tcl_PosixError(interp), (char *) NULL);
goto end;
}
@@ -318,9 +1365,18 @@ Tcl_EvalFile(interp, fileName)
iPtr = (Interp *) interp;
oldScriptFile = iPtr->scriptFile;
- iPtr->scriptFile = fileName;
+ iPtr->scriptFile = pathPtr;
+ Tcl_IncrRefCount(iPtr->scriptFile);
string = Tcl_GetStringFromObj(objPtr, &length);
result = Tcl_EvalEx(interp, string, length, 0);
+ /*
+ * 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) {
@@ -332,14 +1388,13 @@ Tcl_EvalFile(interp, fileName)
* Record information telling where the error occurred.
*/
- sprintf(msg, "\n (file \"%.150s\" line %d)", fileName,
+ sprintf(msg, "\n (file \"%.150s\" line %d)", Tcl_GetString(pathPtr),
interp->errorLine);
Tcl_AddErrorInfo(interp, msg);
}
end:
Tcl_DecrRefCount(objPtr);
- Tcl_DStringFree(&nameString);
return result;
}
@@ -411,12 +1466,12 @@ Tcl_SetErrno(err)
*----------------------------------------------------------------------
*/
-char *
+CONST char *
Tcl_PosixError(interp)
Tcl_Interp *interp; /* Interpreter whose $errorCode variable
* is to be changed. */
{
- char *id, *msg;
+ CONST char *id, *msg;
msg = Tcl_ErrnoMsg(errno);
id = Tcl_ErrnoId();
@@ -427,12 +1482,12 @@ Tcl_PosixError(interp)
/*
*----------------------------------------------------------------------
*
- * TclStat --
+ * Tcl_FSStat --
*
* This procedure replaces the library version of stat and lsat.
- * The chain of functions that have been "inserted" into the
- * 'statProcList' will be called in succession until either
- * a value of zero is returned, or the entire list is visited.
+ *
+ * The appropriate function for the filesystem to which pathPtr
+ * belongs will be called.
*
* Results:
* See stat documentation.
@@ -444,38 +1499,118 @@ Tcl_PosixError(interp)
*/
int
-TclStat(path, buf)
- CONST char *path; /* Path of file to stat (in current CP). */
- struct stat *buf; /* Filled with results of stat call. */
+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_Filesystem *fsPtr;
+#ifdef USE_OBSOLETE_FS_HOOKS
StatProc *statProcPtr;
+ struct stat oldStyleStatBuffer;
int retVal = -1;
+ char *path;
+ Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
+ if (transPtr == NULL) {
+ path = NULL;
+ } else {
+ path = Tcl_GetString(transPtr);
+ }
/*
* Call each of the "stat" function in succession. A non-return
* value of -1 indicates the particular function has succeeded.
*/
- Tcl_MutexLock(&hookMutex);
+ Tcl_MutexLock(&obsoleteFsHookMutex);
statProcPtr = statProcList;
while ((retVal == -1) && (statProcPtr != NULL)) {
- retVal = (*statProcPtr->proc)(path, buf);
+ retVal = (*statProcPtr->proc)(path, &oldStyleStatBuffer);
statProcPtr = statProcPtr->nextPtr;
}
- Tcl_MutexUnlock(&hookMutex);
+ 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);
+ }
+ }
+ Tcl_SetErrno(ENOENT);
+ return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FSLstat --
+ *
+ * This procedure 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.
+ *
+ * Results:
+ * See lstat documentation.
+ *
+ * Side effects:
+ * See lstat documentation.
+ *
+ *----------------------------------------------------------------------
+ */
- return (retVal);
+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_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);
+ }
+ }
+ }
+ Tcl_SetErrno(ENOENT);
+ return -1;
}
/*
*----------------------------------------------------------------------
*
- * TclAccess --
+ * Tcl_FSAccess --
*
* This procedure replaces the library version of access.
- * The chain of functions that have been "inserted" into the
- * 'accessProcList' will be called in succession until either
- * a value of zero is returned, or the entire list is visited.
+ * The appropriate function for the filesystem to which pathPtr
+ * belongs will be called.
*
* Results:
* See access documentation.
@@ -487,38 +1622,57 @@ TclStat(path, buf)
*/
int
-TclAccess(path, mode)
- CONST char *path; /* Path of file to access (in current CP). */
+Tcl_FSAccess(pathPtr, mode)
+ Tcl_Obj *pathPtr; /* Path of file to access (in current CP). */
int mode; /* Permission setting. */
{
+ Tcl_Filesystem *fsPtr;
+#ifdef USE_OBSOLETE_FS_HOOKS
AccessProc *accessProcPtr;
int retVal = -1;
+ char *path;
+ Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
+ if (transPtr == NULL) {
+ path = NULL;
+ } else {
+ path = Tcl_GetString(transPtr);
+ }
/*
* Call each of the "access" function in succession. A non-return
* value of -1 indicates the particular function has succeeded.
*/
- Tcl_MutexLock(&hookMutex);
+ Tcl_MutexLock(&obsoleteFsHookMutex);
accessProcPtr = accessProcList;
while ((retVal == -1) && (accessProcPtr != NULL)) {
retVal = (*accessProcPtr->proc)(path, mode);
accessProcPtr = accessProcPtr->nextPtr;
}
- Tcl_MutexUnlock(&hookMutex);
+ Tcl_MutexUnlock(&obsoleteFsHookMutex);
+ if (retVal != -1) {
+ return retVal;
+ }
+#endif /* USE_OBSOLETE_FS_HOOKS */
+ fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+ if (fsPtr != NULL) {
+ Tcl_FSAccessProc *proc = fsPtr->accessProc;
+ if (proc != NULL) {
+ return (*proc)(pathPtr, mode);
+ }
+ }
- return (retVal);
+ Tcl_SetErrno(ENOENT);
+ return -1;
}
/*
*----------------------------------------------------------------------
*
- * Tcl_OpenFileChannel --
+ * Tcl_FSOpenFileChannel --
*
- * The chain of functions that have been "inserted" into the
- * 'openFileChannelProcList' will be called in succession until
- * either a valid file channel is returned, or the entire list is
- * visited.
+ * The appropriate function for the filesystem to which pathPtr
+ * belongs will be called.
*
* Results:
* The new channel or NULL, if the named file could not be opened.
@@ -531,18 +1685,32 @@ TclAccess(path, mode)
*/
Tcl_Channel
-Tcl_OpenFileChannel(interp, fileName, modeString, permissions)
+Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions)
Tcl_Interp *interp; /* Interpreter for error reporting;
* can be NULL. */
- char *fileName; /* Name of file to open. */
- char *modeString; /* A list of POSIX open modes or
+ 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 what modes to create
* it? */
{
+ Tcl_Filesystem *fsPtr;
+#ifdef USE_OBSOLETE_FS_HOOKS
OpenFileChannelProc *openFileChannelProcPtr;
Tcl_Channel retVal = NULL;
+ char *path;
+#endif /* USE_OBSOLETE_FS_HOOKS */
+ Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
+ if (transPtr == NULL) {
+ return NULL;
+ }
+#ifdef USE_OBSOLETE_FS_HOOKS
+ if (transPtr == NULL) {
+ path = NULL;
+ } else {
+ path = Tcl_GetString(transPtr);
+ }
/*
* Call each of the "Tcl_OpenFileChannel" function in succession.
@@ -550,27 +1718,3301 @@ Tcl_OpenFileChannel(interp, fileName, modeString, permissions)
* succeeded.
*/
- Tcl_MutexLock(&hookMutex);
+ Tcl_MutexLock(&obsoleteFsHookMutex);
openFileChannelProcPtr = openFileChannelProcList;
while ((retVal == NULL) && (openFileChannelProcPtr != NULL)) {
- retVal = (*openFileChannelProcPtr->proc)(interp, fileName,
+ retVal = (*openFileChannelProcPtr->proc)(interp, path,
modeString, permissions);
openFileChannelProcPtr = openFileChannelProcPtr->nextPtr;
}
- Tcl_MutexUnlock(&hookMutex);
+ Tcl_MutexUnlock(&obsoleteFsHookMutex);
+ if (retVal != NULL) {
+ return retVal;
+ }
+#endif /* USE_OBSOLETE_FS_HOOKS */
+ fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+ if (fsPtr != NULL) {
+ Tcl_FSOpenFileChannelProc *proc = fsPtr->openFileChannelProc;
+ if (proc != NULL) {
+ int mode, seekFlag;
+ mode = TclGetOpenMode(interp, modeString, &seekFlag);
+ if (mode == -1) {
+ return NULL;
+ }
+ 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;
+ }
+ }
+ }
+ return retVal;
+ }
+ }
+ /* File doesn't belong to any filesystem that can open it */
+ Tcl_SetErrno(ENOENT);
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "couldn't open \"",
+ Tcl_GetString(pathPtr), "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
+ }
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 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 each
+ * filesystem's Tcl_FSMatchInDirectoryProc having to deal with
+ * this issue, we create a pathPtr on the fly, 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.
+ *
+ * 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 and correct type.
+ *
+ * Results:
+ *
+ * The return value is a standard Tcl result indicating whether an
+ * error 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.
+ *
+ * Side effects:
+ * The interpreter may have an error message inserted into it.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+Tcl_FSMatchInDirectory(interp, result, pathPtr, pattern, types)
+ Tcl_Interp *interp; /* Interpreter to receive error messages. */
+ Tcl_Obj *result; /* 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 = Tcl_FSGetFileSystemForPath(pathPtr);
+ if (fsPtr != NULL) {
+ Tcl_FSMatchInDirectoryProc *proc = fsPtr->matchInDirectoryProc;
+ if (proc != NULL) {
+ return (*proc)(interp, result, pathPtr, pattern, types);
+ }
+ } else {
+ Tcl_Obj* cwd;
+ int ret = -1;
+ if (pathPtr != NULL) {
+ int len;
+ Tcl_GetStringFromObj(pathPtr,&len);
+ if (len != 0) {
+ /*
+ * We have no idea how to match files in a directory
+ * which belongs to no known filesystem
+ */
+ Tcl_SetErrno(ENOENT);
+ return -1;
+ }
+ }
+ /*
+ * We have an empty or NULL path. This is defined to mean we
+ * must search for files within the current 'cwd'. We
+ * therefore use that, but then since the proc we call will
+ * return results which include the cwd we must then trim it
+ * off the front of each path in the result. We choose to deal
+ * with this here (in the generic code), since if we don't,
+ * every single filesystem's implementation of
+ * Tcl_FSMatchInDirectory will have to deal with it for us.
+ */
+ cwd = Tcl_FSGetCwd(NULL);
+ if (cwd == NULL) {
+ if (interp != NULL) {
+ Tcl_SetResult(interp, "glob couldn't determine "
+ "the current working directory", TCL_STATIC);
+ }
+ return TCL_ERROR;
+ }
+ fsPtr = Tcl_FSGetFileSystemForPath(cwd);
+ if (fsPtr != NULL) {
+ Tcl_FSMatchInDirectoryProc *proc = fsPtr->matchInDirectoryProc;
+ if (proc != NULL) {
+ int cwdLen;
+ Tcl_Obj *cwdDir;
+ char *cwdStr;
+ char sep = 0;
+ Tcl_Obj* tmpResultPtr = Tcl_NewListObj(0, NULL);
+ /*
+ * We know the cwd is a normalised object which does
+ * not end in a directory delimiter, unless the cwd
+ * is the name of a volume, in which case it will
+ * end in a delimiter! We handle this situation here.
+ * A better test than the '!= sep' might be to simply
+ * check if 'cwd' is a root volume.
+ *
+ * Note that if we get this wrong, we will strip off
+ * either too much or too little below, leading to
+ * wrong answers returned by glob.
+ */
+ cwdDir = Tcl_DuplicateObj(cwd);
+ Tcl_IncrRefCount(cwdDir);
+ cwdStr = Tcl_GetStringFromObj(cwdDir, &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.
+ */
+ switch (tclPlatform) {
+ case TCL_PLATFORM_UNIX:
+ if (cwdStr[cwdLen-1] != '/') {
+ sep = '/';
+ }
+ break;
+ case TCL_PLATFORM_WINDOWS:
+ if (cwdStr[cwdLen-1] != '/' && cwdStr[cwdLen-1] != '\\') {
+ sep = '/';
+ }
+ break;
+ case TCL_PLATFORM_MAC:
+ if (cwdStr[cwdLen-1] != ':') {
+ sep = ':';
+ }
+ break;
+ }
+ if (sep != 0) {
+ Tcl_AppendToObj(cwdDir, &sep, 1);
+ cwdLen++;
+ /* Note: cwdStr may no longer be a valid pointer now */
+ }
+ ret = (*proc)(interp, tmpResultPtr, cwdDir, pattern, types);
+ Tcl_DecrRefCount(cwdDir);
+ if (ret == TCL_OK) {
+ int resLength;
+
+ ret = Tcl_ListObjLength(interp, tmpResultPtr, &resLength);
+ if (ret == TCL_OK) {
+ Tcl_Obj *elt, *cutElt;
+ char *eltStr;
+ int eltLen, i;
+
+ for (i = 0; i < resLength; i++) {
+ Tcl_ListObjIndex(interp, tmpResultPtr, i, &elt);
+ eltStr = Tcl_GetStringFromObj(elt,&eltLen);
+ cutElt = Tcl_NewStringObj(eltStr + cwdLen,
+ eltLen - cwdLen);
+ Tcl_ListObjAppendElement(interp, result, cutElt);
+ }
+ }
+ }
+ Tcl_DecrRefCount(tmpResultPtr);
+ }
+ }
+ Tcl_DecrRefCount(cwd);
+ return ret;
+ }
+ Tcl_SetErrno(ENOENT);
+ return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FSGetCwd --
+ *
+ * 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).
+ *
+ * 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 therefore ensure they only access the cwd through this
+ * function to avoid confusion.
+ *
+ * If a global cwdPathPtr already exists, it is returned, subject
+ * to a synchronisation attempt in that cwdPathPtr's fs.
+ * Otherwise, the chain of functions that have been "inserted"
+ * into the filesystem will be called in succession until either a
+ * value other than NULL is returned, or the entire list is
+ * visited.
+ *
+ * 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 returned, an error message is left in the
+ * interp's result.
+ *
+ * The result already has its refCount incremented for the caller.
+ * When it is no longer needed, that refCount 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.
+ *
+ * Of course it is probably a bad idea for multiple threads to
+ * be *setting* the cwd anyway, but we can at least try to
+ * help the case of multiple reads with occasional sets.
+ *
+ * Side effects:
+ * Various objects may be freed and allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj*
+Tcl_FSGetCwd(interp)
+ Tcl_Interp *interp;
+{
+ Tcl_Obj *cwdToReturn;
+
+ if (FsCwdPointerEquals(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 indicates the particular function has
+ * succeeded.
+ */
+
+ fsRecPtr = FsGetIterator();
+ while ((retVal == NULL) && (fsRecPtr != NULL)) {
+ Tcl_FSGetCwdProc *proc = fsRecPtr->fsPtr->getCwdProc;
+ if (proc != NULL) {
+ retVal = (*proc)(interp);
+ }
+ fsRecPtr = fsRecPtr->nextPtr;
+ }
+ FsReleaseIterator();
+ /*
+ * Now the 'cwd' may NOT be normalized, at least on some
+ * platforms. For the sake of efficiency, we want a completely
+ * normalized cwd at all times.
+ *
+ * Finally, if retVal is NULL, we do not have a cwd, which
+ * could be problematic.
+ */
+ if (retVal != NULL) {
+ Tcl_Obj *norm = FSNormalizeAbsolutePath(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 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.
+ */
+ Tcl_MutexLock(&cwdMutex);
+ /* Just in case the pointer has been set by another
+ * thread between now and the test above */
+ if (cwdPathPtr != NULL) {
+ Tcl_DecrRefCount(cwdPathPtr);
+ }
+ cwdPathPtr = norm;
+ Tcl_MutexUnlock(&cwdMutex);
+ }
+ Tcl_DecrRefCount(retVal);
+ }
+ } else {
+ /*
+ * 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, the permissions on
+ * that directory have changed.
+ */
+ Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(cwdPathPtr);
+ /*
+ * 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 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;
+ if (proc != NULL) {
+ Tcl_Obj *retVal = (*proc)(interp);
+ if (retVal != NULL) {
+ Tcl_Obj *norm = FSNormalizeAbsolutePath(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 */
+ } else if (Tcl_FSEqualPaths(cwdPathPtr, norm)) {
+ /*
+ * 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.
+ */
+ Tcl_DecrRefCount(norm);
+ } else {
+ /* The cwd has in fact changed, so we must
+ * lock down the cwdMutex to modify. */
+ Tcl_MutexLock(&cwdMutex);
+ Tcl_DecrRefCount(cwdPathPtr);
+ cwdPathPtr = norm;
+ Tcl_MutexUnlock(&cwdMutex);
+ }
+ Tcl_DecrRefCount(retVal);
+ } else {
+ /* The 'cwd' function returned an error, so we
+ * reset the cwd after locking down the mutex. */
+ Tcl_MutexLock(&cwdMutex);
+ Tcl_DecrRefCount(cwdPathPtr);
+ cwdPathPtr = NULL;
+ Tcl_MutexUnlock(&cwdMutex);
+ }
+ }
+ }
+ }
+
+ /*
+ * The paths all eventually fall through to here. Note that
+ * we use a bunch of separate mutex locks throughout this
+ * code to help prevent deadlocks between threads. Really
+ * the only weirdness will arise if multiple threads are setting
+ * and reading the cwd, and that behaviour is always going to be
+ * a little suspect.
+ */
+ Tcl_MutexLock(&cwdMutex);
+ cwdToReturn = cwdPathPtr;
+ if (cwdToReturn != NULL) {
+ Tcl_IncrRefCount(cwdToReturn);
+ }
+ Tcl_MutexUnlock(&cwdMutex);
+
+ return (cwdToReturn);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FSUtime --
+ *
+ * This procedure replaces the library version of utime.
+ * The appropriate function for the filesystem to which pathPtr
+ * belongs will be called.
+ *
+ * Results:
+ * See utime documentation.
+ *
+ * Side effects:
+ * See utime documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+ if (fsPtr != NULL) {
+ Tcl_FSUtimeProc *proc = fsPtr->utimeProc;
+ if (proc != NULL) {
+ return (*proc)(pathPtr, tval);
+ }
+ }
+ return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NativeFileAttrStrings --
+ *
+ * This procedure 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 support, and is placed here because
+ * it is shared by Unix, MacOS and Windows code.
+ *
+ * Results:
+ * An array of strings
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static CONST char**
+NativeFileAttrStrings(pathPtr, objPtrRef)
+ Tcl_Obj *pathPtr;
+ Tcl_Obj** objPtrRef;
+{
+ return tclpFileAttrStrings;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NativeFileAttrsGet --
+ *
+ * This procedure 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, MacOS 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 refCount to ensure it is properly
+ * freed.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+{
+ return (*tclpFileAttrProcs[index].getProc)(interp, index,
+ pathPtr, objPtrRef);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NativeFileAttrsSet --
+ *
+ * This procedure 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, MacOS and Windows code.
+ *
+ * Results:
+ * Standard Tcl return code.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+{
+ return (*tclpFileAttrProcs[index].setProc)(interp, index,
+ pathPtr, objPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FSFileAttrStrings --
+ *
+ * This procedure 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 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 if the list should be
+ * disposed of by Tcl when done, it should have a refCount of zero,
+ * and if the list should not be disposed of, the filesystem
+ * should ensure it retains a refCount on the object.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+CONST char **
+Tcl_FSFileAttrStrings(pathPtr, objPtrRef)
+ 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);
+ }
+ }
+ Tcl_SetErrno(ENOENT);
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ * 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 refCount to ensure it is properly
+ * freed.
+
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+ if (fsPtr != NULL) {
+ Tcl_FSFileAttrsGetProc *proc = fsPtr->fileAttrsGetProc;
+ if (proc != NULL) {
+ return (*proc)(interp, index, pathPtr, objPtrRef);
+ }
+ }
+ Tcl_SetErrno(ENOENT);
+ return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ * Results:
+ * Standard Tcl return code.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+ if (fsPtr != NULL) {
+ Tcl_FSFileAttrsSetProc *proc = fsPtr->fileAttrsSetProc;
+ if (proc != NULL) {
+ return (*proc)(interp, index, pathPtr, objPtr);
+ }
+ }
+ Tcl_SetErrno(ENOENT);
+ return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FSChdir --
+ *
+ * This function replaces the library version of chdir().
+ *
+ * The path is normalized and then passed to the filesystem
+ * which claims it.
+ *
+ * Results:
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+Tcl_FSChdir(pathPtr)
+ Tcl_Obj *pathPtr;
+{
+ Tcl_Filesystem *fsPtr;
+ int retVal = -1;
+
+ if (Tcl_FSGetNormalizedPath(NULL, pathPtr) == NULL) {
+ return TCL_ERROR;
+ }
+
+ fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+ if (fsPtr != NULL) {
+ Tcl_FSChdirProc *proc = fsPtr->chdirProc;
+ if (proc != NULL) {
+ retVal = (*proc)(pathPtr);
+ } else {
+ /* Fallback on stat-based implementation */
+ Tcl_StatBuf buf;
+ /* If the file can be stat'ed and is a directory and
+ * is readable, then we can chdir. */
+ if ((Tcl_FSStat(pathPtr, &buf) == 0)
+ && (S_ISDIR(buf.st_mode))
+ && (Tcl_FSAccess(pathPtr, R_OK) == 0)) {
+ /* We allow the chdir */
+ retVal = 0;
+ }
+ }
+ }
+
+ if (retVal != -1) {
+ /*
+ * 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 (retVal == TCL_OK) {
+ /*
+ * 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 correct value
+ * will have been cached as a result of the
+ * Tcl_FSGetFileSystemForPath call above anyway).
+ */
+ Tcl_Obj *normDirName = Tcl_FSGetNormalizedPath(NULL, pathPtr);
+ if (normDirName == NULL) {
+ return TCL_ERROR;
+ }
+ /*
+ * We will be adding a reference to this object when
+ * we store it in the cwdPathPtr.
+ */
+ Tcl_IncrRefCount(normDirName);
+ /* Get a lock on the cwd while we modify it */
+ Tcl_MutexLock(&cwdMutex);
+ /* Free up the previous cwd we stored */
+ if (cwdPathPtr != NULL) {
+ Tcl_DecrRefCount(cwdPathPtr);
+ }
+ /* Now remember the current cwd */
+ cwdPathPtr = normDirName;
+ Tcl_MutexUnlock(&cwdMutex);
+ }
+ }
+
return (retVal);
}
/*
*----------------------------------------------------------------------
*
+ * 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.
+ *
+ * Note that the native filesystem doesn't actually assume
+ * 'pathPtr' is a path. Rather it assumes filename is either
+ * a path or just the name of a file which can be found somewhere
+ * in the environment's 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 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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
+ * code. */
+ 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. */
+ Tcl_LoadHandle *handlePtr; /* 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;
+ if (proc != NULL) {
+ int retVal = (*proc)(interp, pathPtr, handlePtr, unloadProcPtr);
+ if (retVal != TCL_OK) {
+ return retVal;
+ }
+ if (*handlePtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (sym1 != NULL) {
+ *proc1Ptr = TclpFindSymbol(interp, *handlePtr, sym1);
+ }
+ if (sym2 != NULL) {
+ *proc2Ptr = TclpFindSymbol(interp, *handlePtr, sym2);
+ }
+ return retVal;
+ } else {
+ Tcl_Filesystem *copyFsPtr;
+ Tcl_Obj *copyToPtr;
+
+ /* First check if it is readable -- and exists! */
+ 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;
+ }
+
+ /*
+ * Get a temporary filename to use, first to
+ * copy the file into, and then to load.
+ */
+ copyToPtr = TclpTempFileName();
+ if (copyToPtr == NULL) {
+ return -1;
+ }
+ Tcl_IncrRefCount(copyToPtr);
+
+ 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.
+ */
+ Tcl_FSDeleteFile(copyToPtr);
+ Tcl_DecrRefCount(copyToPtr);
+ return -1;
+ }
+
+ if (TclCrossFilesystemCopy(interp, pathPtr,
+ copyToPtr) == TCL_OK) {
+ /*
+ * 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 0777. Or directly:
+ *
+ * Tcl_Obj* perm = Tcl_NewStringObj("0777",-1);
+ * Tcl_IncrRefCount(perm);
+ * Tcl_FSFileAttrsSet(NULL, 2, copyToPtr, perm);
+ * Tcl_DecrRefCount(perm);
+ *
+ */
+ Tcl_LoadHandle newLoadHandle = NULL;
+ Tcl_FSUnloadFileProc *newUnloadProcPtr = NULL;
+ FsDivertLoad *tvdlPtr;
+ int retVal;
+
+ retVal = Tcl_FSLoadFile(interp, copyToPtr, sym1, sym2,
+ proc1Ptr, proc2Ptr,
+ &newLoadHandle,
+ &newUnloadProcPtr);
+ if (retVal != TCL_OK) {
+ /* The file didn't load successfully */
+ Tcl_FSDeleteFile(copyToPtr);
+ Tcl_DecrRefCount(copyToPtr);
+ return retVal;
+ }
+ /*
+ * 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 (Tcl_FSDeleteFile(copyToPtr) == TCL_OK) {
+ Tcl_DecrRefCount(copyToPtr);
+ (*handlePtr) = NULL;
+ (*unloadProcPtr) = NULL;
+ return TCL_OK;
+ }
+ /*
+ * When we unload this file, we need to divert the
+ * unloading so we can unload and cleanup the
+ * temporary file correctly.
+ */
+ tvdlPtr = (FsDivertLoad*) ckalloc(sizeof(FsDivertLoad));
+
+ /*
+ * Remember three pieces of information. This allows
+ * us to cleanup the diverted load completely, on
+ * platforms which allow proper unloading of code.
+ */
+ tvdlPtr->loadHandle = newLoadHandle;
+ tvdlPtr->unloadProcPtr = newUnloadProcPtr;
+ /* copyToPtr is already incremented for this reference */
+ tvdlPtr->divertedFile = copyToPtr;
+ /*
+ * This is the filesystem we loaded it into. It is
+ * almost certainly the tclNativeFilesystem, but we don't
+ * want to make that assumption. 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.
+ */
+ tvdlPtr->divertedFilesystem = copyFsPtr;
+ /* Get the native representation of the file path */
+ tvdlPtr->divertedFileNativeRep = Tcl_FSGetInternalRep(copyToPtr,
+ copyFsPtr);
+ copyToPtr = NULL;
+ (*handlePtr) = (Tcl_LoadHandle) tvdlPtr;
+ (*unloadProcPtr) = &FSUnloadTempFile;
+
+ return retVal;
+ } else {
+ /* Cross-platform copy failed */
+ Tcl_FSDeleteFile(copyToPtr);
+ Tcl_DecrRefCount(copyToPtr);
+ return TCL_ERROR;
+ }
+ }
+ }
+ Tcl_SetErrno(ENOENT);
+ return -1;
+}
+/*
+ * This function used to be in the platform specific directories, but it
+ * has now been made to work cross-platform
+ */
+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. */
+{
+ Tcl_LoadHandle handle = NULL;
+ int res;
+
+ res = TclpDlopen(interp, pathPtr, &handle, unloadProcPtr);
+
+ if (res != TCL_OK) {
+ return res;
+ }
+
+ if (handle == NULL) {
+ return TCL_ERROR;
+ }
+
+ *clientDataPtr = (ClientData)handle;
+
+ *proc1Ptr = TclpFindSymbol(interp, handle, sym1);
+ *proc2Ptr = TclpFindSymbol(interp, handle, sym2);
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FSUnloadTempFile --
+ *
+ * This function is called when we loaded a library of code via
+ * an intermediate temporary file. This function ensures
+ * the library is correctly unloaded and the temporary file
+ * is correctly deleted.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * 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. */
+{
+ FsDivertLoad *tvdlPtr = (FsDivertLoad*)loadHandle;
+ /*
+ * This test should never trigger, since we give
+ * the client data in the function above.
+ */
+ 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 because the shared library is still in
+ * use.
+ */
+ if (tvdlPtr->unloadProcPtr != NULL) {
+ (*tvdlPtr->unloadProcPtr)(tvdlPtr->loadHandle);
+ }
+
+ /* Remove the temporary file we created. */
+ if (Tcl_FSDeleteFile(tvdlPtr->divertedFile) != TCL_OK) {
+ /*
+ * The above may have failed because the filesystem, or something
+ * it depends upon (e.g. encodings) are being taken down because
+ * Tcl is exiting.
+ *
+ * Therefore we try to call the filesystem's 'delete file proc'
+ * directly. Note that this call may still cause problems, because
+ * it will ask for the native representation of the divertedFile,
+ * and that may need to be _recalculated_, in which case this
+ * call isn't very different to the above. What we could do
+ * instead is generate a new Tcl_Obj (pure native) by calling:
+ *
+ * Tcl_Obj *tmp = Tcl_FSNewNativePath(tvdlPtr->divertedFile,
+ * tvdlPtr->divertedFileNativeRep);
+ * Tcl_IncrRefCount(tmp);
+ * tvdlPtr->divertedFilesystem->deleteFileProc(tmp);
+ * Tcl_DecrRefCount(tmp);
+ *
+ * and then use that in this call. This approach would potentially
+ * work even if the encodings and everything else have been
+ * deconstructed. For the moment, however, we simply assume
+ * Tcl_FSDeleteFile has worked correctly.
+ */
+ }
+
+ /*
+ * 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);
+ ckfree((char*)tvdlPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * 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 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 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 is given by the 'linkAction' flags, which is
+ * an or'd combination of:
+ *
+ * TCL_CREATE_SYMBOLIC_LINK
+ * TCL_CREATE_HARD_LINK
+ *
+ * Note that most filesystems will not support linking across
+ * to different filesystems, so this function will usually
+ * fail unless toPtr is in the same FS as pathPtr.
+ *
+ * Side effects:
+ * 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_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+ if (fsPtr != NULL) {
+ Tcl_FSLinkProc *proc = fsPtr->linkProc;
+ if (proc != NULL) {
+ return (*proc)(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.
+ */
+#ifndef S_IFLNK
+ errno = EINVAL;
+#else
+ Tcl_SetErrno(ENOENT);
+#endif /* S_IFLNK */
+ return NULL;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_FSListVolumes --
+ *
+ * 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 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 we are
+ * building, and then decrement the refCount.
+ *
+ * Results:
+ * The list of volumes, in an object which has refCount 0.
+ *
+ * Side effects:
+ * None
+ *
+ *---------------------------------------------------------------------------
+ */
+
+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 all the functions registered, since we want
+ * a list of all drives from all filesystems.
+ */
+
+ fsRecPtr = FsGetIterator();
+ while (fsRecPtr != NULL) {
+ Tcl_FSListVolumesProc *proc = fsRecPtr->fsPtr->listVolumesProc;
+ if (proc != NULL) {
+ Tcl_Obj *thisFsVolumes = (*proc)();
+ if (thisFsVolumes != NULL) {
+ Tcl_ListObjAppendList(NULL, resultPtr, thisFsVolumes);
+ Tcl_DecrRefCount(thisFsVolumes);
+ }
+ }
+ fsRecPtr = fsRecPtr->nextPtr;
+ }
+ FsReleaseIterator();
+
+ return resultPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FSGetPathType --
+ *
+ * Determines whether a given path is relative to the current
+ * directory, relative to the current volume, or absolute.
+ *
+ * Results:
+ * Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or
+ * TCL_PATH_VOLUME_RELATIVE.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_PathType
+Tcl_FSGetPathType(pathObjPtr)
+ Tcl_Obj *pathObjPtr;
+{
+ return FSGetPathType(pathObjPtr, NULL, NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FSGetPathType --
+ *
+ * Determines whether a given path is relative to the current
+ * directory, relative to the current volume, or absolute. If the
+ * caller wishes to know which filesystem claimed the path (in the
+ * case for which the path is absolute), then a reference to a
+ * filesystem pointer can be passed in (but passing NULL is
+ * acceptable).
+ *
+ * Results:
+ * Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or
+ * 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.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_PathType
+FSGetPathType(pathObjPtr, filesystemPtrPtr, driveNameLengthPtr)
+ Tcl_Obj *pathObjPtr;
+ Tcl_Filesystem **filesystemPtrPtr;
+ int *driveNameLengthPtr;
+{
+ if (Tcl_FSConvertToPathType(NULL, pathObjPtr) != TCL_OK) {
+ return GetPathType(pathObjPtr, filesystemPtrPtr,
+ driveNameLengthPtr, NULL);
+ } else {
+ FsPath *fsPathPtr = (FsPath*) pathObjPtr->internalRep.otherValuePtr;
+ if (fsPathPtr->cwdPtr != NULL) {
+ return TCL_PATH_RELATIVE;
+ } else {
+ return GetPathType(pathObjPtr, filesystemPtrPtr,
+ driveNameLengthPtr, NULL);
+ }
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_FSSplitPath --
+ *
+ * This function takes the given Tcl_Obj, which should be a valid
+ * path, and returns a Tcl List object containing each segment of
+ * that path as an element.
+ *
+ * Results:
+ * 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.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tcl_Obj*
+Tcl_FSSplitPath(pathPtr, lenPtr)
+ 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;
+ char separator = '/';
+ int driveNameLength;
+ char *p;
+
+ /*
+ * Perform platform specific splitting.
+ */
+
+ if (FSGetPathType(pathPtr, &fsPtr, &driveNameLength)
+ == TCL_PATH_ABSOLUTE) {
+ if (fsPtr == &tclNativeFilesystem) {
+ return TclpNativeSplitPath(pathPtr, lenPtr);
+ }
+ } else {
+ return TclpNativeSplitPath(pathPtr, lenPtr);
+ }
+
+ /* We assume separators are single characters */
+ if (fsPtr->filesystemSeparatorProc != NULL) {
+ Tcl_Obj *sep = (*fsPtr->filesystemSeparatorProc)(pathPtr);
+ if (sep != NULL) {
+ separator = Tcl_GetString(sep)[0];
+ }
+ }
+
+ /*
+ * 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)
+ */
+ result = Tcl_NewObj();
+ p = Tcl_GetString(pathPtr);
+ Tcl_ListObjAppendElement(NULL, result,
+ Tcl_NewStringObj(p, driveNameLength));
+ p+= driveNameLength;
+
+ /* Add the remaining path elements to the list */
+ for (;;) {
+ 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);
+ Tcl_AppendToObj(nextElt, elementStart, length);
+ } else {
+ nextElt = Tcl_NewStringObj(elementStart, length);
+ }
+ Tcl_ListObjAppendElement(NULL, result, nextElt);
+ }
+ if (*p++ == '\0') {
+ break;
+ }
+ }
+
+ /*
+ * Compute the number of elements in the result.
+ */
+
+ if (lenPtr != NULL) {
+ Tcl_ListObjLength(NULL, result, lenPtr);
+ }
+ return result;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_FSJoinPath --
+ *
+ * This function takes the given Tcl_Obj, which should be a valid
+ * list, and returns the path object given by considering the
+ * first 'elements' elements as valid path segments. If elements < 0,
+ * we use the entire list.
+ *
+ * Results:
+ * Returns object with refCount of zero.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+Tcl_Obj*
+Tcl_FSJoinPath(listObj, elements)
+ Tcl_Obj *listObj;
+ int elements;
+{
+ 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 */
+ int listTest;
+ if (Tcl_ListObjLength(NULL, listObj, &listTest) != TCL_OK) {
+ return NULL;
+ }
+ /*
+ * Correct this if it is too large, otherwise we will
+ * waste our timing joining null elements to the path
+ */
+ if (elements > listTest) {
+ elements = listTest;
+ }
+ }
+
+ res = Tcl_NewObj();
+
+ for (i = 0; i < elements; i++) {
+ Tcl_Obj *elt;
+ int driveNameLength;
+ Tcl_PathType type;
+ char *strElt;
+ int strEltLen;
+ int length;
+ char *ptr;
+ Tcl_Obj *driveName = NULL;
+
+ Tcl_ListObjIndex(NULL, listObj, i, &elt);
+ strElt = Tcl_GetStringFromObj(elt, &strEltLen);
+ type = GetPathType(elt, &fsPtr, &driveNameLength, &driveName);
+ if (type != TCL_PATH_RELATIVE) {
+ /* Zero out the current result */
+ Tcl_DecrRefCount(res);
+ if (driveName != NULL) {
+ res = Tcl_DuplicateObj(driveName);
+ Tcl_DecrRefCount(driveName);
+ } else {
+ res = Tcl_NewStringObj(strElt, driveNameLength);
+ }
+ strElt += driveNameLength;
+ }
+
+ ptr = Tcl_GetStringFromObj(res, &length);
+
+ /*
+ * Strip off any './' before a tilde, unless this is the
+ * beginning of the path.
+ */
+ if (length > 0 && strEltLen > 0) {
+ if ((strElt[0] == '.') && (strElt[1] == '/')
+ && (strElt[2] == '~')) {
+ strElt += 2;
+ }
+ }
+
+ /*
+ * A NULL value for fsPtr at this stage basically means
+ * we're trying to join a relative path onto something
+ * which is also relative (or empty). There's nothing
+ * particularly wrong with that.
+ */
+ if (*strElt == '\0') continue;
+
+ if (fsPtr == &tclNativeFilesystem || fsPtr == NULL) {
+ TclpNativeJoinPath(res, strElt);
+ } else {
+ char separator = '/';
+ int needsSep = 0;
+
+ if (fsPtr->filesystemSeparatorProc != NULL) {
+ Tcl_Obj *sep = (*fsPtr->filesystemSeparatorProc)(res);
+ if (sep != NULL) {
+ separator = Tcl_GetString(sep)[0];
+ }
+ }
+
+ if (length > 0 && ptr[length -1] != '/') {
+ Tcl_AppendToObj(res, &separator, 1);
+ length++;
+ }
+ Tcl_SetObjLength(res, length + (int) strlen(strElt));
+
+ ptr = Tcl_GetString(res) + length;
+ for (; *strElt != '\0'; strElt++) {
+ if (*strElt == separator) {
+ while (strElt[1] == separator) {
+ strElt++;
+ }
+ if (strElt[1] != '\0') {
+ if (needsSep) {
+ *ptr++ = separator;
+ }
+ }
+ } else {
+ *ptr++ = *strElt;
+ needsSep = 1;
+ }
+ }
+ length = ptr - Tcl_GetString(res);
+ Tcl_SetObjLength(res, length);
+ }
+ }
+ return res;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetPathType --
+ *
+ * Helper function used by FSGetPathType.
+ *
+ * Results:
+ * Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or
+ * 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.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_PathType
+GetPathType(pathObjPtr, filesystemPtrPtr, driveNameLengthPtr, driveNameRef)
+ Tcl_Obj *pathObjPtr;
+ Tcl_Filesystem **filesystemPtrPtr;
+ int *driveNameLengthPtr;
+ Tcl_Obj **driveNameRef;
+{
+ FilesystemRecord *fsRecPtr;
+ int pathLen;
+ char *path;
+ Tcl_PathType type = TCL_PATH_RELATIVE;
+
+ path = Tcl_GetStringFromObj(pathObjPtr, &pathLen);
+
+ /*
+ * Call each of the "listVolumes" function in succession, checking
+ * whether the given path is an absolute path on any of the volumes
+ * returned (this is done by checking whether the path's prefix
+ * matches).
+ */
+
+ fsRecPtr = FsGetIterator();
+ 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 mac, 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.
+ *
+ * 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.
+ */
+ if ((fsRecPtr->fsPtr != &tclNativeFilesystem) && (proc != NULL)) {
+ int numVolumes;
+ Tcl_Obj *thisFsVolumes = (*proc)();
+ if (thisFsVolumes != NULL) {
+ 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'.
+ *
+ * It would be better if we could signal an error
+ * here (but panic seems a bit excessive).
+ */
+ numVolumes = -1;
+ }
+ while (numVolumes > 0) {
+ Tcl_Obj *vol;
+ int len;
+ char *strVol;
+
+ numVolumes--;
+ Tcl_ListObjIndex(NULL, thisFsVolumes, numVolumes, &vol);
+ strVol = Tcl_GetStringFromObj(vol,&len);
+ if (pathLen < len) {
+ continue;
+ }
+ if (strncmp(strVol, path, (size_t) len) == 0) {
+ type = TCL_PATH_ABSOLUTE;
+ if (filesystemPtrPtr != NULL) {
+ *filesystemPtrPtr = fsRecPtr->fsPtr;
+ }
+ if (driveNameLengthPtr != NULL) {
+ *driveNameLengthPtr = len;
+ }
+ if (driveNameRef != NULL) {
+ *driveNameRef = vol;
+ Tcl_IncrRefCount(vol);
+ }
+ break;
+ }
+ }
+ Tcl_DecrRefCount(thisFsVolumes);
+ if (type == TCL_PATH_ABSOLUTE) {
+ /* We don't need to examine any more filesystems */
+ break;
+ }
+ }
+ }
+ fsRecPtr = fsRecPtr->nextPtr;
+ }
+ FsReleaseIterator();
+
+ if (type != TCL_PATH_ABSOLUTE) {
+ type = TclpGetNativePathType(pathObjPtr, driveNameLengthPtr,
+ driveNameRef);
+ if ((type == TCL_PATH_ABSOLUTE) && (filesystemPtrPtr != NULL)) {
+ *filesystemPtrPtr = &tclNativeFilesystem;
+ }
+ }
+ return type;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_FSRenameFile --
+ *
+ * If the two paths given belong to the same filesystem, we call
+ * that filesystems rename function. Otherwise we simply
+ * return the posix error 'EXDEV', and -1.
+ *
+ * Results:
+ * Standard Tcl error code if a function was called.
+ *
+ * Side effects:
+ * A file may be renamed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tcl_FSRenameFile(srcPathPtr, destPathPtr)
+ Tcl_Obj* srcPathPtr; /* Pathname of file or dir to be renamed
+ * (UTF-8). */
+ Tcl_Obj *destPathPtr; /* New pathname of file or directory
+ * (UTF-8). */
+{
+ int retVal = -1;
+ 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 (retVal == -1) {
+ Tcl_SetErrno(EXDEV);
+ }
+ return retVal;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * 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.
+ *
+ * Note that in the native filesystems, 'copyFileProc' is defined
+ * to copy soft links (i.e. it copies the links themselves, not
+ * the things they point to).
+ *
+ * Results:
+ * Standard Tcl error code if a function was called.
+ *
+ * Side effects:
+ * A file may be copied.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+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). */
+{
+ int retVal = -1;
+ 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 (retVal == -1) {
+ Tcl_SetErrno(EXDEV);
+ }
+ return retVal;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclCrossFilesystemCopy --
+ *
+ * Helper for above function, and for Tcl_FSLoadFile, to copy
+ * files from one filesystem to another. This function will
+ * overwrite the target file if it already exists.
+ *
+ * Results:
+ * Standard Tcl error code.
+ *
+ * Side effects:
+ * A file may be created.
+ *
+ *---------------------------------------------------------------------------
+ */
+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). */
+{
+ int result = TCL_ERROR;
+ int prot = 0666;
+
+ Tcl_Channel out = Tcl_FSOpenFileChannel(interp, target, "w", prot);
+ if (out != NULL) {
+ /* It looks like we can copy it over */
+ 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;
+ /*
+ * Copy it synchronously. We might wish to add an
+ * asynchronous option to support vfs's which are
+ * slow (e.g. network sockets).
+ */
+ Tcl_SetChannelOption(interp, in, "-translation", "binary");
+ Tcl_SetChannelOption(interp, out, "-translation", "binary");
+
+ 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.
+ */
+ Tcl_Close(interp, in);
+ Tcl_Close(interp, out);
+
+ /* Set modification date of copied file */
+ if (Tcl_FSLstat(source, &sourceStatBuf) != 0) {
+ tval.actime = sourceStatBuf.st_atime;
+ tval.modtime = sourceStatBuf.st_mtime;
+ Tcl_FSUtime(source, &tval);
+ }
+ }
+ }
+ return result;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_FSDeleteFile --
+ *
+ * The appropriate function for the filesystem to which pathPtr
+ * belongs will be called.
+ *
+ * Results:
+ * Standard Tcl error code.
+ *
+ * Side effects:
+ * A file may be deleted.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tcl_FSDeleteFile(pathPtr)
+ 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);
+ }
+ }
+ Tcl_SetErrno(ENOENT);
+ return -1;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_FSCreateDirectory --
+ *
+ * The appropriate function for the filesystem to which pathPtr
+ * belongs will be called.
+ *
+ * Results:
+ * Standard Tcl error code.
+ *
+ * Side effects:
+ * A directory may be created.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tcl_FSCreateDirectory(pathPtr)
+ 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);
+ }
+ }
+ Tcl_SetErrno(ENOENT);
+ return -1;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * 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.
+ *
+ * Results:
+ * Standard Tcl error code if a function was called.
+ *
+ * Side effects:
+ * A directory may be copied.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tcl_FSCopyDirectory(srcPathPtr, destPathPtr, errorPtr)
+ 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 object containing name of file
+ * causing error, with refCount 1. */
+{
+ int retVal = -1;
+ 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 (retVal == -1) {
+ Tcl_SetErrno(EXDEV);
+ }
+ return retVal;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_FSRemoveDirectory --
+ *
+ * The appropriate function for the filesystem to which pathPtr
+ * belongs will be called.
+ *
+ * Results:
+ * Standard Tcl error code.
+ *
+ * Side effects:
+ * A directory may be deleted.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tcl_FSRemoveDirectory(pathPtr, recursive, errorPtr)
+ 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 object containing name of file
+ * causing error, with refCount 1. */
+{
+ Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+ if (fsPtr != NULL) {
+ Tcl_FSRemoveDirectoryProc *proc = fsPtr->removeDirectoryProc;
+ if (proc != NULL) {
+ if (recursive) {
+ /*
+ * We check whether the cwd lies inside this directory
+ * and move it if it does.
+ */
+ Tcl_Obj *cwdPtr = Tcl_FSGetCwd(NULL);
+ if (cwdPtr != NULL) {
+ char *cwdStr, *normPathStr;
+ int cwdLen, normLen;
+ Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr);
+ 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 = TclFileDirname(NULL, pathPtr);
+ Tcl_FSChdir(dirPtr);
+ Tcl_DecrRefCount(dirPtr);
+ }
+ }
+ Tcl_DecrRefCount(cwdPtr);
+ }
+ }
+ return (*proc)(pathPtr, recursive, errorPtr);
+ }
+ }
+ Tcl_SetErrno(ENOENT);
+ return -1;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_FSConvertToPathType --
+ *
+ * This function 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).
+ *
+ * Results:
+ * Standard Tcl error code.
+ *
+ * Side effects:
+ * The old representation may be freed, and new memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tcl_FSConvertToPathType(interp, objPtr)
+ Tcl_Interp *interp; /* Interpreter in which to store error
+ * message (if necessary). */
+ Tcl_Obj *objPtr; /* 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 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 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 path.
+ */
+ if (objPtr->typePtr == &tclFsPathType) {
+ FsPath *fsPathPtr = (FsPath*) objPtr->internalRep.otherValuePtr;
+ if (fsPathPtr->filesystemEpoch != theFilesystemEpoch) {
+ FreeFsPathInternalRep(objPtr);
+ objPtr->typePtr = NULL;
+ return Tcl_ConvertToType(interp, objPtr, &tclFsPathType);
+ }
+ if (fsPathPtr->cwdPtr == NULL) {
+ return TCL_OK;
+ } else {
+ if (FsCwdPointerEquals(fsPathPtr->cwdPtr)) {
+ return TCL_OK;
+ } else {
+ FreeFsPathInternalRep(objPtr);
+ objPtr->typePtr = NULL;
+ return Tcl_ConvertToType(interp, objPtr, &tclFsPathType);
+ }
+ }
+ } else {
+ return Tcl_ConvertToType(interp, objPtr, &tclFsPathType);
+ }
+}
+
+
+/*
+ * Helper function for SetFsPathFromAny. Returns position of first
+ * directory delimiter in the path.
+ */
+static int
+FindSplitPos(path, separator)
+ char *path;
+ char *separator;
+{
+ int count = 0;
+ switch (tclPlatform) {
+ case TCL_PLATFORM_UNIX:
+ case TCL_PLATFORM_MAC:
+ while (path[count] != 0) {
+ if (path[count] == *separator) {
+ return count;
+ }
+ count++;
+ }
+ break;
+
+ case TCL_PLATFORM_WINDOWS:
+ while (path[count] != 0) {
+ if (path[count] == *separator || path[count] == '\\') {
+ return count;
+ }
+ count++;
+ }
+ break;
+ }
+ return count;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * SetFsPathFromAbsoluteNormalized --
+ *
+ * Like SetFsPathFromAny, but assumes the given object is an
+ * absolute normalized path. Only for internal use.
+ *
+ * Results:
+ * Standard Tcl error code.
+ *
+ * Side effects:
+ * The old representation may be freed, and new memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+SetFsPathFromAbsoluteNormalized(interp, objPtr)
+ Tcl_Interp *interp; /* Used for error reporting if not NULL. */
+ Tcl_Obj *objPtr; /* The object to convert. */
+{
+ FsPath *fsPathPtr;
+
+ if (objPtr->typePtr == &tclFsPathType) {
+ return TCL_OK;
+ }
+
+ /* Free old representation */
+ if (objPtr->typePtr != NULL) {
+ if (objPtr->bytes == NULL) {
+ if (objPtr->typePtr->updateStringProc == NULL) {
+ if (interp != NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "can't find object",
+ "string representation", (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+ objPtr->typePtr->updateStringProc(objPtr);
+ }
+ if ((objPtr->typePtr->freeIntRepProc) != NULL) {
+ (*objPtr->typePtr->freeIntRepProc)(objPtr);
+ }
+ }
+
+ fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));
+ /* It's a pure normalized absolute path */
+ fsPathPtr->translatedPathPtr = NULL;
+ fsPathPtr->normPathPtr = objPtr;
+ fsPathPtr->cwdPtr = NULL;
+ fsPathPtr->nativePathPtr = NULL;
+ fsPathPtr->fsRecPtr = NULL;
+ fsPathPtr->filesystemEpoch = theFilesystemEpoch;
+
+ objPtr->internalRep.otherValuePtr = (VOID *) fsPathPtr;
+ objPtr->typePtr = &tclFsPathType;
+
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * SetFsPathFromAny --
+ *
+ * This function tries to convert the given Tcl_Obj to a valid
+ * Tcl path type.
+ *
+ * The filename may begin with "~" (to indicate current user's
+ * home directory) or "~<user>" (to indicate any user's home
+ * directory).
+ *
+ * Results:
+ * Standard Tcl error code.
+ *
+ * Side effects:
+ * The old representation may be freed, and new memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+SetFsPathFromAny(interp, objPtr)
+ Tcl_Interp *interp; /* Used for error reporting if not NULL. */
+ Tcl_Obj *objPtr; /* The object to convert. */
+{
+ int len;
+ FsPath *fsPathPtr;
+ Tcl_Obj *transPtr;
+ char *name;
+
+ if (objPtr->typePtr == &tclFsPathType) {
+ return TCL_OK;
+ }
+
+ /*
+ * First step is to translate the filename. This is similar to
+ * Tcl_TranslateFilename, but shouldn't convert everything to
+ * windows backslashes on that platform. The current
+ * implementation of this piece is a slightly optimised version
+ * of the various Tilde/Split/Join stuff to avoid multiple
+ * split/join operations.
+ *
+ * We remove any trailing directory separator.
+ *
+ * However, the split/join routines are quite complex, and
+ * one has to make sure not to break anything on Unix, Win
+ * or MacOS (fCmd.test, fileName.test and cmdAH.test exercise
+ * most of the code).
+ */
+ name = Tcl_GetStringFromObj(objPtr,&len);
+
+ /*
+ * Handle tilde substitutions, if needed.
+ */
+ if (name[0] == '~') {
+ char *expandedUser;
+ Tcl_DString temp;
+ int split;
+ char separator='/';
+
+ if (tclPlatform==TCL_PLATFORM_MAC) {
+ if (strchr(name, ':') != NULL) separator = ':';
+ }
+
+ split = FindSplitPos(name, &separator);
+ if (split != len) {
+ /* We have multiple pieces '~user/foo/bar...' */
+ name[split] = '\0';
+ }
+ /* Do some tilde substitution */
+ if (name[1] == '\0') {
+ /* We have just '~' */
+ CONST char *dir;
+ Tcl_DString dirString;
+ if (split != len) { name[split] = separator; }
+
+ 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);
+ }
+ return TCL_ERROR;
+ }
+ Tcl_DStringInit(&temp);
+ Tcl_JoinPath(1, &dir, &temp);
+ Tcl_DStringFree(&dirString);
+ } else {
+ /* We have a user name '~user' */
+ 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_DStringFree(&temp);
+ if (split != len) { name[split] = separator; }
+ return TCL_ERROR;
+ }
+ if (split != len) { name[split] = separator; }
+ }
+
+ expandedUser = Tcl_DStringValue(&temp);
+ transPtr = Tcl_NewStringObj(expandedUser, Tcl_DStringLength(&temp));
+
+ if (split != len) {
+ /* Join up the tilde substitution with the rest */
+ if (name[split+1] == separator) {
+
+ /*
+ * Somewhat tricky case like ~//foo/bar.
+ * Make use of Split/Join machinery to get it right.
+ * Assumes all paths beginning with ~ are part of the
+ * native filesystem.
+ */
+
+ int objc;
+ Tcl_Obj **objv;
+ Tcl_Obj *parts = TclpNativeSplitPath(objPtr, NULL);
+ Tcl_ListObjGetElements(NULL, parts, &objc, &objv);
+ /* Skip '~'. It's replaced by its expansion */
+ objc--; objv++;
+ while (objc--) {
+ TclpNativeJoinPath(transPtr, Tcl_GetString(*objv++));
+ }
+ Tcl_DecrRefCount(parts);
+ } else {
+ /* Simple case. "rest" is relative path. Just join it. */
+ Tcl_Obj *rest = Tcl_NewStringObj(name+split+1,-1);
+ transPtr = Tcl_FSJoinToPath(transPtr, 1, &rest);
+ }
+ }
+ Tcl_DStringFree(&temp);
+ } else {
+ transPtr = Tcl_FSJoinToPath(objPtr,0,NULL);
+ }
+
+ /*
+ * 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->translatedPathPtr = transPtr;
+ Tcl_IncrRefCount(fsPathPtr->translatedPathPtr);
+ fsPathPtr->normPathPtr = NULL;
+ fsPathPtr->cwdPtr = NULL;
+ fsPathPtr->nativePathPtr = NULL;
+ fsPathPtr->fsRecPtr = NULL;
+ fsPathPtr->filesystemEpoch = theFilesystemEpoch;
+
+ /*
+ * Free old representation before installing our new one.
+ */
+ if (objPtr->typePtr != NULL && objPtr->typePtr->freeIntRepProc != NULL) {
+ (objPtr->typePtr->freeIntRepProc)(objPtr);
+ }
+ objPtr->internalRep.otherValuePtr = (VOID *) fsPathPtr;
+ objPtr->typePtr = &tclFsPathType;
+
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_FSNewNativePath --
+ *
+ * This function performs the something like that reverse of the
+ * usual obj->path->nativerep conversions. If some code retrieves
+ * a path in native form (from, e.g. readlink 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.
+ *
+ * Any memory which is allocated for 'clientData' should be retained
+ * until clientData is passed to the filesystem's freeInternalRepProc
+ * when it can be freed. The built in platform-specific filesystems
+ * use 'ckalloc' to allocate clientData, and ckfree to free it.
+ *
+ * Results:
+ * NULL or a valid path object pointer, with refCount zero.
+ *
+ * Side effects:
+ * New memory may be allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_FSNewNativePath(fromFilesystem, clientData)
+ Tcl_Filesystem* fromFilesystem;
+ ClientData clientData;
+{
+ Tcl_Obj *objPtr;
+ FsPath *fsPathPtr;
+ FilesystemRecord *fsFromPtr;
+ Tcl_FSInternalToNormalizedProc *proc;
+ int epoch;
+
+ fsFromPtr = GetFilesystemRecord(fromFilesystem, &epoch);
+
+ if (fsFromPtr == NULL) {
+ return NULL;
+ }
+
+ proc = fsFromPtr->fsPtr->internalToNormalizedProc;
+
+ if (proc == NULL) {
+ return NULL;
+ }
+
+ objPtr = (*proc)(clientData);
+ if (objPtr == NULL) {
+ return NULL;
+ }
+
+ /*
+ * Free old representation; shouldn't normally be any,
+ * but best to be safe.
+ */
+ if (objPtr->typePtr != NULL) {
+ if (objPtr->bytes == NULL) {
+ if (objPtr->typePtr->updateStringProc == NULL) {
+ return NULL;
+ }
+ objPtr->typePtr->updateStringProc(objPtr);
+ }
+ if ((objPtr->typePtr->freeIntRepProc) != NULL) {
+ (*objPtr->typePtr->freeIntRepProc)(objPtr);
+ }
+ }
+
+ fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));
+ fsPathPtr->translatedPathPtr = NULL;
+ /* Circular reference, by design */
+ fsPathPtr->normPathPtr = objPtr;
+ fsPathPtr->cwdPtr = NULL;
+ fsPathPtr->nativePathPtr = clientData;
+ fsPathPtr->fsRecPtr = fsFromPtr;
+ /* We must increase the refCount for this filesystem. */
+ fsPathPtr->fsRecPtr->fileRefCount++;
+ fsPathPtr->filesystemEpoch = epoch;
+
+ objPtr->internalRep.otherValuePtr = (VOID *) fsPathPtr;
+ objPtr->typePtr = &tclFsPathType;
+ return objPtr;
+}
+
+static void
+FreeFsPathInternalRep(pathObjPtr)
+ Tcl_Obj *pathObjPtr; /* Path object with internal rep to free. */
+{
+ register FsPath* fsPathPtr =
+ (FsPath*) pathObjPtr->internalRep.otherValuePtr;
+
+ if (fsPathPtr->translatedPathPtr != NULL) {
+ Tcl_DecrRefCount(fsPathPtr->translatedPathPtr);
+ }
+ if (fsPathPtr->normPathPtr != NULL) {
+ if (fsPathPtr->normPathPtr != pathObjPtr) {
+ Tcl_DecrRefCount(fsPathPtr->normPathPtr);
+ }
+ fsPathPtr->normPathPtr = NULL;
+ }
+ if (fsPathPtr->cwdPtr != NULL) {
+ Tcl_DecrRefCount(fsPathPtr->cwdPtr);
+ }
+ if (fsPathPtr->nativePathPtr != NULL) {
+ if (fsPathPtr->fsRecPtr != NULL) {
+ if (fsPathPtr->fsRecPtr->fsPtr->freeInternalRepProc != NULL) {
+ (*fsPathPtr->fsRecPtr->fsPtr
+ ->freeInternalRepProc)(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);
+}
+
+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. */
+{
+ register FsPath* srcFsPathPtr =
+ (FsPath*) srcPtr->internalRep.otherValuePtr;
+ register FsPath* copyFsPathPtr =
+ (FsPath*) ckalloc((unsigned)sizeof(FsPath));
+ Tcl_FSDupInternalRepProc *dupProc;
+
+ copyPtr->internalRep.otherValuePtr = (VOID *) copyFsPathPtr;
+
+ if (srcFsPathPtr->translatedPathPtr != NULL) {
+ copyFsPathPtr->translatedPathPtr = srcFsPathPtr->translatedPathPtr;
+ Tcl_IncrRefCount(copyFsPathPtr->translatedPathPtr);
+ } else {
+ copyFsPathPtr->translatedPathPtr = NULL;
+ }
+
+ if (srcFsPathPtr->normPathPtr != NULL) {
+ copyFsPathPtr->normPathPtr = srcFsPathPtr->normPathPtr;
+ if (copyFsPathPtr->normPathPtr != copyPtr) {
+ Tcl_IncrRefCount(copyFsPathPtr->normPathPtr);
+ }
+ } else {
+ copyFsPathPtr->normPathPtr = NULL;
+ }
+
+ if (srcFsPathPtr->cwdPtr != NULL) {
+ copyFsPathPtr->cwdPtr = srcFsPathPtr->cwdPtr;
+ Tcl_IncrRefCount(copyFsPathPtr->cwdPtr);
+ } else {
+ copyFsPathPtr->cwdPtr = NULL;
+ }
+
+ if (srcFsPathPtr->fsRecPtr != NULL
+ && srcFsPathPtr->nativePathPtr != NULL) {
+ dupProc = srcFsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc;
+ if (dupProc != NULL) {
+ copyFsPathPtr->nativePathPtr =
+ (*dupProc)(srcFsPathPtr->nativePathPtr);
+ } else {
+ copyFsPathPtr->nativePathPtr = NULL;
+ }
+ } else {
+ copyFsPathPtr->nativePathPtr = NULL;
+ }
+ copyFsPathPtr->fsRecPtr = srcFsPathPtr->fsRecPtr;
+ copyFsPathPtr->filesystemEpoch = srcFsPathPtr->filesystemEpoch;
+ if (copyFsPathPtr->fsRecPtr != NULL) {
+ copyFsPathPtr->fsRecPtr->fileRefCount++;
+ }
+
+ copyPtr->typePtr = &tclFsPathType;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_FSGetTranslatedPath --
+ *
+ * This function attempts to extract the translated path
+ * from the given Tcl_Obj. 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 (if it is non-NULL)
+ *
+ * Results:
+ * NULL or a valid Tcl_Obj pointer.
+ *
+ * Side effects:
+ * Only those of 'Tcl_FSConvertToPathType'
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tcl_Obj*
+Tcl_FSGetTranslatedPath(interp, pathPtr)
+ Tcl_Interp *interp;
+ Tcl_Obj* pathPtr;
+{
+ register FsPath* srcFsPathPtr;
+ if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) {
+ return NULL;
+ }
+ srcFsPathPtr = (FsPath*) pathPtr->internalRep.otherValuePtr;
+ if (srcFsPathPtr->translatedPathPtr == NULL) {
+ /*
+ * 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.
+ */
+ return srcFsPathPtr->normPathPtr;
+ } else {
+ /* It is an ordinary path object */
+ return srcFsPathPtr->translatedPathPtr;
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_FSGetTranslatedStringPath --
+ *
+ * This function attempts to extract the translated path
+ * from the given Tcl_Obj. If the translation succeeds (i.e. the
+ * object is a valid path), then the path is returned. Otherwise NULL
+ * will be returned, and an error message may be left in the
+ * interpreter (if it is non-NULL)
+ *
+ * Results:
+ * NULL or a valid string.
+ *
+ * Side effects:
+ * Only those of 'Tcl_FSConvertToPathType'
+ *
+ *---------------------------------------------------------------------------
+ */
+CONST char*
+Tcl_FSGetTranslatedStringPath(interp, pathPtr)
+Tcl_Interp *interp;
+Tcl_Obj* pathPtr;
+{
+ Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
+ if (transPtr == NULL) {
+ return NULL;
+ } else {
+ return Tcl_GetString(transPtr);
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_FSGetNormalizedPath --
+ *
+ * This important function attempts to extract from the given Tcl_Obj
+ * a unique normalised path representation, whose string value can
+ * be used as a unique identifier for the file.
+ *
+ * Results:
+ * NULL or a valid path object pointer.
+ *
+ * Side effects:
+ * 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, pathObjPtr)
+ Tcl_Interp *interp;
+ Tcl_Obj* pathObjPtr;
+{
+ register FsPath* srcFsPathPtr;
+ if (Tcl_FSConvertToPathType(interp, pathObjPtr) != TCL_OK) {
+ return NULL;
+ }
+ srcFsPathPtr = (FsPath*) pathObjPtr->internalRep.otherValuePtr;
+ if (srcFsPathPtr->normPathPtr == NULL) {
+ int relative = 0;
+ /*
+ * Since normPathPtr is NULL, but this is a valid path
+ * object, we know that the translatedPathPtr cannot be NULL.
+ */
+ Tcl_Obj *absolutePath = srcFsPathPtr->translatedPathPtr;
+ char *path = Tcl_GetString(absolutePath);
+
+ /*
+ * We have to be a little bit careful here to avoid infinite loops
+ * we're asking Tcl_FSGetPathType to return the path's type, but
+ * that call can actually result in a lot of other filesystem
+ * action, which might loop back through here.
+ */
+ if ((path[0] != '\0') &&
+ (Tcl_FSGetPathType(pathObjPtr) == TCL_PATH_RELATIVE)) {
+ Tcl_Obj *cwd = Tcl_FSGetCwd(interp);
+
+ if (cwd == NULL) {
+ return NULL;
+ }
+
+ absolutePath = Tcl_FSJoinToPath(cwd, 1, &absolutePath);
+ Tcl_IncrRefCount(absolutePath);
+ Tcl_DecrRefCount(cwd);
+
+ relative = 1;
+ }
+ /* Already has refCount incremented */
+ srcFsPathPtr->normPathPtr = FSNormalizeAbsolutePath(interp, absolutePath);
+ if (!strcmp(Tcl_GetString(srcFsPathPtr->normPathPtr),
+ Tcl_GetString(pathObjPtr))) {
+ /*
+ * The path was already normalized.
+ * Get rid of the duplicate.
+ */
+ Tcl_DecrRefCount(srcFsPathPtr->normPathPtr);
+ /*
+ * We do *not* increment the refCount for
+ * this circular reference
+ */
+ srcFsPathPtr->normPathPtr = pathObjPtr;
+ }
+ if (relative) {
+ /* This was returned by Tcl_FSJoinToPath above */
+ Tcl_DecrRefCount(absolutePath);
+
+ /* Get a quick, temporary lock on the cwd while we copy it */
+ Tcl_MutexLock(&cwdMutex);
+ srcFsPathPtr->cwdPtr = cwdPathPtr;
+ Tcl_IncrRefCount(srcFsPathPtr->cwdPtr);
+ Tcl_MutexUnlock(&cwdMutex);
+ }
+ }
+ return srcFsPathPtr->normPathPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_FSGetInternalRep --
+ *
+ * Extract the internal representation of a given path object,
+ * in the given filesystem. If the path object 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
+ * 'Tcl_FSCreateInternalRepProc'.
+ *
+ * Results:
+ * NULL or a valid internal representation.
+ *
+ * Side effects:
+ * An attempt may be made to convert the object.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+ClientData
+Tcl_FSGetInternalRep(pathObjPtr, fsPtr)
+ Tcl_Obj* pathObjPtr;
+ Tcl_Filesystem *fsPtr;
+{
+ register FsPath* srcFsPathPtr;
+
+ if (Tcl_FSConvertToPathType(NULL, pathObjPtr) != TCL_OK) {
+ return NULL;
+ }
+ srcFsPathPtr = (FsPath*) pathObjPtr->internalRep.otherValuePtr;
+
+ /*
+ * 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.
+ *
+ * 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) {
+ /*
+ * 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 is at least safer
+ * to allow this sub-optimal routing.
+ */
+ Tcl_FSGetFileSystemForPath(pathObjPtr);
+
+ /*
+ * If we fail through here, then the path is probably not a
+ * valid path in the filesystsem, and is most likely to be a
+ * use of the empty path "" via a direct call to one of the
+ * objectified interfaces (e.g. from the Tcl testsuite).
+ */
+ srcFsPathPtr = (FsPath*) pathObjPtr->internalRep.otherValuePtr;
+ if (srcFsPathPtr->fsRecPtr == NULL) {
+ return NULL;
+ }
+ }
+
+ if (fsPtr != srcFsPathPtr->fsRecPtr->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.
+ */
+ Tcl_Filesystem *actualFs = Tcl_FSGetFileSystemForPath(pathObjPtr);
+ if (actualFs == fsPtr) {
+ return Tcl_FSGetInternalRep(pathObjPtr, fsPtr);
+ }
+ return NULL;
+ }
+
+ if (srcFsPathPtr->nativePathPtr == NULL) {
+ Tcl_FSCreateInternalRepProc *proc;
+ proc = srcFsPathPtr->fsRecPtr->fsPtr->createInternalRepProc;
+
+ if (proc == NULL) {
+ return NULL;
+ }
+ srcFsPathPtr->nativePathPtr = (*proc)(pathObjPtr);
+ }
+ return srcFsPathPtr->nativePathPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_FSGetNativePath --
+ *
+ * This function is for use by the Win/Unix/MacOS 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 filesystem, but if for
+ * some reason they are called directly (i.e. by procedures
+ * 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 of this function with different signatures, for
+ * example Tcl_FSGetNativeMacPath, Tcl_FSGetNativeUnixPath etc.
+ * Right now, since native paths are all string based, we use just
+ * one function. On MacOS we could possibly use an FSSpec or
+ * FSRef as the native representation.
+ *
+ * Results:
+ * NULL or a valid native path.
+ *
+ * Side effects:
+ * See Tcl_FSGetInternalRep.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+CONST char *
+Tcl_FSGetNativePath(pathObjPtr)
+ Tcl_Obj *pathObjPtr;
+{
+ return (CONST char *)Tcl_FSGetInternalRep(pathObjPtr, &tclNativeFilesystem);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * NativeCreateNativeRep --
+ *
+ * Create a native representation for the given path.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+static ClientData
+NativeCreateNativeRep(pathObjPtr)
+ Tcl_Obj* pathObjPtr;
+{
+ char *nativePathPtr;
+ Tcl_DString ds;
+ Tcl_Obj* normPtr;
+ int len;
+ char *str;
+
+ /* Make sure the normalized path is set */
+ normPtr = Tcl_FSGetNormalizedPath(NULL, pathObjPtr);
+
+ str = Tcl_GetStringFromObj(normPtr,&len);
+#ifdef __WIN32__
+ Tcl_WinUtfToTChar(str, len, &ds);
+ if (tclWinProcs->useWide) {
+ nativePathPtr = ckalloc((unsigned)(sizeof(WCHAR)+Tcl_DStringLength(&ds)));
+ memcpy((VOID*)nativePathPtr, (VOID*)Tcl_DStringValue(&ds),
+ (size_t) (sizeof(WCHAR)+Tcl_DStringLength(&ds)));
+ } else {
+ nativePathPtr = ckalloc((unsigned)(sizeof(char)+Tcl_DStringLength(&ds)));
+ memcpy((VOID*)nativePathPtr, (VOID*)Tcl_DStringValue(&ds),
+ (size_t) (sizeof(char)+Tcl_DStringLength(&ds)));
+ }
+#else
+ Tcl_UtfToExternalDString(NULL, str, len, &ds);
+ nativePathPtr = ckalloc((unsigned)(sizeof(char)+Tcl_DStringLength(&ds)));
+ memcpy((VOID*)nativePathPtr, (VOID*)Tcl_DStringValue(&ds),
+ (size_t) (sizeof(char)+Tcl_DStringLength(&ds)));
+#endif
+
+ Tcl_DStringFree(&ds);
+ return (ClientData)nativePathPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpNativeToNormalized --
+ *
+ * Convert native format to a normalized path object, with refCount
+ * of zero.
+ *
+ * Results:
+ * A valid normalized path.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+Tcl_Obj*
+TclpNativeToNormalized(clientData)
+ ClientData clientData;
+{
+ Tcl_DString ds;
+ Tcl_Obj *objPtr;
+ CONST char *copy;
+ int len;
+
+#ifdef __WIN32__
+ Tcl_WinTCharToUtf((CONST char*)clientData, -1, &ds);
+#else
+ Tcl_ExternalToUtfDString(NULL, (CONST char*)clientData, -1, &ds);
+#endif
+
+ copy = Tcl_DStringValue(&ds);
+ len = Tcl_DStringLength(&ds);
+
+#ifdef __WIN32__
+ /*
+ * Certain native path representations on Windows have this special
+ * prefix to indicate that they are to be treated specially. For
+ * example extremely long paths, or symlinks
+ */
+ if (*copy == '\\') {
+ if (0 == strncmp(copy,"\\??\\",4)) {
+ copy += 4;
+ len -= 4;
+ } else if (0 == strncmp(copy,"\\\\?\\",4)) {
+ copy += 4;
+ len -= 4;
+ }
+ }
+#endif
+
+ objPtr = Tcl_NewStringObj(copy,len);
+ Tcl_DStringFree(&ds);
+
+ return objPtr;
+}
+
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * NativeDupInternalRep --
+ *
+ * Duplicate the native representation.
+ *
+ * Results:
+ * The copied native representation, or NULL if it is not possible
+ * to copy the representation.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+static ClientData
+NativeDupInternalRep(clientData)
+ ClientData clientData;
+{
+ ClientData copy;
+ size_t len;
+
+ if (clientData == NULL) {
+ return NULL;
+ }
+
+#ifdef __WIN32__
+ if (tclWinProcs->useWide) {
+ /* unicode representation when running on NT/2K/XP */
+ len = sizeof(WCHAR) + (wcslen((CONST WCHAR*)clientData) * sizeof(WCHAR));
+ } else {
+ /* ansi representation when running on 95/98/ME */
+ len = sizeof(char) + (strlen((CONST char*)clientData) * sizeof(char));
+ }
+#else
+ /* ansi representation when running on Unix/MacOS */
+ len = sizeof(char) + (strlen((CONST char*)clientData) * sizeof(char));
+#endif
+
+ copy = (ClientData) ckalloc(len);
+ memcpy((VOID*)copy, (VOID*)clientData, len);
+ return copy;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * NativePathInFilesystem --
+ *
+ * Any path object is acceptable to the native filesystem, by
+ * default (we will throw errors when illegal paths are actually
+ * tried to be used).
+ *
+ * However, this behavior means the native filesystem must be
+ * the last filesystem in the lookup list (otherwise it will
+ * claim all files belong to it, and other filesystems will
+ * never get a look in).
+ *
+ * Results:
+ * TCL_OK, to indicate 'yes', -1 to indicate no.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+static int
+NativePathInFilesystem(pathPtr, clientDataPtr)
+ Tcl_Obj *pathPtr;
+ ClientData *clientDataPtr;
+{
+ int len;
+ Tcl_GetStringFromObj(pathPtr,&len);
+ if (len == 0) {
+ return -1;
+ } else {
+ /* We accept any path as valid */
+ return TCL_OK;
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * NativeFreeInternalRep --
+ *
+ * Free a native internal representation, which will be non-NULL.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory is released.
+ *
+ *---------------------------------------------------------------------------
+ */
+static void
+NativeFreeInternalRep(clientData)
+ ClientData clientData;
+{
+ ckfree((char*)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.
+ *
+ * Results:
+ * A list of two elements.
+ *
+ * Side effects:
+ * The object may be converted to a path type.
+ *
+ *---------------------------------------------------------------------------
+ */
+Tcl_Obj*
+Tcl_FSFileSystemInfo(pathObjPtr)
+ Tcl_Obj* pathObjPtr;
+{
+ Tcl_Obj *resPtr;
+ Tcl_FSFilesystemPathTypeProc *proc;
+ Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathObjPtr);
+
+ if (fsPtr == NULL) {
+ return NULL;
+ }
+
+ resPtr = Tcl_NewListObj(0,NULL);
+
+ Tcl_ListObjAppendElement(NULL, resPtr,
+ Tcl_NewStringObj(fsPtr->typeName,-1));
+
+ proc = fsPtr->filesystemPathTypeProc;
+ if (proc != NULL) {
+ Tcl_Obj *typePtr = (*proc)(pathObjPtr);
+ if (typePtr != NULL) {
+ Tcl_ListObjAppendElement(NULL, resPtr, typePtr);
+ }
+ }
+
+ return resPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_FSPathSeparator --
+ *
+ * This function returns the separator to be used for a given
+ * path. The object returned should have a refCount of zero
+ *
+ * Results:
+ * A Tcl object, with a refCount of zero. If the caller
+ * needs to retain a reference to the object, it should
+ * call Tcl_IncrRefCount.
+ *
+ * Side effects:
+ * The path object may be converted to a path type.
+ *
+ *---------------------------------------------------------------------------
+ */
+Tcl_Obj*
+Tcl_FSPathSeparator(pathObjPtr)
+ Tcl_Obj* pathObjPtr;
+{
+ Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathObjPtr);
+
+ if (fsPtr == NULL) {
+ return NULL;
+ }
+ if (fsPtr->filesystemSeparatorProc != NULL) {
+ return (*fsPtr->filesystemSeparatorProc)(pathObjPtr);
+ }
+
+ return NULL;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * NativeFilesystemSeparator --
+ *
+ * This function is part of the native filesystem support, and
+ * returns the separator for the given path.
+ *
+ * Results:
+ * String object containing the separator character.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+static Tcl_Obj*
+NativeFilesystemSeparator(pathObjPtr)
+ Tcl_Obj* pathObjPtr;
+{
+ char *separator = NULL; /* lint */
+ switch (tclPlatform) {
+ case TCL_PLATFORM_UNIX:
+ separator = "/";
+ break;
+ case TCL_PLATFORM_WINDOWS:
+ separator = "\\";
+ break;
+ case TCL_PLATFORM_MAC:
+ separator = ":";
+ break;
+ }
+ return Tcl_NewStringObj(separator,1);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_FSGetFileSystemForPath --
+ *
+ * This function determines which filesystem to use for a
+ * particular path 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.
+ *
+ * Results:
+.* NULL or a filesystem which will accept this path.
+ *
+ * Side effects:
+ * The object may be converted to a path type.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tcl_Filesystem*
+Tcl_FSGetFileSystemForPath(pathObjPtr)
+ Tcl_Obj* pathObjPtr;
+{
+ FilesystemRecord *fsRecPtr;
+ Tcl_Filesystem* retVal = NULL;
+ FsPath* srcFsPathPtr;
+
+ /*
+ * 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).
+ */
+
+ if (pathObjPtr->refCount == 0) {
+ return NULL;
+ }
+
+ /*
+ * This will ensure the pathObjPtr can be converted into a
+ * "path" type, and that we are able to generate a complete
+ * normalized path which is used to determine the filesystem
+ * match.
+ */
+
+ if (Tcl_FSGetNormalizedPath(NULL, pathObjPtr) == NULL) {
+ return NULL;
+ }
+
+ /*
+ * Get a lock on theFilesystemEpoch and the filesystemList
+ *
+ * While we don't need the fsRecPtr until the while loop below, we
+ * do want to make sure the theFilesystemEpoch doesn't change
+ * between the 'if' and 'while' blocks, getting this iterator will
+ * ensure that everything is consistent
+ */
+ fsRecPtr = FsGetIterator();
+
+ /* Make sure pathObjPtr is of the correct epoch */
+
+ srcFsPathPtr = (FsPath*) pathObjPtr->internalRep.otherValuePtr;
+
+ /*
+ * Check if the filesystem has changed in some way since
+ * this object's internal representation was calculated.
+ */
+ if (srcFsPathPtr->filesystemEpoch != theFilesystemEpoch) {
+ /*
+ * We have to discard the stale representation and
+ * recalculate it
+ */
+ FreeFsPathInternalRep(pathObjPtr);
+ pathObjPtr->typePtr = NULL;
+ if (SetFsPathFromAny(NULL, pathObjPtr) != TCL_OK) {
+ goto done;
+ }
+ srcFsPathPtr = (FsPath*) pathObjPtr->internalRep.otherValuePtr;
+ }
+
+ /* Check whether the object is already assigned to a fs */
+ if (srcFsPathPtr->fsRecPtr != NULL) {
+ retVal = srcFsPathPtr->fsRecPtr->fsPtr;
+ goto done;
+ }
+
+ /*
+ * 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;
+ if (proc != NULL) {
+ ClientData clientData = NULL;
+ int ret = (*proc)(pathObjPtr, &clientData);
+ if (ret != -1) {
+ /*
+ * We assume the srcFsPathPtr hasn't been changed
+ * by the above call to the pathInFilesystemProc.
+ */
+ srcFsPathPtr->fsRecPtr = fsRecPtr;
+ srcFsPathPtr->nativePathPtr = clientData;
+ srcFsPathPtr->filesystemEpoch = theFilesystemEpoch;
+ fsRecPtr->fileRefCount++;
+ retVal = fsRecPtr->fsPtr;
+ }
+ }
+ fsRecPtr = fsRecPtr->nextPtr;
+ }
+
+ done:
+ FsReleaseIterator();
+ return retVal;
+}
+
+/* Simple helper function */
+static FilesystemRecord*
+GetFilesystemRecord(fromFilesystem, epoch)
+ Tcl_Filesystem *fromFilesystem;
+ int *epoch;
+{
+ FilesystemRecord *fsRecPtr = FsGetIterator();
+ while (fsRecPtr != NULL) {
+ if (fsRecPtr->fsPtr == fromFilesystem) {
+ *epoch = theFilesystemEpoch;
+ break;
+ }
+ fsRecPtr = fsRecPtr->nextPtr;
+ }
+ FsReleaseIterator();
+ return fsRecPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_FSEqualPaths --
+ *
+ * This function tests whether the two paths given are equal path
+ * objects. If either or both is NULL, 0 is always returned.
+ *
+ * Results:
+ * 1 or 0.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tcl_FSEqualPaths(firstPtr, secondPtr)
+ Tcl_Obj* firstPtr;
+ Tcl_Obj* secondPtr;
+{
+ if (firstPtr == secondPtr) {
+ return 1;
+ } else {
+ int tempErrno;
+
+ if (firstPtr == NULL || secondPtr == NULL) {
+ return 0;
+ }
+ if (!(strcmp(Tcl_GetString(firstPtr), Tcl_GetString(secondPtr)))) {
+ return 1;
+ }
+ /*
+ * Try the most thorough, correct method of comparing fully
+ * normalized paths
+ */
+
+ tempErrno = Tcl_GetErrno();
+ firstPtr = Tcl_FSGetNormalizedPath(NULL, firstPtr);
+ secondPtr = Tcl_FSGetNormalizedPath(NULL, secondPtr);
+ Tcl_SetErrno(tempErrno);
+
+ if (firstPtr == NULL || secondPtr == NULL) {
+ return 0;
+ }
+ if (!(strcmp(Tcl_GetString(firstPtr), Tcl_GetString(secondPtr)))) {
+ return 1;
+ }
+ }
+ return 0;
+}
+
+/*
+ * utime wants a normalized, NOT native path. I assume a native
+ * version of 'utime' doesn't exist (at least under that name) on NT/2000.
+ * If a native function does exist somewhere, then we could use:
+ *
+ * return native_utime(Tcl_FSGetNativePath(pathPtr),tval);
+ *
+ * This seems rather strange when compared with stat, lstat, access, etc.
+ * all of which want a native path.
+ */
+static int
+NativeUtime(pathPtr, tval)
+ Tcl_Obj *pathPtr;
+ struct utimbuf *tval;
+{
+#ifdef MAC_TCL
+ long gmt_offset=TclpGetGMTOffset();
+ struct utimbuf local_tval;
+ local_tval.actime=tval->actime+gmt_offset;
+ local_tval.modtime=tval->modtime+gmt_offset;
+ return utime(Tcl_GetString(Tcl_FSGetNormalizedPath(NULL,pathPtr)),
+ &local_tval);
+#else
+ return utime(Tcl_GetString(Tcl_FSGetNormalizedPath(NULL,pathPtr)),tval);
+#endif
+}
+
+/* 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 be have exactly like 'TclStat' when called
- * during that time (see 'TclStat(...)' for more informatin).
+ * 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:
@@ -578,7 +5020,7 @@ Tcl_OpenFileChannel(interp, fileName, modeString, permissions)
* could not be allocated.
*
* Side effects:
- * Memory allocataed and modifies the link list for 'TclStat'
+ * Memory allocated and modifies the link list for 'TclStat'
* functions.
*
*----------------------------------------------------------------------
@@ -597,10 +5039,10 @@ TclStatInsertProc (proc)
if (newStatProcPtr != NULL) {
newStatProcPtr->proc = proc;
- Tcl_MutexLock(&hookMutex);
+ Tcl_MutexLock(&obsoleteFsHookMutex);
newStatProcPtr->nextPtr = statProcList;
statProcList = newStatProcPtr;
- Tcl_MutexUnlock(&hookMutex);
+ Tcl_MutexUnlock(&obsoleteFsHookMutex);
retVal = TCL_OK;
}
@@ -636,7 +5078,7 @@ TclStatDeleteProc (proc)
StatProc *tmpStatProcPtr;
StatProc *prevStatProcPtr = NULL;
- Tcl_MutexLock(&hookMutex);
+ Tcl_MutexLock(&obsoleteFsHookMutex);
tmpStatProcPtr = statProcList;
/*
* Traverse the 'statProcList' looking for the particular node
@@ -644,7 +5086,7 @@ TclStatDeleteProc (proc)
* the list. Ensure that the "default" node cannot be removed.
*/
- while ((retVal == TCL_ERROR) && (tmpStatProcPtr != &defaultStatProc)) {
+ while ((retVal == TCL_ERROR) && (tmpStatProcPtr != NULL)) {
if (tmpStatProcPtr->proc == proc) {
if (prevStatProcPtr == NULL) {
statProcList = tmpStatProcPtr->nextPtr;
@@ -652,7 +5094,7 @@ TclStatDeleteProc (proc)
prevStatProcPtr->nextPtr = tmpStatProcPtr->nextPtr;
}
- Tcl_Free((char *)tmpStatProcPtr);
+ ckfree((char *)tmpStatProcPtr);
retVal = TCL_OK;
} else {
@@ -661,7 +5103,7 @@ TclStatDeleteProc (proc)
}
}
- Tcl_MutexUnlock(&hookMutex);
+ Tcl_MutexUnlock(&obsoleteFsHookMutex);
return (retVal);
}
@@ -671,17 +5113,18 @@ TclStatDeleteProc (proc)
* 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 be have exactly like 'TclAccess' when
- * called during that time (see 'TclAccess(...)' for more informatin).
- * The function will be added even if it already in the list.
+ * 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 allocataed and modifies the link list for 'TclAccess'
+ * Memory allocated and modifies the link list for 'TclAccess'
* functions.
*
*----------------------------------------------------------------------
@@ -700,10 +5143,10 @@ TclAccessInsertProc(proc)
if (newAccessProcPtr != NULL) {
newAccessProcPtr->proc = proc;
- Tcl_MutexLock(&hookMutex);
+ Tcl_MutexLock(&obsoleteFsHookMutex);
newAccessProcPtr->nextPtr = accessProcList;
accessProcList = newAccessProcPtr;
- Tcl_MutexUnlock(&hookMutex);
+ Tcl_MutexUnlock(&obsoleteFsHookMutex);
retVal = TCL_OK;
}
@@ -745,9 +5188,9 @@ TclAccessDeleteProc(proc)
* the list. Ensure that the "default" node cannot be removed.
*/
- Tcl_MutexLock(&hookMutex);
+ Tcl_MutexLock(&obsoleteFsHookMutex);
tmpAccessProcPtr = accessProcList;
- while ((retVal == TCL_ERROR) && (tmpAccessProcPtr != &defaultAccessProc)) {
+ while ((retVal == TCL_ERROR) && (tmpAccessProcPtr != NULL)) {
if (tmpAccessProcPtr->proc == proc) {
if (prevAccessProcPtr == NULL) {
accessProcList = tmpAccessProcPtr->nextPtr;
@@ -755,7 +5198,7 @@ TclAccessDeleteProc(proc)
prevAccessProcPtr->nextPtr = tmpAccessProcPtr->nextPtr;
}
- Tcl_Free((char *)tmpAccessProcPtr);
+ ckfree((char *)tmpAccessProcPtr);
retVal = TCL_OK;
} else {
@@ -763,7 +5206,7 @@ TclAccessDeleteProc(proc)
tmpAccessProcPtr = tmpAccessProcPtr->nextPtr;
}
}
- Tcl_MutexUnlock(&hookMutex);
+ Tcl_MutexUnlock(&obsoleteFsHookMutex);
return (retVal);
}
@@ -775,9 +5218,9 @@ TclAccessDeleteProc(proc)
*
* 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 be have
+ * 'Tcl_OpenFileChannel(...)'. The passed function should behave
* exactly like 'Tcl_OpenFileChannel' when called during that time
- * (see 'Tcl_OpenFileChannel(...)' for more informatin). The
+ * (see 'Tcl_OpenFileChannel(...)' for more information). The
* function will be added even if it already in the list.
*
* Results:
@@ -785,7 +5228,7 @@ TclAccessDeleteProc(proc)
* could not be allocated.
*
* Side effects:
- * Memory allocataed and modifies the link list for
+ * Memory allocated and modifies the link list for
* 'Tcl_OpenFileChannel' functions.
*
*----------------------------------------------------------------------
@@ -805,10 +5248,10 @@ TclOpenFileChannelInsertProc(proc)
if (newOpenFileChannelProcPtr != NULL) {
newOpenFileChannelProcPtr->proc = proc;
- Tcl_MutexLock(&hookMutex);
+ Tcl_MutexLock(&obsoleteFsHookMutex);
newOpenFileChannelProcPtr->nextPtr = openFileChannelProcList;
openFileChannelProcList = newOpenFileChannelProcPtr;
- Tcl_MutexUnlock(&hookMutex);
+ Tcl_MutexUnlock(&obsoleteFsHookMutex);
retVal = TCL_OK;
}
@@ -824,7 +5267,7 @@ TclOpenFileChannelInsertProc(proc)
*
* Removed the passed function pointer from the list of
* 'Tcl_OpenFileChannel' functions. Ensures that the built-in
- * open file channel function is not removvable.
+ * open file channel function is not removable.
*
* Results:
* TCL_OK if the procedure pointer was successfully removed,
@@ -847,13 +5290,13 @@ TclOpenFileChannelDeleteProc(proc)
/*
* Traverse the 'openFileChannelProcList' 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.
+ * the list.
*/
- Tcl_MutexLock(&hookMutex);
+ Tcl_MutexLock(&obsoleteFsHookMutex);
tmpOpenFileChannelProcPtr = openFileChannelProcList;
while ((retVal == TCL_ERROR) &&
- (tmpOpenFileChannelProcPtr != &defaultOpenFileChannelProc)) {
+ (tmpOpenFileChannelProcPtr != NULL)) {
if (tmpOpenFileChannelProcPtr->proc == proc) {
if (prevOpenFileChannelProcPtr == NULL) {
openFileChannelProcList = tmpOpenFileChannelProcPtr->nextPtr;
@@ -862,7 +5305,7 @@ TclOpenFileChannelDeleteProc(proc)
tmpOpenFileChannelProcPtr->nextPtr;
}
- Tcl_Free((char *)tmpOpenFileChannelProcPtr);
+ ckfree((char *)tmpOpenFileChannelProcPtr);
retVal = TCL_OK;
} else {
@@ -870,7 +5313,8 @@ TclOpenFileChannelDeleteProc(proc)
tmpOpenFileChannelProcPtr = tmpOpenFileChannelProcPtr->nextPtr;
}
}
- Tcl_MutexUnlock(&hookMutex);
+ Tcl_MutexUnlock(&obsoleteFsHookMutex);
return (retVal);
}
+#endif /* USE_OBSOLETE_FS_HOOKS */
diff --git a/tcl/generic/tclIndexObj.c b/tcl/generic/tclIndexObj.c
index 3187de62c0a..b8ebd014bb9 100644
--- a/tcl/generic/tclIndexObj.c
+++ b/tcl/generic/tclIndexObj.c
@@ -14,6 +14,7 @@
*/
#include "tclInt.h"
+#include "tclPort.h"
/*
* Prototypes for procedures defined later in this file:
@@ -21,6 +22,10 @@
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));
/*
* The structure below defines the index Tcl object type by means of
@@ -29,18 +34,36 @@ static int SetIndexFromAny _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_ObjType tclIndexType = {
"index", /* name */
- (Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */
- (Tcl_DupInternalRepProc *) NULL, /* dupIntRepProc */
- (Tcl_UpdateStringProc *) NULL, /* updateStringProc */
+ FreeIndex, /* freeIntRepProc */
+ DupIndex, /* dupIntRepProc */
+ UpdateStringOfIndex, /* updateStringProc */
SetIndexFromAny /* setFromAnyProc */
};
/*
- * Boolean flag indicating whether or not the tclIndexType object
- * type has been registered with the Tcl compiler.
+ * The definition of the internal representation of the "index"
+ * object; The internalRep.otherValuePtr 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. */
+} IndexRep;
+
+/*
+ * The following macros greatly simplify moving through a table...
*/
+#define STRING_AT(table, offset, index) \
+ (*((CONST char * CONST *)(((char *)(table)) + ((offset) * (index)))))
+#define NEXT_ENTRY(table, offset) \
+ (&(STRING_AT(table, offset, 1)))
+#define EXPAND_OF(indexRep) \
+ STRING_AT((indexRep)->tablePtr, (indexRep)->offset, (indexRep)->index)
-static int indexTypeInitialized = 0;
/*
*----------------------------------------------------------------------
@@ -73,10 +96,10 @@ 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. */
- char **tablePtr; /* Array of strings to compare against the
+ CONST char **tablePtr; /* Array of strings to compare against the
* value of objPtr; last entry must be NULL
* and there must not be duplicate entries. */
- char *msg; /* Identifying word to use in error messages. */
+ CONST char *msg; /* Identifying word to use in error messages. */
int flags; /* 0 or TCL_EXACT */
int *indexPtr; /* Place to store resulting integer index. */
{
@@ -88,10 +111,17 @@ Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr)
* is cached).
*/
- if ((objPtr->typePtr == &tclIndexType)
- && (objPtr->internalRep.twoPtrValue.ptr1 == (VOID *) tablePtr)) {
- *indexPtr = (int) objPtr->internalRep.twoPtrValue.ptr2;
- return TCL_OK;
+ if (objPtr->typePtr == &tclIndexType) {
+ IndexRep *indexRep = (IndexRep *) objPtr->internalRep.otherValuePtr;
+ /*
+ * 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 *)) {
+ *indexPtr = indexRep->index;
+ return TCL_OK;
+ }
}
return Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, sizeof(char *),
msg, flags, indexPtr);
@@ -131,28 +161,33 @@ 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. */
- char **tablePtr; /* The first string in the table. The second
+ 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 */
- char *msg; /* Identifying word to use in error messages. */
+ 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 index, length, i, numAbbrev;
- char *key, *p1, *p2, **entryPtr;
+ char *key, *p1;
+ CONST char *p2;
+ CONST char * CONST *entryPtr;
Tcl_Obj *resultPtr;
+ IndexRep *indexRep;
/*
* See if there is a valid cached result from a previous lookup.
*/
- if ((objPtr->typePtr == &tclIndexType)
- && (objPtr->internalRep.twoPtrValue.ptr1 == (VOID *) tablePtr)) {
- *indexPtr = (int) objPtr->internalRep.twoPtrValue.ptr2;
- return TCL_OK;
+ if (objPtr->typePtr == &tclIndexType) {
+ indexRep = (IndexRep *) objPtr->internalRep.otherValuePtr;
+ if (indexRep->tablePtr==tablePtr && indexRep->offset==offset) {
+ *indexPtr = indexRep->index;
+ return TCL_OK;
+ }
}
/*
@@ -160,16 +195,6 @@ Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags,
* abbreviations unless TCL_EXACT is set in flags.
*/
- if (!indexTypeInitialized) {
- /*
- * This is the first time we've done a lookup. Register the
- * tclIndexType.
- */
-
- Tcl_RegisterObjType(&tclIndexType);
- indexTypeInitialized = 1;
- }
-
key = Tcl_GetStringFromObj(objPtr, &length);
index = -1;
numAbbrev = 0;
@@ -182,15 +207,21 @@ Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags,
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 = (char **) ((long) entryPtr + offset), i++) {
+ entryPtr = NEXT_ENTRY(entryPtr, offset), i++) {
for (p1 = key, p2 = *entryPtr; *p1 == *p2; p1++, p2++) {
- if (*p1 == 0) {
+ if (*p1 == '\0') {
index = i;
goto done;
}
}
- if (*p1 == 0) {
+ if (*p1 == '\0') {
/*
* The value is an abbreviation for this entry. Continue
* checking other entries to make sure it's unique. If we
@@ -203,36 +234,51 @@ Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags,
index = i;
}
}
+ /*
+ * Check if we were instructed to disallow abbreviations.
+ */
if ((flags & TCL_EXACT) || (numAbbrev != 1)) {
goto error;
}
done:
- if ((objPtr->typePtr != NULL)
- && (objPtr->typePtr->freeIntRepProc != NULL)) {
- objPtr->typePtr->freeIntRepProc(objPtr);
- }
- objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tablePtr;
/*
- * Make sure to account for offsets != sizeof(char *). [Bug 5153]
+ * Cache the found representation. Note that we want to avoid
+ * allocating a new internal-rep if at all possible since that is
+ * potentially a slow operation.
*/
- objPtr->internalRep.twoPtrValue.ptr2 =
- (VOID *) (index * (offset / sizeof(char *)));
- objPtr->typePtr = &tclIndexType;
+ if (objPtr->typePtr == &tclIndexType) {
+ indexRep = (IndexRep *) objPtr->internalRep.otherValuePtr;
+ } else {
+ if ((objPtr->typePtr != NULL)
+ && (objPtr->typePtr->freeIntRepProc != NULL)) {
+ objPtr->typePtr->freeIntRepProc(objPtr);
+ }
+ indexRep = (IndexRep *) ckalloc(sizeof(IndexRep));
+ objPtr->internalRep.otherValuePtr = (VOID *) indexRep;
+ objPtr->typePtr = &tclIndexType;
+ }
+ indexRep->tablePtr = (VOID*) tablePtr;
+ indexRep->offset = offset;
+ indexRep->index = index;
+
*indexPtr = index;
return TCL_OK;
error:
if (interp != NULL) {
+ /*
+ * Produce a fancy error message.
+ */
int count;
resultPtr = Tcl_GetObjResult(interp);
Tcl_AppendStringsToObj(resultPtr,
(numAbbrev > 1) ? "ambiguous " : "bad ", msg, " \"",
- key, "\": must be ", *tablePtr, (char *) NULL);
- for (entryPtr = (char **) ((long) tablePtr + offset), count = 0;
+ key, "\": must be ", STRING_AT(tablePtr,offset,0), (char*)NULL);
+ for (entryPtr = NEXT_ENTRY(tablePtr, offset), count = 0;
*entryPtr != NULL;
- entryPtr = (char **) ((long) entryPtr + offset), count++) {
- if ((*((char **) ((long) entryPtr + offset))) == NULL) {
+ entryPtr = NEXT_ENTRY(entryPtr, offset), count++) {
+ if (*NEXT_ENTRY(entryPtr, offset) == NULL) {
Tcl_AppendStringsToObj(resultPtr,
(count > 0) ? ", or " : " or ", *entryPtr,
(char *) NULL);
@@ -279,6 +325,94 @@ SetIndexFromAny(interp, objPtr)
/*
*----------------------------------------------------------------------
*
+ * UpdateStringOfIndex --
+ *
+ * This procedure is called to convert a Tcl object from index
+ * internal form to its string form. No abbreviation is ever
+ * generated.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The string representation of the object is updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfIndex(objPtr)
+ Tcl_Obj *objPtr;
+{
+ IndexRep *indexRep = (IndexRep *) objPtr->internalRep.otherValuePtr;
+ register char *buf;
+ register unsigned len;
+ register CONST char *indexStr = EXPAND_OF(indexRep);
+
+ len = strlen(indexStr);
+ buf = (char *) ckalloc(len + 1);
+ memcpy(buf, indexStr, len+1);
+ objPtr->bytes = buf;
+ objPtr->length = len;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupIndex --
+ *
+ * This procedure is called to copy the internal rep of an index
+ * Tcl object from to another object.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The internal representation of the target object is updated
+ * and the type is set.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupIndex(srcPtr, dupPtr)
+ Tcl_Obj *srcPtr, *dupPtr;
+{
+ IndexRep *srcIndexRep = (IndexRep *) srcPtr->internalRep.otherValuePtr;
+ IndexRep *dupIndexRep = (IndexRep *) ckalloc(sizeof(IndexRep));
+
+ memcpy(dupIndexRep, srcIndexRep, sizeof(IndexRep));
+ dupPtr->internalRep.otherValuePtr = (VOID *) dupIndexRep;
+ dupPtr->typePtr = &tclIndexType;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeIndex --
+ *
+ * This procedure is called to delete the internal rep of an index
+ * Tcl object.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The internal representation of the target object is deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeIndex(objPtr)
+ Tcl_Obj *objPtr;
+{
+ ckfree((char *) objPtr->internalRep.otherValuePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_WrongNumArgs --
*
* This procedure generates a "wrong # args" error message in an
@@ -308,13 +442,13 @@ Tcl_WrongNumArgs(interp, objc, objv, message)
Tcl_Obj *CONST objv[]; /* Initial argument objects, which
* should be included in the error
* message. */
- char *message; /* Error message to print after the
+ CONST char *message; /* Error message to print after the
* leading objects in objv. The
* message may be NULL. */
{
Tcl_Obj *objPtr;
- char **tablePtr;
int i;
+ register IndexRep *indexRep;
objPtr = Tcl_GetObjResult(interp);
Tcl_AppendToObj(objPtr, "wrong # args: should be \"", -1);
@@ -326,21 +460,24 @@ Tcl_WrongNumArgs(interp, objc, objv, message)
*/
if (objv[i]->typePtr == &tclIndexType) {
- tablePtr = ((char **) objv[i]->internalRep.twoPtrValue.ptr1);
- Tcl_AppendStringsToObj(objPtr,
- tablePtr[(int) objv[i]->internalRep.twoPtrValue.ptr2],
- (char *) NULL);
+ indexRep = (IndexRep *) objv[i]->internalRep.otherValuePtr;
+ Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), (char *) NULL);
} else {
Tcl_AppendStringsToObj(objPtr, Tcl_GetString(objv[i]),
(char *) NULL);
}
- if (i < (objc - 1)) {
+
+ /*
+ * Append a space character (" ") if there is more text to follow
+ * (either another element from objv, or the message string).
+ */
+ if ((i < (objc - 1)) || message) {
Tcl_AppendStringsToObj(objPtr, " ", (char *) NULL);
}
}
+
if (message) {
- Tcl_AppendStringsToObj(objPtr, " ", message, (char *) NULL);
+ Tcl_AppendStringsToObj(objPtr, message, (char *) NULL);
}
Tcl_AppendStringsToObj(objPtr, "\"", (char *) NULL);
}
-
diff --git a/tcl/generic/tclInitScript.h b/tcl/generic/tclInitScript.h
index 749492361b9..dcb94c6e583 100644
--- a/tcl/generic/tclInitScript.h
+++ b/tcl/generic/tclInitScript.h
@@ -49,8 +49,10 @@ static char initScript[] = "if {[info proc tclInit]==\"\"} {\n\
if {[info exists env(TCL_LIBRARY)]} {\n\
lappend dirs $env(TCL_LIBRARY)\n\
}\n\
- lappend dirs $tclDefaultLibrary\n\
- unset tclDefaultLibrary\n\
+ catch {\n\
+ lappend dirs $tclDefaultLibrary\n\
+ unset tclDefaultLibrary\n\
+ }\n\
set dirs [concat $dirs $tcl_libPath]\n\
}\n\
foreach i $dirs {\n\
@@ -62,7 +64,6 @@ static char initScript[] = "if {[info proc tclInit]==\"\"} {\n\
} else {\n\
append errors \"$tclfile: $msg\n$errorInfo\n\"\n\
}\n\
- set tcl_pkgPath [lreplace $tcl_pkgPath end end]\n\
}\n\
}\n\
set msg \"Can't find a usable init.tcl in the following directories: \n\"\n\
diff --git a/tcl/generic/tclInt.decls b/tcl/generic/tclInt.decls
index 71903e72fe9..e5eb2074d76 100644
--- a/tcl/generic/tclInt.decls
+++ b/tcl/generic/tclInt.decls
@@ -7,6 +7,8 @@
# files
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
+# 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.
#
@@ -23,9 +25,10 @@ interface tclInt
# Use at your own risk. Note that the position of functions should not
# be changed between versions to avoid gratuitous incompatibilities.
-declare 0 generic {
- int TclAccess(CONST char *path, int mode)
-}
+# Replaced by Tcl_FSAccess in 8.4:
+#declare 0 generic {
+# int TclAccess(CONST char *path, int mode)
+#}
declare 1 generic {
int TclAccessDeleteProc(TclAccessProc_ *proc)
}
@@ -40,7 +43,7 @@ declare 3 generic {
# int TclChdir(Tcl_Interp *interp, char *dirName)
# }
declare 5 {unix win} {
- int TclCleanupChildren(Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, \
+ int TclCleanupChildren(Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr,
Tcl_Channel errorChan)
}
declare 6 generic {
@@ -50,19 +53,20 @@ declare 7 generic {
int TclCopyAndCollapse(int count, CONST char *src, char *dst)
}
declare 8 generic {
- int TclCopyChannel(Tcl_Interp *interp, Tcl_Channel inChan, \
+ int TclCopyChannel(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, char **argv, \
- Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, \
+ 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, char *procName, \
+ int TclCreateProc(Tcl_Interp *interp, Namespace *nsPtr,
+ CONST char *procName,
Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr)
}
declare 11 generic {
@@ -72,8 +76,8 @@ declare 12 generic {
void TclDeleteVars(Interp *iPtr, Tcl_HashTable *tablePtr)
}
declare 13 generic {
- int TclDoGlob(Tcl_Interp *interp, char *separators, \
- Tcl_DString *headPtr, char *tail, GlobTypeData *types)
+ int TclDoGlob(Tcl_Interp *interp, char *separators,
+ Tcl_DString *headPtr, char *tail, Tcl_GlobTypeData *types)
}
declare 14 generic {
void TclDumpMemoryInfo(FILE *outFile)
@@ -85,28 +89,29 @@ declare 14 generic {
declare 16 generic {
void TclExprFloatError(Tcl_Interp *interp, double value)
}
-declare 17 generic {
- int TclFileAttrsCmd(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
-}
-declare 18 generic {
- int TclFileCopyCmd(Tcl_Interp *interp, int argc, char **argv)
-}
-declare 19 generic {
- int TclFileDeleteCmd(Tcl_Interp *interp, int argc, char **argv)
-}
-declare 20 generic {
- int TclFileMakeDirsCmd(Tcl_Interp *interp, int argc, char **argv)
-}
-declare 21 generic {
- int TclFileRenameCmd(Tcl_Interp *interp, int argc, char **argv)
-}
+# Removed in 8.4
+#declare 17 generic {
+# int TclFileAttrsCmd(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
+#}
+#declare 18 generic {
+# int TclFileCopyCmd(Tcl_Interp *interp, int argc, char **argv)
+#}
+#declare 19 generic {
+# int TclFileDeleteCmd(Tcl_Interp *interp, int argc, char **argv)
+#}
+#declare 20 generic {
+# int TclFileMakeDirsCmd(Tcl_Interp *interp, int argc, char **argv)
+#}
+#declare 21 generic {
+# 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, \
+ 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, char *procName)
+ Proc * TclFindProc(Interp *iPtr, CONST char *procName)
}
declare 24 generic {
int TclFormatInt(char *buffer, long n)
@@ -119,16 +124,17 @@ declare 25 generic {
# char * TclGetCwd(Tcl_Interp *interp)
# }
declare 27 generic {
- int TclGetDate(char *p, unsigned long now, long zone, \
+ int TclGetDate(char *p, unsigned long now, long zone,
unsigned long *timePtr)
}
declare 28 generic {
Tcl_Channel TclpGetDefaultStdChannel(int type)
}
-declare 29 generic {
- Tcl_Obj * TclGetElementOfIndexedArray(Tcl_Interp *interp, \
- int localIndex, Tcl_Obj *elemPtr, int leaveErrorMsg)
-}
+# Removed in 8.4b2:
+#declare 29 generic {
+# 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)
@@ -137,36 +143,38 @@ declare 31 generic {
char * TclGetExtension(char *name)
}
declare 32 generic {
- int TclGetFrame(Tcl_Interp *interp, char *str, CallFrame **framePtrPtr)
+ int TclGetFrame(Tcl_Interp *interp, CONST char *str,
+ CallFrame **framePtrPtr)
}
declare 33 generic {
TclCmdProcType TclGetInterpProc(void)
}
declare 34 generic {
- int TclGetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr, \
+ int TclGetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr,
int endValue, int *indexPtr)
}
-declare 35 generic {
- Tcl_Obj * TclGetIndexedScalar(Tcl_Interp *interp, int localIndex, \
- int leaveErrorMsg)
-}
+# Removed in 8.4b2:
+#declare 35 generic {
+# Tcl_Obj * TclGetIndexedScalar(Tcl_Interp *interp, int localIndex,
+# int flags)
+#}
declare 36 generic {
- int TclGetLong(Tcl_Interp *interp, char *str, long *longPtr)
+ int TclGetLong(Tcl_Interp *interp, CONST char *str, long *longPtr)
}
declare 37 generic {
int TclGetLoadedPackages(Tcl_Interp *interp, char *targetName)
}
declare 38 generic {
- int TclGetNamespaceForQualName(Tcl_Interp *interp, char *qualName, \
- Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, \
- Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, \
- char **simpleNamePtr)
+ int TclGetNamespaceForQualName(Tcl_Interp *interp, CONST char *qualName,
+ Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr,
+ Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr,
+ CONST char **simpleNamePtr)
}
declare 39 generic {
TclObjCmdProcType TclGetObjInterpProc(void)
}
declare 40 generic {
- int TclGetOpenMode(Tcl_Interp *interp, char *str, int *seekFlagPtr)
+ int TclGetOpenMode(Tcl_Interp *interp, CONST char *str, int *seekFlagPtr)
}
declare 41 generic {
Tcl_Command TclGetOriginalCommand(Tcl_Command command)
@@ -175,10 +183,10 @@ declare 42 generic {
char * TclpGetUserHome(CONST char *name, Tcl_DString *bufferPtr)
}
declare 43 generic {
- int TclGlobalInvoke(Tcl_Interp *interp, int argc, char **argv, int flags)
+ int TclGlobalInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv, int flags)
}
declare 44 generic {
- int TclGuessPackageName(char *fileName, Tcl_DString *bufPtr)
+ int TclGuessPackageName(CONST char *fileName, Tcl_DString *bufPtr)
}
declare 45 generic {
int TclHideUnsafeCommands(Tcl_Interp *interp)
@@ -186,34 +194,36 @@ declare 45 generic {
declare 46 generic {
int TclInExit(void)
}
-declare 47 generic {
- Tcl_Obj * TclIncrElementOfIndexedArray(Tcl_Interp *interp, \
- int localIndex, Tcl_Obj *elemPtr, long incrAmount)
-}
-declare 48 generic {
- Tcl_Obj * TclIncrIndexedScalar(Tcl_Interp *interp, int localIndex, \
- long incrAmount)
-}
+# Removed in 8.4b2:
+#declare 47 generic {
+# Tcl_Obj * TclIncrElementOfIndexedArray(Tcl_Interp *interp,
+# int localIndex, Tcl_Obj *elemPtr, long incrAmount)
+#}
+# Removed in 8.4b2:
+#declare 48 generic {
+# Tcl_Obj * TclIncrIndexedScalar(Tcl_Interp *interp, int localIndex,
+# long incrAmount)
+#}
declare 49 generic {
- Tcl_Obj * TclIncrVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, \
+ Tcl_Obj * TclIncrVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
Tcl_Obj *part2Ptr, long incrAmount, int part1NotParsed)
}
declare 50 generic {
- void TclInitCompiledLocals(Tcl_Interp *interp, CallFrame *framePtr, \
+ void TclInitCompiledLocals(Tcl_Interp *interp, CallFrame *framePtr,
Namespace *nsPtr)
}
declare 51 generic {
int TclInterpInit(Tcl_Interp *interp)
}
declare 52 generic {
- int TclInvoke(Tcl_Interp *interp, int argc, char **argv, int flags)
+ int TclInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv, int flags)
}
declare 53 generic {
- int TclInvokeObjectCommand(ClientData clientData, Tcl_Interp *interp, \
- int argc, char **argv)
+ int TclInvokeObjectCommand(ClientData clientData, Tcl_Interp *interp,
+ int argc, CONST84 char **argv)
}
declare 54 generic {
- int TclInvokeStringCommand(ClientData clientData, Tcl_Interp *interp, \
+ int TclInvokeStringCommand(ClientData clientData, Tcl_Interp *interp,
int objc, Tcl_Obj *CONST objv[])
}
declare 55 generic {
@@ -221,8 +231,8 @@ declare 55 generic {
}
# Replaced with TclpLoadFile in 8.1:
# declare 56 generic {
-# int TclLoadFile(Tcl_Interp *interp, char *fileName, char *sym1, \
-# char *sym2, Tcl_PackageInitProc **proc1Ptr, \
+# 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:
@@ -230,16 +240,17 @@ declare 55 generic {
# int TclLooksLikeInt(char *p)
# }
declare 58 generic {
- Var * TclLookupVar(Tcl_Interp *interp, char *part1, char *part2, \
- int flags, char *msg, int createPart1, int createPart2, \
+ Var * TclLookupVar(Tcl_Interp *interp, CONST char *part1, CONST char *part2,
+ int flags, CONST char *msg, int createPart1, int createPart2,
Var **arrayPtrPtr)
}
-declare 59 generic {
- int TclpMatchFiles(Tcl_Interp *interp, char *separators, \
- Tcl_DString *dirPtr, char *pattern, char *tail)
-}
+# Replaced by Tcl_FSMatchInDirectory in 8.4
+#declare 59 generic {
+# int TclpMatchFiles(Tcl_Interp *interp, char *separators,
+# Tcl_DString *dirPtr, char *pattern, char *tail)
+#}
declare 60 generic {
- int TclNeedSpace(char *start, char *end)
+ int TclNeedSpace(CONST char *start, CONST char *end)
}
declare 61 generic {
Tcl_Obj * TclNewProcBodyObj(Proc *procPtr)
@@ -248,15 +259,15 @@ declare 62 generic {
int TclObjCommandComplete(Tcl_Obj *cmdPtr)
}
declare 63 generic {
- int TclObjInterpProc(ClientData clientData, Tcl_Interp *interp, \
+ int TclObjInterpProc(ClientData clientData, Tcl_Interp *interp,
int objc, Tcl_Obj *CONST objv[])
}
declare 64 generic {
- int TclObjInvoke(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], \
+ int TclObjInvoke(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[],
int flags)
}
declare 65 generic {
- int TclObjInvokeGlobal(Tcl_Interp *interp, int objc, \
+ int TclObjInvokeGlobal(Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[], int flags)
}
declare 66 generic {
@@ -265,25 +276,26 @@ declare 66 generic {
declare 67 generic {
int TclOpenFileChannelInsertProc(TclOpenFileChannelProc_ *proc)
}
-declare 68 generic {
- int TclpAccess(CONST char *path, int mode)
-}
+# Replaced by Tcl_FSAccess in 8.4:
+#declare 68 generic {
+# int TclpAccess(CONST char *path, int mode)
+#}
declare 69 generic {
char * TclpAlloc(unsigned int size)
}
-declare 70 generic {
- int TclpCopyFile(CONST char *source, CONST char *dest)
-}
-declare 71 generic {
- int TclpCopyDirectory(CONST char *source, CONST char *dest, \
- Tcl_DString *errorPtr)
-}
-declare 72 generic {
- int TclpCreateDirectory(CONST char *path)
-}
-declare 73 generic {
- int TclpDeleteFile(CONST char *path)
-}
+#declare 70 generic {
+# int TclpCopyFile(CONST char *source, CONST char *dest)
+#}
+#declare 71 generic {
+# int TclpCopyDirectory(CONST char *source, CONST char *dest,
+# Tcl_DString *errorPtr)
+#}
+#declare 72 generic {
+# int TclpCreateDirectory(CONST char *path)
+#}
+#declare 73 generic {
+# int TclpDeleteFile(CONST char *path)
+#}
declare 74 generic {
void TclpFree(char *ptr)
}
@@ -293,51 +305,56 @@ declare 75 generic {
declare 76 generic {
unsigned long TclpGetSeconds(void)
}
+
+# deprecated
declare 77 generic {
void TclpGetTime(Tcl_Time *time)
}
+
declare 78 generic {
int TclpGetTimeZone(unsigned long time)
}
-declare 79 generic {
- int TclpListVolumes(Tcl_Interp *interp)
-}
-declare 80 generic {
- Tcl_Channel TclpOpenFileChannel(Tcl_Interp *interp, char *fileName, \
- char *modeString, int permissions)
-}
+# Replaced by Tcl_FSListVolumes in 8.4:
+#declare 79 generic {
+# int TclpListVolumes(Tcl_Interp *interp)
+#}
+# Replaced by Tcl_FSOpenFileChannel in 8.4:
+#declare 80 generic {
+# Tcl_Channel TclpOpenFileChannel(Tcl_Interp *interp, char *fileName,
+# char *modeString, int permissions)
+#}
declare 81 generic {
char * TclpRealloc(char *ptr, unsigned int size)
}
-declare 82 generic {
- int TclpRemoveDirectory(CONST char *path, int recursive, \
- Tcl_DString *errorPtr)
-}
-declare 83 generic {
- int TclpRenameFile(CONST char *source, CONST char *dest)
-}
+#declare 82 generic {
+# int TclpRemoveDirectory(CONST char *path, int recursive,
+# Tcl_DString *errorPtr)
+#}
+#declare 83 generic {
+# int TclpRenameFile(CONST char *source, CONST char *dest)
+#}
# Removed in 8.1:
# declare 84 generic {
-# int TclParseBraces(Tcl_Interp *interp, char *str, char **termPtr, \
+# int TclParseBraces(Tcl_Interp *interp, char *str, char **termPtr,
# ParseValue *pvPtr)
# }
# declare 85 generic {
-# int TclParseNestedCmd(Tcl_Interp *interp, char *str, int flags, \
+# int TclParseNestedCmd(Tcl_Interp *interp, char *str, int flags,
# char **termPtr, ParseValue *pvPtr)
# }
# declare 86 generic {
-# int TclParseQuotes(Tcl_Interp *interp, char *str, int termChar, \
+# int TclParseQuotes(Tcl_Interp *interp, char *str, int termChar,
# int flags, char **termPtr, ParseValue *pvPtr)
# }
# declare 87 generic {
# void TclPlatformInit(Tcl_Interp *interp)
# }
declare 88 generic {
- char * TclPrecTraceProc(ClientData clientData, Tcl_Interp *interp, \
- char *name1, char *name2, int flags)
+ char * TclPrecTraceProc(ClientData clientData, Tcl_Interp *interp,
+ CONST char *name1, CONST char *name2, int flags)
}
declare 89 generic {
- int TclPreventAliasLoop(Tcl_Interp *interp, Tcl_Interp *cmdInterp, \
+ int TclPreventAliasLoop(Tcl_Interp *interp, Tcl_Interp *cmdInterp,
Tcl_Command cmd)
}
# Removed in 8.1 (only available if compiled with TCL_COMPILE_DEBUG):
@@ -348,20 +365,21 @@ declare 91 generic {
void TclProcCleanupProc(Proc *procPtr)
}
declare 92 generic {
- int TclProcCompileProc(Tcl_Interp *interp, Proc *procPtr, \
- Tcl_Obj *bodyPtr, Namespace *nsPtr, CONST char *description, \
+ int TclProcCompileProc(Tcl_Interp *interp, Proc *procPtr,
+ Tcl_Obj *bodyPtr, Namespace *nsPtr, CONST char *description,
CONST char *procName)
}
declare 93 generic {
void TclProcDeleteProc(ClientData clientData)
}
declare 94 generic {
- int TclProcInterpProc(ClientData clientData, Tcl_Interp *interp, \
- int argc, char **argv)
-}
-declare 95 generic {
- int TclpStat(CONST char *path, struct stat *buf)
+ int TclProcInterpProc(ClientData clientData, Tcl_Interp *interp,
+ int argc, CONST84 char **argv)
}
+# Replaced by Tcl_FSStat in 8.4:
+#declare 95 generic {
+# int TclpStat(CONST char *path, Tcl_StatBuf *buf)
+#}
declare 96 generic {
int TclRenameCommand(Tcl_Interp *interp, char *oldName, char *newName)
}
@@ -371,14 +389,16 @@ declare 97 generic {
declare 98 generic {
int TclServiceIdle(void)
}
-declare 99 generic {
- Tcl_Obj * TclSetElementOfIndexedArray(Tcl_Interp *interp, \
- int localIndex, Tcl_Obj *elemPtr, Tcl_Obj *objPtr, int leaveErrorMsg)
-}
-declare 100 generic {
- Tcl_Obj * TclSetIndexedScalar(Tcl_Interp *interp, int localIndex, \
- Tcl_Obj *objPtr, int leaveErrorMsg)
-}
+# Removed in 8.4b2:
+#declare 99 generic {
+# Tcl_Obj * TclSetElementOfIndexedArray(Tcl_Interp *interp, int localIndex,
+# Tcl_Obj *elemPtr, Tcl_Obj *objPtr, int flags)
+#}
+# Removed in 8.4b2:
+#declare 100 generic {
+# Tcl_Obj * TclSetIndexedScalar(Tcl_Interp *interp, int localIndex,
+# Tcl_Obj *objPtr, int flags)
+#}
declare 101 {unix win} {
char * TclSetPreInitScript(char *string)
}
@@ -386,15 +406,16 @@ declare 102 generic {
void TclSetupEnv(Tcl_Interp *interp)
}
declare 103 generic {
- int TclSockGetPort(Tcl_Interp *interp, char *str, char *proto, \
+ int TclSockGetPort(Tcl_Interp *interp, char *str, char *proto,
int *portPtr)
}
declare 104 {unix win} {
int TclSockMinimumBuffers(int sock, int size)
}
-declare 105 generic {
- int TclStat(CONST char *path, struct stat *buf)
-}
+# Replaced by Tcl_FSStat in 8.4:
+#declare 105 generic {
+# int TclStat(CONST char *path, Tcl_StatBuf *buf)
+#}
declare 106 generic {
int TclStatDeleteProc(TclStatProc_ *proc)
}
@@ -416,54 +437,54 @@ declare 109 generic {
# defined here instead of in tcl.decls since they are not stable yet.
declare 111 generic {
- void Tcl_AddInterpResolvers(Tcl_Interp *interp, char *name, \
- Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, \
+ void Tcl_AddInterpResolvers(Tcl_Interp *interp, CONST char *name,
+ Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc,
Tcl_ResolveCompiledVarProc *compiledVarProc)
}
declare 112 generic {
- int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr, \
+ int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
Tcl_Obj *objPtr)
}
declare 113 generic {
- Tcl_Namespace * Tcl_CreateNamespace(Tcl_Interp *interp, char *name, \
+ Tcl_Namespace * Tcl_CreateNamespace(Tcl_Interp *interp, CONST char *name,
ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc)
}
declare 114 generic {
void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr)
}
declare 115 generic {
- int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr, char *pattern, \
- int resetListFirst)
+ int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
+ CONST char *pattern, int resetListFirst)
}
declare 116 generic {
- Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, char *name, \
+ 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, char *name, \
+ Tcl_Namespace * Tcl_FindNamespace(Tcl_Interp *interp, CONST char *name,
Tcl_Namespace *contextNsPtr, int flags)
}
declare 118 generic {
- int Tcl_GetInterpResolvers(Tcl_Interp *interp, char *name, \
+ int Tcl_GetInterpResolvers(Tcl_Interp *interp, CONST char *name,
Tcl_ResolverInfo *resInfo)
}
declare 119 generic {
- int Tcl_GetNamespaceResolvers(Tcl_Namespace *namespacePtr, \
+ int Tcl_GetNamespaceResolvers(Tcl_Namespace *namespacePtr,
Tcl_ResolverInfo *resInfo)
}
declare 120 generic {
- Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp, char *name, \
+ Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp, CONST char *name,
Tcl_Namespace *contextNsPtr, int flags)
}
declare 121 generic {
- int Tcl_ForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, \
- char *pattern)
+ int Tcl_ForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
+ CONST char *pattern)
}
declare 122 generic {
Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
}
declare 123 generic {
- void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command, \
+ void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command,
Tcl_Obj *objPtr)
}
declare 124 generic {
@@ -473,26 +494,26 @@ declare 125 generic {
Tcl_Namespace * Tcl_GetGlobalNamespace(Tcl_Interp *interp)
}
declare 126 generic {
- void Tcl_GetVariableFullName(Tcl_Interp *interp, Tcl_Var variable, \
+ void Tcl_GetVariableFullName(Tcl_Interp *interp, Tcl_Var variable,
Tcl_Obj *objPtr)
}
declare 127 generic {
- int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr, \
- char *pattern, int allowOverwrite)
+ int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
+ CONST char *pattern, int allowOverwrite)
}
declare 128 generic {
void Tcl_PopCallFrame(Tcl_Interp* interp)
}
declare 129 generic {
- int Tcl_PushCallFrame(Tcl_Interp* interp, Tcl_CallFrame *framePtr, \
+ int Tcl_PushCallFrame(Tcl_Interp* interp, Tcl_CallFrame *framePtr,
Tcl_Namespace *nsPtr, int isProcCallFrame)
}
declare 130 generic {
- int Tcl_RemoveInterpResolvers(Tcl_Interp *interp, char *name)
+ int Tcl_RemoveInterpResolvers(Tcl_Interp *interp, CONST char *name)
}
declare 131 generic {
- void Tcl_SetNamespaceResolvers(Tcl_Namespace *namespacePtr, \
- Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, \
+ void Tcl_SetNamespaceResolvers(Tcl_Namespace *namespacePtr,
+ Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc,
Tcl_ResolveCompiledVarProc *compiledVarProc)
}
declare 132 generic {
@@ -502,8 +523,8 @@ declare 133 generic {
struct tm * TclpGetDate(TclpTime_t time, int useGMT)
}
declare 134 generic {
- size_t TclpStrftime(char *s, size_t maxsize, CONST char *format, \
- CONST struct tm *t)
+ size_t TclpStrftime(char *s, size_t maxsize, CONST char *format,
+ CONST struct tm *t, int useGMT)
}
declare 135 generic {
int TclpCheckStackSpace(void)
@@ -511,33 +532,34 @@ declare 135 generic {
# Added in 8.1:
-declare 137 generic {
- int TclpChdir(CONST char *dirName)
-}
+#declare 137 generic {
+# int TclpChdir(CONST char *dirName)
+#}
declare 138 generic {
- char * TclGetEnv(CONST char *name, Tcl_DString *valuePtr)
-}
-declare 139 generic {
- int TclpLoadFile(Tcl_Interp *interp, char *fileName, char *sym1, \
- char *sym2, Tcl_PackageInitProc **proc1Ptr, \
- Tcl_PackageInitProc **proc2Ptr, ClientData *clientDataPtr)
+ CONST84_RETURN char * TclGetEnv(CONST char *name, Tcl_DString *valuePtr)
}
+#declare 139 generic {
+# int TclpLoadFile(Tcl_Interp *interp, char *fileName, char *sym1,
+# char *sym2, Tcl_PackageInitProc **proc1Ptr,
+# Tcl_PackageInitProc **proc2Ptr, ClientData *clientDataPtr)
+#}
declare 140 generic {
- int TclLooksLikeInt(char *bytes, int length)
+ int TclLooksLikeInt(CONST char *bytes, int length)
}
+# This is used by TclX, but should otherwise be considered private
declare 141 generic {
- char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
+ CONST84_RETURN char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
}
declare 142 generic {
- int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr, \
+ int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr,
CompileHookProc *hookProc, ClientData clientData)
}
declare 143 generic {
- int TclAddLiteralObj(struct CompileEnv *envPtr, Tcl_Obj *objPtr, \
+ int TclAddLiteralObj(struct CompileEnv *envPtr, Tcl_Obj *objPtr,
LiteralEntry **litPtrPtr)
}
declare 144 generic {
- void TclHideLiteral(Tcl_Interp *interp, struct CompileEnv *envPtr, \
+ void TclHideLiteral(Tcl_Interp *interp, struct CompileEnv *envPtr,
int index)
}
declare 145 generic {
@@ -566,7 +588,7 @@ declare 150 generic {
int TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re)
}
declare 151 generic {
- void TclRegExpRangeUniChar(Tcl_RegExp re, int index, int *startPtr, \
+ void TclRegExpRangeUniChar(Tcl_RegExp re, int index, int *startPtr,
int *endPtr)
}
@@ -577,43 +599,93 @@ declare 153 generic {
Tcl_Obj *TclGetLibraryPath(void)
}
-# moved to tclTest.c in 8.3.2/8.4a2
+# moved to tclTest.c (static) in 8.3.2/8.4a2
#declare 154 generic {
# int TclTestChannelCmd(ClientData clientData,
# Tcl_Interp *interp, int argc, char **argv)
#}
#declare 155 generic {
-# int TclTestChannelEventCmd(ClientData clientData, \
+# int TclTestChannelEventCmd(ClientData clientData,
# Tcl_Interp *interp, int argc, char **argv)
#}
declare 156 generic {
- void TclRegError (Tcl_Interp *interp, char *msg, \
+ void TclRegError (Tcl_Interp *interp, CONST char *msg,
int status)
}
declare 157 generic {
- Var * TclVarTraceExists (Tcl_Interp *interp, char *varName)
+ Var * TclVarTraceExists (Tcl_Interp *interp, CONST char *varName)
}
declare 158 generic {
- void TclSetStartupScriptFileName(char *filename)
+ void TclSetStartupScriptFileName(CONST char *filename)
}
declare 159 generic {
- char *TclGetStartupScriptFileName(void)
-}
-declare 160 generic {
- int TclpMatchFilesTypes(Tcl_Interp *interp, char *separators, \
- Tcl_DString *dirPtr, char *pattern, char *tail, GlobTypeData *types)
+ CONST84_RETURN char *TclGetStartupScriptFileName(void)
}
+#declare 160 generic {
+# int TclpMatchFilesTypes(Tcl_Interp *interp, char *separators,
+# Tcl_DString *dirPtr, char *pattern, char *tail, GlobTypeData *types)
+#}
# new in 8.3.2/8.4a2
declare 161 generic {
- int TclChannelTransform(Tcl_Interp *interp, Tcl_Channel chan, \
+ int TclChannelTransform(Tcl_Interp *interp, Tcl_Channel chan,
Tcl_Obj *cmdObjPtr)
}
declare 162 generic {
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
+# "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)
+}
+
+# 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 {
+ void TclExpandCodeArray (void *envPtr)
+}
+
+# These functions are vfs aware, but are generally only useful internally.
+declare 165 generic {
+ void TclpSetInitialEncodings(void)
+}
+
+# New function due to TIP #33
+declare 166 generic {
+ 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 {
+ void TclSetStartupScriptPath(Tcl_Obj *pathPtr)
+}
+declare 168 generic {
+ 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 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 171 generic {
+ int TclCheckExecutionTraces (Tcl_Interp *interp, CONST char *command, int numChars, \
+ Command *cmdPtr, int result, int traceFlags, int objc, \
+ Tcl_Obj *CONST objv[])
+}
+
##############################################################################
# Define the platform specific internal Tcl interface. These functions are
@@ -646,11 +718,11 @@ declare 5 mac {
int FSpSetDefaultDir(FSSpecPtr theSpec)
}
declare 6 mac {
- OSErr FSpFindFolder(short vRefNum, OSType folderType, \
+ OSErr FSpFindFolder(short vRefNum, OSType folderType,
Boolean createFolder, FSSpec *spec)
}
declare 7 mac {
- void GetGlobalMouse(Point *mouse)
+ void GetGlobalMouseTcl(Point *mouse)
}
# The following routines are utility functions in Tcl. They are exported
@@ -658,15 +730,15 @@ declare 7 mac {
# however. The first set are from the MoreFiles package.
declare 8 mac {
- pascal OSErr FSpGetDirectoryID(CONST FSSpec *spec, long *theDirID, \
+ pascal OSErr FSpGetDirectoryIDTcl(CONST FSSpec *spec, long *theDirID,
Boolean *isDirectory)
}
declare 9 mac {
- pascal short FSpOpenResFileCompat(CONST FSSpec *spec, \
+ pascal short FSpOpenResFileCompatTcl(CONST FSSpec *spec,
SignedByte permission)
}
declare 10 mac {
- pascal void FSpCreateResFileCompat(CONST FSSpec *spec, OSType creator, \
+ pascal void FSpCreateResFileCompatTcl(CONST FSSpec *spec, OSType creator,
OSType fileType, ScriptCode scriptTag)
}
@@ -677,7 +749,7 @@ declare 11 mac {
int FSpLocationFromPath(int length, CONST char *path, FSSpecPtr theSpec)
}
declare 12 mac {
- OSErr FSpPathFromLocation(FSSpecPtr theSpec, int *length, \
+ OSErr FSpPathFromLocation(FSSpecPtr theSpec, int *length,
Handle *fullPath)
}
@@ -705,7 +777,7 @@ declare 19 mac {
int TclMacTimerExpired(void *timerToken)
}
declare 20 mac {
- int TclMacRegisterResourceFork(short fileRef, Tcl_Obj *tokenPtr, \
+ int TclMacRegisterResourceFork(short fileRef, Tcl_Obj *tokenPtr,
int insert)
}
declare 21 mac {
@@ -721,8 +793,15 @@ declare 23 mac {
# declare 24 mac {
# int TclMacReadlink(char *path, char *buf, int size)
# }
+declare 24 mac {
+ char * TclpGetTZName(int isdst)
+}
declare 25 mac {
- int TclMacChmod(char *path, int mode)
+ int TclMacChmod(CONST char *path, int mode)
+}
+# version of FSpLocationFromPath that doesn't resolve the last path component
+declare 26 mac {
+ int FSpLLocationFromPath(int length, CONST char *path, FSSpecPtr theSpec)
}
############################
@@ -735,11 +814,11 @@ declare 1 win {
void TclWinConvertWSAError(DWORD errCode)
}
declare 2 win {
- struct servent * TclWinGetServByName(CONST char *nm, \
+ struct servent * TclWinGetServByName(CONST char *nm,
CONST char *proto)
}
declare 3 win {
- int TclWinGetSockOpt(SOCKET s, int level, int optname, \
+ int TclWinGetSockOpt(SOCKET s, int level, int optname,
char FAR * optval, int FAR *optlen)
}
declare 4 win {
@@ -753,7 +832,7 @@ declare 6 win {
u_short TclWinNToHS(u_short ns)
}
declare 7 win {
- int TclWinSetSockOpt(SOCKET s, int level, int optname, \
+ int TclWinSetSockOpt(SOCKET s, int level, int optname,
CONST char FAR * optval, int optlen)
}
declare 8 win {
@@ -776,15 +855,15 @@ declare 12 win {
int TclpCloseFile(TclFile file)
}
declare 13 win {
- Tcl_Channel TclpCreateCommandChannel(TclFile readFile, \
+ Tcl_Channel TclpCreateCommandChannel(TclFile readFile,
TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr)
}
declare 14 win {
int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe)
}
declare 15 win {
- int TclpCreateProcess(Tcl_Interp *interp, int argc, char **argv, \
- TclFile inputFile, TclFile outputFile, TclFile errorFile, \
+ int TclpCreateProcess(Tcl_Interp *interp, int argc, CONST char **argv,
+ TclFile inputFile, TclFile outputFile, TclFile errorFile,
Tcl_Pid *pidPtr)
}
# Signature changed in 8.1:
@@ -803,9 +882,11 @@ declare 19 win {
declare 20 win {
void TclWinAddProcess(HANDLE hProcess, DWORD id)
}
-declare 21 win {
- void TclpAsyncMark(Tcl_AsyncHandler async)
-}
+
+# removed permanently for 8.4
+#declare 21 win {
+# void TclpAsyncMark(Tcl_AsyncHandler async)
+#}
# Added in 8.1:
declare 22 win {
@@ -824,6 +905,12 @@ declare 26 win {
void TclWinSetInterfaces(int wide)
}
+# Added in Tcl 8.3.3 / 8.4
+
+declare 27 win {
+ void TclWinFlushDirtyChannels (void)
+}
+
#########################
# Unix specific internals
@@ -836,21 +923,20 @@ declare 1 unix {
int TclpCloseFile(TclFile file)
}
declare 2 unix {
- Tcl_Channel TclpCreateCommandChannel(TclFile readFile, \
+ Tcl_Channel TclpCreateCommandChannel(TclFile readFile,
TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr)
}
declare 3 unix {
int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe)
}
declare 4 unix {
- int TclpCreateProcess(Tcl_Interp *interp, int argc, char **argv, \
- TclFile inputFile, TclFile outputFile, TclFile errorFile, \
+ 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 {
-# TclFile TclpCreateTempFile(char *contents,
-# Tcl_DString *namePtr)
+# TclFile TclpCreateTempFile(char *contents, Tcl_DString *namePtr)
# }
declare 6 unix {
TclFile TclpMakeFile(Tcl_Channel channel, int direction)
@@ -868,3 +954,21 @@ declare 9 unix {
TclFile TclpCreateTempFile(CONST char *contents)
}
+# Added in 8.4:
+
+declare 10 unix {
+ Tcl_DirEntry * TclpReaddir(DIR * dir)
+}
+
+declare 11 unix {
+ struct tm * TclpLocaltime(time_t * clock)
+}
+
+declare 12 unix {
+ struct tm * TclpGmtime(time_t * clock)
+}
+
+declare 13 unix {
+ char * TclpInetNtoa(struct in_addr addr)
+}
+
diff --git a/tcl/generic/tclInt.h b/tcl/generic/tclInt.h
index 641e9d665a9..7de19273884 100644
--- a/tcl/generic/tclInt.h
+++ b/tcl/generic/tclInt.h
@@ -7,6 +7,7 @@
* Copyright (c) 1993-1997 Lucent Technologies.
* Copyright (c) 1994-1998 Sun Microsystems, Inc.
* Copyright (c) 1998-1999 by Scriptics Corporation.
+ * Copyright (c) 2001, 2002 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.
@@ -27,12 +28,12 @@
* needed by stdlib.h in some configurations.
*/
-#include <stdio.h>
-
#ifndef _TCL
#include "tcl.h"
#endif
+#include <stdio.h>
+
#include <ctype.h>
#ifdef NO_LIMITS_H
# include "../compat/limits.h"
@@ -90,15 +91,15 @@ typedef struct Tcl_ResolvedVarInfo {
typedef int (Tcl_ResolveCompiledVarProc) _ANSI_ARGS_((
- Tcl_Interp* interp, char* name, int length,
+ Tcl_Interp* interp, CONST84 char* name, int length,
Tcl_Namespace *context, Tcl_ResolvedVarInfo **rPtr));
typedef int (Tcl_ResolveVarProc) _ANSI_ARGS_((
- Tcl_Interp* interp, char* name, Tcl_Namespace *context,
+ Tcl_Interp* interp, CONST84 char* name, Tcl_Namespace *context,
int flags, Tcl_Var *rPtr));
typedef int (Tcl_ResolveCmdProc) _ANSI_ARGS_((Tcl_Interp* interp,
- char* name, Tcl_Namespace *context, int flags,
+ CONST84 char* name, Tcl_Namespace *context, int flags,
Tcl_Command *rPtr));
typedef struct Tcl_ResolverInfo {
@@ -184,11 +185,13 @@ typedef struct Namespace {
* namespace has already cached a Command *
* pointer; this causes all its cached
* Command* pointers to be invalidated. */
- int resolverEpoch; /* Incremented whenever the name resolution
- * rules change for this namespace; this
- * invalidates all byte codes compiled in
- * the namespace, causing the code to be
- * recompiled under the new rules. */
+ int resolverEpoch; /* Incremented whenever (a) the name resolution
+ * rules change for this namespace or (b) a
+ * newly added command shadows a command that
+ * is compiled to bytecodes.
+ * This invalidates all byte codes compiled
+ * in the namespace, causing the code to be
+ * recompiled under the new rules.*/
Tcl_ResolveCmdProc *cmdResProc;
/* If non-null, this procedure overrides
* the usual command resolution mechanism
@@ -270,6 +273,43 @@ typedef struct VarTrace {
} VarTrace;
/*
+ * The following structure defines a command trace, which is used to
+ * invoke a specific C procedure whenever certain operations are performed
+ * on a command.
+ */
+
+typedef struct CommandTrace {
+ Tcl_CommandTraceProc *traceProc;/* Procedure to call when operations given
+ * by flags are performed on command. */
+ ClientData clientData; /* Argument to pass to proc. */
+ int flags; /* What events the trace procedure is
+ * interested in: OR-ed combination of
+ * TCL_TRACE_RENAME, TCL_TRACE_DELETE. */
+ struct CommandTrace *nextPtr; /* Next in list of traces associated with
+ * a particular command. */
+} CommandTrace;
+
+/*
+ * When a command trace is active (i.e. its associated procedure is
+ * executing), one of the following structures is linked into a list
+ * associated with the command's interpreter. The information in
+ * the structure is needed in order for Tcl to behave reasonably
+ * if traces are deleted while traces are active.
+ */
+
+typedef struct ActiveCommandTrace {
+ struct Command *cmdPtr; /* Command that's being traced. */
+ struct ActiveCommandTrace *nextPtr;
+ /* Next in list of all active command
+ * traces for the interpreter, or NULL
+ * if no more. */
+ CommandTrace *nextTracePtr; /* Next trace to check after current
+ * trace procedure returns; if this
+ * trace gets deleted, must update pointer
+ * to avoid using free'd memory. */
+} ActiveCommandTrace;
+
+/*
* When a variable trace is active (i.e. its associated procedure is
* executing), one of the following structures is linked into a list
* associated with the variable's interpreter. The information in
@@ -614,12 +654,35 @@ typedef struct Proc {
typedef struct Trace {
int level; /* Only trace commands at nesting level
* less than or equal to this. */
- Tcl_CmdTraceProc *proc; /* Procedure to call to trace command. */
+ Tcl_CmdObjTraceProc *proc; /* Procedure to call to trace command. */
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 */
} Trace;
/*
+ * When an interpreter trace is active (i.e. its associated procedure
+ * is executing), one of the following structures is linked into a list
+ * associated with the interpreter. The information in the structure
+ * is needed in order for Tcl to behave reasonably if traces are
+ * deleted while traces are active.
+ */
+
+typedef struct ActiveInterpTrace {
+ struct ActiveInterpTrace *nextPtr;
+ /* Next in list of all active command
+ * traces for the interpreter, or NULL
+ * if no more. */
+ Trace *nextTracePtr; /* Next trace to check after current
+ * trace procedure returns; if this
+ * trace gets deleted, must update pointer
+ * to avoid using free'd memory. */
+} ActiveInterpTrace;
+
+/*
* The structure below defines an entry in the assocData hash table which
* is associated with an interpreter. The entry contains a pointer to a
* function to call when the interpreter is deleted, and a pointer to
@@ -701,11 +764,6 @@ typedef struct CallFrame {
typedef VOID **TclHandle;
-EXTERN TclHandle TclHandleCreate _ANSI_ARGS_((VOID *ptr));
-EXTERN void TclHandleFree _ANSI_ARGS_((TclHandle handle));
-EXTERN TclHandle TclHandlePreserve _ANSI_ARGS_((TclHandle handle));
-EXTERN void TclHandleRelease _ANSI_ARGS_((TclHandle handle));
-
/*
*----------------------------------------------------------------
* Data structures related to history. These are used primarily
@@ -852,6 +910,8 @@ typedef struct ExecEnv {
int stackTop; /* Index of current top of stack; -1 when
* the stack is empty. */
int stackEnd; /* Index of last usable item in stack. */
+ Tcl_Obj *errorInfo;
+ Tcl_Obj *errorCode;
} ExecEnv;
/*
@@ -1020,10 +1080,8 @@ typedef struct Command {
/* Procedure invoked when deleting command
* to, e.g., free all client data. */
ClientData deleteData; /* Arbitrary value passed to deleteProc. */
- int deleted; /* Means that the command is in the process
- * of being deleted (its deleteProc is
- * currently executing). Other attempts to
- * delete the command should be ignored. */
+ int flags; /* Miscellaneous bits of information about
+ * command. See below for definitions. */
ImportRef *importRefPtr; /* List of each imported Command created in
* another namespace when this command is
* imported. These imported commands
@@ -1031,9 +1089,35 @@ typedef struct Command {
* command. The list is used to remove all
* those imported commands when deleting
* this "real" command. */
+ CommandTrace *tracePtr; /* First in list of all traces set for this
+ * command. */
} Command;
/*
+ * Flag bits for commands.
+ *
+ * CMD_IS_DELETED - Means that the command is in the process
+ * of being deleted (its deleteProc is
+ * currently executing). Other attempts to
+ * delete the command should be ignored.
+ * CMD_TRACE_ACTIVE - 1 means that trace processing is currently
+ * underway for a rename/delete change.
+ * See the two flags below for which is
+ * currently being processed.
+ * CMD_HAS_EXEC_TRACES - 1 means that this command has at least
+ * one execution trace (as opposed to simple
+ * delete/rename traces) in its tracePtr list.
+ * 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
+ * recursive deletes will not be traced.
+ * (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
+
+/*
*----------------------------------------------------------------
* Data structures related to name resolution procedures.
*----------------------------------------------------------------
@@ -1134,7 +1218,7 @@ typedef struct Interp {
/*
* Information related to procedures and variables. See tclProc.c
- * and tclvar.c for usage.
+ * and tclVar.c for usage.
*/
int numLevels; /* Keeps track of how many nested calls to
@@ -1153,7 +1237,7 @@ typedef struct Interp {
* unless an "uplevel" command is
* executing). NULL means no procedure is
* active or "uplevel 0" is executing. */
- ActiveVarTrace *activeTracePtr;
+ ActiveVarTrace *activeVarTracePtr;
/* First in list of active traces for
* interp, or NULL if no active traces. */
int returnCode; /* Completion code to return if current
@@ -1223,11 +1307,9 @@ typedef struct Interp {
* are added/removed by calling
* Tcl_AddInterpResolvers and
* Tcl_RemoveInterpResolver. */
- char *scriptFile; /* NULL means there is no nested source
+ Tcl_Obj *scriptFile; /* NULL means there is no nested source
* command active; otherwise this points to
- * the name of the file being sourced (it's
- * not malloc-ed: it points to an argument
- * to Tcl_EvalFile. */
+ * pathPtr of the file being sourced. */
int flags; /* Various flag bits. See below. */
long randSeed; /* Seed used for rand() function. */
Trace *tracePtr; /* List of traces for this interpreter. */
@@ -1248,6 +1330,16 @@ typedef struct Interp {
* accessed directly; see comment above. */
Tcl_ThreadId threadId; /* ID of thread that owns the interpreter */
+ ActiveCommandTrace *activeCmdTracePtr;
+ /* First in list of active command traces for
+ * interp, or NULL if no active traces. */
+ ActiveInterpTrace *activeInterpTracePtr;
+ /* First in list of active traces for
+ * interp, or NULL if no active traces. */
+
+ int tracesForbiddingInline; /* Count of traces (in the list headed by
+ * tracePtr) that forbid inline bytecode
+ * compilation */
/*
* Statistical information about the bytecode compiler and interpreter's
* operation.
@@ -1306,6 +1398,9 @@ typedef struct Interp {
* interpreter; instead, have Tcl_EvalObj call
* Tcl_EvalEx. Used primarily for testing the
* new parser.
+ * INTERP_TRACE_IN_PROGRESS: Non-zero means that an interp trace is currently
+ * active; so no further trace callbacks should be
+ * invoked.
*/
#define DELETED 1
@@ -1317,6 +1412,7 @@ typedef struct Interp {
#define RAND_SEED_INITIALIZED 0x40
#define SAFE_INTERP 0x80
#define USE_EVAL_DIRECT 0x100
+#define INTERP_TRACE_IN_PROGRESS 0x200
/*
*----------------------------------------------------------------
@@ -1379,7 +1475,7 @@ typedef struct ParseValue {
#define TCL_ALIGN(x) (((int)(x) + 7) & ~7)
/*
- * The following macros are used to specify the runtime platform
+ * The following enum values are used to specify the runtime platform
* setting of the tclPlatform variable.
*/
@@ -1390,6 +1486,19 @@ typedef enum {
} TclPlatformType;
/*
+ * 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
+ */
+
+typedef enum TclEolTranslation {
+ TCL_TRANSLATE_AUTO, /* Eol == \r, \n and \r\n. */
+ TCL_TRANSLATE_CR, /* Eol == \r. */
+ TCL_TRANSLATE_LF, /* Eol == \n. */
+ TCL_TRANSLATE_CRLF /* Eol == \r\n. */
+} TclEolTranslation;
+
+/*
* Flags for TclInvoke:
*
* TCL_INVOKE_HIDDEN Invoke a hidden command; if not set,
@@ -1434,9 +1543,9 @@ typedef struct List {
*/
typedef int (TclGetFileAttrProc) _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, CONST char *fileName, Tcl_Obj **attrObjPtrPtr));
+ int objIndex, Tcl_Obj *fileName, Tcl_Obj **attrObjPtrPtr));
typedef int (TclSetFileAttrProc) _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, CONST char *fileName, Tcl_Obj *attrObjPtr));
+ int objIndex, Tcl_Obj *fileName, Tcl_Obj *attrObjPtr));
typedef struct TclFileAttrProcs {
TclGetFileAttrProc *getProc; /* The procedure for getting attrs. */
@@ -1451,63 +1560,42 @@ typedef struct TclFileAttrProcs {
typedef struct TclFile_ *TclFile;
/*
+ * Opaque names for platform specific types.
+ */
+
+typedef struct TclpTime_t_ *TclpTime_t;
+
+/*
+ * The "globParameters" argument of the function TclGlob is an
+ * or'ed combination of the following values:
+ */
+
+#define TCL_GLOBMODE_NO_COMPLAIN 1
+#define TCL_GLOBMODE_JOIN 2
+#define TCL_GLOBMODE_DIR 4
+#define TCL_GLOBMODE_TAILS 8
+
+/*
*----------------------------------------------------------------
- * Data structures related to hooking 'TclStat(...)' and
- * 'TclAccess(...)'.
+ * Data structures related to obsolete filesystem hooks
*----------------------------------------------------------------
*/
typedef int (TclStatProc_) _ANSI_ARGS_((CONST char *path, struct stat *buf));
typedef int (TclAccessProc_) _ANSI_ARGS_((CONST char *path, int mode));
typedef Tcl_Channel (TclOpenFileChannelProc_) _ANSI_ARGS_((Tcl_Interp *interp,
- char *fileName, char *modeString,
+ CONST char *fileName, CONST char *modeString,
int permissions));
-typedef int (*TclCmdProcType) _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char *argv[]));
-typedef int (*TclObjCmdProcType) _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int objc, struct Tcl_Obj * CONST objv[]));
/*
- * Opaque names for platform specific types.
- */
-
-typedef struct TclpTime_t_ *TclpTime_t;
-
-/*
- * The following structure is used to pass glob type data amongst
- * the various glob routines and TclpMatchFilesTypes. Currently
- * most of the fields are ignored. However they will be used in
- * a future release to implement glob's ability to find files
- * of particular types/permissions/etc only.
- */
-typedef struct GlobTypeData {
- /* Corresponds to bcdpfls as in 'find -t' */
- int type;
- /* Corresponds to file permissions */
- int perm;
- /* Acceptable mac type */
- Tcl_Obj* macType;
- /* Acceptable mac creator */
- Tcl_Obj* macCreator;
-} GlobTypeData;
-
-/*
- * type and permission definitions for glob command
+ *----------------------------------------------------------------
+ * Data structures related to procedures
+ *----------------------------------------------------------------
*/
-#define TCL_GLOB_TYPE_BLOCK (1<<0)
-#define TCL_GLOB_TYPE_CHAR (1<<1)
-#define TCL_GLOB_TYPE_DIR (1<<2)
-#define TCL_GLOB_TYPE_PIPE (1<<3)
-#define TCL_GLOB_TYPE_FILE (1<<4)
-#define TCL_GLOB_TYPE_LINK (1<<5)
-#define TCL_GLOB_TYPE_SOCK (1<<6)
-#define TCL_GLOB_PERM_RONLY (1<<0)
-#define TCL_GLOB_PERM_HIDDEN (1<<1)
-#define TCL_GLOB_PERM_R (1<<2)
-#define TCL_GLOB_PERM_W (1<<3)
-#define TCL_GLOB_PERM_X (1<<4)
+typedef Tcl_CmdProc *TclCmdProcType;
+typedef Tcl_ObjCmdProc *TclObjCmdProcType;
/*
*----------------------------------------------------------------
@@ -1523,8 +1611,6 @@ extern char * tclDefaultEncodingDir;
extern Tcl_ChannelType tclFileChannelType;
extern char * tclMemDumpFileName;
extern TclPlatformType tclPlatform;
-extern char * tclpFileAttrStrings[];
-extern CONST TclFileAttrProcs tclpFileAttrProcs[];
/*
* Variables denoting the Tcl object types defined in the core.
@@ -1534,10 +1620,26 @@ extern Tcl_ObjType tclBooleanType;
extern Tcl_ObjType tclByteArrayType;
extern Tcl_ObjType tclByteCodeType;
extern Tcl_ObjType tclDoubleType;
+extern Tcl_ObjType tclEndOffsetType;
extern Tcl_ObjType tclIntType;
extern Tcl_ObjType tclListType;
extern Tcl_ObjType tclProcBodyType;
extern Tcl_ObjType tclStringType;
+extern Tcl_ObjType tclArraySearchType;
+extern Tcl_ObjType tclIndexType;
+extern Tcl_ObjType tclNsNameType;
+#ifndef TCL_WIDE_INT_IS_LONG
+extern Tcl_ObjType tclWideIntType;
+#endif
+
+/*
+ * Variables denoting the hash key types defined in the core.
+ */
+
+extern Tcl_HashKeyType tclArrayHashKeyType;
+extern Tcl_HashKeyType tclOneWordHashKeyType;
+extern Tcl_HashKeyType tclStringHashKeyType;
+extern Tcl_HashKeyType tclObjHashKeyType;
/*
* The head of the list of free Tcl objects, and the total number of Tcl
@@ -1549,6 +1651,8 @@ extern Tcl_Obj * tclFreeObjList;
#ifdef TCL_COMPILE_STATS
extern long tclObjsAlloced;
extern long tclObjsFreed;
+#define TCL_MAX_SHARED_OBJ_STATS 5
+extern long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS];
#endif /* TCL_COMPILE_STATS */
/*
@@ -1558,6 +1662,7 @@ extern long tclObjsFreed;
*/
extern char * tclEmptyStringRep;
+extern char tclEmptyString;
/*
*----------------------------------------------------------------
@@ -1566,55 +1671,22 @@ extern char * tclEmptyStringRep;
*----------------------------------------------------------------
*/
-EXTERN int TclAccess _ANSI_ARGS_((CONST char *path,
- int mode));
-EXTERN int TclAccessDeleteProc _ANSI_ARGS_((TclAccessProc_ *proc));
-EXTERN int TclAccessInsertProc _ANSI_ARGS_((TclAccessProc_ *proc));
-EXTERN void TclAllocateFreeObjects _ANSI_ARGS_((void));
EXTERN int TclArraySet _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj));
EXTERN int TclCheckBadOctal _ANSI_ARGS_((Tcl_Interp *interp,
- char *value));
-EXTERN int TclCleanupChildren _ANSI_ARGS_((Tcl_Interp *interp,
- int numPids, Tcl_Pid *pidPtr,
- Tcl_Channel errorChan));
-EXTERN void TclCleanupCommand _ANSI_ARGS_((Command *cmdPtr));
-EXTERN int TclCopyChannel _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Channel inChan, Tcl_Channel outChan,
- int toRead, Tcl_Obj *cmdPtr));
-/*
- * TclCreatePipeline unofficially exported for use by BLT.
- */
-EXTERN int TclCreatePipeline _ANSI_ARGS_((Tcl_Interp *interp,
- int argc, char **argv, Tcl_Pid **pidArrayPtr,
- TclFile *inPipePtr, TclFile *outPipePtr,
- TclFile *errFilePtr));
-EXTERN int TclCreateProc _ANSI_ARGS_((Tcl_Interp *interp,
- Namespace *nsPtr, char *procName,
- Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr,
- Proc **procPtrPtr));
-EXTERN void TclDeleteCompiledLocalVars _ANSI_ARGS_((
- Interp *iPtr, CallFrame *framePtr));
-EXTERN void TclDeleteVars _ANSI_ARGS_((Interp *iPtr,
- Tcl_HashTable *tablePtr));
-EXTERN int TclDoGlob _ANSI_ARGS_((Tcl_Interp *interp,
- char *separators, Tcl_DString *headPtr,
- char *tail, GlobTypeData *types));
-EXTERN void TclDumpMemoryInfo _ANSI_ARGS_((FILE *outFile));
+ CONST char *value));
EXTERN void TclExpandTokenArray _ANSI_ARGS_((
Tcl_Parse *parsePtr));
-EXTERN void TclExprFloatError _ANSI_ARGS_((Tcl_Interp *interp,
- double value));
EXTERN int TclFileAttrsCmd _ANSI_ARGS_((Tcl_Interp *interp,
int objc, Tcl_Obj *CONST objv[]));
EXTERN int TclFileCopyCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int argc, char **argv)) ;
+ int objc, Tcl_Obj *CONST objv[])) ;
EXTERN int TclFileDeleteCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int argc, char **argv));
+ int objc, Tcl_Obj *CONST objv[]));
EXTERN int TclFileMakeDirsCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int argc, char **argv)) ;
+ int objc, Tcl_Obj *CONST objv[])) ;
EXTERN int TclFileRenameCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int argc, char **argv)) ;
+ int objc, Tcl_Obj *CONST objv[])) ;
EXTERN void TclFinalizeAllocSubsystem _ANSI_ARGS_((void));
EXTERN void TclFinalizeCompExecEnv _ANSI_ARGS_((void));
EXTERN void TclFinalizeCompilation _ANSI_ARGS_((void));
@@ -1622,68 +1694,18 @@ EXTERN void TclFinalizeEncodingSubsystem _ANSI_ARGS_((void));
EXTERN void TclFinalizeEnvironment _ANSI_ARGS_((void));
EXTERN void TclFinalizeExecution _ANSI_ARGS_((void));
EXTERN void TclFinalizeIOSubsystem _ANSI_ARGS_((void));
+EXTERN void TclFinalizeFilesystem _ANSI_ARGS_((void));
EXTERN void TclFinalizeLoad _ANSI_ARGS_((void));
EXTERN void TclFinalizeMemorySubsystem _ANSI_ARGS_((void));
EXTERN void TclFinalizeNotifier _ANSI_ARGS_((void));
+EXTERN void TclFinalizeAsync _ANSI_ARGS_((void));
EXTERN void TclFinalizeSynchronization _ANSI_ARGS_((void));
EXTERN void TclFinalizeThreadData _ANSI_ARGS_((void));
EXTERN void TclFindEncodings _ANSI_ARGS_((CONST char *argv0));
-EXTERN Proc * TclFindProc _ANSI_ARGS_((Interp *iPtr,
- char *procName));
-EXTERN int TclFormatInt _ANSI_ARGS_((char *buffer, long n));
-EXTERN void TclFreePackageInfo _ANSI_ARGS_((Interp *iPtr));
-EXTERN int TclGetDate _ANSI_ARGS_((char *p,
- unsigned long now, long zone,
- unsigned long *timePtr));
-EXTERN Tcl_Obj * TclGetElementOfIndexedArray _ANSI_ARGS_((
- Tcl_Interp *interp, int localIndex,
- Tcl_Obj *elemPtr, int leaveErrorMsg));
-EXTERN char * TclGetExtension _ANSI_ARGS_((char *name));
-EXTERN int TclGetFrame _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, CallFrame **framePtrPtr));
-EXTERN TclCmdProcType TclGetInterpProc _ANSI_ARGS_((void));
-EXTERN int TclGetIntForIndex _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr, int endValue, int *indexPtr));
-EXTERN Tcl_Obj * TclGetIndexedScalar _ANSI_ARGS_((Tcl_Interp *interp,
- int localIndex, int leaveErrorMsg));
-EXTERN int TclGetLong _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, long *longPtr));
-EXTERN int TclGetLoadedPackages _ANSI_ARGS_((
- Tcl_Interp *interp, char *targetName));
-EXTERN int TclGetNamespaceForQualName _ANSI_ARGS_((
- Tcl_Interp *interp, char *qualName,
- Namespace *cxtNsPtr, int flags,
- Namespace **nsPtrPtr, Namespace **altNsPtrPtr,
- Namespace **actualCxtPtrPtr,
- char **simpleNamePtr));
-EXTERN TclObjCmdProcType TclGetObjInterpProc _ANSI_ARGS_((void));
-EXTERN int TclGetOpenMode _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, int *seekFlagPtr));
-EXTERN Tcl_Command TclGetOriginalCommand _ANSI_ARGS_((
- Tcl_Command command));
EXTERN int TclGlob _ANSI_ARGS_((Tcl_Interp *interp,
- char *pattern, char *unquotedPrefix,
- int globFlags, GlobTypeData* types));
-EXTERN int TclGlobalInvoke _ANSI_ARGS_((Tcl_Interp *interp,
- int argc, char **argv, int flags));
-EXTERN int TclGuessPackageName _ANSI_ARGS_((char *fileName,
- Tcl_DString *bufPtr));
-EXTERN int TclHideUnsafeCommands _ANSI_ARGS_((
- Tcl_Interp *interp));
-EXTERN int TclInExit _ANSI_ARGS_((void));
-EXTERN Tcl_Obj * TclIncrElementOfIndexedArray _ANSI_ARGS_((
- Tcl_Interp *interp, int localIndex,
- Tcl_Obj *elemPtr, long incrAmount));
-EXTERN Tcl_Obj * TclIncrIndexedScalar _ANSI_ARGS_((
- Tcl_Interp *interp, int localIndex,
- long incrAmount));
-EXTERN Tcl_Obj * TclIncrVar2 _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr,
- long incrAmount, int flags));
+ char *pattern, Tcl_Obj *unquotedPrefix,
+ int globFlags, Tcl_GlobTypeData* types));
EXTERN void TclInitAlloc _ANSI_ARGS_((void));
-EXTERN void TclInitCompiledLocals _ANSI_ARGS_((
- Tcl_Interp *interp, CallFrame *framePtr,
- Namespace *nsPtr));
EXTERN void TclInitDbCkalloc _ANSI_ARGS_((void));
EXTERN void TclInitEncodingSubsystem _ANSI_ARGS_((void));
EXTERN void TclInitIOSubsystem _ANSI_ARGS_((void));
@@ -1691,47 +1713,43 @@ EXTERN void TclInitNamespaceSubsystem _ANSI_ARGS_((void));
EXTERN void TclInitNotifier _ANSI_ARGS_((void));
EXTERN void TclInitObjSubsystem _ANSI_ARGS_((void));
EXTERN void TclInitSubsystems _ANSI_ARGS_((CONST char *argv0));
-EXTERN int TclInvoke _ANSI_ARGS_((Tcl_Interp *interp,
- int argc, char **argv, int flags));
-EXTERN int TclInvokeObjectCommand _ANSI_ARGS_((
- ClientData clientData, Tcl_Interp *interp,
- int argc, char **argv));
-EXTERN int TclInvokeStringCommand _ANSI_ARGS_((
- ClientData clientData, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]));
EXTERN int TclIsLocalScalar _ANSI_ARGS_((CONST char *src,
int len));
-EXTERN Proc * TclIsProc _ANSI_ARGS_((Command *cmdPtr));
-EXTERN Var * TclLookupVar _ANSI_ARGS_((Tcl_Interp *interp,
- char *part1, char *part2, int flags, char *msg,
- int createPart1, int createPart2,
- Var **arrayPtrPtr));
-EXTERN int TclMathInProgress _ANSI_ARGS_((void));
-EXTERN int TclNeedSpace _ANSI_ARGS_((char *start, char *end));
-EXTERN Tcl_Obj * TclNewProcBodyObj _ANSI_ARGS_((Proc *procPtr));
-EXTERN int TclObjCommandComplete _ANSI_ARGS_((Tcl_Obj *cmdPtr));
-EXTERN int TclObjInterpProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-EXTERN int TclObjInvoke _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[], int flags));
-EXTERN int TclObjInvokeGlobal _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[], int flags));
-EXTERN int TclOpenFileChannelDeleteProc _ANSI_ARGS_((
- TclOpenFileChannelProc_ *proc));
-EXTERN int TclOpenFileChannelInsertProc _ANSI_ARGS_((
- TclOpenFileChannelProc_ *proc));
-EXTERN int TclpAccess _ANSI_ARGS_((CONST char *filename,
+EXTERN int TclJoinThread _ANSI_ARGS_((Tcl_ThreadId id,
+ int* result));
+EXTERN Tcl_Obj * TclLindexList _ANSI_ARGS_((Tcl_Interp* interp,
+ Tcl_Obj* listPtr,
+ Tcl_Obj* argPtr ));
+EXTERN Tcl_Obj * TclLindexFlat _ANSI_ARGS_((Tcl_Interp* interp,
+ Tcl_Obj* listPtr,
+ int indexCount,
+ Tcl_Obj *CONST indexArray[]
+ ));
+EXTERN Tcl_Obj * TclLsetList _ANSI_ARGS_((Tcl_Interp* interp,
+ Tcl_Obj* listPtr,
+ Tcl_Obj* indexPtr,
+ Tcl_Obj* valuePtr
+ ));
+EXTERN Tcl_Obj * TclLsetFlat _ANSI_ARGS_((Tcl_Interp* interp,
+ Tcl_Obj* listPtr,
+ int indexCount,
+ Tcl_Obj *CONST indexArray[],
+ Tcl_Obj* valuePtr
+ ));
+EXTERN int TclParseBackslash _ANSI_ARGS_((CONST char *src,
+ int numBytes, int *readPtr, char *dst));
+EXTERN int TclParseHex _ANSI_ARGS_((CONST char *src, int numBytes,
+ Tcl_UniChar *resultPtr));
+EXTERN int TclParseInteger _ANSI_ARGS_((CONST char *string,
+ int numBytes));
+EXTERN int TclParseWhiteSpace _ANSI_ARGS_((CONST char *src,
+ int numBytes, Tcl_Parse *parsePtr, char *typePtr));
+EXTERN int TclpObjAccess _ANSI_ARGS_((Tcl_Obj *filename,
int mode));
-EXTERN char * TclpAlloc _ANSI_ARGS_((unsigned int size));
+EXTERN int TclpObjLstat _ANSI_ARGS_((Tcl_Obj *pathPtr,
+ Tcl_StatBuf *buf));
EXTERN int TclpCheckStackSpace _ANSI_ARGS_((void));
-EXTERN int TclpCopyFile _ANSI_ARGS_((CONST char *source,
- CONST char *dest));
-EXTERN int TclpCopyDirectory _ANSI_ARGS_((CONST char *source,
- CONST char *dest, Tcl_DString *errorPtr));
-EXTERN int TclpCreateDirectory _ANSI_ARGS_((CONST char *path));
-EXTERN int TclpDeleteFile _ANSI_ARGS_((CONST char *path));
-EXTERN void TclpExit _ANSI_ARGS_((int status));
+EXTERN Tcl_Obj* TclpTempFileName _ANSI_ARGS_((void));
EXTERN void TclpFinalizeCondition _ANSI_ARGS_((
Tcl_Condition *condPtr));
EXTERN void TclpFinalizeMutex _ANSI_ARGS_((Tcl_Mutex *mutexPtr));
@@ -1743,56 +1761,63 @@ EXTERN char * TclpFindExecutable _ANSI_ARGS_((
CONST char *argv0));
EXTERN int TclpFindVariable _ANSI_ARGS_((CONST char *name,
int *lengthPtr));
-EXTERN void TclpFree _ANSI_ARGS_((char *ptr));
-EXTERN unsigned long TclpGetClicks _ANSI_ARGS_((void));
-EXTERN Tcl_Channel TclpGetDefaultStdChannel _ANSI_ARGS_((int type));
-EXTERN unsigned long TclpGetSeconds _ANSI_ARGS_((void));
-EXTERN void TclpGetTime _ANSI_ARGS_((Tcl_Time *time));
-EXTERN int TclpGetTimeZone _ANSI_ARGS_((unsigned long time));
-EXTERN char * TclpGetUserHome _ANSI_ARGS_((CONST char *name,
- Tcl_DString *bufferPtr));
-EXTERN int TclpHasSockets _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN void TclpInitLibraryPath _ANSI_ARGS_((CONST char *argv0));
EXTERN void TclpInitLock _ANSI_ARGS_((void));
EXTERN void TclpInitPlatform _ANSI_ARGS_((void));
EXTERN void TclpInitUnlock _ANSI_ARGS_((void));
-EXTERN int TclpListVolumes _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int TclpLoadFile _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *pathPtr,
+ CONST char *sym1, CONST char *sym2,
+ Tcl_PackageInitProc **proc1Ptr,
+ Tcl_PackageInitProc **proc2Ptr,
+ ClientData *clientDataPtr,
+ Tcl_FSUnloadFileProc **unloadProcPtr));
+EXTERN Tcl_Obj* TclpObjListVolumes _ANSI_ARGS_((void));
EXTERN void TclpMasterLock _ANSI_ARGS_((void));
EXTERN void TclpMasterUnlock _ANSI_ARGS_((void));
EXTERN int TclpMatchFiles _ANSI_ARGS_((Tcl_Interp *interp,
char *separators, Tcl_DString *dirPtr,
char *pattern, char *tail));
+EXTERN int TclpObjNormalizePath _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *pathPtr, int nextCheckpoint));
+EXTERN int TclpObjCreateDirectory _ANSI_ARGS_((Tcl_Obj *pathPtr));
+EXTERN void TclpNativeJoinPath _ANSI_ARGS_((Tcl_Obj *prefix,
+ char *joining));
+EXTERN Tcl_Obj* TclpNativeSplitPath _ANSI_ARGS_((Tcl_Obj *pathPtr,
+ int *lenPtr));
+EXTERN Tcl_PathType TclpGetNativePathType _ANSI_ARGS_((Tcl_Obj *pathObjPtr,
+ int *driveNameLengthPtr, Tcl_Obj **driveNameRef));
+EXTERN int TclCrossFilesystemCopy _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *source, Tcl_Obj *target));
+EXTERN int TclpObjDeleteFile _ANSI_ARGS_((Tcl_Obj *pathPtr));
+EXTERN int TclpObjCopyDirectory _ANSI_ARGS_((Tcl_Obj *srcPathPtr,
+ Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr));
+EXTERN int TclpObjCopyFile _ANSI_ARGS_((Tcl_Obj *srcPathPtr,
+ Tcl_Obj *destPathPtr));
+EXTERN int TclpObjRemoveDirectory _ANSI_ARGS_((Tcl_Obj *pathPtr,
+ int recursive, Tcl_Obj **errorPtr));
+EXTERN int TclpObjRenameFile _ANSI_ARGS_((Tcl_Obj *srcPathPtr,
+ Tcl_Obj *destPathPtr));
+EXTERN int TclpMatchInDirectory _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *resultPtr, Tcl_Obj *pathPtr,
+ CONST char *pattern, Tcl_GlobTypeData *types));
+EXTERN Tcl_Obj* TclpObjGetCwd _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN Tcl_Obj* TclpObjLink _ANSI_ARGS_((Tcl_Obj *pathPtr,
+ Tcl_Obj *toPtr, int linkType));
+EXTERN int TclpObjChdir _ANSI_ARGS_((Tcl_Obj *pathPtr));
+EXTERN Tcl_Obj* TclFileDirname _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj*pathPtr));
+EXTERN int TclpObjStat _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_StatBuf *buf));
EXTERN Tcl_Channel TclpOpenFileChannel _ANSI_ARGS_((Tcl_Interp *interp,
- char *fileName, char *modeString,
+ Tcl_Obj *pathPtr, int mode,
int permissions));
+EXTERN void TclpPanic _ANSI_ARGS_(TCL_VARARGS(CONST char *,
+ format));
EXTERN char * TclpReadlink _ANSI_ARGS_((CONST char *fileName,
Tcl_DString *linkPtr));
-EXTERN char * TclpRealloc _ANSI_ARGS_((char *ptr,
- unsigned int size));
EXTERN void TclpReleaseFile _ANSI_ARGS_((TclFile file));
-EXTERN int TclpRemoveDirectory _ANSI_ARGS_((CONST char *path,
- int recursive, Tcl_DString *errorPtr));
-EXTERN int TclpRenameFile _ANSI_ARGS_((CONST char *source,
- CONST char *dest));
-EXTERN void TclpSetInitialEncodings _ANSI_ARGS_((void));
EXTERN void TclpSetVariables _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN VOID * TclpSysAlloc _ANSI_ARGS_((long size, int isBin));
-EXTERN void TclpSysFree _ANSI_ARGS_((VOID *ptr));
-EXTERN VOID * TclpSysRealloc _ANSI_ARGS_((VOID *cp,
- unsigned int size));
-EXTERN void TclpUnloadFile _ANSI_ARGS_((ClientData clientData));
-EXTERN char * TclPrecTraceProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, char *name1, char *name2,
- int flags));
-EXTERN int TclPreventAliasLoop _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Interp *cmdInterp, Tcl_Command cmd));
-EXTERN void TclProcCleanupProc _ANSI_ARGS_((Proc *procPtr));
-EXTERN int TclProcCompileProc _ANSI_ARGS_((Tcl_Interp *interp,
- Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr,
- CONST char *description, CONST char *procName));
-EXTERN void TclProcDeleteProc _ANSI_ARGS_((ClientData clientData));
-EXTERN int TclProcInterpProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+EXTERN void TclpUnloadFile _ANSI_ARGS_((Tcl_LoadHandle loadHandle));
EXTERN VOID * TclpThreadDataKeyGet _ANSI_ARGS_((
Tcl_ThreadDataKey *keyPtr));
EXTERN void TclpThreadDataKeyInit _ANSI_ARGS_((
@@ -1802,33 +1827,22 @@ EXTERN void TclpThreadDataKeySet _ANSI_ARGS_((
EXTERN void TclpThreadExit _ANSI_ARGS_((int status));
EXTERN void TclRememberCondition _ANSI_ARGS_((Tcl_Condition *mutex));
EXTERN void TclRememberDataKey _ANSI_ARGS_((Tcl_ThreadDataKey *mutex));
+EXTERN VOID TclRememberJoinableThread _ANSI_ARGS_((Tcl_ThreadId id));
EXTERN void TclRememberMutex _ANSI_ARGS_((Tcl_Mutex *mutex));
-EXTERN int TclRenameCommand _ANSI_ARGS_((Tcl_Interp *interp,
- char *oldName, char *newName)) ;
-EXTERN void TclResetShadowedCmdRefs _ANSI_ARGS_((
- Tcl_Interp *interp, Command *newCmdPtr));
-EXTERN int TclServiceIdle _ANSI_ARGS_((void));
-EXTERN Tcl_Obj * TclSetElementOfIndexedArray _ANSI_ARGS_((
- Tcl_Interp *interp, int localIndex,
- Tcl_Obj *elemPtr, Tcl_Obj *objPtr,
- int leaveErrorMsg));
-EXTERN Tcl_Obj * TclSetIndexedScalar _ANSI_ARGS_((Tcl_Interp *interp,
- int localIndex, Tcl_Obj *objPtr,
- int leaveErrorMsg));
-EXTERN char * TclSetPreInitScript _ANSI_ARGS_((char *string));
-EXTERN void TclSetupEnv _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN int TclSockGetPort _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, char *proto, int *portPtr));
-EXTERN int TclSockMinimumBuffers _ANSI_ARGS_((int sock,
- int size));
-EXTERN int TclStat _ANSI_ARGS_((CONST char *path,
- struct stat *buf));
-EXTERN int TclStatDeleteProc _ANSI_ARGS_((TclStatProc_ *proc));
-EXTERN int TclStatInsertProc _ANSI_ARGS_((TclStatProc_ *proc));
-EXTERN void TclTeardownNamespace _ANSI_ARGS_((Namespace *nsPtr));
+EXTERN VOID TclSignalExitThread _ANSI_ARGS_((Tcl_ThreadId id,
+ int result));
EXTERN void TclTransferResult _ANSI_ARGS_((Tcl_Interp *sourceInterp,
int result, Tcl_Interp *targetInterp));
-EXTERN int TclUpdateReturnInfo _ANSI_ARGS_((Interp *iPtr));
+EXTERN Tcl_Obj* TclpNativeToNormalized
+ _ANSI_ARGS_((ClientData clientData));
+EXTERN Tcl_Obj* TclpFilesystemPathType
+ _ANSI_ARGS_((Tcl_Obj* pathObjPtr));
+EXTERN Tcl_PackageInitProc* TclpFindSymbol _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_LoadHandle loadHandle, CONST char *symbol));
+EXTERN int TclpDlopen _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *pathPtr,
+ Tcl_LoadHandle *loadHandle,
+ Tcl_FSUnloadFileProc **unloadProcPtr));
/*
*----------------------------------------------------------------
@@ -1926,6 +1940,8 @@ EXTERN int Tcl_LreplaceObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_LsearchObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Tcl_LsetObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp* interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_LsortObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_NamespaceObjCmd _ANSI_ARGS_((ClientData clientData,
@@ -1997,7 +2013,7 @@ EXTERN int Tcl_WhileObjCmd _ANSI_ARGS_((ClientData clientData,
#ifdef MAC_TCL
EXTERN int Tcl_EchoCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST84 char **argv));
EXTERN int Tcl_LsObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_BeepObjCmd _ANSI_ARGS_((ClientData clientData,
@@ -2014,6 +2030,8 @@ EXTERN int Tcl_ResourceObjCmd _ANSI_ARGS_((ClientData clientData,
*----------------------------------------------------------------
*/
+EXTERN int TclCompileAppendCmd _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
EXTERN int TclCompileBreakCmd _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
EXTERN int TclCompileCatchCmd _ANSI_ARGS_((Tcl_Interp *interp,
@@ -2030,12 +2048,52 @@ EXTERN int TclCompileIfCmd _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
EXTERN int TclCompileIncrCmd _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+EXTERN int TclCompileLappendCmd _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+EXTERN int TclCompileLindexCmd _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+EXTERN int TclCompileListCmd _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+EXTERN int TclCompileLlengthCmd _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+EXTERN int TclCompileLsetCmd _ANSI_ARGS_((Tcl_Interp* interp,
+ Tcl_Parse* parsePtr, struct CompileEnv* envPtr));
+EXTERN int TclCompileRegexpCmd _ANSI_ARGS_((Tcl_Interp* interp,
+ Tcl_Parse* parsePtr, struct CompileEnv* envPtr));
+EXTERN int TclCompileReturnCmd _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
EXTERN int TclCompileSetCmd _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+EXTERN int TclCompileStringCmd _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
EXTERN int TclCompileWhileCmd _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
/*
+ * Functions defined in generic/tclVar.c and currenttly exported only
+ * for use by the bytecode compiler and engine. Some of these could later
+ * be placed in the public interface.
+ */
+
+EXTERN Var * TclLookupArrayElement _ANSI_ARGS_((Tcl_Interp *interp,
+ CONST char *arrayName, CONST char *elName, CONST int flags,
+ CONST char *msg, CONST int createPart1,
+ CONST int createPart2, Var *arrayPtr));
+EXTERN Var * TclObjLookupVar _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *part1Ptr, CONST char *part2, int flags,
+ CONST char *msg, CONST int createPart1,
+ CONST int createPart2, Var **arrayPtrPtr));
+EXTERN Tcl_Obj *TclPtrGetVar _ANSI_ARGS_((Tcl_Interp *interp, Var *varPtr,
+ Var *arrayPtr, CONST char *part1, CONST char *part2,
+ CONST int flags));
+EXTERN Tcl_Obj *TclPtrSetVar _ANSI_ARGS_((Tcl_Interp *interp, Var *varPtr,
+ Var *arrayPtr, CONST char *part1, CONST char *part2,
+ Tcl_Obj *newValuePtr, CONST int flags));
+EXTERN Tcl_Obj *TclPtrIncrVar _ANSI_ARGS_((Tcl_Interp *interp, Var *varPtr,
+ Var *arrayPtr, CONST char *part1, CONST char *part2,
+ CONST long i, CONST int flags));
+
+/*
*----------------------------------------------------------------
* Macros used by the Tcl core to create and release Tcl objects.
* TclNewObj(objPtr) creates a new object denoting an empty string.
@@ -2050,6 +2108,10 @@ EXTERN int TclCompileWhileCmd _ANSI_ARGS_((Tcl_Interp *interp,
*
* EXTERN void TclNewObj _ANSI_ARGS_((Tcl_Obj *objPtr));
* EXTERN void TclDecrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr));
+ *
+ * These macros are defined in terms of two macros that depend on
+ * memory allocator in use: TclAllocObjStorage, TclFreeObjStorage.
+ * They are defined below.
*----------------------------------------------------------------
*/
@@ -2063,78 +2125,102 @@ EXTERN int TclCompileWhileCmd _ANSI_ARGS_((Tcl_Interp *interp,
# define TclIncrObjsFreed()
#endif /* TCL_COMPILE_STATS */
-#ifdef TCL_MEM_DEBUG
-# define TclNewObj(objPtr) \
- (objPtr) = (Tcl_Obj *) \
- Tcl_DbCkalloc(sizeof(Tcl_Obj), __FILE__, __LINE__); \
- (objPtr)->refCount = 0; \
- (objPtr)->bytes = tclEmptyStringRep; \
- (objPtr)->length = 0; \
- (objPtr)->typePtr = NULL; \
- TclIncrObjsAllocated()
-
-# define TclDbNewObj(objPtr, file, line) \
- (objPtr) = (Tcl_Obj *) Tcl_DbCkalloc(sizeof(Tcl_Obj), (file), (line)); \
+#define TclNewObj(objPtr) \
+ TclAllocObjStorage(objPtr); \
+ TclIncrObjsAllocated(); \
(objPtr)->refCount = 0; \
(objPtr)->bytes = tclEmptyStringRep; \
(objPtr)->length = 0; \
- (objPtr)->typePtr = NULL; \
- TclIncrObjsAllocated()
-
-# define TclDecrRefCount(objPtr) \
+ (objPtr)->typePtr = NULL
+
+#define TclDecrRefCount(objPtr) \
if (--(objPtr)->refCount <= 0) { \
- if ((objPtr)->refCount < -1) \
- panic("Reference count for %lx was negative: %s line %d", \
- (objPtr), __FILE__, __LINE__); \
- if (((objPtr)->bytes != NULL) \
- && ((objPtr)->bytes != tclEmptyStringRep)) { \
- ckfree((char *) (objPtr)->bytes); \
- } \
if (((objPtr)->typePtr != NULL) \
&& ((objPtr)->typePtr->freeIntRepProc != NULL)) { \
(objPtr)->typePtr->freeIntRepProc(objPtr); \
} \
- ckfree((char *) (objPtr)); \
+ if (((objPtr)->bytes != NULL) \
+ && ((objPtr)->bytes != tclEmptyStringRep)) { \
+ ckfree((char *) (objPtr)->bytes); \
+ } \
+ TclFreeObjStorage(objPtr); \
TclIncrObjsFreed(); \
}
+#ifdef TCL_MEM_DEBUG
+# define TclAllocObjStorage(objPtr) \
+ (objPtr) = (Tcl_Obj *) \
+ Tcl_DbCkalloc(sizeof(Tcl_Obj), __FILE__, __LINE__)
+
+# define TclFreeObjStorage(objPtr) \
+ if ((objPtr)->refCount < -1) { \
+ panic("Reference count for %lx was negative: %s line %d", \
+ (objPtr), __FILE__, __LINE__); \
+ } \
+ ckfree((char *) (objPtr))
+
+# define TclDbNewObj(objPtr, file, line) \
+ (objPtr) = (Tcl_Obj *) Tcl_DbCkalloc(sizeof(Tcl_Obj), (file), (line)); \
+ (objPtr)->refCount = 0; \
+ (objPtr)->bytes = tclEmptyStringRep; \
+ (objPtr)->length = 0; \
+ (objPtr)->typePtr = NULL; \
+ TclIncrObjsAllocated()
+
+#elif defined(PURIFY)
+
+/*
+ * 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
+ */
+
+# define TclAllocObjStorage(objPtr) \
+ (objPtr) = (Tcl_Obj *) Tcl_Ckalloc(sizeof(Tcl_Obj))
+
+# define TclFreeObjStorage(objPtr) \
+ ckfree((char *) (objPtr))
+
+#elif defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
+
+/*
+ * The TCL_THREADS mode is like the regular mode but allocates Tcl_Obj's
+ * from per-thread caches.
+ */
+
+EXTERN Tcl_Obj *TclThreadAllocObj _ANSI_ARGS_((void));
+EXTERN void TclThreadFreeObj _ANSI_ARGS_((Tcl_Obj *));
+
+# define TclAllocObjStorage(objPtr) \
+ (objPtr) = TclThreadAllocObj()
+
+# define TclFreeObjStorage(objPtr) \
+ TclThreadFreeObj((objPtr))
+
#else /* not TCL_MEM_DEBUG */
#ifdef TCL_THREADS
+/* declared in tclObj.c */
extern Tcl_Mutex tclObjMutex;
#endif
-# define TclNewObj(objPtr) \
- Tcl_MutexLock(&tclObjMutex); \
- if (tclFreeObjList == NULL) { \
- TclAllocateFreeObjects(); \
- } \
- (objPtr) = tclFreeObjList; \
- tclFreeObjList = (Tcl_Obj *) \
- tclFreeObjList->internalRep.otherValuePtr; \
- (objPtr)->refCount = 0; \
- (objPtr)->bytes = tclEmptyStringRep; \
- (objPtr)->length = 0; \
- (objPtr)->typePtr = NULL; \
- TclIncrObjsAllocated(); \
- Tcl_MutexUnlock(&tclObjMutex)
+# 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 TclDecrRefCount(objPtr) \
- if (--(objPtr)->refCount <= 0) { \
- if (((objPtr)->bytes != NULL) \
- && ((objPtr)->bytes != tclEmptyStringRep)) { \
- ckfree((char *) (objPtr)->bytes); \
- } \
- if (((objPtr)->typePtr != NULL) \
- && ((objPtr)->typePtr->freeIntRepProc != NULL)) { \
- (objPtr)->typePtr->freeIntRepProc(objPtr); \
- } \
- Tcl_MutexLock(&tclObjMutex); \
- (objPtr)->internalRep.otherValuePtr = (VOID *) tclFreeObjList; \
- tclFreeObjList = (objPtr); \
- TclIncrObjsFreed(); \
- Tcl_MutexUnlock(&tclObjMutex); \
- }
#endif /* TCL_MEM_DEBUG */
/*
@@ -2179,6 +2265,23 @@ extern Tcl_Mutex tclObjMutex;
#define TclGetString(objPtr) \
((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString((objPtr)))
+/*
+ *----------------------------------------------------------------
+ * 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:
+ *
+ * EXTERN int TclUniCharNcmp _ANSI_ARGS_((CONST Tcl_UniChar *cs,
+ * CONST Tcl_UniChar *ct, unsigned long n));
+ *----------------------------------------------------------------
+ */
+#ifdef WORDS_BIGENDIAN
+# define TclUniCharNcmp(cs,ct,n) memcmp((cs),(ct),(n)*sizeof(Tcl_UniChar))
+#else /* !WORDS_BIGENDIAN */
+# define TclUniCharNcmp Tcl_UniCharNcmp
+#endif /* WORDS_BIGENDIAN */
+
#include "tclIntDecls.h"
# undef TCL_STORAGE_CLASS
@@ -2186,4 +2289,3 @@ extern Tcl_Mutex tclObjMutex;
#endif /* _TCLINT */
-
diff --git a/tcl/generic/tclIntDecls.h b/tcl/generic/tclIntDecls.h
index 900fc2e9f00..adea7f58f25 100644
--- a/tcl/generic/tclIntDecls.h
+++ b/tcl/generic/tclIntDecls.h
@@ -29,8 +29,7 @@
* Exported function declarations:
*/
-/* 0 */
-EXTERN int TclAccess _ANSI_ARGS_((CONST char * path, int mode));
+/* Slot 0 is reserved */
/* 1 */
EXTERN int TclAccessDeleteProc _ANSI_ARGS_((
TclAccessProc_ * proc));
@@ -64,20 +63,20 @@ EXTERN int TclCopyChannel _ANSI_ARGS_((Tcl_Interp * interp,
#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
/* 9 */
EXTERN int TclCreatePipeline _ANSI_ARGS_((Tcl_Interp * interp,
- int argc, char ** argv,
+ int argc, CONST char ** argv,
Tcl_Pid ** pidArrayPtr, TclFile * inPipePtr,
TclFile * outPipePtr, TclFile * errFilePtr));
#endif /* UNIX */
#ifdef __WIN32__
/* 9 */
EXTERN int TclCreatePipeline _ANSI_ARGS_((Tcl_Interp * interp,
- int argc, char ** argv,
+ int argc, CONST char ** argv,
Tcl_Pid ** pidArrayPtr, TclFile * inPipePtr,
TclFile * outPipePtr, TclFile * errFilePtr));
#endif /* __WIN32__ */
/* 10 */
EXTERN int TclCreateProc _ANSI_ARGS_((Tcl_Interp * interp,
- Namespace * nsPtr, char * procName,
+ Namespace * nsPtr, CONST char * procName,
Tcl_Obj * argsPtr, Tcl_Obj * bodyPtr,
Proc ** procPtrPtr));
/* 11 */
@@ -89,28 +88,18 @@ EXTERN void TclDeleteVars _ANSI_ARGS_((Interp * iPtr,
/* 13 */
EXTERN int TclDoGlob _ANSI_ARGS_((Tcl_Interp * interp,
char * separators, Tcl_DString * headPtr,
- char * tail, GlobTypeData * types));
+ char * tail, Tcl_GlobTypeData * types));
/* 14 */
EXTERN void TclDumpMemoryInfo _ANSI_ARGS_((FILE * outFile));
/* Slot 15 is reserved */
/* 16 */
EXTERN void TclExprFloatError _ANSI_ARGS_((Tcl_Interp * interp,
double value));
-/* 17 */
-EXTERN int TclFileAttrsCmd _ANSI_ARGS_((Tcl_Interp * interp,
- int objc, Tcl_Obj *CONST objv[]));
-/* 18 */
-EXTERN int TclFileCopyCmd _ANSI_ARGS_((Tcl_Interp * interp,
- int argc, char ** argv));
-/* 19 */
-EXTERN int TclFileDeleteCmd _ANSI_ARGS_((Tcl_Interp * interp,
- int argc, char ** argv));
-/* 20 */
-EXTERN int TclFileMakeDirsCmd _ANSI_ARGS_((Tcl_Interp * interp,
- int argc, char ** argv));
-/* 21 */
-EXTERN int TclFileRenameCmd _ANSI_ARGS_((Tcl_Interp * interp,
- int argc, char ** argv));
+/* Slot 17 is reserved */
+/* Slot 18 is reserved */
+/* Slot 19 is reserved */
+/* Slot 20 is reserved */
+/* Slot 21 is reserved */
/* 22 */
EXTERN int TclFindElement _ANSI_ARGS_((Tcl_Interp * interp,
CONST char * listStr, int listLength,
@@ -119,7 +108,7 @@ EXTERN int TclFindElement _ANSI_ARGS_((Tcl_Interp * interp,
int * bracePtr));
/* 23 */
EXTERN Proc * TclFindProc _ANSI_ARGS_((Interp * iPtr,
- char * procName));
+ CONST char * procName));
/* 24 */
EXTERN int TclFormatInt _ANSI_ARGS_((char * buffer, long n));
/* 25 */
@@ -130,44 +119,39 @@ EXTERN int TclGetDate _ANSI_ARGS_((char * p, unsigned long now,
long zone, unsigned long * timePtr));
/* 28 */
EXTERN Tcl_Channel TclpGetDefaultStdChannel _ANSI_ARGS_((int type));
-/* 29 */
-EXTERN Tcl_Obj * TclGetElementOfIndexedArray _ANSI_ARGS_((
- Tcl_Interp * interp, int localIndex,
- Tcl_Obj * elemPtr, int leaveErrorMsg));
+/* Slot 29 is reserved */
/* Slot 30 is reserved */
/* 31 */
EXTERN char * TclGetExtension _ANSI_ARGS_((char * name));
/* 32 */
EXTERN int TclGetFrame _ANSI_ARGS_((Tcl_Interp * interp,
- char * str, CallFrame ** framePtrPtr));
+ CONST char * str, CallFrame ** framePtrPtr));
/* 33 */
EXTERN TclCmdProcType TclGetInterpProc _ANSI_ARGS_((void));
/* 34 */
EXTERN int TclGetIntForIndex _ANSI_ARGS_((Tcl_Interp * interp,
Tcl_Obj * objPtr, int endValue,
int * indexPtr));
-/* 35 */
-EXTERN Tcl_Obj * TclGetIndexedScalar _ANSI_ARGS_((Tcl_Interp * interp,
- int localIndex, int leaveErrorMsg));
+/* Slot 35 is reserved */
/* 36 */
EXTERN int TclGetLong _ANSI_ARGS_((Tcl_Interp * interp,
- char * str, long * longPtr));
+ CONST char * str, long * longPtr));
/* 37 */
EXTERN int TclGetLoadedPackages _ANSI_ARGS_((
Tcl_Interp * interp, char * targetName));
/* 38 */
EXTERN int TclGetNamespaceForQualName _ANSI_ARGS_((
- Tcl_Interp * interp, char * qualName,
+ Tcl_Interp * interp, CONST char * qualName,
Namespace * cxtNsPtr, int flags,
Namespace ** nsPtrPtr,
Namespace ** altNsPtrPtr,
Namespace ** actualCxtPtrPtr,
- char ** simpleNamePtr));
+ CONST char ** simpleNamePtr));
/* 39 */
EXTERN TclObjCmdProcType TclGetObjInterpProc _ANSI_ARGS_((void));
/* 40 */
EXTERN int TclGetOpenMode _ANSI_ARGS_((Tcl_Interp * interp,
- char * str, int * seekFlagPtr));
+ CONST char * str, int * seekFlagPtr));
/* 41 */
EXTERN Tcl_Command TclGetOriginalCommand _ANSI_ARGS_((
Tcl_Command command));
@@ -176,23 +160,17 @@ EXTERN char * TclpGetUserHome _ANSI_ARGS_((CONST char * name,
Tcl_DString * bufferPtr));
/* 43 */
EXTERN int TclGlobalInvoke _ANSI_ARGS_((Tcl_Interp * interp,
- int argc, char ** argv, int flags));
+ int argc, CONST84 char ** argv, int flags));
/* 44 */
-EXTERN int TclGuessPackageName _ANSI_ARGS_((char * fileName,
- Tcl_DString * bufPtr));
+EXTERN int TclGuessPackageName _ANSI_ARGS_((
+ CONST char * fileName, Tcl_DString * bufPtr));
/* 45 */
EXTERN int TclHideUnsafeCommands _ANSI_ARGS_((
Tcl_Interp * interp));
/* 46 */
EXTERN int TclInExit _ANSI_ARGS_((void));
-/* 47 */
-EXTERN Tcl_Obj * TclIncrElementOfIndexedArray _ANSI_ARGS_((
- Tcl_Interp * interp, int localIndex,
- Tcl_Obj * elemPtr, long incrAmount));
-/* 48 */
-EXTERN Tcl_Obj * TclIncrIndexedScalar _ANSI_ARGS_((
- Tcl_Interp * interp, int localIndex,
- long incrAmount));
+/* Slot 47 is reserved */
+/* Slot 48 is reserved */
/* 49 */
EXTERN Tcl_Obj * TclIncrVar2 _ANSI_ARGS_((Tcl_Interp * interp,
Tcl_Obj * part1Ptr, Tcl_Obj * part2Ptr,
@@ -205,11 +183,11 @@ EXTERN void TclInitCompiledLocals _ANSI_ARGS_((
EXTERN int TclInterpInit _ANSI_ARGS_((Tcl_Interp * interp));
/* 52 */
EXTERN int TclInvoke _ANSI_ARGS_((Tcl_Interp * interp, int argc,
- char ** argv, int flags));
+ CONST84 char ** argv, int flags));
/* 53 */
EXTERN int TclInvokeObjectCommand _ANSI_ARGS_((
ClientData clientData, Tcl_Interp * interp,
- int argc, char ** argv));
+ int argc, CONST84 char ** argv));
/* 54 */
EXTERN int TclInvokeStringCommand _ANSI_ARGS_((
ClientData clientData, Tcl_Interp * interp,
@@ -220,15 +198,13 @@ EXTERN Proc * TclIsProc _ANSI_ARGS_((Command * cmdPtr));
/* Slot 57 is reserved */
/* 58 */
EXTERN Var * TclLookupVar _ANSI_ARGS_((Tcl_Interp * interp,
- char * part1, char * part2, int flags,
- char * msg, int createPart1, int createPart2,
- Var ** arrayPtrPtr));
-/* 59 */
-EXTERN int TclpMatchFiles _ANSI_ARGS_((Tcl_Interp * interp,
- char * separators, Tcl_DString * dirPtr,
- char * pattern, char * tail));
+ CONST char * part1, CONST char * part2,
+ int flags, CONST char * msg, int createPart1,
+ int createPart2, Var ** arrayPtrPtr));
+/* Slot 59 is reserved */
/* 60 */
-EXTERN int TclNeedSpace _ANSI_ARGS_((char * start, char * end));
+EXTERN int TclNeedSpace _ANSI_ARGS_((CONST char * start,
+ CONST char * end));
/* 61 */
EXTERN Tcl_Obj * TclNewProcBodyObj _ANSI_ARGS_((Proc * procPtr));
/* 62 */
@@ -249,20 +225,13 @@ EXTERN int TclOpenFileChannelDeleteProc _ANSI_ARGS_((
/* 67 */
EXTERN int TclOpenFileChannelInsertProc _ANSI_ARGS_((
TclOpenFileChannelProc_ * proc));
-/* 68 */
-EXTERN int TclpAccess _ANSI_ARGS_((CONST char * path, int mode));
+/* Slot 68 is reserved */
/* 69 */
EXTERN char * TclpAlloc _ANSI_ARGS_((unsigned int size));
-/* 70 */
-EXTERN int TclpCopyFile _ANSI_ARGS_((CONST char * source,
- CONST char * dest));
-/* 71 */
-EXTERN int TclpCopyDirectory _ANSI_ARGS_((CONST char * source,
- CONST char * dest, Tcl_DString * errorPtr));
-/* 72 */
-EXTERN int TclpCreateDirectory _ANSI_ARGS_((CONST char * path));
-/* 73 */
-EXTERN int TclpDeleteFile _ANSI_ARGS_((CONST char * path));
+/* Slot 70 is reserved */
+/* Slot 71 is reserved */
+/* Slot 72 is reserved */
+/* Slot 73 is reserved */
/* 74 */
EXTERN void TclpFree _ANSI_ARGS_((char * ptr));
/* 75 */
@@ -273,29 +242,21 @@ EXTERN unsigned long TclpGetSeconds _ANSI_ARGS_((void));
EXTERN void TclpGetTime _ANSI_ARGS_((Tcl_Time * time));
/* 78 */
EXTERN int TclpGetTimeZone _ANSI_ARGS_((unsigned long time));
-/* 79 */
-EXTERN int TclpListVolumes _ANSI_ARGS_((Tcl_Interp * interp));
-/* 80 */
-EXTERN Tcl_Channel TclpOpenFileChannel _ANSI_ARGS_((Tcl_Interp * interp,
- char * fileName, char * modeString,
- int permissions));
+/* Slot 79 is reserved */
+/* Slot 80 is reserved */
/* 81 */
EXTERN char * TclpRealloc _ANSI_ARGS_((char * ptr,
unsigned int size));
-/* 82 */
-EXTERN int TclpRemoveDirectory _ANSI_ARGS_((CONST char * path,
- int recursive, Tcl_DString * errorPtr));
-/* 83 */
-EXTERN int TclpRenameFile _ANSI_ARGS_((CONST char * source,
- CONST char * dest));
+/* Slot 82 is reserved */
+/* Slot 83 is reserved */
/* Slot 84 is reserved */
/* Slot 85 is reserved */
/* Slot 86 is reserved */
/* Slot 87 is reserved */
/* 88 */
EXTERN char * TclPrecTraceProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp * interp, char * name1,
- char * name2, int flags));
+ 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));
@@ -311,10 +272,9 @@ EXTERN int TclProcCompileProc _ANSI_ARGS_((Tcl_Interp * interp,
EXTERN void TclProcDeleteProc _ANSI_ARGS_((ClientData clientData));
/* 94 */
EXTERN int TclProcInterpProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp * interp, int argc, char ** argv));
-/* 95 */
-EXTERN int TclpStat _ANSI_ARGS_((CONST char * path,
- struct stat * buf));
+ Tcl_Interp * interp, int argc,
+ CONST84 char ** argv));
+/* Slot 95 is reserved */
/* 96 */
EXTERN int TclRenameCommand _ANSI_ARGS_((Tcl_Interp * interp,
char * oldName, char * newName));
@@ -323,15 +283,8 @@ EXTERN void TclResetShadowedCmdRefs _ANSI_ARGS_((
Tcl_Interp * interp, Command * newCmdPtr));
/* 98 */
EXTERN int TclServiceIdle _ANSI_ARGS_((void));
-/* 99 */
-EXTERN Tcl_Obj * TclSetElementOfIndexedArray _ANSI_ARGS_((
- Tcl_Interp * interp, int localIndex,
- Tcl_Obj * elemPtr, Tcl_Obj * objPtr,
- int leaveErrorMsg));
-/* 100 */
-EXTERN Tcl_Obj * TclSetIndexedScalar _ANSI_ARGS_((Tcl_Interp * interp,
- int localIndex, Tcl_Obj * objPtr,
- int leaveErrorMsg));
+/* Slot 99 is reserved */
+/* Slot 100 is reserved */
#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
/* 101 */
EXTERN char * TclSetPreInitScript _ANSI_ARGS_((char * string));
@@ -355,9 +308,7 @@ EXTERN int TclSockMinimumBuffers _ANSI_ARGS_((int sock,
EXTERN int TclSockMinimumBuffers _ANSI_ARGS_((int sock,
int size));
#endif /* __WIN32__ */
-/* 105 */
-EXTERN int TclStat _ANSI_ARGS_((CONST char * path,
- struct stat * buf));
+/* Slot 105 is reserved */
/* 106 */
EXTERN int TclStatDeleteProc _ANSI_ARGS_((TclStatProc_ * proc));
/* 107 */
@@ -369,7 +320,7 @@ EXTERN int TclUpdateReturnInfo _ANSI_ARGS_((Interp * iPtr));
/* Slot 110 is reserved */
/* 111 */
EXTERN void Tcl_AddInterpResolvers _ANSI_ARGS_((
- Tcl_Interp * interp, char * name,
+ Tcl_Interp * interp, CONST char * name,
Tcl_ResolveCmdProc * cmdProc,
Tcl_ResolveVarProc * varProc,
Tcl_ResolveCompiledVarProc * compiledVarProc));
@@ -379,26 +330,26 @@ EXTERN int Tcl_AppendExportList _ANSI_ARGS_((
Tcl_Obj * objPtr));
/* 113 */
EXTERN Tcl_Namespace * Tcl_CreateNamespace _ANSI_ARGS_((Tcl_Interp * interp,
- char * name, ClientData clientData,
+ CONST char * name, ClientData clientData,
Tcl_NamespaceDeleteProc * deleteProc));
/* 114 */
EXTERN void Tcl_DeleteNamespace _ANSI_ARGS_((
Tcl_Namespace * nsPtr));
/* 115 */
EXTERN int Tcl_Export _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Namespace * nsPtr, char * pattern,
+ Tcl_Namespace * nsPtr, CONST char * pattern,
int resetListFirst));
/* 116 */
EXTERN Tcl_Command Tcl_FindCommand _ANSI_ARGS_((Tcl_Interp * interp,
- char * name, Tcl_Namespace * contextNsPtr,
- int flags));
+ CONST char * name,
+ Tcl_Namespace * contextNsPtr, int flags));
/* 117 */
EXTERN Tcl_Namespace * Tcl_FindNamespace _ANSI_ARGS_((Tcl_Interp * interp,
- char * name, Tcl_Namespace * contextNsPtr,
- int flags));
+ CONST char * name,
+ Tcl_Namespace * contextNsPtr, int flags));
/* 118 */
EXTERN int Tcl_GetInterpResolvers _ANSI_ARGS_((
- Tcl_Interp * interp, char * name,
+ Tcl_Interp * interp, CONST char * name,
Tcl_ResolverInfo * resInfo));
/* 119 */
EXTERN int Tcl_GetNamespaceResolvers _ANSI_ARGS_((
@@ -406,11 +357,11 @@ EXTERN int Tcl_GetNamespaceResolvers _ANSI_ARGS_((
Tcl_ResolverInfo * resInfo));
/* 120 */
EXTERN Tcl_Var Tcl_FindNamespaceVar _ANSI_ARGS_((
- Tcl_Interp * interp, char * name,
+ Tcl_Interp * interp, CONST char * name,
Tcl_Namespace * contextNsPtr, int flags));
/* 121 */
EXTERN int Tcl_ForgetImport _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Namespace * nsPtr, char * pattern));
+ Tcl_Namespace * nsPtr, CONST char * pattern));
/* 122 */
EXTERN Tcl_Command Tcl_GetCommandFromObj _ANSI_ARGS_((
Tcl_Interp * interp, Tcl_Obj * objPtr));
@@ -430,7 +381,7 @@ EXTERN void Tcl_GetVariableFullName _ANSI_ARGS_((
Tcl_Obj * objPtr));
/* 127 */
EXTERN int Tcl_Import _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Namespace * nsPtr, char * pattern,
+ Tcl_Namespace * nsPtr, CONST char * pattern,
int allowOverwrite));
/* 128 */
EXTERN void Tcl_PopCallFrame _ANSI_ARGS_((Tcl_Interp* interp));
@@ -440,7 +391,7 @@ EXTERN int Tcl_PushCallFrame _ANSI_ARGS_((Tcl_Interp* interp,
Tcl_Namespace * nsPtr, int isProcCallFrame));
/* 130 */
EXTERN int Tcl_RemoveInterpResolvers _ANSI_ARGS_((
- Tcl_Interp * interp, char * name));
+ Tcl_Interp * interp, CONST char * name));
/* 131 */
EXTERN void Tcl_SetNamespaceResolvers _ANSI_ARGS_((
Tcl_Namespace * namespacePtr,
@@ -453,26 +404,21 @@ EXTERN int TclpHasSockets _ANSI_ARGS_((Tcl_Interp * interp));
EXTERN struct tm * TclpGetDate _ANSI_ARGS_((TclpTime_t time, int useGMT));
/* 134 */
EXTERN size_t TclpStrftime _ANSI_ARGS_((char * s, size_t maxsize,
- CONST char * format, CONST struct tm * t));
+ CONST char * format, CONST struct tm * t,
+ int useGMT));
/* 135 */
EXTERN int TclpCheckStackSpace _ANSI_ARGS_((void));
/* Slot 136 is reserved */
-/* 137 */
-EXTERN int TclpChdir _ANSI_ARGS_((CONST char * dirName));
+/* Slot 137 is reserved */
/* 138 */
-EXTERN char * TclGetEnv _ANSI_ARGS_((CONST char * name,
+EXTERN CONST84_RETURN char * TclGetEnv _ANSI_ARGS_((CONST char * name,
Tcl_DString * valuePtr));
-/* 139 */
-EXTERN int TclpLoadFile _ANSI_ARGS_((Tcl_Interp * interp,
- char * fileName, char * sym1, char * sym2,
- Tcl_PackageInitProc ** proc1Ptr,
- Tcl_PackageInitProc ** proc2Ptr,
- ClientData * clientDataPtr));
+/* Slot 139 is reserved */
/* 140 */
-EXTERN int TclLooksLikeInt _ANSI_ARGS_((char * bytes,
+EXTERN int TclLooksLikeInt _ANSI_ARGS_((CONST char * bytes,
int length));
/* 141 */
-EXTERN char * TclpGetCwd _ANSI_ARGS_((Tcl_Interp * interp,
+EXTERN CONST84_RETURN char * TclpGetCwd _ANSI_ARGS_((Tcl_Interp * interp,
Tcl_DString * cwdPtr));
/* 142 */
EXTERN int TclSetByteCodeFromAny _ANSI_ARGS_((
@@ -510,32 +456,58 @@ EXTERN Tcl_Obj * TclGetLibraryPath _ANSI_ARGS_((void));
/* Slot 155 is reserved */
/* 156 */
EXTERN void TclRegError _ANSI_ARGS_((Tcl_Interp * interp,
- char * msg, int status));
+ CONST char * msg, int status));
/* 157 */
EXTERN Var * TclVarTraceExists _ANSI_ARGS_((Tcl_Interp * interp,
- char * varName));
+ CONST char * varName));
/* 158 */
EXTERN void TclSetStartupScriptFileName _ANSI_ARGS_((
- char * filename));
+ CONST char * filename));
/* 159 */
-EXTERN char * TclGetStartupScriptFileName _ANSI_ARGS_((void));
-/* 160 */
-EXTERN int TclpMatchFilesTypes _ANSI_ARGS_((Tcl_Interp * interp,
- char * separators, Tcl_DString * dirPtr,
- char * pattern, char * tail,
- GlobTypeData * types));
+EXTERN CONST84_RETURN char * TclGetStartupScriptFileName _ANSI_ARGS_((void));
+/* Slot 160 is reserved */
/* 161 */
EXTERN int TclChannelTransform _ANSI_ARGS_((Tcl_Interp * interp,
Tcl_Channel chan, Tcl_Obj * cmdObjPtr));
/* 162 */
EXTERN void TclChannelEventScriptInvoker _ANSI_ARGS_((
ClientData clientData, int flags));
+/* 163 */
+EXTERN void * TclGetInstructionTable _ANSI_ARGS_((void));
+/* 164 */
+EXTERN void TclExpandCodeArray _ANSI_ARGS_((void * envPtr));
+/* 165 */
+EXTERN void TclpSetInitialEncodings _ANSI_ARGS_((void));
+/* 166 */
+EXTERN int TclListObjSetElement _ANSI_ARGS_((
+ Tcl_Interp * interp, Tcl_Obj * listPtr,
+ int index, Tcl_Obj * valuePtr));
+/* 167 */
+EXTERN void TclSetStartupScriptPath _ANSI_ARGS_((
+ Tcl_Obj * pathPtr));
+/* 168 */
+EXTERN Tcl_Obj * TclGetStartupScriptPath _ANSI_ARGS_((void));
+/* 169 */
+EXTERN int TclpUtfNcmp2 _ANSI_ARGS_((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[]));
+/* 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[]));
typedef struct TclIntStubs {
int magic;
struct TclIntStubHooks *hooks;
- int (*tclAccess) _ANSI_ARGS_((CONST char * path, int mode)); /* 0 */
+ void *reserved0;
int (*tclAccessDeleteProc) _ANSI_ARGS_((TclAccessProc_ * proc)); /* 1 */
int (*tclAccessInsertProc) _ANSI_ARGS_((TclAccessProc_ * proc)); /* 2 */
void (*tclAllocateFreeObjects) _ANSI_ARGS_((void)); /* 3 */
@@ -553,65 +525,65 @@ typedef struct TclIntStubs {
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__) && !defined(MAC_TCL) /* UNIX */
- int (*tclCreatePipeline) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv, Tcl_Pid ** pidArrayPtr, TclFile * inPipePtr, TclFile * outPipePtr, TclFile * errFilePtr)); /* 9 */
+ 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, char ** argv, Tcl_Pid ** pidArrayPtr, TclFile * inPipePtr, TclFile * outPipePtr, TclFile * errFilePtr)); /* 9 */
+ int (*tclCreatePipeline) _ANSI_ARGS_((Tcl_Interp * interp, int argc, CONST char ** argv, Tcl_Pid ** pidArrayPtr, TclFile * inPipePtr, TclFile * outPipePtr, TclFile * errFilePtr)); /* 9 */
#endif /* __WIN32__ */
#ifdef MAC_TCL
void *reserved9;
#endif /* MAC_TCL */
- int (*tclCreateProc) _ANSI_ARGS_((Tcl_Interp * interp, Namespace * nsPtr, char * procName, Tcl_Obj * argsPtr, Tcl_Obj * bodyPtr, Proc ** procPtrPtr)); /* 10 */
+ 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 */
- int (*tclDoGlob) _ANSI_ARGS_((Tcl_Interp * interp, char * separators, Tcl_DString * headPtr, char * tail, GlobTypeData * types)); /* 13 */
+ int (*tclDoGlob) _ANSI_ARGS_((Tcl_Interp * interp, char * separators, Tcl_DString * headPtr, char * tail, Tcl_GlobTypeData * types)); /* 13 */
void (*tclDumpMemoryInfo) _ANSI_ARGS_((FILE * outFile)); /* 14 */
void *reserved15;
void (*tclExprFloatError) _ANSI_ARGS_((Tcl_Interp * interp, double value)); /* 16 */
- int (*tclFileAttrsCmd) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])); /* 17 */
- int (*tclFileCopyCmd) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv)); /* 18 */
- int (*tclFileDeleteCmd) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv)); /* 19 */
- int (*tclFileMakeDirsCmd) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv)); /* 20 */
- int (*tclFileRenameCmd) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv)); /* 21 */
+ 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, char * procName)); /* 23 */
+ Proc * (*tclFindProc) _ANSI_ARGS_((Interp * iPtr, CONST char * procName)); /* 23 */
int (*tclFormatInt) _ANSI_ARGS_((char * buffer, long n)); /* 24 */
void (*tclFreePackageInfo) _ANSI_ARGS_((Interp * iPtr)); /* 25 */
void *reserved26;
int (*tclGetDate) _ANSI_ARGS_((char * p, unsigned long now, long zone, unsigned long * timePtr)); /* 27 */
Tcl_Channel (*tclpGetDefaultStdChannel) _ANSI_ARGS_((int type)); /* 28 */
- Tcl_Obj * (*tclGetElementOfIndexedArray) _ANSI_ARGS_((Tcl_Interp * interp, int localIndex, Tcl_Obj * elemPtr, int leaveErrorMsg)); /* 29 */
+ void *reserved29;
void *reserved30;
char * (*tclGetExtension) _ANSI_ARGS_((char * name)); /* 31 */
- int (*tclGetFrame) _ANSI_ARGS_((Tcl_Interp * interp, char * str, CallFrame ** framePtrPtr)); /* 32 */
+ int (*tclGetFrame) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, CallFrame ** framePtrPtr)); /* 32 */
TclCmdProcType (*tclGetInterpProc) _ANSI_ARGS_((void)); /* 33 */
int (*tclGetIntForIndex) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int endValue, int * indexPtr)); /* 34 */
- Tcl_Obj * (*tclGetIndexedScalar) _ANSI_ARGS_((Tcl_Interp * interp, int localIndex, int leaveErrorMsg)); /* 35 */
- int (*tclGetLong) _ANSI_ARGS_((Tcl_Interp * interp, char * str, long * longPtr)); /* 36 */
+ 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, char * qualName, Namespace * cxtNsPtr, int flags, Namespace ** nsPtrPtr, Namespace ** altNsPtrPtr, Namespace ** actualCxtPtrPtr, char ** simpleNamePtr)); /* 38 */
+ 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, char * str, int * seekFlagPtr)); /* 40 */
+ 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 */
- int (*tclGlobalInvoke) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv, int flags)); /* 43 */
- int (*tclGuessPackageName) _ANSI_ARGS_((char * fileName, Tcl_DString * bufPtr)); /* 44 */
+ int (*tclGlobalInvoke) _ANSI_ARGS_((Tcl_Interp * interp, int argc, CONST84 char ** argv, int flags)); /* 43 */
+ 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 */
- Tcl_Obj * (*tclIncrElementOfIndexedArray) _ANSI_ARGS_((Tcl_Interp * interp, int localIndex, Tcl_Obj * elemPtr, long incrAmount)); /* 47 */
- Tcl_Obj * (*tclIncrIndexedScalar) _ANSI_ARGS_((Tcl_Interp * interp, int localIndex, long incrAmount)); /* 48 */
+ 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 */
- int (*tclInvoke) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv, int flags)); /* 52 */
- int (*tclInvokeObjectCommand) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char ** argv)); /* 53 */
+ int (*tclInvoke) _ANSI_ARGS_((Tcl_Interp * interp, int argc, CONST84 char ** argv, int flags)); /* 52 */
+ 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, char * part1, char * part2, int flags, char * msg, int createPart1, int createPart2, Var ** arrayPtrPtr)); /* 58 */
- int (*tclpMatchFiles) _ANSI_ARGS_((Tcl_Interp * interp, char * separators, Tcl_DString * dirPtr, char * pattern, char * tail)); /* 59 */
- int (*tclNeedSpace) _ANSI_ARGS_((char * start, char * end)); /* 60 */
+ 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 */
@@ -619,39 +591,39 @@ typedef struct TclIntStubs {
int (*tclObjInvokeGlobal) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[], int flags)); /* 65 */
int (*tclOpenFileChannelDeleteProc) _ANSI_ARGS_((TclOpenFileChannelProc_ * proc)); /* 66 */
int (*tclOpenFileChannelInsertProc) _ANSI_ARGS_((TclOpenFileChannelProc_ * proc)); /* 67 */
- int (*tclpAccess) _ANSI_ARGS_((CONST char * path, int mode)); /* 68 */
+ void *reserved68;
char * (*tclpAlloc) _ANSI_ARGS_((unsigned int size)); /* 69 */
- int (*tclpCopyFile) _ANSI_ARGS_((CONST char * source, CONST char * dest)); /* 70 */
- int (*tclpCopyDirectory) _ANSI_ARGS_((CONST char * source, CONST char * dest, Tcl_DString * errorPtr)); /* 71 */
- int (*tclpCreateDirectory) _ANSI_ARGS_((CONST char * path)); /* 72 */
- int (*tclpDeleteFile) _ANSI_ARGS_((CONST char * path)); /* 73 */
+ 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 */
- int (*tclpListVolumes) _ANSI_ARGS_((Tcl_Interp * interp)); /* 79 */
- Tcl_Channel (*tclpOpenFileChannel) _ANSI_ARGS_((Tcl_Interp * interp, char * fileName, char * modeString, int permissions)); /* 80 */
+ void *reserved79;
+ void *reserved80;
char * (*tclpRealloc) _ANSI_ARGS_((char * ptr, unsigned int size)); /* 81 */
- int (*tclpRemoveDirectory) _ANSI_ARGS_((CONST char * path, int recursive, Tcl_DString * errorPtr)); /* 82 */
- int (*tclpRenameFile) _ANSI_ARGS_((CONST char * source, CONST char * dest)); /* 83 */
+ void *reserved82;
+ void *reserved83;
void *reserved84;
void *reserved85;
void *reserved86;
void *reserved87;
- char * (*tclPrecTraceProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, char * name1, char * name2, int flags)); /* 88 */
+ 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 */
- int (*tclProcInterpProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char ** argv)); /* 94 */
- int (*tclpStat) _ANSI_ARGS_((CONST char * path, struct stat * buf)); /* 95 */
+ int (*tclProcInterpProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, CONST84 char ** argv)); /* 94 */
+ 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 */
- Tcl_Obj * (*tclSetElementOfIndexedArray) _ANSI_ARGS_((Tcl_Interp * interp, int localIndex, Tcl_Obj * elemPtr, Tcl_Obj * objPtr, int leaveErrorMsg)); /* 99 */
- Tcl_Obj * (*tclSetIndexedScalar) _ANSI_ARGS_((Tcl_Interp * interp, int localIndex, Tcl_Obj * objPtr, int leaveErrorMsg)); /* 100 */
+ void *reserved99;
+ void *reserved100;
#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
char * (*tclSetPreInitScript) _ANSI_ARGS_((char * string)); /* 101 */
#endif /* UNIX */
@@ -672,43 +644,43 @@ typedef struct TclIntStubs {
#ifdef MAC_TCL
void *reserved104;
#endif /* MAC_TCL */
- int (*tclStat) _ANSI_ARGS_((CONST char * path, struct stat * buf)); /* 105 */
+ 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, char * name, Tcl_ResolveCmdProc * cmdProc, Tcl_ResolveVarProc * varProc, Tcl_ResolveCompiledVarProc * compiledVarProc)); /* 111 */
+ 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, char * name, ClientData clientData, Tcl_NamespaceDeleteProc * deleteProc)); /* 113 */
+ 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, char * pattern, int resetListFirst)); /* 115 */
- Tcl_Command (*tcl_FindCommand) _ANSI_ARGS_((Tcl_Interp * interp, char * name, Tcl_Namespace * contextNsPtr, int flags)); /* 116 */
- Tcl_Namespace * (*tcl_FindNamespace) _ANSI_ARGS_((Tcl_Interp * interp, char * name, Tcl_Namespace * contextNsPtr, int flags)); /* 117 */
- int (*tcl_GetInterpResolvers) _ANSI_ARGS_((Tcl_Interp * interp, char * name, Tcl_ResolverInfo * resInfo)); /* 118 */
+ 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, char * name, Tcl_Namespace * contextNsPtr, int flags)); /* 120 */
- int (*tcl_ForgetImport) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Namespace * nsPtr, char * pattern)); /* 121 */
+ 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, char * pattern, int allowOverwrite)); /* 127 */
+ 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, char * name)); /* 130 */
+ 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_((TclpTime_t time, int useGMT)); /* 133 */
- size_t (*tclpStrftime) _ANSI_ARGS_((char * s, size_t maxsize, CONST char * format, CONST struct tm * t)); /* 134 */
+ size_t (*tclpStrftime) _ANSI_ARGS_((char * s, size_t maxsize, CONST char * format, CONST struct tm * t, int useGMT)); /* 134 */
int (*tclpCheckStackSpace) _ANSI_ARGS_((void)); /* 135 */
void *reserved136;
- int (*tclpChdir) _ANSI_ARGS_((CONST char * dirName)); /* 137 */
- char * (*tclGetEnv) _ANSI_ARGS_((CONST char * name, Tcl_DString * valuePtr)); /* 138 */
- int (*tclpLoadFile) _ANSI_ARGS_((Tcl_Interp * interp, char * fileName, char * sym1, char * sym2, Tcl_PackageInitProc ** proc1Ptr, Tcl_PackageInitProc ** proc2Ptr, ClientData * clientDataPtr)); /* 139 */
- int (*tclLooksLikeInt) _ANSI_ARGS_((char * bytes, int length)); /* 140 */
- char * (*tclpGetCwd) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_DString * cwdPtr)); /* 141 */
+ 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 */
@@ -723,13 +695,22 @@ typedef struct TclIntStubs {
Tcl_Obj * (*tclGetLibraryPath) _ANSI_ARGS_((void)); /* 153 */
void *reserved154;
void *reserved155;
- void (*tclRegError) _ANSI_ARGS_((Tcl_Interp * interp, char * msg, int status)); /* 156 */
- Var * (*tclVarTraceExists) _ANSI_ARGS_((Tcl_Interp * interp, char * varName)); /* 157 */
- void (*tclSetStartupScriptFileName) _ANSI_ARGS_((char * filename)); /* 158 */
- char * (*tclGetStartupScriptFileName) _ANSI_ARGS_((void)); /* 159 */
- int (*tclpMatchFilesTypes) _ANSI_ARGS_((Tcl_Interp * interp, char * separators, Tcl_DString * dirPtr, char * pattern, char * tail, GlobTypeData * types)); /* 160 */
+ 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 */
} TclIntStubs;
#ifdef __cplusplus
@@ -746,10 +727,7 @@ extern TclIntStubs *tclIntStubsPtr;
* Inline function declarations:
*/
-#ifndef TclAccess
-#define TclAccess \
- (tclIntStubsPtr->tclAccess) /* 0 */
-#endif
+/* Slot 0 is reserved */
#ifndef TclAccessDeleteProc
#define TclAccessDeleteProc \
(tclIntStubsPtr->tclAccessDeleteProc) /* 1 */
@@ -824,26 +802,11 @@ extern TclIntStubs *tclIntStubsPtr;
#define TclExprFloatError \
(tclIntStubsPtr->tclExprFloatError) /* 16 */
#endif
-#ifndef TclFileAttrsCmd
-#define TclFileAttrsCmd \
- (tclIntStubsPtr->tclFileAttrsCmd) /* 17 */
-#endif
-#ifndef TclFileCopyCmd
-#define TclFileCopyCmd \
- (tclIntStubsPtr->tclFileCopyCmd) /* 18 */
-#endif
-#ifndef TclFileDeleteCmd
-#define TclFileDeleteCmd \
- (tclIntStubsPtr->tclFileDeleteCmd) /* 19 */
-#endif
-#ifndef TclFileMakeDirsCmd
-#define TclFileMakeDirsCmd \
- (tclIntStubsPtr->tclFileMakeDirsCmd) /* 20 */
-#endif
-#ifndef TclFileRenameCmd
-#define TclFileRenameCmd \
- (tclIntStubsPtr->tclFileRenameCmd) /* 21 */
-#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 */
@@ -869,10 +832,7 @@ extern TclIntStubs *tclIntStubsPtr;
#define TclpGetDefaultStdChannel \
(tclIntStubsPtr->tclpGetDefaultStdChannel) /* 28 */
#endif
-#ifndef TclGetElementOfIndexedArray
-#define TclGetElementOfIndexedArray \
- (tclIntStubsPtr->tclGetElementOfIndexedArray) /* 29 */
-#endif
+/* Slot 29 is reserved */
/* Slot 30 is reserved */
#ifndef TclGetExtension
#define TclGetExtension \
@@ -890,10 +850,7 @@ extern TclIntStubs *tclIntStubsPtr;
#define TclGetIntForIndex \
(tclIntStubsPtr->tclGetIntForIndex) /* 34 */
#endif
-#ifndef TclGetIndexedScalar
-#define TclGetIndexedScalar \
- (tclIntStubsPtr->tclGetIndexedScalar) /* 35 */
-#endif
+/* Slot 35 is reserved */
#ifndef TclGetLong
#define TclGetLong \
(tclIntStubsPtr->tclGetLong) /* 36 */
@@ -938,14 +895,8 @@ extern TclIntStubs *tclIntStubsPtr;
#define TclInExit \
(tclIntStubsPtr->tclInExit) /* 46 */
#endif
-#ifndef TclIncrElementOfIndexedArray
-#define TclIncrElementOfIndexedArray \
- (tclIntStubsPtr->tclIncrElementOfIndexedArray) /* 47 */
-#endif
-#ifndef TclIncrIndexedScalar
-#define TclIncrIndexedScalar \
- (tclIntStubsPtr->tclIncrIndexedScalar) /* 48 */
-#endif
+/* Slot 47 is reserved */
+/* Slot 48 is reserved */
#ifndef TclIncrVar2
#define TclIncrVar2 \
(tclIntStubsPtr->tclIncrVar2) /* 49 */
@@ -980,10 +931,7 @@ extern TclIntStubs *tclIntStubsPtr;
#define TclLookupVar \
(tclIntStubsPtr->tclLookupVar) /* 58 */
#endif
-#ifndef TclpMatchFiles
-#define TclpMatchFiles \
- (tclIntStubsPtr->tclpMatchFiles) /* 59 */
-#endif
+/* Slot 59 is reserved */
#ifndef TclNeedSpace
#define TclNeedSpace \
(tclIntStubsPtr->tclNeedSpace) /* 60 */
@@ -1016,30 +964,15 @@ extern TclIntStubs *tclIntStubsPtr;
#define TclOpenFileChannelInsertProc \
(tclIntStubsPtr->tclOpenFileChannelInsertProc) /* 67 */
#endif
-#ifndef TclpAccess
-#define TclpAccess \
- (tclIntStubsPtr->tclpAccess) /* 68 */
-#endif
+/* Slot 68 is reserved */
#ifndef TclpAlloc
#define TclpAlloc \
(tclIntStubsPtr->tclpAlloc) /* 69 */
#endif
-#ifndef TclpCopyFile
-#define TclpCopyFile \
- (tclIntStubsPtr->tclpCopyFile) /* 70 */
-#endif
-#ifndef TclpCopyDirectory
-#define TclpCopyDirectory \
- (tclIntStubsPtr->tclpCopyDirectory) /* 71 */
-#endif
-#ifndef TclpCreateDirectory
-#define TclpCreateDirectory \
- (tclIntStubsPtr->tclpCreateDirectory) /* 72 */
-#endif
-#ifndef TclpDeleteFile
-#define TclpDeleteFile \
- (tclIntStubsPtr->tclpDeleteFile) /* 73 */
-#endif
+/* Slot 70 is reserved */
+/* Slot 71 is reserved */
+/* Slot 72 is reserved */
+/* Slot 73 is reserved */
#ifndef TclpFree
#define TclpFree \
(tclIntStubsPtr->tclpFree) /* 74 */
@@ -1060,26 +993,14 @@ extern TclIntStubs *tclIntStubsPtr;
#define TclpGetTimeZone \
(tclIntStubsPtr->tclpGetTimeZone) /* 78 */
#endif
-#ifndef TclpListVolumes
-#define TclpListVolumes \
- (tclIntStubsPtr->tclpListVolumes) /* 79 */
-#endif
-#ifndef TclpOpenFileChannel
-#define TclpOpenFileChannel \
- (tclIntStubsPtr->tclpOpenFileChannel) /* 80 */
-#endif
+/* Slot 79 is reserved */
+/* Slot 80 is reserved */
#ifndef TclpRealloc
#define TclpRealloc \
(tclIntStubsPtr->tclpRealloc) /* 81 */
#endif
-#ifndef TclpRemoveDirectory
-#define TclpRemoveDirectory \
- (tclIntStubsPtr->tclpRemoveDirectory) /* 82 */
-#endif
-#ifndef TclpRenameFile
-#define TclpRenameFile \
- (tclIntStubsPtr->tclpRenameFile) /* 83 */
-#endif
+/* Slot 82 is reserved */
+/* Slot 83 is reserved */
/* Slot 84 is reserved */
/* Slot 85 is reserved */
/* Slot 86 is reserved */
@@ -1109,10 +1030,7 @@ extern TclIntStubs *tclIntStubsPtr;
#define TclProcInterpProc \
(tclIntStubsPtr->tclProcInterpProc) /* 94 */
#endif
-#ifndef TclpStat
-#define TclpStat \
- (tclIntStubsPtr->tclpStat) /* 95 */
-#endif
+/* Slot 95 is reserved */
#ifndef TclRenameCommand
#define TclRenameCommand \
(tclIntStubsPtr->tclRenameCommand) /* 96 */
@@ -1125,14 +1043,8 @@ extern TclIntStubs *tclIntStubsPtr;
#define TclServiceIdle \
(tclIntStubsPtr->tclServiceIdle) /* 98 */
#endif
-#ifndef TclSetElementOfIndexedArray
-#define TclSetElementOfIndexedArray \
- (tclIntStubsPtr->tclSetElementOfIndexedArray) /* 99 */
-#endif
-#ifndef TclSetIndexedScalar
-#define TclSetIndexedScalar \
- (tclIntStubsPtr->tclSetIndexedScalar) /* 100 */
-#endif
+/* Slot 99 is reserved */
+/* Slot 100 is reserved */
#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
#ifndef TclSetPreInitScript
#define TclSetPreInitScript \
@@ -1165,10 +1077,7 @@ extern TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclSockMinimumBuffers) /* 104 */
#endif
#endif /* __WIN32__ */
-#ifndef TclStat
-#define TclStat \
- (tclIntStubsPtr->tclStat) /* 105 */
-#endif
+/* Slot 105 is reserved */
#ifndef TclStatDeleteProc
#define TclStatDeleteProc \
(tclIntStubsPtr->tclStatDeleteProc) /* 106 */
@@ -1287,18 +1196,12 @@ extern TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclpCheckStackSpace) /* 135 */
#endif
/* Slot 136 is reserved */
-#ifndef TclpChdir
-#define TclpChdir \
- (tclIntStubsPtr->tclpChdir) /* 137 */
-#endif
+/* Slot 137 is reserved */
#ifndef TclGetEnv
#define TclGetEnv \
(tclIntStubsPtr->tclGetEnv) /* 138 */
#endif
-#ifndef TclpLoadFile
-#define TclpLoadFile \
- (tclIntStubsPtr->tclpLoadFile) /* 139 */
-#endif
+/* Slot 139 is reserved */
#ifndef TclLooksLikeInt
#define TclLooksLikeInt \
(tclIntStubsPtr->tclLooksLikeInt) /* 140 */
@@ -1373,10 +1276,7 @@ extern TclIntStubs *tclIntStubsPtr;
#define TclGetStartupScriptFileName \
(tclIntStubsPtr->tclGetStartupScriptFileName) /* 159 */
#endif
-#ifndef TclpMatchFilesTypes
-#define TclpMatchFilesTypes \
- (tclIntStubsPtr->tclpMatchFilesTypes) /* 160 */
-#endif
+/* Slot 160 is reserved */
#ifndef TclChannelTransform
#define TclChannelTransform \
(tclIntStubsPtr->tclChannelTransform) /* 161 */
@@ -1385,10 +1285,45 @@ extern TclIntStubs *tclIntStubsPtr;
#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
#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
/* !END!: Do not edit above this line. */
#endif /* _TCLINTDECLS */
-
diff --git a/tcl/generic/tclIntPlatDecls.h b/tcl/generic/tclIntPlatDecls.h
index b985bb0987e..fb6f7d1c90c 100644
--- a/tcl/generic/tclIntPlatDecls.h
+++ b/tcl/generic/tclIntPlatDecls.h
@@ -43,9 +43,9 @@ EXTERN int TclpCreatePipe _ANSI_ARGS_((TclFile * readPipe,
TclFile * writePipe));
/* 4 */
EXTERN int TclpCreateProcess _ANSI_ARGS_((Tcl_Interp * interp,
- int argc, char ** argv, TclFile inputFile,
- TclFile outputFile, TclFile errorFile,
- Tcl_Pid * pidPtr));
+ int argc, CONST char ** argv,
+ TclFile inputFile, TclFile outputFile,
+ TclFile errorFile, Tcl_Pid * pidPtr));
/* Slot 5 is reserved */
/* 6 */
EXTERN TclFile TclpMakeFile _ANSI_ARGS_((Tcl_Channel channel,
@@ -59,6 +59,14 @@ EXTERN int TclUnixWaitForFile _ANSI_ARGS_((int fd, int mask,
/* 9 */
EXTERN TclFile TclpCreateTempFile _ANSI_ARGS_((
CONST char * contents));
+/* 10 */
+EXTERN Tcl_DirEntry * TclpReaddir _ANSI_ARGS_((DIR * dir));
+/* 11 */
+EXTERN struct tm * TclpLocaltime _ANSI_ARGS_((time_t * clock));
+/* 12 */
+EXTERN struct tm * TclpGmtime _ANSI_ARGS_((time_t * clock));
+/* 13 */
+EXTERN char * TclpInetNtoa _ANSI_ARGS_((struct in_addr addr));
#endif /* UNIX */
#ifdef __WIN32__
/* 0 */
@@ -101,9 +109,9 @@ EXTERN int TclpCreatePipe _ANSI_ARGS_((TclFile * readPipe,
TclFile * writePipe));
/* 15 */
EXTERN int TclpCreateProcess _ANSI_ARGS_((Tcl_Interp * interp,
- int argc, char ** argv, TclFile inputFile,
- TclFile outputFile, TclFile errorFile,
- Tcl_Pid * pidPtr));
+ int argc, CONST char ** argv,
+ TclFile inputFile, TclFile outputFile,
+ TclFile errorFile, Tcl_Pid * pidPtr));
/* Slot 16 is reserved */
/* Slot 17 is reserved */
/* 18 */
@@ -115,8 +123,7 @@ EXTERN TclFile TclpOpenFile _ANSI_ARGS_((CONST char * fname,
/* 20 */
EXTERN void TclWinAddProcess _ANSI_ARGS_((HANDLE hProcess,
DWORD id));
-/* 21 */
-EXTERN void TclpAsyncMark _ANSI_ARGS_((Tcl_AsyncHandler async));
+/* Slot 21 is reserved */
/* 22 */
EXTERN TclFile TclpCreateTempFile _ANSI_ARGS_((
CONST char * contents));
@@ -128,6 +135,8 @@ EXTERN char * TclWinNoBackslash _ANSI_ARGS_((char * path));
EXTERN TclPlatformType * TclWinGetPlatform _ANSI_ARGS_((void));
/* 26 */
EXTERN void TclWinSetInterfaces _ANSI_ARGS_((int wide));
+/* 27 */
+EXTERN void TclWinFlushDirtyChannels _ANSI_ARGS_((void));
#endif /* __WIN32__ */
#ifdef MAC_TCL
/* 0 */
@@ -148,15 +157,16 @@ EXTERN OSErr FSpFindFolder _ANSI_ARGS_((short vRefNum,
OSType folderType, Boolean createFolder,
FSSpec * spec));
/* 7 */
-EXTERN void GetGlobalMouse _ANSI_ARGS_((Point * mouse));
+EXTERN void GetGlobalMouseTcl _ANSI_ARGS_((Point * mouse));
/* 8 */
-EXTERN pascal OSErr FSpGetDirectoryID _ANSI_ARGS_((CONST FSSpec * spec,
- long * theDirID, Boolean * isDirectory));
+EXTERN pascal OSErr FSpGetDirectoryIDTcl _ANSI_ARGS_((
+ CONST FSSpec * spec, long * theDirID,
+ Boolean * isDirectory));
/* 9 */
-EXTERN pascal short FSpOpenResFileCompat _ANSI_ARGS_((
+EXTERN pascal short FSpOpenResFileCompatTcl _ANSI_ARGS_((
CONST FSSpec * spec, SignedByte permission));
/* 10 */
-EXTERN pascal void FSpCreateResFileCompat _ANSI_ARGS_((
+EXTERN pascal void FSpCreateResFileCompatTcl _ANSI_ARGS_((
CONST FSSpec * spec, OSType creator,
OSType fileType, ScriptCode scriptTag));
/* 11 */
@@ -192,9 +202,13 @@ EXTERN int TclMacCreateEnv _ANSI_ARGS_((void));
/* 23 */
EXTERN FILE * TclMacFOpenHack _ANSI_ARGS_((CONST char * path,
CONST char * mode));
-/* Slot 24 is reserved */
+/* 24 */
+EXTERN char * TclpGetTZName _ANSI_ARGS_((int isdst));
/* 25 */
-EXTERN int TclMacChmod _ANSI_ARGS_((char * path, int mode));
+EXTERN int TclMacChmod _ANSI_ARGS_((CONST char * path, int mode));
+/* 26 */
+EXTERN int FSpLLocationFromPath _ANSI_ARGS_((int length,
+ CONST char * path, FSSpecPtr theSpec));
#endif /* MAC_TCL */
typedef struct TclIntPlatStubs {
@@ -206,12 +220,16 @@ typedef struct TclIntPlatStubs {
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, char ** argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid * pidPtr)); /* 4 */
+ 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) _ANSI_ARGS_((time_t * clock)); /* 11 */
+ struct tm * (*tclpGmtime) _ANSI_ARGS_((time_t * clock)); /* 12 */
+ char * (*tclpInetNtoa) _ANSI_ARGS_((struct in_addr addr)); /* 13 */
#endif /* UNIX */
#ifdef __WIN32__
void (*tclWinConvertError) _ANSI_ARGS_((DWORD errCode)); /* 0 */
@@ -229,18 +247,19 @@ typedef struct TclIntPlatStubs {
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, char ** argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid * pidPtr)); /* 15 */
+ 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 (*tclpAsyncMark) _ANSI_ARGS_((Tcl_AsyncHandler async)); /* 21 */
+ void *reserved21;
TclFile (*tclpCreateTempFile) _ANSI_ARGS_((CONST char * contents)); /* 22 */
char * (*tclpGetTZName) _ANSI_ARGS_((int isdst)); /* 23 */
char * (*tclWinNoBackslash) _ANSI_ARGS_((char * path)); /* 24 */
TclPlatformType * (*tclWinGetPlatform) _ANSI_ARGS_((void)); /* 25 */
void (*tclWinSetInterfaces) _ANSI_ARGS_((int wide)); /* 26 */
+ void (*tclWinFlushDirtyChannels) _ANSI_ARGS_((void)); /* 27 */
#endif /* __WIN32__ */
#ifdef MAC_TCL
VOID * (*tclpSysAlloc) _ANSI_ARGS_((long size, int isBin)); /* 0 */
@@ -250,10 +269,10 @@ typedef struct TclIntPlatStubs {
int (*fSpGetDefaultDir) _ANSI_ARGS_((FSSpecPtr theSpec)); /* 4 */
int (*fSpSetDefaultDir) _ANSI_ARGS_((FSSpecPtr theSpec)); /* 5 */
OSErr (*fSpFindFolder) _ANSI_ARGS_((short vRefNum, OSType folderType, Boolean createFolder, FSSpec * spec)); /* 6 */
- void (*getGlobalMouse) _ANSI_ARGS_((Point * mouse)); /* 7 */
- pascal OSErr (*fSpGetDirectoryID) _ANSI_ARGS_((CONST FSSpec * spec, long * theDirID, Boolean * isDirectory)); /* 8 */
- pascal short (*fSpOpenResFileCompat) _ANSI_ARGS_((CONST FSSpec * spec, SignedByte permission)); /* 9 */
- pascal void (*fSpCreateResFileCompat) _ANSI_ARGS_((CONST FSSpec * spec, OSType creator, OSType fileType, ScriptCode scriptTag)); /* 10 */
+ void (*getGlobalMouseTcl) _ANSI_ARGS_((Point * mouse)); /* 7 */
+ pascal OSErr (*fSpGetDirectoryIDTcl) _ANSI_ARGS_((CONST FSSpec * spec, long * theDirID, Boolean * isDirectory)); /* 8 */
+ pascal short (*fSpOpenResFileCompatTcl) _ANSI_ARGS_((CONST FSSpec * spec, SignedByte permission)); /* 9 */
+ pascal void (*fSpCreateResFileCompatTcl) _ANSI_ARGS_((CONST FSSpec * spec, OSType creator, OSType fileType, ScriptCode scriptTag)); /* 10 */
int (*fSpLocationFromPath) _ANSI_ARGS_((int length, CONST char * path, FSSpecPtr theSpec)); /* 11 */
OSErr (*fSpPathFromLocation) _ANSI_ARGS_((FSSpecPtr theSpec, int * length, Handle * fullPath)); /* 12 */
void (*tclMacExitHandler) _ANSI_ARGS_((void)); /* 13 */
@@ -267,8 +286,9 @@ typedef struct TclIntPlatStubs {
short (*tclMacUnRegisterResourceFork) _ANSI_ARGS_((char * tokenPtr, Tcl_Obj * resultPtr)); /* 21 */
int (*tclMacCreateEnv) _ANSI_ARGS_((void)); /* 22 */
FILE * (*tclMacFOpenHack) _ANSI_ARGS_((CONST char * path, CONST char * mode)); /* 23 */
- void *reserved24;
- int (*tclMacChmod) _ANSI_ARGS_((char * path, int mode)); /* 25 */
+ char * (*tclpGetTZName) _ANSI_ARGS_((int isdst)); /* 24 */
+ int (*tclMacChmod) _ANSI_ARGS_((CONST char * path, int mode)); /* 25 */
+ int (*fSpLLocationFromPath) _ANSI_ARGS_((int length, CONST char * path, FSSpecPtr theSpec)); /* 26 */
#endif /* MAC_TCL */
} TclIntPlatStubs;
@@ -324,6 +344,22 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr;
#define TclpCreateTempFile \
(tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
#endif
+#ifndef TclpReaddir
+#define TclpReaddir \
+ (tclIntPlatStubsPtr->tclpReaddir) /* 10 */
+#endif
+#ifndef TclpLocaltime
+#define TclpLocaltime \
+ (tclIntPlatStubsPtr->tclpLocaltime) /* 11 */
+#endif
+#ifndef TclpGmtime
+#define TclpGmtime \
+ (tclIntPlatStubsPtr->tclpGmtime) /* 12 */
+#endif
+#ifndef TclpInetNtoa
+#define TclpInetNtoa \
+ (tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */
+#endif
#endif /* UNIX */
#ifdef __WIN32__
#ifndef TclWinConvertError
@@ -398,10 +434,7 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr;
#define TclWinAddProcess \
(tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */
#endif
-#ifndef TclpAsyncMark
-#define TclpAsyncMark \
- (tclIntPlatStubsPtr->tclpAsyncMark) /* 21 */
-#endif
+/* Slot 21 is reserved */
#ifndef TclpCreateTempFile
#define TclpCreateTempFile \
(tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */
@@ -422,6 +455,10 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr;
#define TclWinSetInterfaces \
(tclIntPlatStubsPtr->tclWinSetInterfaces) /* 26 */
#endif
+#ifndef TclWinFlushDirtyChannels
+#define TclWinFlushDirtyChannels \
+ (tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */
+#endif
#endif /* __WIN32__ */
#ifdef MAC_TCL
#ifndef TclpSysAlloc
@@ -452,21 +489,21 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr;
#define FSpFindFolder \
(tclIntPlatStubsPtr->fSpFindFolder) /* 6 */
#endif
-#ifndef GetGlobalMouse
-#define GetGlobalMouse \
- (tclIntPlatStubsPtr->getGlobalMouse) /* 7 */
+#ifndef GetGlobalMouseTcl
+#define GetGlobalMouseTcl \
+ (tclIntPlatStubsPtr->getGlobalMouseTcl) /* 7 */
#endif
-#ifndef FSpGetDirectoryID
-#define FSpGetDirectoryID \
- (tclIntPlatStubsPtr->fSpGetDirectoryID) /* 8 */
+#ifndef FSpGetDirectoryIDTcl
+#define FSpGetDirectoryIDTcl \
+ (tclIntPlatStubsPtr->fSpGetDirectoryIDTcl) /* 8 */
#endif
-#ifndef FSpOpenResFileCompat
-#define FSpOpenResFileCompat \
- (tclIntPlatStubsPtr->fSpOpenResFileCompat) /* 9 */
+#ifndef FSpOpenResFileCompatTcl
+#define FSpOpenResFileCompatTcl \
+ (tclIntPlatStubsPtr->fSpOpenResFileCompatTcl) /* 9 */
#endif
-#ifndef FSpCreateResFileCompat
-#define FSpCreateResFileCompat \
- (tclIntPlatStubsPtr->fSpCreateResFileCompat) /* 10 */
+#ifndef FSpCreateResFileCompatTcl
+#define FSpCreateResFileCompatTcl \
+ (tclIntPlatStubsPtr->fSpCreateResFileCompatTcl) /* 10 */
#endif
#ifndef FSpLocationFromPath
#define FSpLocationFromPath \
@@ -520,11 +557,18 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr;
#define TclMacFOpenHack \
(tclIntPlatStubsPtr->tclMacFOpenHack) /* 23 */
#endif
-/* Slot 24 is reserved */
+#ifndef TclpGetTZName
+#define TclpGetTZName \
+ (tclIntPlatStubsPtr->tclpGetTZName) /* 24 */
+#endif
#ifndef TclMacChmod
#define TclMacChmod \
(tclIntPlatStubsPtr->tclMacChmod) /* 25 */
#endif
+#ifndef FSpLLocationFromPath
+#define FSpLLocationFromPath \
+ (tclIntPlatStubsPtr->fSpLLocationFromPath) /* 26 */
+#endif
#endif /* MAC_TCL */
#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
@@ -532,4 +576,3 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr;
/* !END!: Do not edit above this line. */
#endif /* _TCLINTPLATDECLS */
-
diff --git a/tcl/generic/tclInterp.c b/tcl/generic/tclInterp.c
index 96d2e27d418..f8626b5773c 100644
--- a/tcl/generic/tclInterp.c
+++ b/tcl/generic/tclInterp.c
@@ -12,9 +12,9 @@
* RCS: @(#) $Id$
*/
-#include <stdio.h>
#include "tclInt.h"
#include "tclPort.h"
+#include <stdio.h>
/*
* Counter for how many aliases were created (global)
@@ -35,12 +35,6 @@ typedef struct Alias {
Tcl_Obj *namePtr; /* Name of alias command in slave interp. */
Tcl_Interp *targetInterp; /* Interp in which target command will be
* invoked. */
- Tcl_Obj *prefixPtr; /* Tcl list making up the prefix of the
- * target command to be invoked in the target
- * interpreter. Additional arguments
- * specified when calling the alias in the
- * slave interp will be appended to the prefix
- * before the command is invoked. */
Tcl_Command slaveCmd; /* Source command in slave interpreter,
* bound to command that invokes the target
* command in the target interpreter. */
@@ -56,6 +50,16 @@ typedef struct Alias {
* redirecting to it. Random access to this
* hash table is never required - we are using
* a hash table only for convenience. */
+ int objc; /* Count of Tcl_Obj in the prefix of the
+ * target command to be invoked in the
+ * target interpreter. Additional arguments
+ * specified when calling the alias in the
+ * slave interp will be appended to the prefix
+ * before the command is invoked. */
+ Tcl_Obj *objPtr; /* The first actual prefix object - the target
+ * command name; this has to be at the end of the
+ * structure, which will be extended to accomodate
+ * the remaining objects in the prefix. */
} Alias;
/*
@@ -190,6 +194,10 @@ static int SlaveObjCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Obj *CONST objv[]));
static void SlaveObjCmdDeleteProc _ANSI_ARGS_((
ClientData clientData));
+static int SlaveRecursionLimit _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Interp *slaveInterp, int objc,
+ Tcl_Obj *CONST objv[]));
+
/*
*---------------------------------------------------------------------------
@@ -347,18 +355,20 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv)
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
int index;
- static char *options[] = {
+ static CONST char *options[] = {
"alias", "aliases", "create", "delete",
"eval", "exists", "expose", "hide",
"hidden", "issafe", "invokehidden", "marktrusted",
- "slaves", "share", "target", "transfer",
+ "recursionlimit", "slaves", "share",
+ "target", "transfer",
NULL
};
enum option {
OPT_ALIAS, OPT_ALIASES, OPT_CREATE, OPT_DELETE,
OPT_EVAL, OPT_EXISTS, OPT_EXPOSE, OPT_HIDE,
OPT_HIDDEN, OPT_ISSAFE, OPT_INVOKEHID, OPT_MARKTRUSTED,
- OPT_SLAVES, OPT_SHARE, OPT_TARGET, OPT_TRANSFER
+ OPT_RECLIMIT, OPT_SLAVES, OPT_SHARE,
+ OPT_TARGET, OPT_TRANSFER
};
@@ -419,7 +429,7 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv)
int i, last, safe;
Tcl_Obj *slavePtr;
char buf[16 + TCL_INTEGER_SPACE];
- static char *options[] = {
+ static CONST char *options[] = {
"-safe", "--", NULL
};
enum option {
@@ -582,7 +592,7 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv)
case OPT_INVOKEHID: {
int i, index, global;
Tcl_Interp *slaveInterp;
- static char *hiddenOptions[] = {
+ static CONST char *hiddenOptions[] = {
"-global", "--", NULL
};
enum hiddenOption {
@@ -630,6 +640,19 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv)
}
return SlaveMarkTrusted(interp, slaveInterp);
}
+ case OPT_RECLIMIT: {
+ Tcl_Interp *slaveInterp;
+
+ if (objc != 3 && objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "path ?newlimit?");
+ return TCL_ERROR;
+ }
+ slaveInterp = GetInterp(interp, objv[2]);
+ if (slaveInterp == NULL) {
+ return TCL_ERROR;
+ }
+ return SlaveRecursionLimit(interp, slaveInterp, objc - 3, objv + 3);
+ }
case OPT_SLAVES: {
Tcl_Interp *slaveInterp;
InterpInfo *iiPtr;
@@ -808,11 +831,11 @@ GetInterp2(interp, objc, objv)
int
Tcl_CreateAlias(slaveInterp, slaveCmd, targetInterp, targetCmd, argc, argv)
Tcl_Interp *slaveInterp; /* Interpreter for source command. */
- char *slaveCmd; /* Command to install in slave. */
+ CONST char *slaveCmd; /* Command to install in slave. */
Tcl_Interp *targetInterp; /* Interpreter for target command. */
- char *targetCmd; /* Name of target command. */
+ CONST char *targetCmd; /* Name of target command. */
int argc; /* How many additional arguments? */
- char **argv; /* These are the additional args. */
+ CONST char * CONST *argv; /* These are the additional args. */
{
Tcl_Obj *slaveObjPtr, *targetObjPtr;
Tcl_Obj **objv;
@@ -863,9 +886,9 @@ Tcl_CreateAlias(slaveInterp, slaveCmd, targetInterp, targetCmd, argc, argv)
int
Tcl_CreateAliasObj(slaveInterp, slaveCmd, targetInterp, targetCmd, objc, objv)
Tcl_Interp *slaveInterp; /* Interpreter for source command. */
- char *slaveCmd; /* Command to install in slave. */
+ CONST char *slaveCmd; /* Command to install in slave. */
Tcl_Interp *targetInterp; /* Interpreter for target command. */
- char *targetCmd; /* Name of target command. */
+ CONST char *targetCmd; /* Name of target command. */
int objc; /* How many additional arguments? */
Tcl_Obj *CONST objv[]; /* Argument vector. */
{
@@ -906,11 +929,11 @@ int
Tcl_GetAlias(interp, aliasName, targetInterpPtr, targetNamePtr, argcPtr,
argvPtr)
Tcl_Interp *interp; /* Interp to start search from. */
- char *aliasName; /* Name of alias to find. */
+ CONST char *aliasName; /* Name of alias to find. */
Tcl_Interp **targetInterpPtr; /* (Return) target interpreter. */
- char **targetNamePtr; /* (Return) name of target command. */
+ CONST char **targetNamePtr; /* (Return) name of target command. */
int *argcPtr; /* (Return) count of addnl args. */
- char ***argvPtr; /* (Return) additional arguments. */
+ CONST char ***argvPtr; /* (Return) additional arguments. */
{
InterpInfo *iiPtr;
Tcl_HashEntry *hPtr;
@@ -926,7 +949,8 @@ Tcl_GetAlias(interp, aliasName, targetInterpPtr, targetNamePtr, argcPtr,
return TCL_ERROR;
}
aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
- Tcl_ListObjGetElements(NULL, aliasPtr->prefixPtr, &objc, &objv);
+ objc = aliasPtr->objc;
+ objv = &aliasPtr->objPtr;
if (targetInterpPtr != NULL) {
*targetInterpPtr = aliasPtr->targetInterp;
@@ -938,7 +962,8 @@ Tcl_GetAlias(interp, aliasName, targetInterpPtr, targetNamePtr, argcPtr,
*argcPtr = objc - 1;
}
if (argvPtr != NULL) {
- *argvPtr = (char **) ckalloc((unsigned) sizeof(char *) * (objc - 1));
+ *argvPtr = (CONST char **)
+ ckalloc((unsigned) sizeof(CONST char *) * (objc - 1));
for (i = 1; i < objc; i++) {
*argvPtr[i - 1] = Tcl_GetString(objv[i]);
}
@@ -949,7 +974,7 @@ Tcl_GetAlias(interp, aliasName, targetInterpPtr, targetNamePtr, argcPtr,
/*
*----------------------------------------------------------------------
*
- * Tcl_ObjGetAlias --
+ * Tcl_GetAliasObj --
*
* Object version: Gets information about an alias.
*
@@ -966,9 +991,9 @@ int
Tcl_GetAliasObj(interp, aliasName, targetInterpPtr, targetNamePtr, objcPtr,
objvPtr)
Tcl_Interp *interp; /* Interp to start search from. */
- char *aliasName; /* Name of alias to find. */
+ CONST char *aliasName; /* Name of alias to find. */
Tcl_Interp **targetInterpPtr; /* (Return) target interpreter. */
- char **targetNamePtr; /* (Return) name of target command. */
+ CONST char **targetNamePtr; /* (Return) name of target command. */
int *objcPtr; /* (Return) count of addnl args. */
Tcl_Obj ***objvPtr; /* (Return) additional args. */
{
@@ -986,12 +1011,13 @@ Tcl_GetAliasObj(interp, aliasName, targetInterpPtr, targetNamePtr, objcPtr,
return TCL_ERROR;
}
aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
- Tcl_ListObjGetElements(NULL, aliasPtr->prefixPtr, &objc, &objv);
+ objc = aliasPtr->objc;
+ objv = &aliasPtr->objPtr;
if (targetInterpPtr != (Tcl_Interp **) NULL) {
*targetInterpPtr = aliasPtr->targetInterp;
}
- if (targetNamePtr != (char **) NULL) {
+ if (targetNamePtr != (CONST char **) NULL) {
*targetNamePtr = Tcl_GetString(objv[0]);
}
if (objcPtr != (int *) NULL) {
@@ -1056,17 +1082,16 @@ TclPreventAliasLoop(interp, cmdInterp, cmd)
aliasPtr = (Alias *) cmdPtr->objClientData;
nextAliasPtr = aliasPtr;
while (1) {
- int objc;
- Tcl_Obj **objv;
+ Tcl_Obj *cmdNamePtr;
/*
* If the target of the next alias in the chain is the same as
* the source alias, we have a loop.
*/
- Tcl_ListObjGetElements(NULL, nextAliasPtr->prefixPtr, &objc, &objv);
+ cmdNamePtr = nextAliasPtr->objPtr;
aliasCmd = Tcl_FindCommand(nextAliasPtr->targetInterp,
- Tcl_GetString(objv[0]),
+ Tcl_GetString(cmdNamePtr),
Tcl_GetGlobalNamespace(nextAliasPtr->targetInterp),
/*flags*/ 0);
if (aliasCmd == (Tcl_Command) NULL) {
@@ -1132,14 +1157,24 @@ AliasCreate(interp, slaveInterp, masterInterp, namePtr, targetNamePtr,
Target *targetPtr;
Slave *slavePtr;
Master *masterPtr;
+ int i;
+ Tcl_Obj **prefv;
- aliasPtr = (Alias *) ckalloc((unsigned) sizeof(Alias));
+ aliasPtr = (Alias *) ckalloc((unsigned) (sizeof(Alias)
+ + objc * sizeof(Tcl_Obj *)));
aliasPtr->namePtr = namePtr;
Tcl_IncrRefCount(aliasPtr->namePtr);
aliasPtr->targetInterp = masterInterp;
- aliasPtr->prefixPtr = Tcl_NewListObj(1, &targetNamePtr);
- Tcl_ListObjReplace(NULL, aliasPtr->prefixPtr, 1, 0, objc, objv);
- Tcl_IncrRefCount(aliasPtr->prefixPtr);
+
+ aliasPtr->objc = objc + 1;
+ prefv = &aliasPtr->objPtr;
+
+ *prefv = targetNamePtr;
+ Tcl_IncrRefCount(targetNamePtr);
+ for (i = 0; i < objc; i++) {
+ *(++prefv) = objv[i];
+ Tcl_IncrRefCount(objv[i]);
+ }
aliasPtr->slaveCmd = Tcl_CreateObjCommand(slaveInterp,
Tcl_GetString(namePtr), AliasObjCmd, (ClientData) aliasPtr,
@@ -1156,7 +1191,10 @@ AliasCreate(interp, slaveInterp, masterInterp, namePtr, targetNamePtr,
Command *cmdPtr;
Tcl_DecrRefCount(aliasPtr->namePtr);
- Tcl_DecrRefCount(aliasPtr->prefixPtr);
+ Tcl_DecrRefCount(targetNamePtr);
+ for (i = 0; i < objc; i++) {
+ Tcl_DecrRefCount(objv[i]);
+ }
cmdPtr = (Command *) aliasPtr->slaveCmd;
cmdPtr->clientData = NULL;
@@ -1245,7 +1283,7 @@ 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 describe. */
+ Tcl_Obj *namePtr; /* Name of alias to delete. */
{
Slave *slavePtr;
Alias *aliasPtr;
@@ -1297,6 +1335,7 @@ AliasDescribe(interp, slaveInterp, namePtr)
Slave *slavePtr;
Tcl_HashEntry *hPtr;
Alias *aliasPtr;
+ Tcl_Obj *prefixPtr;
/*
* If the alias has been renamed in the slave, the master can still use
@@ -1310,7 +1349,8 @@ AliasDescribe(interp, slaveInterp, namePtr)
return TCL_OK;
}
aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
- Tcl_SetObjResult(interp, aliasPtr->prefixPtr);
+ prefixPtr = Tcl_NewListObj(aliasPtr->objc, &aliasPtr->objPtr);
+ Tcl_SetObjResult(interp, prefixPtr);
return TCL_OK;
}
@@ -1381,71 +1421,51 @@ AliasObjCmd(clientData, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument vector. */
{
+#define ALIAS_CMDV_PREALLOC 10
Tcl_Interp *targetInterp;
Alias *aliasPtr;
int result, prefc, cmdc;
- Tcl_Obj *cmdPtr;
Tcl_Obj **prefv, **cmdv;
-
+ Tcl_Obj *cmdArr[ALIAS_CMDV_PREALLOC];
aliasPtr = (Alias *) clientData;
targetInterp = aliasPtr->targetInterp;
- Tcl_Preserve((ClientData) targetInterp);
-
- ((Interp *) targetInterp)->numLevels++;
-
- Tcl_ResetResult(targetInterp);
- Tcl_AllowExceptions(targetInterp);
-
/*
* Append the arguments to the command prefix and invoke the command
* in the target interp's global namespace.
*/
- Tcl_ListObjGetElements(NULL, aliasPtr->prefixPtr, &prefc, &prefv);
- cmdPtr = Tcl_NewListObj(prefc, prefv);
- Tcl_ListObjReplace(NULL, cmdPtr, prefc, 0, objc - 1, objv + 1);
- Tcl_ListObjGetElements(NULL, cmdPtr, &cmdc, &cmdv);
- result = TclObjInvoke(targetInterp, cmdc, cmdv,
- TCL_INVOKE_NO_TRACEBACK);
- Tcl_DecrRefCount(cmdPtr);
-
- ((Interp *) targetInterp)->numLevels--;
-
- /*
- * Check if we are at the bottom of the stack for the target interpreter.
- * If so, check for special return codes.
- */
-
- if (((Interp *) targetInterp)->numLevels == 0) {
- if (result == TCL_RETURN) {
- result = TclUpdateReturnInfo((Interp *) targetInterp);
- }
- if ((result != TCL_OK) && (result != TCL_ERROR)) {
- Tcl_ResetResult(targetInterp);
- if (result == TCL_BREAK) {
- Tcl_SetObjResult(targetInterp,
- Tcl_NewStringObj("invoked \"break\" outside of a loop",
- -1));
- } else if (result == TCL_CONTINUE) {
- Tcl_SetObjResult(targetInterp,
- Tcl_NewStringObj(
- "invoked \"continue\" outside of a loop",
- -1));
- } else {
- char buf[32 + TCL_INTEGER_SPACE];
-
- sprintf(buf, "command returned bad code: %d", result);
- Tcl_SetObjResult(targetInterp, Tcl_NewStringObj(buf, -1));
- }
- result = TCL_ERROR;
- }
+ prefc = aliasPtr->objc;
+ prefv = &aliasPtr->objPtr;
+ cmdc = prefc + objc - 1;
+ if (cmdc <= ALIAS_CMDV_PREALLOC) {
+ cmdv = cmdArr;
+ } else {
+ cmdv = (Tcl_Obj **) ckalloc((unsigned) (cmdc * sizeof(Tcl_Obj *)));
}
- TclTransferResult(targetInterp, result, interp);
+ 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 *)));
+
+ Tcl_ResetResult(targetInterp);
- Tcl_Release((ClientData) targetInterp);
+ if (targetInterp != interp) {
+ Tcl_Preserve((ClientData) targetInterp);
+ result = Tcl_EvalObjv(targetInterp, cmdc, cmdv, TCL_EVAL_INVOKE);
+ TclTransferResult(targetInterp, result, interp);
+ Tcl_Release((ClientData) targetInterp);
+ } else {
+ result = Tcl_EvalObjv(targetInterp, cmdc, cmdv, TCL_EVAL_INVOKE);
+ }
+
+ if (cmdv != cmdArr) {
+ ckfree((char *) cmdv);
+ }
return result;
+#undef ALIAS_CMDV_PREALLOC
}
/*
@@ -1472,11 +1492,16 @@ AliasObjCmdDeleteProc(clientData)
{
Alias *aliasPtr;
Target *targetPtr;
+ int i;
+ Tcl_Obj **objv;
aliasPtr = (Alias *) clientData;
Tcl_DecrRefCount(aliasPtr->namePtr);
- Tcl_DecrRefCount(aliasPtr->prefixPtr);
+ objv = &aliasPtr->objPtr;
+ for (i = 0; i < aliasPtr->objc; i++) {
+ Tcl_DecrRefCount(objv[i]);
+ }
Tcl_DeleteHashEntry(aliasPtr->aliasEntryPtr);
targetPtr = (Target *) Tcl_GetHashValue(aliasPtr->targetEntryPtr);
@@ -1512,7 +1537,7 @@ AliasObjCmdDeleteProc(clientData)
Tcl_Interp *
Tcl_CreateSlave(interp, slavePath, isSafe)
Tcl_Interp *interp; /* Interpreter to start search at. */
- char *slavePath; /* Name of slave to create. */
+ CONST char *slavePath; /* Name of slave to create. */
int isSafe; /* Should new slave be "safe" ? */
{
Tcl_Obj *pathPtr;
@@ -1545,7 +1570,7 @@ Tcl_CreateSlave(interp, slavePath, isSafe)
Tcl_Interp *
Tcl_GetSlave(interp, slavePath)
Tcl_Interp *interp; /* Interpreter to start search from. */
- char *slavePath; /* Path of slave to find. */
+ CONST char *slavePath; /* Path of slave to find. */
{
Tcl_Obj *pathPtr;
Tcl_Interp *slaveInterp;
@@ -1780,6 +1805,11 @@ SlaveCreate(interp, pathPtr, safe)
if (Tcl_Init(slaveInterp) == TCL_ERROR) {
goto error;
}
+ /*
+ * This will create the "memory" command in slave interpreters
+ * if we compiled with TCL_MEM_DEBUG, otherwise it does nothing.
+ */
+ Tcl_InitMemory(slaveInterp);
}
return slaveInterp;
@@ -1816,15 +1846,15 @@ SlaveObjCmd(clientData, interp, objc, objv)
{
Tcl_Interp *slaveInterp;
int index;
- static char *options[] = {
+ static CONST char *options[] = {
"alias", "aliases", "eval", "expose",
"hide", "hidden", "issafe", "invokehidden",
- "marktrusted", NULL
+ "marktrusted", "recursionlimit", NULL
};
enum options {
OPT_ALIAS, OPT_ALIASES, OPT_EVAL, OPT_EXPOSE,
OPT_HIDE, OPT_HIDDEN, OPT_ISSAFE, OPT_INVOKEHIDDEN,
- OPT_MARKTRUSTED
+ OPT_MARKTRUSTED, OPT_RECLIMIT
};
slaveInterp = (Tcl_Interp *) clientData;
@@ -1843,22 +1873,28 @@ SlaveObjCmd(clientData, interp, objc, objv)
switch ((enum options) index) {
case OPT_ALIAS: {
- if (objc == 3) {
- return AliasDescribe(interp, slaveInterp, objv[2]);
- }
- if (Tcl_GetString(objv[3])[0] == '\0') {
- if (objc == 4) {
- return AliasDelete(interp, slaveInterp, objv[2]);
+ if (objc > 2) {
+ if (objc == 3) {
+ return AliasDescribe(interp, slaveInterp, objv[2]);
+ }
+ if (Tcl_GetString(objv[3])[0] == '\0') {
+ if (objc == 4) {
+ return AliasDelete(interp, slaveInterp, objv[2]);
+ }
+ } else {
+ return AliasCreate(interp, slaveInterp, interp, objv[2],
+ objv[3], objc - 4, objv + 4);
}
- } else {
- return AliasCreate(interp, slaveInterp, interp, objv[2],
- objv[3], objc - 4, objv + 4);
}
Tcl_WrongNumArgs(interp, 2, objv,
"aliasName ?targetName? ?args..?");
return TCL_ERROR;
}
case OPT_ALIASES: {
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, (char *) NULL);
+ return TCL_ERROR;
+ }
return AliasList(interp, slaveInterp);
}
case OPT_EVAL: {
@@ -1890,12 +1926,16 @@ SlaveObjCmd(clientData, interp, objc, objv)
return SlaveHidden(interp, slaveInterp);
}
case OPT_ISSAFE: {
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, (char *) NULL);
+ return TCL_ERROR;
+ }
Tcl_SetIntObj(Tcl_GetObjResult(interp), Tcl_IsSafe(slaveInterp));
return TCL_OK;
}
case OPT_INVOKEHIDDEN: {
int global, i, index;
- static char *hiddenOptions[] = {
+ static CONST char *hiddenOptions[] = {
"-global", "--", NULL
};
enum hiddenOption {
@@ -1932,6 +1972,13 @@ SlaveObjCmd(clientData, interp, objc, objv)
}
return SlaveMarkTrusted(interp, slaveInterp);
}
+ case OPT_RECLIMIT: {
+ if (objc != 2 && objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?newlimit?");
+ return TCL_ERROR;
+ }
+ return SlaveRecursionLimit(interp, slaveInterp, objc - 2, objv + 2);
+ }
}
return TCL_ERROR;
@@ -2074,6 +2121,65 @@ SlaveExpose(interp, slaveInterp, objc, objv)
/*
*----------------------------------------------------------------------
*
+ * SlaveRecursionLimit --
+ *
+ * Helper function to set/query the Recursion limit of an interp
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * When (objc == 1), slaveInterp will be set to a new recursion
+ * limit of objv[0].
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+{
+ Interp *iPtr;
+ int limit;
+
+ if (objc) {
+ if (Tcl_IsSafe(interp)) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "permission denied: ",
+ "safe interpreters cannot change recursion limit",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[0], &limit) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ if (limit <= 0) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "recursion limit must be > 0", -1));
+ return TCL_ERROR;
+ }
+ Tcl_SetRecursionLimit(slaveInterp, limit);
+ iPtr = (Interp *) slaveInterp;
+ if (interp == slaveInterp && iPtr->numLevels > limit) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "falling back due to new recursion limit", -1));
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, objv[0]);
+ return TCL_OK;
+ } else {
+ limit = Tcl_SetRecursionLimit(slaveInterp, 0);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(limit));
+ return TCL_OK;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* SlaveHide --
*
* Helper function to hide a command in a slave interpreter.
diff --git a/tcl/generic/tclLink.c b/tcl/generic/tclLink.c
index 13c5691a863..6edba23678a 100644
--- a/tcl/generic/tclLink.c
+++ b/tcl/generic/tclLink.c
@@ -26,7 +26,7 @@
typedef struct Link {
Tcl_Interp *interp; /* Interpreter containing Tcl variable. */
- char *varName; /* Name of variable (must be global). This
+ Tcl_Obj *varName; /* Name of variable (must be global). This
* is needed during trace callbacks, since
* the actual variable may be aliased at
* that time via upvar. */
@@ -35,6 +35,7 @@ typedef struct Link {
union {
int i;
double d;
+ Tcl_WideInt w;
} lastValue; /* Last known value of C variable; used to
* avoid string conversions. */
int flags; /* Miscellaneous one-bit values; see below
@@ -59,10 +60,9 @@ typedef struct Link {
*/
static char * LinkTraceProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, char *name1, char *name2,
- int flags));
-static char * StringValue _ANSI_ARGS_((Link *linkPtr,
- char *buffer));
+ Tcl_Interp *interp, CONST char *name1,
+ CONST char *name2, int flags));
+static Tcl_Obj * ObjValue _ANSI_ARGS_((Link *linkPtr));
/*
*----------------------------------------------------------------------
@@ -88,21 +88,21 @@ static char * StringValue _ANSI_ARGS_((Link *linkPtr,
int
Tcl_LinkVar(interp, varName, addr, type)
Tcl_Interp *interp; /* Interpreter in which varName exists. */
- char *varName; /* Name of a global variable in interp. */
+ 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 may have TCL_LINK_READ_ONLY
* OR'ed in. */
{
+ Tcl_Obj *objPtr;
Link *linkPtr;
- char buffer[TCL_DOUBLE_SPACE];
int code;
linkPtr = (Link *) ckalloc(sizeof(Link));
linkPtr->interp = interp;
- linkPtr->varName = (char *) ckalloc((unsigned) (strlen(varName) + 1));
- strcpy(linkPtr->varName, varName);
+ linkPtr->varName = Tcl_NewStringObj(varName, -1);
+ Tcl_IncrRefCount(linkPtr->varName);
linkPtr->addr = addr;
linkPtr->type = type & ~TCL_LINK_READ_ONLY;
if (type & TCL_LINK_READ_ONLY) {
@@ -110,9 +110,11 @@ Tcl_LinkVar(interp, varName, addr, type)
} else {
linkPtr->flags = 0;
}
- if (Tcl_SetVar(interp, varName, StringValue(linkPtr, buffer),
+ objPtr = ObjValue(linkPtr);
+ if (Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr,
TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
- ckfree(linkPtr->varName);
+ Tcl_DecrRefCount(linkPtr->varName);
+ Tcl_DecrRefCount(objPtr);
ckfree((char *) linkPtr);
return TCL_ERROR;
}
@@ -120,7 +122,7 @@ Tcl_LinkVar(interp, varName, addr, type)
|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc,
(ClientData) linkPtr);
if (code != TCL_OK) {
- ckfree(linkPtr->varName);
+ Tcl_DecrRefCount(linkPtr->varName);
ckfree((char *) linkPtr);
}
return code;
@@ -147,7 +149,7 @@ Tcl_LinkVar(interp, varName, addr, type)
void
Tcl_UnlinkVar(interp, varName)
Tcl_Interp *interp; /* Interpreter containing variable to unlink. */
- char *varName; /* Global variable in interp to unlink. */
+ CONST char *varName; /* Global variable in interp to unlink. */
{
Link *linkPtr;
@@ -159,7 +161,7 @@ Tcl_UnlinkVar(interp, varName)
Tcl_UntraceVar(interp, varName,
TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
LinkTraceProc, (ClientData) linkPtr);
- ckfree(linkPtr->varName);
+ Tcl_DecrRefCount(linkPtr->varName);
ckfree((char *) linkPtr);
}
@@ -185,10 +187,9 @@ Tcl_UnlinkVar(interp, varName)
void
Tcl_UpdateLinkedVar(interp, varName)
Tcl_Interp *interp; /* Interpreter containing variable. */
- char *varName; /* Name of global variable that is linked. */
+ CONST char *varName; /* Name of global variable that is linked. */
{
Link *linkPtr;
- char buffer[TCL_DOUBLE_SPACE];
int savedFlag;
linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
@@ -198,7 +199,7 @@ Tcl_UpdateLinkedVar(interp, varName)
}
savedFlag = linkPtr->flags & LINK_BEING_UPDATED;
linkPtr->flags |= LINK_BEING_UPDATED;
- Tcl_SetVar(interp, linkPtr->varName, StringValue(linkPtr, buffer),
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
linkPtr->flags = (linkPtr->flags & ~LINK_BEING_UPDATED) | savedFlag;
}
@@ -228,15 +229,15 @@ static char *
LinkTraceProc(clientData, interp, name1, name2, flags)
ClientData clientData; /* Contains information about the link. */
Tcl_Interp *interp; /* Interpreter containing Tcl variable. */
- char *name1; /* First part of variable name. */
- char *name2; /* Second part of variable name. */
+ 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;
- int changed;
- char buffer[TCL_DOUBLE_SPACE];
- char *value, **pp, *result;
- Tcl_Obj *objPtr;
+ int changed, valueLength;
+ CONST char *value;
+ char **pp, *result;
+ Tcl_Obj *objPtr, *valueObj;
/*
* If the variable is being unset, then just re-create it (with a
@@ -245,14 +246,14 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
if (flags & TCL_TRACE_UNSETS) {
if (flags & TCL_INTERP_DESTROYED) {
- ckfree(linkPtr->varName);
+ Tcl_DecrRefCount(linkPtr->varName);
ckfree((char *) linkPtr);
} else if (flags & TCL_TRACE_DESTROYED) {
- Tcl_SetVar(interp, linkPtr->varName, StringValue(linkPtr, buffer),
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- Tcl_TraceVar(interp, linkPtr->varName, TCL_GLOBAL_ONLY
- |TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
- LinkTraceProc, (ClientData) linkPtr);
+ Tcl_TraceVar(interp, Tcl_GetString(linkPtr->varName),
+ TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES
+ |TCL_TRACE_UNSETS, LinkTraceProc, (ClientData) linkPtr);
}
return NULL;
}
@@ -275,21 +276,24 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
if (flags & TCL_TRACE_READS) {
switch (linkPtr->type) {
- case TCL_LINK_INT:
- case TCL_LINK_BOOLEAN:
- changed = *(int *)(linkPtr->addr) != linkPtr->lastValue.i;
- break;
- case TCL_LINK_DOUBLE:
- changed = *(double *)(linkPtr->addr) != linkPtr->lastValue.d;
- break;
- case TCL_LINK_STRING:
- changed = 1;
- break;
- default:
- return "internal error: bad linked variable type";
+ case TCL_LINK_INT:
+ case TCL_LINK_BOOLEAN:
+ changed = *(int *)(linkPtr->addr) != linkPtr->lastValue.i;
+ break;
+ case TCL_LINK_DOUBLE:
+ changed = *(double *)(linkPtr->addr) != linkPtr->lastValue.d;
+ break;
+ case TCL_LINK_WIDE_INT:
+ changed = *(Tcl_WideInt *)(linkPtr->addr) != linkPtr->lastValue.w;
+ break;
+ case TCL_LINK_STRING:
+ changed = 1;
+ break;
+ default:
+ return "internal error: bad linked variable type";
}
if (changed) {
- Tcl_SetVar(interp, linkPtr->varName, StringValue(linkPtr, buffer),
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
}
return NULL;
@@ -305,12 +309,12 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
*/
if (linkPtr->flags & LINK_READ_ONLY) {
- Tcl_SetVar(interp, linkPtr->varName, StringValue(linkPtr, buffer),
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return "linked variable is read-only";
}
- value = Tcl_GetVar(interp, linkPtr->varName, TCL_GLOBAL_ONLY);
- if (value == NULL) {
+ valueObj = Tcl_ObjGetVar2(interp, linkPtr->varName,NULL, TCL_GLOBAL_ONLY);
+ if (valueObj == NULL) {
/*
* This shouldn't ever happen.
*/
@@ -323,48 +327,67 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
result = NULL;
switch (linkPtr->type) {
- case TCL_LINK_INT:
- if (Tcl_GetInt(interp, value, &linkPtr->lastValue.i) != TCL_OK) {
- Tcl_SetObjResult(interp, objPtr);
- Tcl_SetVar(interp, linkPtr->varName,
- StringValue(linkPtr, buffer), TCL_GLOBAL_ONLY);
- result = "variable must have integer value";
- goto end;
- }
- *(int *)(linkPtr->addr) = linkPtr->lastValue.i;
- break;
- case TCL_LINK_DOUBLE:
- if (Tcl_GetDouble(interp, value, &linkPtr->lastValue.d)
- != TCL_OK) {
- Tcl_SetObjResult(interp, objPtr);
- Tcl_SetVar(interp, linkPtr->varName,
- StringValue(linkPtr, buffer), TCL_GLOBAL_ONLY);
- result = "variable must have real value";
- goto end;
- }
- *(double *)(linkPtr->addr) = linkPtr->lastValue.d;
- break;
- case TCL_LINK_BOOLEAN:
- if (Tcl_GetBoolean(interp, value, &linkPtr->lastValue.i)
- != TCL_OK) {
- Tcl_SetObjResult(interp, objPtr);
- Tcl_SetVar(interp, linkPtr->varName,
- StringValue(linkPtr, buffer), TCL_GLOBAL_ONLY);
- result = "variable must have boolean value";
- goto end;
- }
- *(int *)(linkPtr->addr) = linkPtr->lastValue.i;
- break;
- case TCL_LINK_STRING:
- pp = (char **)(linkPtr->addr);
- if (*pp != NULL) {
- ckfree(*pp);
- }
- *pp = (char *) ckalloc((unsigned) (strlen(value) + 1));
- strcpy(*pp, value);
- break;
- default:
- return "internal error: bad linked variable type";
+ case TCL_LINK_INT:
+ if (Tcl_GetIntFromObj(interp, valueObj, &linkPtr->lastValue.i)
+ != TCL_OK) {
+ Tcl_SetObjResult(interp, objPtr);
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+ TCL_GLOBAL_ONLY);
+ result = "variable must have integer value";
+ goto end;
+ }
+ *(int *)(linkPtr->addr) = linkPtr->lastValue.i;
+ break;
+
+ case TCL_LINK_WIDE_INT:
+ if (Tcl_GetWideIntFromObj(interp, valueObj, &linkPtr->lastValue.w)
+ != TCL_OK) {
+ Tcl_SetObjResult(interp, objPtr);
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+ TCL_GLOBAL_ONLY);
+ result = "variable must have integer value";
+ goto end;
+ }
+ *(Tcl_WideInt *)(linkPtr->addr) = linkPtr->lastValue.w;
+ break;
+
+ case TCL_LINK_DOUBLE:
+ if (Tcl_GetDoubleFromObj(interp, valueObj, &linkPtr->lastValue.d)
+ != TCL_OK) {
+ Tcl_SetObjResult(interp, objPtr);
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+ TCL_GLOBAL_ONLY);
+ result = "variable must have real value";
+ goto end;
+ }
+ *(double *)(linkPtr->addr) = linkPtr->lastValue.d;
+ break;
+
+ case TCL_LINK_BOOLEAN:
+ if (Tcl_GetBooleanFromObj(interp, valueObj, &linkPtr->lastValue.i)
+ != TCL_OK) {
+ Tcl_SetObjResult(interp, objPtr);
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+ TCL_GLOBAL_ONLY);
+ result = "variable must have boolean value";
+ goto end;
+ }
+ *(int *)(linkPtr->addr) = linkPtr->lastValue.i;
+ 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);
+ memcpy(*pp, value, (unsigned) valueLength);
+ break;
+
+ default:
+ return "internal error: bad linked variable type";
}
end:
Tcl_DecrRefCount(objPtr);
@@ -374,13 +397,13 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
/*
*----------------------------------------------------------------------
*
- * StringValue --
+ * ObjValue --
*
- * Converts the value of a C variable to a string for use in a
+ * Converts the value of a C variable to a Tcl_Obj* for use in a
* Tcl variable to which it is linked.
*
* Results:
- * The return value is a pointer to a string that represents
+ * The return value is a pointer to a Tcl_Obj that represents
* the value of the C variable given by linkPtr.
*
* Side effects:
@@ -389,42 +412,37 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
*----------------------------------------------------------------------
*/
-static char *
-StringValue(linkPtr, buffer)
+static Tcl_Obj *
+ObjValue(linkPtr)
Link *linkPtr; /* Structure describing linked variable. */
- char *buffer; /* Small buffer to use for converting
- * values. Must have TCL_DOUBLE_SPACE
- * bytes or more. */
{
char *p;
switch (linkPtr->type) {
- case TCL_LINK_INT:
- linkPtr->lastValue.i = *(int *)(linkPtr->addr);
- TclFormatInt(buffer, linkPtr->lastValue.i);
- return buffer;
- case TCL_LINK_DOUBLE:
- linkPtr->lastValue.d = *(double *)(linkPtr->addr);
- Tcl_PrintDouble((Tcl_Interp *) NULL, linkPtr->lastValue.d, buffer);
- return buffer;
- case TCL_LINK_BOOLEAN:
- linkPtr->lastValue.i = *(int *)(linkPtr->addr);
- if (linkPtr->lastValue.i != 0) {
- return "1";
- }
- return "0";
- case TCL_LINK_STRING:
- p = *(char **)(linkPtr->addr);
- if (p == NULL) {
- return "NULL";
- }
- return p;
- }
+ case TCL_LINK_INT:
+ linkPtr->lastValue.i = *(int *)(linkPtr->addr);
+ return Tcl_NewIntObj(linkPtr->lastValue.i);
+ case TCL_LINK_WIDE_INT:
+ linkPtr->lastValue.w = *(Tcl_WideInt *)(linkPtr->addr);
+ return Tcl_NewWideIntObj(linkPtr->lastValue.w);
+ case TCL_LINK_DOUBLE:
+ linkPtr->lastValue.d = *(double *)(linkPtr->addr);
+ return Tcl_NewDoubleObj(linkPtr->lastValue.d);
+ case TCL_LINK_BOOLEAN:
+ linkPtr->lastValue.i = *(int *)(linkPtr->addr);
+ return Tcl_NewBooleanObj(linkPtr->lastValue.i != 0);
+ case TCL_LINK_STRING:
+ p = *(char **)(linkPtr->addr);
+ if (p == NULL) {
+ return Tcl_NewStringObj("NULL", 4);
+ }
+ return Tcl_NewStringObj(p, -1);
/*
* This code only gets executed if the link type is unknown
* (shouldn't ever happen).
*/
-
- return "??";
+ default:
+ return Tcl_NewStringObj("??", 2);
+ }
}
diff --git a/tcl/generic/tclListObj.c b/tcl/generic/tclListObj.c
index 0e22a6020ac..88619f4c158 100644
--- a/tcl/generic/tclListObj.c
+++ b/tcl/generic/tclListObj.c
@@ -6,6 +6,7 @@
*
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
* Copyright (c) 1998 by Scriptics Corporation.
+ * 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.
@@ -29,6 +30,15 @@ static void UpdateStringOfList _ANSI_ARGS_((Tcl_Obj *listPtr));
/*
* The structure below defines the list Tcl object type by means of
* procedures that can be invoked by generic object code.
+ *
+ * The internal representation of a list object is a two-pointer
+ * representation. The first pointer designates a List structure that
+ * contains an array of pointers to the element objects, together with
+ * integers that represent the current element count and the allocated
+ * size of the array. The second pointer is normally NULL; during
+ * execution of functions in this file that operate on nested sublists,
+ * it is occasionally used as working storage to avoid an auxiliary
+ * stack.
*/
Tcl_ObjType tclListType = {
@@ -105,7 +115,8 @@ Tcl_NewListObj(objc, objv)
listRepPtr->elemCount = objc;
listRepPtr->elements = elemPtrs;
- listPtr->internalRep.otherValuePtr = (VOID *) listRepPtr;
+ listPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
+ listPtr->internalRep.twoPtrValue.ptr2 = NULL;
listPtr->typePtr = &tclListType;
}
return listPtr;
@@ -121,9 +132,9 @@ Tcl_NewListObj(objc, objv)
* TCL_MEM_DEBUG is defined. It creates new list objects. It is the
* same as the Tcl_NewListObj procedure above except that it calls
* Tcl_DbCkalloc directly with the file name and line number from its
- * caller. This simplifies debugging since then the checkmem command
- * will report the correct file name and line number when reporting
- * objects that haven't been freed.
+ * 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
* result of calling Tcl_NewListObj.
@@ -147,7 +158,7 @@ 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. */
- 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 debugging. */
@@ -174,7 +185,8 @@ Tcl_DbNewListObj(objc, objv, file, line)
listRepPtr->elemCount = objc;
listRepPtr->elements = elemPtrs;
- listPtr->internalRep.otherValuePtr = (VOID *) listRepPtr;
+ listPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
+ listPtr->internalRep.twoPtrValue.ptr2 = NULL;
listPtr->typePtr = &tclListType;
}
return listPtr;
@@ -186,7 +198,7 @@ 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. */
- 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 debugging. */
@@ -261,10 +273,12 @@ Tcl_SetListObj(objPtr, objc, objv)
listRepPtr->elemCount = objc;
listRepPtr->elements = elemPtrs;
- objPtr->internalRep.otherValuePtr = (VOID *) listRepPtr;
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
+ objPtr->internalRep.twoPtrValue.ptr2 = NULL;
objPtr->typePtr = &tclListType;
} else {
objPtr->bytes = tclEmptyStringRep;
+ objPtr->length = 0;
}
}
@@ -316,7 +330,7 @@ Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr)
return result;
}
}
- listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
+ listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
*objcPtr = listRepPtr->elemCount;
*objvPtr = listRepPtr->elements;
return TCL_OK;
@@ -367,7 +381,7 @@ Tcl_ListObjAppendList(interp, listPtr, elemListPtr)
return result;
}
}
- listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
+ listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
listLen = listRepPtr->elemCount;
result = Tcl_ListObjGetElements(interp, elemListPtr, &objc, &objv);
@@ -430,7 +444,7 @@ Tcl_ListObjAppendElement(interp, listPtr, objPtr)
}
}
- listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
+ listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
elemPtrs = listRepPtr->elements;
numElems = listRepPtr->elemCount;
numRequired = numElems + 1 ;
@@ -514,7 +528,7 @@ Tcl_ListObjIndex(interp, listPtr, index, objPtrPtr)
}
}
- listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
+ listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
if ((index < 0) || (index >= listRepPtr->elemCount)) {
*objPtrPtr = NULL;
} else {
@@ -561,7 +575,7 @@ Tcl_ListObjLength(interp, listPtr, intPtr)
}
}
- listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
+ listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
*intPtr = listRepPtr->elemCount;
return TCL_OK;
}
@@ -629,7 +643,7 @@ Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv)
return result;
}
}
- listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
+ listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
elemPtrs = listRepPtr->elements;
numElems = listRepPtr->elemCount;
@@ -762,6 +776,586 @@ Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv)
/*
*----------------------------------------------------------------------
*
+ * 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 an
+ * error occurs.
+ *
+ * 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 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.
+ *
+ * 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 procedure.
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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' */
+{
+ int indexCount; /* Number of indices in the index list */
+ Tcl_Obj** indices; /* Vector of indices in the index list*/
+
+ int duplicated; /* Flag == 1 if the obj has been
+ * duplicated, 0 otherwise */
+ Tcl_Obj* retValuePtr; /* Pointer to the list to be returned */
+ int index; /* Current index in the list - discarded */
+ int result; /* Status return from library calls */
+ Tcl_Obj* subListPtr; /* Pointer to the current sublist */
+ int elemCount; /* Count of elements in the current sublist */
+ Tcl_Obj** elemPtrs; /* Pointers to elements of current sublist */
+ Tcl_Obj* chainPtr; /* Pointer to the enclosing sublist
+ * of the current sublist */
+ int i;
+
+
+ /*
+ * Determine whether the index arg 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 #23 for details.
+ */
+
+ if ( indexArgPtr->typePtr != &tclListType
+ && TclGetIntForIndex( 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 ) {
+
+ /*
+ * indexArgPtr designates something that is neither an index nor a
+ * well formed list. Report the error via TclLsetFlat.
+ */
+
+ 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.
+ * If there are no indices, simply return 'valuePtr', counting the
+ * returned pointer as a reference.
+ */
+
+ if ( indexCount == 0 ) {
+ Tcl_IncrRefCount( valuePtr );
+ return valuePtr;
+ }
+
+ /*
+ * Duplicate the list arg if necessary.
+ */
+
+ if ( Tcl_IsShared( listPtr ) ) {
+ duplicated = 1;
+ listPtr = Tcl_DuplicateObj( listPtr );
+ Tcl_IncrRefCount( listPtr );
+ } else {
+ duplicated = 0;
+ }
+
+ /*
+ * It would be tempting simply to go off to TclLsetFlat to finish the
+ * processing. Alas, it is also incorrect! The problem is that
+ * 'indexArgPtr' may designate a sublist of 'listPtr' whose value
+ * is to be manipulated. The fact that 'listPtr' is itself unshared
+ * does not guarantee that no sublist is. Therefore, it's necessary
+ * to replicate all the work here, expanding the index list on each
+ * trip through the loop.
+ */
+
+ /*
+ * Anchor the linked list of Tcl_Obj's whose string reps must be
+ * invalidated if the operation succeeds.
+ */
+
+ retValuePtr = listPtr;
+ chainPtr = NULL;
+
+ /*
+ * Handle each index arg by diving into the appropriate sublist
+ */
+
+ for ( i = 0; ; ++i ) {
+
+ /*
+ * Take the sublist apart.
+ */
+
+ result = Tcl_ListObjGetElements( interp, listPtr,
+ &elemCount, &elemPtrs );
+ if ( result != TCL_OK ) {
+ break;
+ }
+ listPtr->internalRep.twoPtrValue.ptr2 = (VOID *) chainPtr;
+
+ /*
+ * Reconstitute the index array
+ */
+
+ result = Tcl_ListObjGetElements( interp, indexArgPtr,
+ &indexCount, &indices );
+ if ( result != TCL_OK ) {
+ /*
+ * Shouldn't be able to get here, because we already
+ * parsed the thing successfully once.
+ */
+ break;
+ }
+
+ /*
+ * Determine the index of the requested element.
+ */
+
+ result = TclGetIntForIndex( interp, indices[ i ],
+ (elemCount - 1), &index );
+ if ( result != TCL_OK ) {
+ break;
+ }
+
+ /*
+ * Check that the index is in range.
+ */
+
+ if ( ( index < 0 ) || ( index >= elemCount ) ) {
+ Tcl_SetObjResult( interp,
+ Tcl_NewStringObj( "list index out of range",
+ -1 ) );
+ result = TCL_ERROR;
+ break;
+ }
+
+ /*
+ * Break the loop after extracting the innermost sublist
+ */
+
+ if ( i >= indexCount-1 ) {
+ result = TCL_OK;
+ break;
+ }
+
+ /*
+ * Extract the appropriate sublist, and make sure that it is unshared.
+ */
+
+ 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, because
+ * we've already checked everything that TclListObjSetElement
+ * checks. If we were to get here, it would result in leaking
+ * subListPtr.
+ */
+ break;
+ }
+ }
+
+ /*
+ * Chain the current sublist onto the linked list of Tcl_Obj's
+ * whose string reps must be spoilt.
+ */
+
+ chainPtr = listPtr;
+ listPtr = subListPtr;
+
+ }
+
+ /*
+ * Store the new element into the correct slot in the innermost sublist.
+ */
+
+ if ( result == TCL_OK ) {
+ result = TclListObjSetElement( interp, listPtr, index, valuePtr );
+ }
+
+ if ( result == TCL_OK ) {
+
+ listPtr->internalRep.twoPtrValue.ptr2 = (VOID *) chainPtr;
+
+ /* Spoil all the string reps */
+
+ while ( listPtr != NULL ) {
+ subListPtr = (Tcl_Obj *) listPtr->internalRep.twoPtrValue.ptr2;
+ Tcl_InvalidateStringRep( listPtr );
+ listPtr->internalRep.twoPtrValue.ptr2 = NULL;
+ listPtr = subListPtr;
+ }
+
+ /* Return the new list if everything worked. */
+
+ if ( !duplicated ) {
+ Tcl_IncrRefCount( retValuePtr );
+ }
+ return retValuePtr;
+ }
+
+ /* Clean up the one dangling reference otherwise */
+
+ if ( duplicated ) {
+ Tcl_DecrRefCount( retValuePtr );
+ }
+ return NULL;
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLsetFlat --
+ *
+ * Core of the 'lset' command when objc>=5. Objv[2], ... ,
+ * objv[objc-2] contain scalar indices.
+ *
+ * Results:
+ * Returns the new value of the list variable, or NULL if an
+ * error occurs.
+ *
+ * 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 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.
+ *
+ * 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 procedure.
+ *
+ * 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_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 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' */
+{
+
+ 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;
+
+ /*
+ * If there are no indices, then simply return the new value,
+ * counting the returned pointer as a reference
+ */
+
+ if ( indexCount == 0 ) {
+ Tcl_IncrRefCount( valuePtr );
+ return valuePtr;
+ }
+
+ /*
+ * If the list is shared, make a private copy.
+ */
+
+ if ( Tcl_IsShared( listPtr ) ) {
+ duplicated = 1;
+ listPtr = Tcl_DuplicateObj( listPtr );
+ Tcl_IncrRefCount( listPtr );
+ } else {
+ duplicated = 0;
+ }
+
+ /*
+ * Anchor the linked list of Tcl_Obj's whose string reps must be
+ * invalidated if the operation succeeds.
+ */
+
+ retValuePtr = listPtr;
+ chainPtr = NULL;
+
+ /*
+ * Handle each index arg by diving into the appropriate sublist
+ */
+
+ for ( i = 0; ; ++i ) {
+
+ /*
+ * Take the sublist apart.
+ */
+
+ result = Tcl_ListObjGetElements( interp, listPtr,
+ &elemCount, &elemPtrs );
+ if ( result != TCL_OK ) {
+ break;
+ }
+ listPtr->internalRep.twoPtrValue.ptr2 = (VOID *) chainPtr;
+
+ /*
+ * Determine the index of the requested element.
+ */
+
+ result = TclGetIntForIndex( interp, indexArray[ i ],
+ (elemCount - 1), &index );
+ if ( result != TCL_OK ) {
+ break;
+ }
+
+ /*
+ * Check that the index is in range.
+ */
+
+ if ( ( index < 0 ) || ( index >= elemCount ) ) {
+ Tcl_SetObjResult( interp,
+ Tcl_NewStringObj( "list index out of range",
+ -1 ) );
+ result = TCL_ERROR;
+ break;
+ }
+
+ /*
+ * Break the loop after extracting the innermost sublist
+ */
+
+ if ( i >= indexCount-1 ) {
+ result = TCL_OK;
+ break;
+ }
+
+ /*
+ * Extract the appropriate sublist, and make sure that it is unshared.
+ */
+
+ 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.
+ */
+ break;
+ }
+ }
+
+ /*
+ * Chain the current sublist onto the linked list of Tcl_Obj's
+ * whose string reps must be spoilt.
+ */
+
+ chainPtr = listPtr;
+ listPtr = subListPtr;
+
+ }
+
+ /* Store the result in the list element */
+
+ if ( result == TCL_OK ) {
+ result = TclListObjSetElement( interp, listPtr, index, valuePtr );
+ }
+
+ if ( result == TCL_OK ) {
+
+ listPtr->internalRep.twoPtrValue.ptr2 = (VOID *) chainPtr;
+
+ /* Spoil all the string reps */
+
+ while ( listPtr != NULL ) {
+ subListPtr = (Tcl_Obj *) listPtr->internalRep.twoPtrValue.ptr2;
+ Tcl_InvalidateStringRep( listPtr );
+ listPtr->internalRep.twoPtrValue.ptr2 = NULL;
+ listPtr = subListPtr;
+ }
+
+ /* Return the new list if everything worked. */
+
+ if ( !duplicated ) {
+ Tcl_IncrRefCount( retValuePtr );
+ }
+ return retValuePtr;
+ }
+
+ /* Clean up the one dangling reference otherwise */
+
+ if ( duplicated ) {
+ Tcl_DecrRefCount( retValuePtr );
+ }
+ return NULL;
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclListObjSetElement --
+ *
+ * Set a single element of a list to a specified value
+ *
+ * Results:
+ *
+ * The return value is normally TCL_OK. If listPtr does not
+ * refer to a list object and cannot be converted to one, TCL_ERROR
+ * is returned and an error message will be left in the interpreter
+ * result if interp is not NULL. Similarly, if index designates
+ * an element outside the range [0..listLength-1], where
+ * listLength is the count of elements in the list object designated
+ * by listPtr, TCL_ERROR is returned and an error message is left
+ * in the interpreter result.
+ *
+ * Side effects:
+ *
+ * Panics if listPtr designates a shared object. Otherwise, attempts
+ * to convert it to a list. Decrements the ref count of the object
+ * at the specified index within the list, replaces with the
+ * object designated by valuePtr, and increments the ref count
+ * of the replacement object.
+ *
+ * It is the caller's responsibility to invalidate the string
+ * representation of the object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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 */
+{
+ 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 */
+
+ /* Ensure that the listPtr parameter designates an unshared list */
+
+ if ( Tcl_IsShared( listPtr ) ) {
+ panic( "Tcl_ListObjSetElement called with shared object" );
+ }
+ if ( listPtr->typePtr != &tclListType ) {
+ result = SetListFromAny( interp, listPtr );
+ if ( result != TCL_OK ) {
+ return result;
+ }
+ }
+ listRepPtr = (List*) listPtr->internalRep.twoPtrValue.ptr1;
+ elemPtrs = listRepPtr->elements;
+ elemCount = listRepPtr->elemCount;
+
+ /* Ensure that the index is in bounds */
+
+ if ( index < 0 || index >= elemCount ) {
+ if ( interp != NULL ) {
+ Tcl_SetObjResult( interp,
+ Tcl_NewStringObj( "list index out of range",
+ -1 ) );
+ return TCL_ERROR;
+ }
+ }
+
+ /* Add a reference to the new list element */
+
+ Tcl_IncrRefCount( valuePtr );
+
+ /* Remove a reference from the old list element */
+
+ Tcl_DecrRefCount( elemPtrs[ index ] );
+
+ /* Stash the new object in the list */
+
+ elemPtrs[ index ] = valuePtr;
+
+ return TCL_OK;
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* FreeListInternalRep --
*
* Deallocate the storage associated with a list object's internal
@@ -772,7 +1366,7 @@ Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv)
*
* Side effects:
* Frees listPtr's List* internal representation and sets listPtr's
- * internalRep.otherValuePtr to NULL. Decrements the ref counts
+ * internalRep.twoPtrValue.ptr1 to NULL. Decrements the ref counts
* of all element objects, which may free them.
*
*----------------------------------------------------------------------
@@ -782,7 +1376,7 @@ static void
FreeListInternalRep(listPtr)
Tcl_Obj *listPtr; /* List object with internal rep to free. */
{
- register List *listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
+ register List *listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
register Tcl_Obj **elemPtrs = listRepPtr->elements;
register Tcl_Obj *objPtr;
int numElems = listRepPtr->elemCount;
@@ -794,6 +1388,9 @@ FreeListInternalRep(listPtr)
}
ckfree((char *) elemPtrs);
ckfree((char *) listRepPtr);
+
+ listPtr->internalRep.twoPtrValue.ptr1 = NULL;
+ listPtr->internalRep.twoPtrValue.ptr2 = NULL;
}
/*
@@ -823,7 +1420,7 @@ DupListInternalRep(srcPtr, copyPtr)
Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
Tcl_Obj *copyPtr; /* Object with internal rep to set. */
{
- List *srcListRepPtr = (List *) srcPtr->internalRep.otherValuePtr;
+ List *srcListRepPtr = (List *) srcPtr->internalRep.twoPtrValue.ptr1;
int numElems = srcListRepPtr->elemCount;
int maxElems = srcListRepPtr->maxElemCount;
register Tcl_Obj **srcElemPtrs = srcListRepPtr->elements;
@@ -849,7 +1446,8 @@ DupListInternalRep(srcPtr, copyPtr)
copyListRepPtr->elemCount = numElems;
copyListRepPtr->elements = copyElemPtrs;
- copyPtr->internalRep.otherValuePtr = (VOID *) copyListRepPtr;
+ copyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) copyListRepPtr;
+ copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
copyPtr->typePtr = &tclListType;
}
@@ -975,7 +1573,8 @@ SetListFromAny(interp, objPtr)
oldTypePtr->freeIntRepProc(objPtr);
}
- objPtr->internalRep.otherValuePtr = (VOID *) listRepPtr;
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
+ objPtr->internalRep.twoPtrValue.ptr2 = NULL;
objPtr->typePtr = &tclListType;
return TCL_OK;
}
@@ -1007,7 +1606,7 @@ UpdateStringOfList(listPtr)
{
# define LOCAL_SIZE 20
int localFlags[LOCAL_SIZE], *flagPtr;
- List *listRepPtr = (List *) listPtr->internalRep.otherValuePtr;
+ List *listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
int numElems = listRepPtr->elemCount;
register int i;
char *elem, *dst;
diff --git a/tcl/generic/tclLiteral.c b/tcl/generic/tclLiteral.c
index 37b1d33aa84..bee26f4251a 100644
--- a/tcl/generic/tclLiteral.c
+++ b/tcl/generic/tclLiteral.c
@@ -696,31 +696,10 @@ TclReleaseLiteral(interp, objPtr)
entryPtr->refCount--;
/*
- * We found the matching LiteralEntry. Check if it's only being
- * kept alive only by a circular reference from a ByteCode
- * stored as its internal rep.
- */
-
- if ((entryPtr->refCount == 1)
- && (objPtr->typePtr == &tclByteCodeType)) {
- codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
- if ((codePtr->numLitObjects == 1)
- && (codePtr->objArrayPtr[0] == objPtr)) {
- entryPtr->refCount = 0;
-
- /*
- * Set the ByteCode object array entry NULL to signal
- * to TclCleanupByteCode to not try to release this
- * about to be freed literal again.
- */
-
- codePtr->objArrayPtr[0] = NULL;
- }
- }
-
- /*
* If the literal is no longer being used by any ByteCode,
- * delete the entry then decrement the ref count of its object.
+ * delete the entry then remove the reference corresponding
+ * to the global literal table entry (decrement the ref count
+ * of the object).
*/
if (entryPtr->refCount == 0) {
@@ -729,27 +708,40 @@ TclReleaseLiteral(interp, objPtr)
} else {
prevPtr->nextPtr = entryPtr->nextPtr;
}
-#ifdef TCL_COMPILE_STATS
- iPtr->stats.currentLitStringBytes -= (double) (length + 1);
-#endif /*TCL_COMPILE_STATS*/
ckfree((char *) entryPtr);
globalTablePtr->numEntries--;
+ TclDecrRefCount(objPtr);
+
/*
- * Remove the reference corresponding to the global
- * literal table entry.
+ * Check if the LiteralEntry is only being kept alive by
+ * a circular reference from a ByteCode stored as its
+ * internal rep. In that case, set the ByteCode object array
+ * entry NULL to signal to TclCleanupByteCode to not try to
+ * release this about to be freed literal again.
*/
+
+ if (objPtr->typePtr == &tclByteCodeType) {
+ codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+ if ((codePtr->numLitObjects == 1)
+ && (codePtr->objArrayPtr[0] == objPtr)) {
+ codePtr->objArrayPtr[0] = NULL;
+ }
+ }
- TclDecrRefCount(objPtr);
+#ifdef TCL_COMPILE_STATS
+ iPtr->stats.currentLitStringBytes -= (double) (length + 1);
+#endif /*TCL_COMPILE_STATS*/
}
break;
}
}
-
+
/*
* Remove the reference corresponding to the local literal table
* entry.
*/
+
Tcl_DecrRefCount(objPtr);
}
diff --git a/tcl/generic/tclLoad.c b/tcl/generic/tclLoad.c
index 81e963a6e86..eb3dbefeddf 100644
--- a/tcl/generic/tclLoad.c
+++ b/tcl/generic/tclLoad.c
@@ -19,7 +19,8 @@
* 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, so these structures are never freed.
+ * are never unloaded, until the application exits, when
+ * TclFinalizeLoad is called, and these structures are freed.
*/
typedef struct LoadedPackage {
@@ -31,8 +32,8 @@ typedef struct LoadedPackage {
* properly capitalized (first letter UC,
* others LC), no "_", as in "Net".
* Malloc-ed. */
- ClientData clientData; /* Token for the loaded file which should be
- * passed to TclpUnloadFile() when the file
+ 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,
* then this field is irrelevant. */
Tcl_PackageInitProc *initProc;
@@ -46,6 +47,11 @@ typedef struct LoadedPackage {
* untrusted scripts). NULL means the
* package can't be used in unsafe
* 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
@@ -113,12 +119,13 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
{
Tcl_Interp *target;
LoadedPackage *pkgPtr, *defaultPtr;
- Tcl_DString pkgName, tmp, initName, safeInitName, fileName;
+ Tcl_DString pkgName, tmp, initName, safeInitName;
Tcl_PackageInitProc *initProc, *safeInitProc;
InterpPackage *ipFirstPtr, *ipPtr;
int code, namesMatch, filesMatch;
- char *p, *tempString, *fullFileName, *packageName;
- ClientData clientData;
+ char *p, *fullFileName, *packageName;
+ Tcl_LoadHandle loadHandle;
+ Tcl_FSUnloadFileProc *unLoadProcPtr = NULL;
Tcl_UniChar ch;
int offset;
@@ -126,11 +133,11 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
Tcl_WrongNumArgs(interp, 1, objv, "fileName ?packageName? ?interp?");
return TCL_ERROR;
}
- tempString = Tcl_GetString(objv[1]);
- fullFileName = Tcl_TranslateFileName(interp, tempString, &fileName);
- if (fullFileName == NULL) {
+ if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) {
return TCL_ERROR;
}
+ fullFileName = Tcl_GetString(objv[1]);
+
Tcl_DStringInit(&pkgName);
Tcl_DStringInit(&initName);
Tcl_DStringInit(&safeInitName);
@@ -265,8 +272,10 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
*/
retc = TclGuessPackageName(fullFileName, &pkgName);
if (!retc) {
- int pargc;
- char **pargv, *pkgGuess;
+ Tcl_Obj *splitPtr;
+ Tcl_Obj *pkgGuessPtr;
+ int pElements;
+ char *pkgGuess;
/*
* The platform-specific code couldn't figure out the
@@ -276,8 +285,9 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
* characters that follow that.
*/
- Tcl_SplitPath(fullFileName, &pargc, &pargv);
- pkgGuess = pargv[pargc-1];
+ splitPtr = Tcl_FSSplitPath(objv[1], &pElements);
+ Tcl_ListObjIndex(NULL, splitPtr, pElements -1, &pkgGuessPtr);
+ pkgGuess = Tcl_GetString(pkgGuessPtr);
if ((pkgGuess[0] == 'l') && (pkgGuess[1] == 'i')
&& (pkgGuess[2] == 'b')) {
pkgGuess += 3;
@@ -291,7 +301,7 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
}
}
if (p == pkgGuess) {
- ckfree((char *)pargv);
+ Tcl_DecrRefCount(splitPtr);
Tcl_AppendResult(interp,
"couldn't figure out package name for ",
fullFileName, (char *) NULL);
@@ -299,7 +309,7 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
goto done;
}
Tcl_DStringAppend(&pkgName, pkgGuess, (p - pkgGuess));
- ckfree((char *)pargv);
+ Tcl_DecrRefCount(splitPtr);
}
}
@@ -328,9 +338,9 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
*/
Tcl_MutexLock(&packageMutex);
- code = TclpLoadFile(interp, fullFileName, Tcl_DStringValue(&initName),
+ code = Tcl_FSLoadFile(interp, objv[1], Tcl_DStringValue(&initName),
Tcl_DStringValue(&safeInitName), &initProc, &safeInitProc,
- &clientData);
+ &loadHandle,&unLoadProcPtr);
Tcl_MutexUnlock(&packageMutex);
if (code != TCL_OK) {
goto done;
@@ -338,7 +348,9 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
if (initProc == NULL) {
Tcl_AppendResult(interp, "couldn't find procedure ",
Tcl_DStringValue(&initName), (char *) NULL);
- TclpUnloadFile(clientData);
+ if (unLoadProcPtr != NULL) {
+ (*unLoadProcPtr)(loadHandle);
+ }
code = TCL_ERROR;
goto done;
}
@@ -354,7 +366,8 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
pkgPtr->packageName = (char *) ckalloc((unsigned)
(Tcl_DStringLength(&pkgName) + 1));
strcpy(pkgPtr->packageName, Tcl_DStringValue(&pkgName));
- pkgPtr->clientData = clientData;
+ pkgPtr->loadHandle = loadHandle;
+ pkgPtr->unLoadProcPtr = unLoadProcPtr;
pkgPtr->initProc = initProc;
pkgPtr->safeInitProc = safeInitProc;
Tcl_MutexLock(&packageMutex);
@@ -410,7 +423,6 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv)
Tcl_DStringFree(&pkgName);
Tcl_DStringFree(&initName);
Tcl_DStringFree(&safeInitName);
- Tcl_DStringFree(&fileName);
Tcl_DStringFree(&tmp);
return code;
}
@@ -439,7 +451,7 @@ Tcl_StaticPackage(interp, pkgName, initProc, safeInitProc)
* package has already been loaded
* into the given interpreter by
* calling the appropriate init proc. */
- 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
@@ -478,7 +490,7 @@ Tcl_StaticPackage(interp, pkgName, initProc, safeInitProc)
pkgPtr->packageName = (char *) ckalloc((unsigned)
(strlen(pkgName) + 1));
strcpy(pkgPtr->packageName, pkgName);
- pkgPtr->clientData = NULL;
+ pkgPtr->loadHandle = NULL;
pkgPtr->initProc = initProc;
pkgPtr->safeInitProc = safeInitProc;
Tcl_MutexLock(&packageMutex);
@@ -653,7 +665,10 @@ TclFinalizeLoad()
* call a function in the dll after it's been unloaded.
*/
if (pkgPtr->fileName[0] != '\0') {
- TclpUnloadFile(pkgPtr->clientData);
+ Tcl_FSUnloadFileProc *unLoadProcPtr = pkgPtr->unLoadProcPtr;
+ if (unLoadProcPtr != NULL) {
+ (*unLoadProcPtr)(pkgPtr->loadHandle);
+ }
}
#endif
ckfree(pkgPtr->fileName);
diff --git a/tcl/generic/tclLoadNone.c b/tcl/generic/tclLoadNone.c
index 35180f5ff52..480331b3e34 100644
--- a/tcl/generic/tclLoadNone.c
+++ b/tcl/generic/tclLoadNone.c
@@ -18,7 +18,7 @@
/*
*----------------------------------------------------------------------
*
- * TclpLoadFile --
+ * 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
@@ -35,18 +35,17 @@
*/
int
-TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
+TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr)
Tcl_Interp *interp; /* Used for error reporting. */
- char *fileName; /* Name of the file containing the desired
- * code. */
- 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
+ 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
- * TclpUnloadFile() to unload the file. */
+ * (*unloadProcPtr)() to unload the file. */
+ Tcl_FSUnloadFileProc **unloadProcPtr;
+ /* Filled with address of Tcl_FSUnloadFileProc
+ * function which should be used for
+ * this file. */
{
Tcl_SetResult(interp,
"dynamic loading is not currently available on this system",
@@ -57,6 +56,30 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
/*
*----------------------------------------------------------------------
*
+ * 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
@@ -76,7 +99,7 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
int
TclGuessPackageName(fileName, bufPtr)
- char *fileName; /* Name of file containing package (already
+ 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. */
@@ -103,10 +126,10 @@ TclGuessPackageName(fileName, bufPtr)
*/
void
-TclpUnloadFile(clientData)
- ClientData clientData; /* ClientData returned by a previous call
- * to TclpLoadFile(). The clientData is
- * a token that represents the loaded
- * file. */
+TclpUnloadFile(loadHandle)
+ Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call
+ * to TclpDlopen(). The loadHandle is
+ * a token that represents the loaded
+ * file. */
{
}
diff --git a/tcl/generic/tclMain.c b/tcl/generic/tclMain.c
index a89d0caf3f3..eedbd8d4a44 100644
--- a/tcl/generic/tclMain.c
+++ b/tcl/generic/tclMain.c
@@ -5,6 +5,7 @@
*
* Copyright (c) 1988-1994 The Regents of the University of California.
* Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 2000 Ajuba Solutions.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -19,35 +20,111 @@
# define TCL_STORAGE_CLASS DLLEXPORT
/*
- * The following code ensures that tclLink.c is linked whenever
- * Tcl is linked. Without this code there's no reference to the
- * code in that file from anywhere in Tcl, so it may not be
- * linked into the application.
- */
-
-EXTERN int Tcl_LinkVar();
-int (*tclDummyLinkVarPtr)() = Tcl_LinkVar;
-
-/*
* Declarations for various library procedures 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).
- * Note: "exit" should really be declared here, but there's no way to
- * declare it without causing conflicts with other definitions elsewher
- * on some systems, so it's better just to leave it out.
*/
+#if !defined(MAC_TCL)
extern int isatty _ANSI_ARGS_((int fd));
-extern char * strcpy _ANSI_ARGS_((char *dst, CONST char *src));
+#else
+#include <unistd.h>
+#endif
+
+static Tcl_Obj *tclStartupScriptPath = NULL;
-static char *tclStartupScriptFileName = NULL;
+static Tcl_MainLoopProc *mainLoopProc = NULL;
+/*
+ * Structure definition for information used to keep the state of
+ * an interactive command processor that reads lines from standard
+ * input and writes prompts and results to standard output.
+ */
+
+typedef enum {
+ PROMPT_NONE, /* Print no prompt */
+ PROMPT_START, /* Print prompt for command start */
+ PROMPT_CONTINUE /* Print prompt for command continuation */
+} PromptType;
+
+typedef struct InteractiveState {
+ Tcl_Channel input; /* The standard input channel from which
+ * lines are read. */
+ int tty; /* Non-zero means standard input is a
+ * terminal-like device. Zero means it's
+ * a file. */
+ Tcl_Obj *commandPtr; /* Used to assemble lines of input into
+ * Tcl commands. */
+ PromptType prompt; /* Next prompt to print */
+ Tcl_Interp *interp; /* Interpreter that evaluates interactive
+ * commands. */
+} InteractiveState;
+
+/*
+ * Forward declarations for procedures defined later in this file.
+ */
+static void Prompt _ANSI_ARGS_((Tcl_Interp *interp,
+ PromptType *promptPtr));
+static void StdinProc _ANSI_ARGS_((ClientData clientData,
+ int mask));
/*
*----------------------------------------------------------------------
*
+ * 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(pathPtr)
+ Tcl_Obj *pathPtr;
+{
+ if (tclStartupScriptPath != NULL) {
+ Tcl_DecrRefCount(tclStartupScriptPath);
+ }
+ tclStartupScriptPath = pathPtr;
+ if (tclStartupScriptPath != NULL) {
+ Tcl_IncrRefCount(tclStartupScriptPath);
+ }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 tclStartupScriptPath;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclSetStartupScriptFileName --
*
* Primes the startup script file name, used to override the
@@ -63,9 +140,10 @@ static char *tclStartupScriptFileName = NULL;
*----------------------------------------------------------------------
*/
void TclSetStartupScriptFileName(fileName)
- char *fileName;
+ CONST char *fileName;
{
- tclStartupScriptFileName = fileName;
+ Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName,-1);
+ TclSetStartupScriptPath(pathPtr);
}
@@ -85,9 +163,14 @@ void TclSetStartupScriptFileName(fileName)
*
*----------------------------------------------------------------------
*/
-char *TclGetStartupScriptFileName()
+CONST char *TclGetStartupScriptFileName()
{
- return tclStartupScriptFileName;
+ Tcl_Obj *pathPtr = TclGetStartupScriptPath();
+
+ if (pathPtr == NULL) {
+ return NULL;
+ }
+ return Tcl_GetString(pathPtr);
}
@@ -101,7 +184,7 @@ char *TclGetStartupScriptFileName()
*
* Results:
* None. This procedure never returns (it exits the process when
- * it's done.
+ * it's done).
*
* Side effects:
* This procedure initializes the Tcl world and then starts
@@ -123,18 +206,18 @@ Tcl_Main(argc, argv, appInitProc)
{
Tcl_Obj *resultPtr;
Tcl_Obj *commandPtr = NULL;
- char buffer[1000], *args;
- int code, gotPartial, tty, length;
+ char buffer[TCL_INTEGER_SPACE + 5], *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();
-#ifdef TCL_MEM_DEBUG
Tcl_InitMemory(interp);
-#endif
/*
* Make command-line arguments available in the Tcl variables "argc"
@@ -142,27 +225,34 @@ Tcl_Main(argc, argv, appInitProc)
* strip it off and use it as the name of a script file to process.
*/
- if (tclStartupScriptFileName == NULL) {
+ if (TclGetStartupScriptPath() == NULL) {
if ((argc > 1) && (argv[1][0] != '-')) {
- tclStartupScriptFileName = argv[1];
+ TclSetStartupScriptFileName(argv[1]);
argc--;
argv++;
}
}
- args = Tcl_Merge(argc-1, argv+1);
+
+ /*
+ * 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);
- if (tclStartupScriptFileName == NULL) {
+ if (TclGetStartupScriptPath() == NULL) {
Tcl_ExternalToUtfDString(NULL, argv[0], -1, &argString);
} else {
- tclStartupScriptFileName = Tcl_ExternalToUtfDString(NULL,
- tclStartupScriptFileName, -1, &argString);
+ TclSetStartupScriptFileName(Tcl_ExternalToUtfDString(NULL,
+ TclGetStartupScriptFileName(), -1, &argString));
}
- TclFormatInt(buffer, argc-1);
+ TclFormatInt(buffer, (long) argc-1);
Tcl_SetVar(interp, "argc", buffer, TCL_GLOBAL_ONLY);
Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&argString), TCL_GLOBAL_ONLY);
@@ -172,13 +262,14 @@ Tcl_Main(argc, argv, appInitProc)
tty = isatty(0);
Tcl_SetVar(interp, "tcl_interactive",
- ((tclStartupScriptFileName == NULL) && tty) ? "1" : "0",
+ ((TclGetStartupScriptPath() == NULL) && tty) ? "1" : "0",
TCL_GLOBAL_ONLY);
/*
* Invoke application-specific initialization.
*/
+ Tcl_Preserve((ClientData) interp);
if ((*appInitProc)(interp) != TCL_OK) {
errChannel = Tcl_GetStdChannel(TCL_STDERR);
if (errChannel) {
@@ -188,17 +279,21 @@ Tcl_Main(argc, argv, appInitProc)
Tcl_WriteChars(errChannel, "\n", 1);
}
}
+ if (Tcl_InterpDeleted(interp)) {
+ goto done;
+ }
/*
* If a script file was specified then just source that file
* and quit.
*/
- if (tclStartupScriptFileName != NULL) {
- code = Tcl_EvalFile(interp, tclStartupScriptFileName);
+ if (TclGetStartupScriptPath() != NULL) {
+ code = Tcl_FSEvalFile(interp, TclGetStartupScriptPath());
if (code != TCL_OK) {
errChannel = Tcl_GetStdChannel(TCL_STDERR);
if (errChannel) {
+
/*
* The following statement guarantees that the errorInfo
* variable is set properly.
@@ -231,63 +326,68 @@ Tcl_Main(argc, argv, appInitProc)
commandPtr = Tcl_NewObj();
Tcl_IncrRefCount(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);
- gotPartial = 0;
- while (1) {
+ while ((inChannel != (Tcl_Channel) NULL) && !Tcl_InterpDeleted(interp)) {
if (tty) {
- Tcl_Obj *promptCmdPtr;
-
- promptCmdPtr = Tcl_GetVar2Ex(interp,
- (gotPartial ? "tcl_prompt2" : "tcl_prompt1"),
- NULL, TCL_GLOBAL_ONLY);
- if (promptCmdPtr == NULL) {
- defaultPrompt:
- if (!gotPartial && outChannel) {
- Tcl_WriteChars(outChannel, "% ", 2);
- }
- } else {
- code = Tcl_EvalObjEx(interp, promptCmdPtr, 0);
- inChannel = Tcl_GetStdChannel(TCL_STDIN);
- outChannel = Tcl_GetStdChannel(TCL_STDOUT);
- errChannel = Tcl_GetStdChannel(TCL_STDERR);
- if (code != TCL_OK) {
- if (errChannel) {
- Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
- Tcl_WriteChars(errChannel, "\n", 1);
- }
- Tcl_AddErrorInfo(interp,
- "\n (script that generates prompt)");
- goto defaultPrompt;
- }
+ Prompt(interp, &prompt);
+ if (Tcl_InterpDeleted(interp)) {
+ break;
}
- if (outChannel) {
- Tcl_Flush(outChannel);
+ inChannel = Tcl_GetStdChannel(TCL_STDIN);
+ if (inChannel == (Tcl_Channel) NULL) {
+ break;
}
}
- if (!inChannel) {
- goto done;
+ if (Tcl_IsShared(commandPtr)) {
+ Tcl_DecrRefCount(commandPtr);
+ commandPtr = Tcl_DuplicateObj(commandPtr);
+ Tcl_IncrRefCount(commandPtr);
}
length = Tcl_GetsObj(inChannel, commandPtr);
if (length < 0) {
- goto done;
- }
- if ((length == 0) && Tcl_Eof(inChannel) && (!gotPartial)) {
- goto done;
+ if (Tcl_InputBlocked(inChannel)) {
+
+ /*
+ * 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;
+ }
+
+ /*
+ * Either EOF, or an error on stdin; we're done
+ */
+
+ break;
}
/*
* Add the newline removed by Tcl_GetsObj back to the string.
*/
+ if (Tcl_IsShared(commandPtr)) {
+ Tcl_DecrRefCount(commandPtr);
+ commandPtr = Tcl_DuplicateObj(commandPtr);
+ Tcl_IncrRefCount(commandPtr);
+ }
Tcl_AppendToObj(commandPtr, "\n", 1);
if (!TclObjCommandComplete(commandPtr)) {
- gotPartial = 1;
+ prompt = PROMPT_CONTINUE;
continue;
}
- gotPartial = 0;
- code = Tcl_RecordAndEvalObj(interp, commandPtr, 0);
+ 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);
@@ -301,31 +401,325 @@ Tcl_Main(argc, argv, appInitProc)
}
} 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_DecrRefCount(resultPtr);
+ }
+ if (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);
+ }
+ 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);
+ }
+
+ (*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);
+ }
+ inChannel = Tcl_GetStdChannel(TCL_STDIN);
+ outChannel = Tcl_GetStdChannel(TCL_STDOUT);
+ errChannel = Tcl_GetStdChannel(TCL_STDERR);
}
#ifdef TCL_MEM_DEBUG
+
+ /*
+ * This code here only for the (unsupported and deprecated)
+ * [checkmem] command.
+ */
+
if (tclMemDumpFileName != NULL) {
- Tcl_DecrRefCount(commandPtr);
+ mainLoopProc = NULL;
Tcl_DeleteInterp(interp);
- Tcl_Exit(0);
}
#endif
}
+ done:
+ if ((exitCode == 0) && (mainLoopProc != NULL)) {
+
+ /*
+ * 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;
+ }
+ if (commandPtr != NULL) {
+ Tcl_DecrRefCount(commandPtr);
+ }
+
/*
* Rather than calling exit, invoke the "exit" command so that
* users can replace "exit" with some other command to do additional
* cleanup on exit. The Tcl_Eval call should never return.
*/
- done:
- if (commandPtr != NULL) {
+ if (!Tcl_InterpDeleted(interp)) {
+ sprintf(buffer, "exit %d", exitCode);
+ Tcl_Eval(interp, buffer);
+
+ /*
+ * If Tcl_Eval returns, trying to eval [exit], something
+ * unusual is happening. Maybe interp has been deleted;
+ * maybe [exit] was redefined. We still want to cleanup
+ * and exit.
+ */
+
+ if (!Tcl_InterpDeleted(interp)) {
+ Tcl_DeleteInterp(interp);
+ }
+ }
+ TclSetStartupScriptPath(NULL);
+
+ /*
+ * If we get here, the master interp has been deleted. Allow
+ * its destruction with the last matching Tcl_Release.
+ */
+
+ Tcl_Release((ClientData) interp);
+ Tcl_Exit(exitCode);
+}
+
+/*
+ *---------------------------------------------------------------
+ *
+ * Tcl_SetMainLoop --
+ *
+ * Sets an alternative main loop procedure.
+ *
+ * Results:
+ * Returns the previously defined main loop procedure.
+ *
+ * Side effects:
+ * This procedure will be called before Tcl exits, allowing for
+ * the creation of an event loop.
+ *
+ *---------------------------------------------------------------
+ */
+
+void
+Tcl_SetMainLoop(proc)
+ Tcl_MainLoopProc *proc;
+{
+ mainLoopProc = proc;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StdinProc --
+ *
+ * This procedure 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.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Could be almost arbitrary, depending on the command that's
+ * typed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+StdinProc(clientData, mask)
+ ClientData clientData; /* The state of interactive cmd line */
+ int mask; /* Not used. */
+{
+ InteractiveState *isPtr = (InteractiveState *) 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);
+ commandPtr = Tcl_DuplicateObj(commandPtr);
+ Tcl_IncrRefCount(commandPtr);
+ }
+ length = Tcl_GetsObj(chan, commandPtr);
+ if (length < 0) {
+ if (Tcl_InputBlocked(chan)) {
+ return;
+ }
+ if (isPtr->tty) {
+ /*
+ * Would be better to find a way to exit the mainLoop?
+ * Or perhaps evaluate [exit]? Leaving as is for now due
+ * to compatibility concerns.
+ */
+ Tcl_Exit(0);
+ }
+ Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) isPtr);
+ return;
+ }
+
+ if (Tcl_IsShared(commandPtr)) {
Tcl_DecrRefCount(commandPtr);
+ commandPtr = Tcl_DuplicateObj(commandPtr);
+ Tcl_IncrRefCount(commandPtr);
+ }
+ Tcl_AppendToObj(commandPtr, "\n", 1);
+ if (!TclObjCommandComplete(commandPtr)) {
+ isPtr->prompt = PROMPT_CONTINUE;
+ goto prompt;
+ }
+ isPtr->prompt = PROMPT_START;
+
+ /*
+ * Disable the stdin channel handler while evaluating the command;
+ * otherwise if the command re-enters the event loop we might
+ * process commands from stdin before the current command is
+ * finished. Among other things, this will trash the text of the
+ * command being evaluated.
+ */
+
+ Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) 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 (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);
+ }
+ } else if (isPtr->tty) {
+ Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
+ Tcl_Channel outChannel = 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);
+ }
+ Tcl_DecrRefCount(resultPtr);
+ }
+
+ /*
+ * If a tty stdin is still around, output a prompt.
+ */
+
+ prompt:
+ if (isPtr->tty && (isPtr->input != (Tcl_Channel) NULL)) {
+ Prompt(interp, &(isPtr->prompt));
+ isPtr->input = Tcl_GetStdChannel(TCL_STDIN);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Prompt --
+ *
+ * Issue a prompt on standard output, or invoke a script
+ * to issue the prompt.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A prompt gets output, and a Tcl script may be evaluated
+ * in interp.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+{
+ Tcl_Obj *promptCmdPtr;
+ int code;
+ Tcl_Channel outChannel, errChannel;
+
+ if (*promptPtr == PROMPT_NONE) {
+ return;
+ }
+
+ promptCmdPtr = Tcl_GetVar2Ex(interp,
+ ((*promptPtr == PROMPT_CONTINUE) ? "tcl_prompt2" : "tcl_prompt1"),
+ NULL, TCL_GLOBAL_ONLY);
+ if (Tcl_InterpDeleted(interp)) {
+ return;
+ }
+ if (promptCmdPtr == NULL) {
+ defaultPrompt:
+ outChannel = Tcl_GetStdChannel(TCL_STDOUT);
+ if ((*promptPtr == PROMPT_START)
+ && (outChannel != (Tcl_Channel) NULL)) {
+ Tcl_WriteChars(outChannel, "% ", 2);
+ }
+ } 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);
+ }
+ goto defaultPrompt;
+ }
+ }
+ outChannel = Tcl_GetStdChannel(TCL_STDOUT);
+ if (outChannel != (Tcl_Channel) NULL) {
+ Tcl_Flush(outChannel);
}
- sprintf(buffer, "exit %d", exitCode);
- Tcl_Eval(interp, buffer);
+ *promptPtr = PROMPT_NONE;
}
diff --git a/tcl/generic/tclNamesp.c b/tcl/generic/tclNamesp.c
index 38f7d2a794c..b628a35de72 100644
--- a/tcl/generic/tclNamesp.c
+++ b/tcl/generic/tclNamesp.c
@@ -104,6 +104,9 @@ static int NamespaceDeleteCmd _ANSI_ARGS_((
static int NamespaceEvalCmd _ANSI_ARGS_((
ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *CONST objv[]));
+static int NamespaceExistsCmd _ANSI_ARGS_((
+ ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[]));
static int NamespaceExportCmd _ANSI_ARGS_((
ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *CONST objv[]));
@@ -163,7 +166,7 @@ Tcl_ObjType tclNsNameType = {
* None.
*
* Side effects:
- * The namespace object type is registered with the Tcl compiler.
+ * None.
*
*----------------------------------------------------------------------
*/
@@ -171,7 +174,9 @@ Tcl_ObjType tclNsNameType = {
void
TclInitNamespaceSubsystem()
{
- Tcl_RegisterObjType(&tclNsNameType);
+ /*
+ * Does nothing for now.
+ */
}
/*
@@ -427,7 +432,7 @@ Tcl_CreateNamespace(interp, name, clientData, deleteProc)
Tcl_Interp *interp; /* Interpreter in which a new namespace
* is being created. Also used for
* error reporting. */
- 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
@@ -442,7 +447,7 @@ Tcl_CreateNamespace(interp, name, clientData, deleteProc)
register Namespace *nsPtr, *ancestorPtr;
Namespace *parentPtr, *dummy1Ptr, *dummy2Ptr;
Namespace *globalNsPtr = iPtr->globalNsPtr;
- char *simpleName;
+ CONST char *simpleName;
Tcl_HashEntry *entryPtr;
Tcl_DString buffer1, buffer2;
int newEntry;
@@ -715,7 +720,8 @@ TclTeardownNamespace(nsPtr)
* variables, in case they had any traces on them.
*/
- char *str, *errorInfoStr, *errorCodeStr;
+ CONST char *str;
+ char *errorInfoStr, *errorCodeStr;
str = Tcl_GetVar((Tcl_Interp *) iPtr, "errorInfo", TCL_GLOBAL_ONLY);
if (str != NULL) {
@@ -896,7 +902,7 @@ Tcl_Export(interp, namespacePtr, pattern, resetListFirst)
Tcl_Namespace *namespacePtr; /* Points to the namespace from which
* commands are to be exported. NULL for
* the current namespace. */
- char *pattern; /* String pattern indicating which commands
+ 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
@@ -909,7 +915,8 @@ Tcl_Export(interp, namespacePtr, pattern, resetListFirst)
#define INIT_EXPORT_PATTERNS 5
Namespace *nsPtr, *exportNsPtr, *dummyPtr;
Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
- char *simplePattern, *patternCpy;
+ CONST char *simplePattern;
+ char *patternCpy;
int neededElems, len, i;
/*
@@ -1096,7 +1103,7 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
Tcl_Namespace *namespacePtr; /* Points to the namespace into which the
* commands are to be imported. NULL for
* the current namespace. */
- char *pattern; /* String pattern indicating which commands
+ 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). */
@@ -1108,7 +1115,8 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
Interp *iPtr = (Interp *) interp;
Namespace *nsPtr, *importNsPtr, *dummyPtr;
Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
- char *simplePattern, *cmdName;
+ CONST char *simplePattern;
+ char *cmdName;
register Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
Command *cmdPtr, *realCmdPtr;
@@ -1265,6 +1273,7 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
"import pattern \"", pattern,
"\" would create a loop containing command \"",
Tcl_DStringValue(&ds), "\"", (char *) NULL);
+ Tcl_DStringFree(&ds);
return TCL_ERROR;
}
}
@@ -1277,6 +1286,7 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
dataPtr->realCmdPtr = cmdPtr;
dataPtr->selfPtr = (Command *) importedCmd;
dataPtr->selfPtr->compileProc = cmdPtr->compileProc;
+ Tcl_DStringFree(&ds);
/*
* Create an ImportRef structure describing this new import
@@ -1328,14 +1338,15 @@ Tcl_ForgetImport(interp, namespacePtr, pattern)
Tcl_Namespace *namespacePtr; /* Points to the namespace from which
* previously imported commands should be
* removed. NULL for current namespace. */
- char *pattern; /* String pattern indicating which imported
+ CONST char *pattern; /* String pattern indicating which imported
* commands to remove. This pattern should
* be qualified by the name of the
* namespace from which the command(s) were
* imported. */
{
Namespace *nsPtr, *importNsPtr, *dummyPtr, *actualCtxPtr;
- char *simplePattern, *cmdName;
+ CONST char *simplePattern;
+ char *cmdName;
register Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
Command *cmdPtr;
@@ -1605,7 +1616,7 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags,
nsPtrPtr, altNsPtrPtr, actualCxtPtrPtr, simpleNamePtr)
Tcl_Interp *interp; /* Interpreter in which to find the
* namespace containing qualName. */
- register char *qualName; /* A namespace-qualified name of an
+ CONST char *qualName; /* A namespace-qualified name of an
* command, variable, or namespace. */
Namespace *cxtNsPtr; /* The namespace in which to start the
* search for qualName's namespace. If NULL
@@ -1637,7 +1648,7 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags,
* the :: namespace if TCL_GLOBAL_ONLY was
* specified, or the current namespace if
* cxtNsPtr was NULL. */
- char **simpleNamePtr; /* Address where procedure stores the
+ CONST char **simpleNamePtr; /* Address where procedure stores the
* simple name at end of the qualName, or
* NULL if qualName is "::" or the flag
* FIND_ONLY_NS was specified. */
@@ -1646,8 +1657,8 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags,
Namespace *nsPtr = cxtNsPtr;
Namespace *altNsPtr;
Namespace *globalNsPtr = iPtr->globalNsPtr;
- register char *start, *end;
- char *nsName;
+ CONST char *start, *end;
+ CONST char *nsName;
Tcl_HashEntry *entryPtr;
Tcl_DString buffer;
int len;
@@ -1870,7 +1881,7 @@ Tcl_Namespace *
Tcl_FindNamespace(interp, name, contextNsPtr, flags)
Tcl_Interp *interp; /* The interpreter in which to find the
* namespace. */
- 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
@@ -1885,7 +1896,7 @@ Tcl_FindNamespace(interp, name, contextNsPtr, flags)
* TCL_LEAVE_ERR_MSG flags. */
{
Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr;
- char *dummy;
+ CONST char *dummy;
/*
* Find the namespace(s) that contain the specified namespace name.
@@ -1929,7 +1940,7 @@ Tcl_Command
Tcl_FindCommand(interp, name, contextNsPtr, flags)
Tcl_Interp *interp; /* The interpreter in which to find the
* command and to report errors. */
- 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
@@ -1952,7 +1963,7 @@ Tcl_FindCommand(interp, name, contextNsPtr, flags)
ResolverScheme *resPtr;
Namespace *nsPtr[2], *cxtNsPtr;
- char *simpleName;
+ CONST char *simpleName;
register Tcl_HashEntry *entryPtr;
register Command *cmdPtr;
register int search;
@@ -2061,7 +2072,7 @@ Tcl_Var
Tcl_FindNamespaceVar(interp, name, contextNsPtr, flags)
Tcl_Interp *interp; /* The interpreter in which to find the
* variable. */
- char *name; /* Variable's name. If it starts with "::",
+ 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
@@ -2083,7 +2094,7 @@ Tcl_FindNamespaceVar(interp, name, contextNsPtr, flags)
Interp *iPtr = (Interp*)interp;
ResolverScheme *resPtr;
Namespace *nsPtr[2], *cxtNsPtr;
- char *simpleName;
+ CONST char *simpleName;
Tcl_HashEntry *entryPtr;
Var *varPtr;
register int search;
@@ -2275,6 +2286,17 @@ TclResetShadowedCmdRefs(interp, newCmdPtr)
hPtr = Tcl_FindHashEntry(&shadowNsPtr->cmdTable, cmdName);
if (hPtr != NULL) {
nsPtr->cmdRefEpoch++;
+
+ /*
+ * If the shadowed command was compiled to bytecodes, we
+ * invalidate all the bytecodes in nsPtr, to force a new
+ * compilation. We use the resolverEpoch to signal the need
+ * for a fresh compilation of every bytecode.
+ */
+
+ if ((((Command *) Tcl_GetHashValue(hPtr))->compileProc) != NULL) {
+ nsPtr->resolverEpoch++;
+ }
}
}
@@ -2342,12 +2364,29 @@ GetNamespaceFromObj(interp, objPtr, nsPtrPtr)
* of a namespace. */
Tcl_Namespace **nsPtrPtr; /* Result namespace pointer goes here. */
{
+ Interp *iPtr = (Interp *) interp;
register ResolvedNsName *resNamePtr;
register Namespace *nsPtr;
- Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
- int result;
+ Namespace *currNsPtr;
+ CallFrame *savedFramePtr;
+ int result = TCL_OK;
+ char *name;
/*
+ * 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 = Tcl_GetString(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.
@@ -2356,7 +2395,7 @@ GetNamespaceFromObj(interp, objPtr, nsPtrPtr)
if (objPtr->typePtr != &tclNsNameType) {
result = tclNsNameType.setFromAnyProc(interp, objPtr);
if (result != TCL_OK) {
- return TCL_ERROR;
+ goto done;
}
}
resNamePtr = (ResolvedNsName *) objPtr->internalRep.otherValuePtr;
@@ -2382,7 +2421,7 @@ GetNamespaceFromObj(interp, objPtr, nsPtrPtr)
if (nsPtr == NULL) { /* try again */
result = tclNsNameType.setFromAnyProc(interp, objPtr);
if (result != TCL_OK) {
- return TCL_ERROR;
+ goto done;
}
resNamePtr = (ResolvedNsName *) objPtr->internalRep.otherValuePtr;
if (resNamePtr != NULL) {
@@ -2393,7 +2432,10 @@ GetNamespaceFromObj(interp, objPtr, nsPtrPtr)
}
}
*nsPtrPtr = (Tcl_Namespace *) nsPtr;
- return TCL_OK;
+
+ done:
+ iPtr->varFramePtr = savedFramePtr;
+ return result;
}
/*
@@ -2409,6 +2451,7 @@ GetNamespaceFromObj(interp, objPtr, nsPtrPtr)
* namespace current
* namespace delete ?name name...?
* namespace eval name arg ?arg...?
+ * namespace exists name
* namespace export ?-clear? ?pattern pattern...?
* namespace forget ?pattern pattern...?
* namespace import ?-force? ?pattern pattern...?
@@ -2442,16 +2485,17 @@ Tcl_NamespaceObjCmd(clientData, interp, objc, objv)
register int objc; /* Number of arguments. */
register Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- static char *subCmds[] = {
- "children", "code", "current", "delete",
- "eval", "export", "forget", "import",
- "inscope", "origin", "parent", "qualifiers",
- "tail", "which", (char *) NULL};
+ static CONST char *subCmds[] = {
+ "children", "code", "current", "delete",
+ "eval", "exists", "export", "forget", "import",
+ "inscope", "origin", "parent", "qualifiers",
+ "tail", "which", (char *) NULL
+ };
enum NSSubCmdIdx {
- NSChildrenIdx, NSCodeIdx, NSCurrentIdx, NSDeleteIdx,
- NSEvalIdx, NSExportIdx, NSForgetIdx, NSImportIdx,
- NSInscopeIdx, NSOriginIdx, NSParentIdx, NSQualifiersIdx,
- NSTailIdx, NSWhichIdx
+ NSChildrenIdx, NSCodeIdx, NSCurrentIdx, NSDeleteIdx,
+ NSEvalIdx, NSExistsIdx, NSExportIdx, NSForgetIdx, NSImportIdx,
+ NSInscopeIdx, NSOriginIdx, NSParentIdx, NSQualifiersIdx,
+ NSTailIdx, NSWhichIdx
};
int index, result;
@@ -2486,6 +2530,9 @@ Tcl_NamespaceObjCmd(clientData, interp, objc, objv)
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;
@@ -2631,10 +2678,10 @@ NamespaceChildrenCmd(dummy, interp, objc, objv)
* Here "arg" can be a list. "namespace code arg" produces a result
* equivalent to that produced by the command
*
- * list namespace inscope [namespace current] $arg
+ * list ::namespace inscope [namespace current] $arg
*
* However, if "arg" is itself a scoped value starting with
- * "namespace inscope", then the result is just "arg".
+ * "::namespace inscope", then the result is just "arg".
*
* Results:
* Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
@@ -2668,6 +2715,10 @@ NamespaceCodeCmd(dummy, interp, objc, objv)
*/
arg = Tcl_GetStringFromObj(objv[2], &length);
+ while (*arg == ':') {
+ arg++;
+ length--;
+ }
if ((*arg == 'n') && (length > 17)
&& (strncmp(arg, "namespace", 9) == 0)) {
for (p = (arg + 9); (*p == ' '); p++) {
@@ -2690,7 +2741,7 @@ NamespaceCodeCmd(dummy, interp, objc, objv)
listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
Tcl_ListObjAppendElement(interp, listPtr,
- Tcl_NewStringObj("namespace", -1));
+ Tcl_NewStringObj("::namespace", -1));
Tcl_ListObjAppendElement(interp, listPtr,
Tcl_NewStringObj("inscope", -1));
@@ -2877,7 +2928,7 @@ NamespaceEvalCmd(dummy, interp, objc, objv)
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
Tcl_Namespace *namespacePtr;
- Tcl_CallFrame frame;
+ CallFrame frame;
Tcl_Obj *objPtr;
char *name;
int length, result;
@@ -2915,11 +2966,13 @@ NamespaceEvalCmd(dummy, interp, objc, objv)
* the command(s).
*/
- result = Tcl_PushCallFrame(interp, &frame, namespacePtr,
- /*isProcCallFrame*/ 0);
+ result = Tcl_PushCallFrame(interp, (Tcl_CallFrame *) &frame,
+ namespacePtr, /*isProcCallFrame*/ 0);
if (result != TCL_OK) {
return TCL_ERROR;
}
+ frame.objc = objc;
+ frame.objv = objv; /* ref counts do not need to be incremented here */
if (objc == 4) {
result = Tcl_EvalObjEx(interp, objv[3], 0);
@@ -2951,6 +3004,53 @@ NamespaceEvalCmd(dummy, interp, objc, objv)
/*
*----------------------------------------------------------------------
*
+ * NamespaceExistsCmd --
+ *
+ * Invoked to implement the "namespace exists" command that returns
+ * true if the given namespace currently exists, and false otherwise.
+ * Handles the following syntax:
+ *
+ * namespace exists name
+ *
+ * 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 wrong, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+{
+ Tcl_Namespace *namespacePtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "name");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Check whether the given namespace exists
+ */
+
+ if (GetNamespaceFromObj(interp, objv[2], &namespacePtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ Tcl_SetBooleanObj(Tcl_GetObjResult(interp), (namespacePtr != NULL));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* NamespaceExportCmd --
*
* Invoked to implement the "namespace export" command that specifies
@@ -3768,7 +3868,8 @@ SetNsNameFromAny(interp, objPtr)
register Tcl_Obj *objPtr; /* The object to convert. */
{
register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
- char *name, *dummy;
+ char *name;
+ CONST char *dummy;
Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr;
register ResolvedNsName *resNamePtr;
@@ -3880,4 +3981,3 @@ UpdateStringOfNsName(objPtr)
}
objPtr->length = length;
}
-
diff --git a/tcl/generic/tclNotify.c b/tcl/generic/tclNotify.c
index 2c386ab9e7c..9e68a6b5879 100644
--- a/tcl/generic/tclNotify.c
+++ b/tcl/generic/tclNotify.c
@@ -116,7 +116,7 @@ TclInitNotifier()
Tcl_MutexLock(&listLock);
tsdPtr->threadId = Tcl_GetCurrentThread();
- tsdPtr->clientData = Tcl_InitNotifier();
+ tsdPtr->clientData = tclStubs.tcl_InitNotifier();
tsdPtr->nextPtr = firstNotifierPtr;
firstNotifierPtr = tsdPtr;
@@ -146,10 +146,21 @@ TclFinalizeNotifier()
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
ThreadSpecificData **prevPtrPtr;
+ Tcl_Event *evPtr, *hold;
+
+ Tcl_MutexLock(&(tsdPtr->queueMutex));
+ for (evPtr = tsdPtr->firstEventPtr; evPtr != (Tcl_Event *) NULL; ) {
+ hold = evPtr;
+ evPtr = evPtr->nextPtr;
+ ckfree((char *) hold);
+ }
+ tsdPtr->firstEventPtr = NULL;
+ tsdPtr->lastEventPtr = NULL;
+ Tcl_MutexUnlock(&(tsdPtr->queueMutex));
Tcl_MutexLock(&listLock);
- Tcl_FinalizeNotifier(tsdPtr->clientData);
+ tclStubs.tcl_FinalizeNotifier(tsdPtr->clientData);
Tcl_MutexFinalize(&(tsdPtr->queueMutex));
for (prevPtrPtr = &firstNotifierPtr; *prevPtrPtr != NULL;
prevPtrPtr = &((*prevPtrPtr)->nextPtr)) {
@@ -192,6 +203,10 @@ Tcl_SetNotifier(notifierProcPtr)
#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;
}
/*
@@ -706,7 +721,7 @@ Tcl_SetServiceMode(mode)
oldMode = tsdPtr->serviceMode;
tsdPtr->serviceMode = mode;
- Tcl_ServiceModeHook(mode);
+ tclStubs.tcl_ServiceModeHook(mode);
return oldMode;
}
@@ -1072,10 +1087,9 @@ Tcl_ThreadAlert(threadId)
Tcl_MutexLock(&listLock);
for (tsdPtr = firstNotifierPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) {
if (tsdPtr->threadId == threadId) {
- Tcl_AlertNotifier(tsdPtr->clientData);
+ tclStubs.tcl_AlertNotifier(tsdPtr->clientData);
break;
}
}
Tcl_MutexUnlock(&listLock);
}
-
diff --git a/tcl/generic/tclObj.c b/tcl/generic/tclObj.c
index 581c6b0aaa5..6af1b59d002 100644
--- a/tcl/generic/tclObj.c
+++ b/tcl/generic/tclObj.c
@@ -6,6 +6,7 @@
*
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
* Copyright (c) 1999 by Scriptics Corporation.
+ * Copyright (c) 2001 by ActiveState Corporation.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -14,6 +15,7 @@
*/
#include "tclInt.h"
+#include "tclCompile.h"
#include "tclPort.h"
/*
@@ -45,18 +47,8 @@ Tcl_Mutex tclObjMutex;
* is shared by all new objects allocated by Tcl_NewObj.
*/
-static char emptyString;
-char *tclEmptyStringRep = &emptyString;
-
-/*
- * The number of Tcl objects ever allocated (by Tcl_NewObj) and freed
- * (by TclFreeObj).
- */
-
-#ifdef TCL_COMPILE_STATS
-long tclObjsAlloced = 0;
-long tclObjsFreed = 0;
-#endif /* TCL_COMPILE_STATS */
+char tclEmptyString = '\0';
+char *tclEmptyStringRep = &tclEmptyString;
/*
* Prototypes for procedures defined later in this file:
@@ -71,6 +63,37 @@ static int SetIntFromAny _ANSI_ARGS_((Tcl_Interp *interp,
static void UpdateStringOfBoolean _ANSI_ARGS_((Tcl_Obj *objPtr));
static void UpdateStringOfDouble _ANSI_ARGS_((Tcl_Obj *objPtr));
static void UpdateStringOfInt _ANSI_ARGS_((Tcl_Obj *objPtr));
+#ifndef TCL_WIDE_INT_IS_LONG
+static int SetWideIntFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr));
+static void UpdateStringOfWideInt _ANSI_ARGS_((Tcl_Obj *objPtr));
+#endif
+
+/*
+ * 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));
+
+/*
+ * 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));
+
/*
* The structures below defines the Tcl object types defined in this file by
@@ -102,6 +125,81 @@ Tcl_ObjType tclIntType = {
UpdateStringOfInt, /* updateStringProc */
SetIntFromAny /* setFromAnyProc */
};
+
+#ifndef TCL_WIDE_INT_IS_LONG
+Tcl_ObjType tclWideIntType = {
+ "wideInt", /* name */
+ (Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */
+ (Tcl_DupInternalRepProc *) NULL, /* dupIntRepProc */
+ UpdateStringOfWideInt, /* updateStringProc */
+ SetWideIntFromAny /* setFromAnyProc */
+};
+#endif
+
+/*
+ * 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 */
+};
+
+/*
+ * 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 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.
+ */
+
+static Tcl_ObjType tclCmdNameType = {
+ "cmdName", /* name */
+ FreeCmdNameInternalRep, /* freeIntRepProc */
+ DupCmdNameInternalRep, /* dupIntRepProc */
+ (Tcl_UpdateStringProc *) 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
+ * representation for a cmdName object. It contains the pointer along
+ * with some information that is used to check the pointer's validity.
+ */
+
+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). */
+ 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 namespace was deleted and a
+ * new one created at the same address). */
+ int refNsCmdEpoch; /* Value of the referencing namespace's
+ * cmdRefEpoch when the pointer was cached.
+ * Before using the cached pointer, we check
+ * if the namespace's epoch was incremented;
+ * if so, this cached pointer is invalid. */
+ int cmdEpoch; /* Value of the command's cmdEpoch when this
+ * pointer was cached. Before using the
+ * cached pointer, we check if the cmd's
+ * epoch was incremented; if so, the cmd was
+ * renamed, deleted, hidden, or exposed, and
+ * so the pointer is invalid. */
+ int refCount; /* Reference count: 1 for each cmdName
+ * object that has a pointer to this
+ * ResolvedCmdName structure as its internal
+ * rep. This structure can be freed when
+ * refCount becomes zero. */
+} ResolvedCmdName;
+
/*
*-------------------------------------------------------------------------
@@ -133,16 +231,30 @@ TclInitObjSubsystem()
Tcl_RegisterObjType(&tclBooleanType);
Tcl_RegisterObjType(&tclByteArrayType);
Tcl_RegisterObjType(&tclDoubleType);
+ Tcl_RegisterObjType(&tclEndOffsetType);
Tcl_RegisterObjType(&tclIntType);
+#ifndef TCL_WIDE_INT_IS_LONG
+ Tcl_RegisterObjType(&tclWideIntType);
+#endif
Tcl_RegisterObjType(&tclStringType);
Tcl_RegisterObjType(&tclListType);
Tcl_RegisterObjType(&tclByteCodeType);
Tcl_RegisterObjType(&tclProcBodyType);
+ Tcl_RegisterObjType(&tclArraySearchType);
+ Tcl_RegisterObjType(&tclIndexType);
+ Tcl_RegisterObjType(&tclNsNameType);
+ Tcl_RegisterObjType(&tclCmdNameType);
#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;
+ }
+ }
Tcl_MutexUnlock(&tclObjMutex);
#endif
}
@@ -306,7 +418,7 @@ Tcl_AppendAllObjTypes(interp, objPtr)
Tcl_ObjType *
Tcl_GetObjType(typeName)
- char *typeName; /* Name of Tcl object type to look up. */
+ CONST char *typeName; /* Name of Tcl object type to look up. */
{
register Tcl_HashEntry *hPtr;
Tcl_ObjType *typePtr;
@@ -404,25 +516,11 @@ Tcl_NewObj()
register Tcl_Obj *objPtr;
/*
- * Allocate the object using the list of free Tcl_Obj structs
- * we maintain.
+ * Use the macro defined in tclInt.h - it will use the
+ * correct allocator.
*/
- Tcl_MutexLock(&tclObjMutex);
- if (tclFreeObjList == NULL) {
- TclAllocateFreeObjects();
- }
- objPtr = tclFreeObjList;
- tclFreeObjList = (Tcl_Obj *) tclFreeObjList->internalRep.otherValuePtr;
-
- objPtr->refCount = 0;
- objPtr->bytes = tclEmptyStringRep;
- objPtr->length = 0;
- objPtr->typePtr = NULL;
-#ifdef TCL_COMPILE_STATS
- tclObjsAlloced++;
-#endif /* TCL_COMPILE_STATS */
- Tcl_MutexUnlock(&tclObjMutex);
+ TclNewObj(objPtr);
return objPtr;
}
#endif /* TCL_MEM_DEBUG */
@@ -437,7 +535,7 @@ Tcl_NewObj()
* empty string. It is the same as the Tcl_NewObj procedure above
* except that it calls Tcl_DbCkalloc directly with the file name and
* line number from its caller. This simplifies debugging since then
- * the checkmem command will report the correct file name and line
+ * 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
@@ -458,7 +556,7 @@ Tcl_NewObj()
Tcl_Obj *
Tcl_DbNewObj(file, line)
- register char *file; /* The name of the source file calling this
+ 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 debugging. */
@@ -466,29 +564,18 @@ Tcl_DbNewObj(file, line)
register Tcl_Obj *objPtr;
/*
- * If debugging Tcl's memory usage, allocate the object using ckalloc.
- * Otherwise, allocate it using the list of free Tcl_Obj structs we
- * maintain.
+ * Use the macro defined in tclInt.h - it will use the
+ * correct allocator.
*/
- objPtr = (Tcl_Obj *) Tcl_DbCkalloc(sizeof(Tcl_Obj), file, line);
- objPtr->refCount = 0;
- objPtr->bytes = tclEmptyStringRep;
- objPtr->length = 0;
- objPtr->typePtr = NULL;
-#ifdef TCL_COMPILE_STATS
- Tcl_MutexLock(&tclObjMutex);
- tclObjsAlloced++;
- Tcl_MutexUnlock(&tclObjMutex);
-#endif /* TCL_COMPILE_STATS */
+ TclDbNewObj(objPtr, file, line);
return objPtr;
}
-
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
Tcl_DbNewObj(file, line)
- 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 debugging. */
@@ -523,23 +610,27 @@ Tcl_DbNewObj(file, line)
void
TclAllocateFreeObjects()
{
- Tcl_Obj tmp[2];
- size_t objSizePlusPadding = /* NB: this assumes byte addressing. */
- ((int)(&(tmp[1])) - (int)(&(tmp[0])));
- size_t bytesToAlloc = (OBJS_TO_ALLOC_EACH_TIME * objSizePlusPadding);
+ size_t bytesToAlloc = (OBJS_TO_ALLOC_EACH_TIME * sizeof(Tcl_Obj));
char *basePtr;
register Tcl_Obj *prevPtr, *objPtr;
register int i;
+ /*
+ * 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. These never do get freed properly.
+ */
+
basePtr = (char *) ckalloc(bytesToAlloc);
memset(basePtr, 0, bytesToAlloc);
prevPtr = NULL;
objPtr = (Tcl_Obj *) basePtr;
- for (i = 0; i < OBJS_TO_ALLOC_EACH_TIME; i++) {
+ for (i = 0; i < OBJS_TO_ALLOC_EACH_TIME; i++) {
objPtr->internalRep.otherValuePtr = (VOID *) prevPtr;
prevPtr = objPtr;
- objPtr = (Tcl_Obj *) (((char *)objPtr) + objSizePlusPadding);
+ objPtr++;
}
tclFreeObjList = prevPtr;
}
@@ -593,18 +684,22 @@ TclFreeObj(objPtr)
* Tcl_Obj structs we maintain.
*/
+#if defined(TCL_MEM_DEBUG) || defined(PURIFY)
Tcl_MutexLock(&tclObjMutex);
-#ifdef TCL_MEM_DEBUG
ckfree((char *) objPtr);
-#else
+ Tcl_MutexUnlock(&tclObjMutex);
+#elif defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
+ TclThreadFreeObj(objPtr);
+#else
+ Tcl_MutexLock(&tclObjMutex);
objPtr->internalRep.otherValuePtr = (VOID *) tclFreeObjList;
tclFreeObjList = objPtr;
+ Tcl_MutexUnlock(&tclObjMutex);
#endif /* TCL_MEM_DEBUG */
#ifdef TCL_COMPILE_STATS
tclObjsFreed++;
#endif /* TCL_COMPILE_STATS */
- Tcl_MutexUnlock(&tclObjMutex);
}
/*
@@ -648,15 +743,7 @@ Tcl_DuplicateObj(objPtr)
if (objPtr->bytes == NULL) {
dupPtr->bytes = NULL;
} else if (objPtr->bytes != tclEmptyStringRep) {
- int len = objPtr->length;
-
- dupPtr->bytes = (char *) ckalloc((unsigned) len+1);
- if (len > 0) {
- memcpy((VOID *) dupPtr->bytes, (VOID *) objPtr->bytes,
- (unsigned) len);
- }
- dupPtr->bytes[len] = '\0';
- dupPtr->length = len;
+ TclInitStringRep(dupPtr, objPtr->bytes, objPtr->length);
}
if (typePtr != NULL) {
@@ -733,24 +820,20 @@ Tcl_GetString(objPtr)
char *
Tcl_GetStringFromObj(objPtr, lengthPtr)
- register Tcl_Obj *objPtr; /* Object whose string rep byte pointer
- * should be returned. */
- 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. */
+ register Tcl_Obj *objPtr; /* Object whose string rep byte pointer should
+ * be returned. */
+ 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 (lengthPtr != NULL) {
- *lengthPtr = objPtr->length;
+ if (objPtr->bytes == NULL) {
+ if (objPtr->typePtr->updateStringProc == NULL) {
+ panic("UpdateStringProc should not be invoked for type %s",
+ objPtr->typePtr->name);
}
- return objPtr->bytes;
+ (*objPtr->typePtr->updateStringProc)(objPtr);
}
- if (objPtr->typePtr->updateStringProc == NULL) {
- panic("UpdateStringProc should not be invoked for type %s",
- objPtr->typePtr->name);
- }
- (*objPtr->typePtr->updateStringProc)(objPtr);
if (lengthPtr != NULL) {
*lengthPtr = objPtr->length;
}
@@ -847,9 +930,9 @@ Tcl_NewBooleanObj(boolValue)
* TCL_MEM_DEBUG is defined. It creates new boolean objects. It is the
* same as the Tcl_NewBooleanObj procedure above except that it calls
* Tcl_DbCkalloc directly with the file name and line number from its
- * caller. This simplifies debugging since then the checkmem command
- * will report the correct file name and line number when reporting
- * objects that haven't been freed.
+ * 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
* result of calling Tcl_NewBooleanObj.
@@ -869,7 +952,7 @@ Tcl_NewBooleanObj(boolValue)
Tcl_Obj *
Tcl_DbNewBooleanObj(boolValue, file, line)
register int boolValue; /* Boolean used to initialize new object. */
- 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 debugging. */
@@ -889,7 +972,7 @@ Tcl_DbNewBooleanObj(boolValue, file, line)
Tcl_Obj *
Tcl_DbNewBooleanObj(boolValue, file, line)
register int boolValue; /* Boolean used to initialize new object. */
- 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 debugging. */
@@ -965,7 +1048,12 @@ Tcl_GetBooleanFromObj(interp, objPtr, boolPtr)
{
register int result;
- result = SetBooleanFromAny(interp, objPtr);
+ if (objPtr->typePtr == &tclBooleanType) {
+ result = TCL_OK;
+ } else {
+ result = SetBooleanFromAny(interp, objPtr);
+ }
+
if (result == TCL_OK) {
*boolPtr = (int) objPtr->internalRep.longValue;
}
@@ -1003,88 +1091,142 @@ SetBooleanFromAny(interp, objPtr)
char lowerCase[10];
int newBool, length;
register int i;
- double dbl;
/*
* Get the string representation. Make it up-to-date if necessary.
*/
-
+
string = Tcl_GetStringFromObj(objPtr, &length);
/*
- * Copy the string converting its characters to lower case.
- */
-
- for (i = 0; (i < 9) && (i < length); i++) {
- c = string[i];
- /*
- * Weed out international characters so we can safely operate
- * on single bytes.
- */
-
- if (c & 0x80) {
- goto badBoolean;
- }
- if (Tcl_UniCharIsUpper(UCHAR(c))) {
- c = (char) Tcl_UniCharToLower(UCHAR(c));
- }
- lowerCase[i] = c;
- }
- lowerCase[i] = 0;
-
- /*
- * Parse the string as a boolean. We use an implementation here that
- * doesn't report errors in interp if interp is NULL.
+ * Use the obvious shortcuts for numerical values; if objPtr is not
+ * of numerical type, parse its string rep.
*/
-
- c = lowerCase[0];
- if ((c == '0') && (lowerCase[1] == '\0')) {
- newBool = 0;
- } else if ((c == '1') && (lowerCase[1] == '\0')) {
- newBool = 1;
- } else if ((c == 'y') && (strncmp(lowerCase, "yes", (size_t) length) == 0)) {
- newBool = 1;
- } else if ((c == 'n') && (strncmp(lowerCase, "no", (size_t) length) == 0)) {
- newBool = 0;
- } else if ((c == 't') && (strncmp(lowerCase, "true", (size_t) length) == 0)) {
- newBool = 1;
- } else if ((c == 'f') && (strncmp(lowerCase, "false", (size_t) length) == 0)) {
- newBool = 0;
- } else if ((c == 'o') && (length >= 2)) {
- if (strncmp(lowerCase, "on", (size_t) length) == 0) {
- newBool = 1;
- } else if (strncmp(lowerCase, "off", (size_t) length) == 0) {
- newBool = 0;
- } else {
- goto badBoolean;
- }
+
+ if (objPtr->typePtr == &tclIntType) {
+ newBool = (objPtr->internalRep.longValue != 0);
+ } else if (objPtr->typePtr == &tclDoubleType) {
+ newBool = (objPtr->internalRep.doubleValue != 0.0);
+#ifndef TCL_WIDE_INT_IS_LONG
+ } else if (objPtr->typePtr == &tclWideIntType) {
+ newBool = (objPtr->internalRep.wideValue != Tcl_LongAsWide(0));
+#endif /* TCL_WIDE_INT_IS_LONG */
} else {
- /*
- * Still might be a string containing the characters representing an
- * int or double that wasn't handled above. This would be a string
- * like "27" or "1.0" that is non-zero and not "1". Such a string
- * whould result in the boolean value true. We try converting to
- * double. If that succeeds and the resulting double is non-zero, we
- * have a "true". Note that numbers can't have embedded NULLs.
+ /*
+ * Copy the string converting its characters to lower case.
*/
-
- dbl = strtod(string, &end);
- if (end == string) {
- goto badBoolean;
+
+ for (i = 0; (i < 9) && (i < length); i++) {
+ c = string[i];
+ /*
+ * Weed out international characters so we can safely operate
+ * on single bytes.
+ */
+
+ if (c & 0x80) {
+ goto badBoolean;
+ }
+ if (Tcl_UniCharIsUpper(UCHAR(c))) {
+ c = (char) Tcl_UniCharToLower(UCHAR(c));
+ }
+ lowerCase[i] = c;
}
-
+ lowerCase[i] = 0;
+
/*
- * Make sure the string has no garbage after the end of the double.
+ * Parse the string as a boolean. We use an implementation here that
+ * doesn't report errors in interp if interp is NULL.
*/
- while ((end < (string+length))
- && isspace(UCHAR(*end))) { /* INTL: ISO only */
- end++;
- }
- if (end != (string+length)) {
- goto badBoolean;
+ c = lowerCase[0];
+ if ((c == '0') && (lowerCase[1] == '\0')) {
+ newBool = 0;
+ } else if ((c == '1') && (lowerCase[1] == '\0')) {
+ newBool = 1;
+ } else if ((c == 'y') && (strncmp(lowerCase, "yes", (size_t) length) == 0)) {
+ newBool = 1;
+ } else if ((c == 'n') && (strncmp(lowerCase, "no", (size_t) length) == 0)) {
+ newBool = 0;
+ } else if ((c == 't') && (strncmp(lowerCase, "true", (size_t) length) == 0)) {
+ newBool = 1;
+ } else if ((c == 'f') && (strncmp(lowerCase, "false", (size_t) length) == 0)) {
+ newBool = 0;
+ } else if ((c == 'o') && (length >= 2)) {
+ if (strncmp(lowerCase, "on", (size_t) length) == 0) {
+ newBool = 1;
+ } else if (strncmp(lowerCase, "off", (size_t) length) == 0) {
+ newBool = 0;
+ } else {
+ goto badBoolean;
+ }
+ } else {
+ double dbl;
+ /*
+ * Boolean values can be extracted from ints or doubles. Note
+ * that we don't use strtoul or strtoull here because we don't
+ * care about what the value is, just whether it is equal to
+ * zero or not.
+ */
+#ifdef TCL_WIDE_INT_IS_LONG
+ newBool = strtol(string, &end, 0);
+ if (end != string) {
+ /*
+ * Make sure the string has no garbage after the end of
+ * the int.
+ */
+ while ((end < (string+length))
+ && isspace(UCHAR(*end))) { /* INTL: ISO only */
+ end++;
+ }
+ if (end == (string+length)) {
+ newBool = (newBool != 0);
+ goto goodBoolean;
+ }
+ }
+#else /* !TCL_WIDE_INT_IS_LONG */
+ Tcl_WideInt wide = strtoll(string, &end, 0);
+ if (end != string) {
+ /*
+ * Make sure the string has no garbage after the end of
+ * the wide int.
+ */
+ while ((end < (string+length))
+ && isspace(UCHAR(*end))) { /* INTL: ISO only */
+ end++;
+ }
+ if (end == (string+length)) {
+ newBool = (wide != Tcl_LongAsWide(0));
+ goto goodBoolean;
+ }
+ }
+#endif /* TCL_WIDE_INT_IS_LONG */
+ /*
+ * Still might be a string containing the characters representing an
+ * int or double that wasn't handled above. This would be a string
+ * like "27" or "1.0" that is non-zero and not "1". Such a string
+ * would result in the boolean value true. We try converting to
+ * double. If that succeeds and the resulting double is non-zero, we
+ * have a "true". Note that numbers can't have embedded NULLs.
+ */
+
+ dbl = strtod(string, &end);
+ if (end == string) {
+ goto badBoolean;
+ }
+
+ /*
+ * Make sure the string has no garbage after the end of the double.
+ */
+
+ while ((end < (string+length))
+ && isspace(UCHAR(*end))) { /* INTL: ISO only */
+ end++;
+ }
+ if (end != (string+length)) {
+ goto badBoolean;
+ }
+ newBool = (dbl != 0.0);
}
- newBool = (dbl != 0.0);
}
/*
@@ -1093,6 +1235,7 @@ SetBooleanFromAny(interp, objPtr)
* Tcl_GetStringFromObj, to use that old internalRep.
*/
+ goodBoolean:
if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
oldTypePtr->freeIntRepProc(objPtr);
}
@@ -1205,9 +1348,9 @@ Tcl_NewDoubleObj(dblValue)
* TCL_MEM_DEBUG is defined. It creates new double objects. It is the
* same as the Tcl_NewDoubleObj procedure above except that it calls
* Tcl_DbCkalloc directly with the file name and line number from its
- * caller. This simplifies debugging since then the checkmem command
- * will report the correct file name and line number when reporting
- * objects that haven't been freed.
+ * 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
* result of calling Tcl_NewDoubleObj.
@@ -1227,7 +1370,7 @@ Tcl_NewDoubleObj(dblValue)
Tcl_Obj *
Tcl_DbNewDoubleObj(dblValue, file, line)
register double dblValue; /* Double used to initialize the object. */
- 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 debugging. */
@@ -1247,7 +1390,7 @@ Tcl_DbNewDoubleObj(dblValue, file, line)
Tcl_Obj *
Tcl_DbNewDoubleObj(dblValue, file, line)
register double dblValue; /* Double used to initialize the object. */
- 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 debugging. */
@@ -1836,8 +1979,8 @@ Tcl_NewLongObj(longValue)
* When the core is compiled with TCL_MEM_DEBUG defined,
* Tcl_DbNewLongObj calls Tcl_DbCkalloc directly with the file name and
* line number from its caller. This simplifies debugging since then
- * the checkmem command will report the caller's file name and line
- * number when reporting objects that haven't been freed.
+ * the [memory active] command will report the caller's file name and
+ * line 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_NewLongObj.
@@ -1859,7 +2002,7 @@ Tcl_Obj *
Tcl_DbNewLongObj(longValue, file, line)
register long longValue; /* Long integer used to initialize the
* new object. */
- 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 debugging. */
@@ -1880,7 +2023,7 @@ Tcl_Obj *
Tcl_DbNewLongObj(longValue, file, line)
register long longValue; /* Long integer used to initialize the
* new object. */
- 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 debugging. */
@@ -1971,6 +2114,380 @@ Tcl_GetLongFromObj(interp, objPtr, longPtr)
/*
*----------------------------------------------------------------------
*
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifndef TCL_WIDE_INT_IS_LONG
+static int
+SetWideIntFromAny(interp, objPtr)
+ Tcl_Interp *interp; /* Used for error reporting if not NULL. */
+ register Tcl_Obj *objPtr; /* The object to convert. */
+{
+ Tcl_ObjType *oldTypePtr = objPtr->typePtr;
+ char *string, *end;
+ int length;
+ register char *p;
+ Tcl_WideInt newWide;
+
+ /*
+ * Get the string representation. Make it up-to-date if necessary.
+ */
+
+ 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, but don't depend on strtoull to handle sign
+ * characters; it won't in some implementations.
+ */
+
+ errno = 0;
+ for (p = string; isspace(UCHAR(*p)); p++) { /* INTL: ISO space. */
+ /* Empty loop body. */
+ }
+ if (*p == '-') {
+ p++;
+ newWide = -((Tcl_WideInt)strtoull(p, &end, 0));
+ } else if (*p == '+') {
+ p++;
+ newWide = strtoull(p, &end, 0);
+ } else {
+ newWide = strtoull(p, &end, 0);
+ }
+ if (end == p) {
+ badInteger:
+ if (interp != NULL) {
+ /*
+ * Must copy string before resetting the result in case a caller
+ * is trying to convert the interpreter's result to an int.
+ */
+
+ char buf[100];
+ sprintf(buf, "expected integer but got \"%.50s\"", string);
+ Tcl_ResetResult(interp);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
+ TclCheckBadOctal(interp, string);
+ }
+ return TCL_ERROR;
+ }
+ if (errno == ERANGE) {
+ if (interp != NULL) {
+ char *s = "integer value too large to represent";
+ Tcl_ResetResult(interp);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
+ Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, (char *) NULL);
+ }
+ 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;
+ }
+
+ /*
+ * 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.
+ */
+
+ if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
+ oldTypePtr->freeIntRepProc(objPtr);
+ }
+
+ objPtr->internalRep.wideValue = newWide;
+ objPtr->typePtr = &tclWideIntType;
+ return TCL_OK;
+}
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The object's string is set to a valid string that results from
+ * the wideInt-to-string conversion.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifndef TCL_WIDE_INT_IS_LONG
+static void
+UpdateStringOfWideInt(objPtr)
+ register Tcl_Obj *objPtr; /* Int object whose string rep to update. */
+{
+ char buffer[TCL_INTEGER_SPACE+2];
+ register unsigned len;
+ register Tcl_WideInt wideVal = objPtr->internalRep.wideValue;
+
+ sprintf(buffer, "%" TCL_LL_MODIFIER "d", wideVal);
+ len = strlen(buffer);
+ objPtr->bytes = ckalloc((unsigned) len + 1);
+ memcpy(objPtr->bytes, buffer, len + 1);
+ objPtr->length = len;
+}
+#endif /* TCL_WIDE_INT_IS_LONG */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_NewWideIntObj --
+ *
+ * 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.
+ *
+ * Otherwise, if the client is compiled without TCL_MEM_DEBUG defined,
+ * calls to Tcl_NewWideIntObj result in a call to one of the two
+ * Tcl_NewWideIntObj implementations below. We provide two implementations
+ * so that the Tcl core can be compiled to do memory debugging of the
+ * core even if a client does not request it for itself.
+ *
+ * Results:
+ * The newly created object is returned. This object will have an
+ * invalid string representation. The returned object has ref count 0.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TCL_MEM_DEBUG
+#undef Tcl_NewWideIntObj
+
+Tcl_Obj *
+Tcl_NewWideIntObj(wideValue)
+ register Tcl_WideInt wideValue; /* Wide integer used to initialize
+ * the new object. */
+{
+ return Tcl_DbNewWideIntObj(wideValue, "unknown", 0);
+}
+
+#else /* if not TCL_MEM_DEBUG */
+
+Tcl_Obj *
+Tcl_NewWideIntObj(wideValue)
+ register Tcl_WideInt wideValue; /* Wide integer used to initialize
+ * the new object. */
+{
+#ifdef TCL_WIDE_INT_IS_LONG
+ return Tcl_NewLongObj(wideValue);
+#else
+ register Tcl_Obj *objPtr;
+
+ TclNewObj(objPtr);
+ objPtr->bytes = NULL;
+
+ objPtr->internalRep.wideValue = wideValue;
+ objPtr->typePtr = &tclWideIntType;
+ return objPtr;
+#endif /* TCL_WIDE_INT_IS_LONG */
+}
+#endif /* if TCL_MEM_DEBUG */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DbNewWideIntObj --
+ *
+ * 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 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.
+ *
+ * When the core is compiled with TCL_MEM_DEBUG defined,
+ * Tcl_DbNewWideIntObj calls Tcl_DbCkalloc directly with the file
+ * name and line number from its caller. This simplifies
+ * debugging since then the checkmem command will report the
+ * caller's file name and line 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.
+ *
+ * Results:
+ * The newly created wide integer object is returned. This object
+ * will have an invalid string representation. The returned object has
+ * ref count 0.
+ *
+ * Side effects:
+ * Allocates memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#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. */
+{
+#ifdef TCL_WIDE_INT_IS_LONG
+ return Tcl_DbNewLongObj(wideValue, file, line);
+#else
+ register Tcl_Obj *objPtr;
+
+ TclDbNewObj(objPtr, file, line);
+ objPtr->bytes = NULL;
+
+ objPtr->internalRep.wideValue = wideValue;
+ objPtr->typePtr = &tclWideIntType;
+ return objPtr;
+#endif
+}
+
+#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. */
+{
+ return Tcl_NewWideIntObj(wideValue);
+}
+#endif /* TCL_MEM_DEBUG */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetWideIntObj --
+ *
+ * Modify an object to be a wide integer object and to have the
+ * specified wide integer value.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The object's old string rep, if any, is freed. Also, any old
+ * internal rep is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+{
+#ifdef TCL_WIDE_INT_IS_LONG
+ Tcl_SetLongObj(objPtr, wideValue);
+#else
+ register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
+
+ if (Tcl_IsShared(objPtr)) {
+ panic("Tcl_SetWideIntObj called with shared object");
+ }
+
+ if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
+ oldTypePtr->freeIntRepProc(objPtr);
+ }
+
+ objPtr->internalRep.wideValue = wideValue;
+ objPtr->typePtr = &tclWideIntType;
+ Tcl_InvalidateStringRep(objPtr);
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetWideIntFromObj --
+ *
+ * Attempt to return a wide integer from the Tcl object "objPtr". If
+ * the object is not already a wide int object, an attempt will be made
+ * to convert it to one.
+ *
+ * Results:
+ * The return value is a standard Tcl object result. If an error occurs
+ * during conversion, an error message is left in the interpreter's
+ * result unless "interp" is NULL.
+ *
+ * Side effects:
+ * If the object is not already an int object, the conversion will free
+ * any old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+{
+#ifdef TCL_WIDE_INT_IS_LONG
+ /*
+ * Next line is type-safe because we only do this when long = Tcl_WideInt
+ */
+ return Tcl_GetLongFromObj(interp, objPtr, wideIntPtr);
+#else
+ register int result;
+
+ 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;
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_DbIncrRefCount --
*
* This procedure is normally called when debugging: i.e., when
@@ -1993,7 +2510,7 @@ void
Tcl_DbIncrRefCount(objPtr, file, line)
register Tcl_Obj *objPtr; /* The object we are registering a
* reference to. */
- 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 debugging. */
@@ -2033,7 +2550,7 @@ void
Tcl_DbDecrRefCount(objPtr, file, line)
register Tcl_Obj *objPtr; /* The object we are releasing a reference
* to. */
- 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 debugging. */
@@ -2074,7 +2591,7 @@ Tcl_DbDecrRefCount(objPtr, file, line)
int
Tcl_DbIsShared(objPtr, file, line)
register Tcl_Obj *objPtr; /* The object to test for being shared. */
- 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 debugging. */
@@ -2086,5 +2603,578 @@ Tcl_DbIsShared(objPtr, file, line)
panic("Trying to check whether previously disposed object is shared.");
}
#endif
+#ifdef TCL_COMPILE_STATS
+ Tcl_MutexLock(&tclObjMutex);
+ if ((objPtr)->refCount <= 1) {
+ tclObjsShared[1]++;
+ } else if ((objPtr)->refCount < TCL_MAX_SHARED_OBJ_STATS) {
+ tclObjsShared[(objPtr)->refCount]++;
+ } else {
+ tclObjsShared[0]++;
+ }
+ Tcl_MutexUnlock(&tclObjMutex);
+#endif
return ((objPtr)->refCount > 1);
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_InitObjHashTable --
+ *
+ * Given storage for a hash table, set up the fields to prepare
+ * the hash table for use, the keys are Tcl_Obj *.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * TablePtr is now ready to be passed to Tcl_FindHashEntry and
+ * Tcl_CreateHashEntry.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_InitObjHashTable(tablePtr)
+ register Tcl_HashTable *tablePtr; /* Pointer to table record, which
+ * is supplied by the caller. */
+{
+ Tcl_InitCustomHashTable(tablePtr, TCL_CUSTOM_PTR_KEYS,
+ &tclObjHashKeyType);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AllocObjEntry --
+ *
+ * Allocate space for a Tcl_HashEntry containing the Tcl_Obj * key.
+ *
+ * Results:
+ * The return value is a pointer to the created entry.
+ *
+ * Side effects:
+ * Increments the reference count on the object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_HashEntry *
+AllocObjEntry(tablePtr, keyPtr)
+ Tcl_HashTable *tablePtr; /* Hash table. */
+ VOID *keyPtr; /* Key to store in the hash table entry. */
+{
+ Tcl_Obj *objPtr = (Tcl_Obj *) keyPtr;
+ Tcl_HashEntry *hPtr;
+
+ hPtr = (Tcl_HashEntry *) ckalloc((unsigned) (sizeof(Tcl_HashEntry)));
+ hPtr->key.oneWordValue = (char *) objPtr;
+ Tcl_IncrRefCount (objPtr);
+
+ return hPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompareObjKeys --
+ *
+ * Compares two Tcl_Obj * keys.
+ *
+ * Results:
+ * The return value is 0 if they are different and 1 if they are
+ * the same.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CompareObjKeys(keyPtr, hPtr)
+ VOID *keyPtr; /* New key to compare. */
+ Tcl_HashEntry *hPtr; /* Existing key to compare. */
+{
+ Tcl_Obj *objPtr1 = (Tcl_Obj *) keyPtr;
+ Tcl_Obj *objPtr2 = (Tcl_Obj *) hPtr->key.oneWordValue;
+ 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 = Tcl_GetString (objPtr1);
+ l1 = objPtr1->length;
+ p2 = Tcl_GetString (objPtr2);
+ l2 = objPtr2->length;
+
+ /*
+ * Only compare if the string representations are of the same length.
+ */
+ if (l1 == l2) {
+ for (;; p1++, p2++, l1--) {
+ if (*p1 != *p2) {
+ break;
+ }
+ if (l1 == 0) {
+ return 1;
+ }
+ }
+ }
+
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeObjEntry --
+ *
+ * Frees space for a Tcl_HashEntry containing the Tcl_Obj * key.
+ *
+ * Results:
+ * The return value is a pointer to the created entry.
+ *
+ * Side effects:
+ * Decrements the reference count of the object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeObjEntry(hPtr)
+ Tcl_HashEntry *hPtr; /* Hash entry to free. */
+{
+ Tcl_Obj *objPtr = (Tcl_Obj *) hPtr->key.oneWordValue;
+
+ Tcl_DecrRefCount (objPtr);
+ ckfree ((char *) hPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * HashObjKey --
+ *
+ * Compute a one-word summary of the string representation of the
+ * Tcl_Obj, which can be used to generate a hash index.
+ *
+ * Results:
+ * The return value is a one-word summary of the information in
+ * the string representation of the Tcl_Obj.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static unsigned int
+HashObjKey(tablePtr, keyPtr)
+ Tcl_HashTable *tablePtr; /* Hash table. */
+ VOID *keyPtr; /* Key from which to compute hash value. */
+{
+ Tcl_Obj *objPtr = (Tcl_Obj *) keyPtr;
+ register CONST char *string;
+ register int length;
+ register unsigned int result;
+ register int c;
+
+ string = Tcl_GetString (objPtr);
+ length = objPtr->length;
+
+ /*
+ * 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 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.
+ */
+
+ result = 0;
+ while (length) {
+ c = *string;
+ string++;
+ length--;
+ if (length == 0) {
+ break;
+ }
+ result += (result<<3) + c;
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetCommandFromObj --
+ *
+ * Returns the command specified by the name in a Tcl_Obj.
+ *
+ * Results:
+ * Returns a token for the command if it is found. Otherwise, if it
+ * can't be found or there is an error, returns NULL.
+ *
+ * Side effects:
+ * May update the internal representation for the object, caching
+ * the command reference so that the next time this procedure 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
+ * command and to report errors. */
+ 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.
+ */
+
+ if (objPtr->typePtr != &tclCmdNameType) {
+ result = tclCmdNameType.setFromAnyProc(interp, objPtr);
+ if (result != TCL_OK) {
+ iPtr->varFramePtr = savedFramePtr;
+ return (Tcl_Command) NULL;
+ }
+ }
+ resPtr = (ResolvedCmdName *) objPtr->internalRep.otherValuePtr;
+
+ /*
+ * Get the current namespace.
+ */
+
+ if (iPtr->varFramePtr != NULL) {
+ currNsPtr = iPtr->varFramePtr->nsPtr;
+ } else {
+ currNsPtr = iPtr->globalNsPtr;
+ }
+
+ /*
+ * 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.
+ */
+
+ 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 (cmdPtr == NULL) {
+ result = tclCmdNameType.setFromAnyProc(interp, objPtr);
+ if (result != TCL_OK) {
+ iPtr->varFramePtr = savedFramePtr;
+ return (Tcl_Command) NULL;
+ }
+ resPtr = (ResolvedCmdName *) objPtr->internalRep.otherValuePtr;
+ if (resPtr != NULL) {
+ cmdPtr = resPtr->cmdPtr;
+ }
+ }
+ iPtr->varFramePtr = savedFramePtr;
+ return (Tcl_Command) cmdPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSetCmdNameObj --
+ *
+ * Modify an object to be an CmdName object that refers to the argument
+ * Command structure.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclSetCmdNameObj(interp, objPtr, cmdPtr)
+ 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 CmdName object. */
+ Command *cmdPtr; /* Points to Command structure that the
+ * CmdName object should refer to. */
+{
+ Interp *iPtr = (Interp *) interp;
+ register ResolvedCmdName *resPtr;
+ Tcl_ObjType *oldTypePtr = objPtr->typePtr;
+ register Namespace *currNsPtr;
+
+ if (oldTypePtr == &tclCmdNameType) {
+ return;
+ }
+
+ /*
+ * 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;
+
+ if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
+ oldTypePtr->freeIntRepProc(objPtr);
+ }
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) resPtr;
+ objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+ objPtr->typePtr = &tclCmdNameType;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeCmdNameInternalRep --
+ *
+ * Frees the resources associated with a cmdName object's internal
+ * representation.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Decrements the ref count of any cached ResolvedCmdName structure
+ * pointed to by the cmdName's internal representation. If this is
+ * the last use of the ResolvedCmdName, it is freed. This in turn
+ * decrements the ref count of the Command structure pointed to by
+ * the ResolvedSymbol, which may free the Command structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeCmdNameInternalRep(objPtr)
+ register Tcl_Obj *objPtr; /* CmdName object with internal
+ * representation to free. */
+{
+ register ResolvedCmdName *resPtr =
+ (ResolvedCmdName *) objPtr->internalRep.otherValuePtr;
+
+ if (resPtr != NULL) {
+ /*
+ * Decrement the reference count of the ResolvedCmdName structure.
+ * If there are no more uses, free the ResolvedCmdName structure.
+ */
+
+ resPtr->refCount--;
+ if (resPtr->refCount == 0) {
+ /*
+ * Now free the cached command, unless it is still in its
+ * hash table or if there are other references to it
+ * from other cmdName objects.
+ */
+
+ Command *cmdPtr = resPtr->cmdPtr;
+ TclCleanupCommand(cmdPtr);
+ ckfree((char *) resPtr);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupCmdNameInternalRep --
+ *
+ * Initialize the internal representation of an cmdName Tcl_Obj to a
+ * copy of the internal representation of an existing cmdName object.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * "copyPtr"s internal rep is set to point to the ResolvedCmdName
+ * structure corresponding to "srcPtr"s internal rep. Increments the
+ * ref count of the ResolvedCmdName structure pointed to by the
+ * cmdName's internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupCmdNameInternalRep(srcPtr, copyPtr)
+ 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.otherValuePtr;
+
+ copyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) resPtr;
+ copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
+ if (resPtr != NULL) {
+ resPtr->refCount++;
+ }
+ copyPtr->typePtr = &tclCmdNameType;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetCmdNameFromAny --
+ *
+ * Generate an cmdName internal form for the Tcl object "objPtr".
+ *
+ * Results:
+ * The return value is a standard Tcl result. The conversion always
+ * succeeds and TCL_OK is returned.
+ *
+ * Side effects:
+ * A pointer to a ResolvedCmdName structure that holds a cached pointer
+ * to the command with a name that matches objPtr's string rep is
+ * stored as objPtr's internal representation. This ResolvedCmdName
+ * pointer will be NULL if no matching command was found. The ref count
+ * of the cached Command's structure (if any) is also incremented.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetCmdNameFromAny(interp, objPtr)
+ 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;
+ 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);
+ }
+
+ /*
+ * Find the Command structure, if any, that describes the command called
+ * "name". Build a ResolvedCmdName that holds a cached pointer to this
+ * Command, and bump the reference count in the referenced Command
+ * structure. A Command structure will not be deleted as long as it is
+ * 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.
+ */
+
+ 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;
+ } else {
+ resPtr = NULL; /* no command named "name" was found */
+ }
+
+ /*
+ * 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.
+ */
+
+ if ((objPtr->typePtr != NULL)
+ && (objPtr->typePtr->freeIntRepProc != NULL)) {
+ objPtr->typePtr->freeIntRepProc(objPtr);
+ }
+
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) resPtr;
+ objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+ objPtr->typePtr = &tclCmdNameType;
+ return TCL_OK;
+}
diff --git a/tcl/generic/tclPanic.c b/tcl/generic/tclPanic.c
index 4e8cc1e2365..4f446b329cf 100644
--- a/tcl/generic/tclPanic.c
+++ b/tcl/generic/tclPanic.c
@@ -2,8 +2,8 @@
* tclPanic.c --
*
* Source code for the "Tcl_Panic" library procedure for Tcl;
- * individual applications will probably override this with
- * an application-specific panic procedure.
+ * individual applications will probably call Tcl_SetPanicProc()
+ * to set an application-specific panic procedure.
*
* Copyright (c) 1988-1993 The Regents of the University of California.
* Copyright (c) 1994 Sun Microsystems, Inc.
@@ -16,13 +16,23 @@
*/
#include "tclInt.h"
+#include "tclPort.h"
/*
* The panicProc variable contains a pointer to an application
* specific panic procedure.
*/
-void (*panicProc) _ANSI_ARGS_(TCL_VARARGS(char *,format)) = NULL;
+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;
+
/*
*----------------------------------------------------------------------
@@ -42,7 +52,7 @@ void (*panicProc) _ANSI_ARGS_(TCL_VARARGS(char *,format)) = NULL;
void
Tcl_SetPanicProc(proc)
- void (*proc) _ANSI_ARGS_(TCL_VARARGS(char *,format));
+ Tcl_PanicProc *proc;
{
panicProc = proc;
}
@@ -65,7 +75,7 @@ Tcl_SetPanicProc(proc)
void
Tcl_PanicVA (format, argList)
- char *format; /* Format string, suitable for passing to
+ CONST char *format; /* Format string, suitable for passing to
* fprintf. */
va_list argList; /* Variable argument list. */
{
@@ -85,6 +95,9 @@ Tcl_PanicVA (format, argList)
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);
} else {
(void) fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5, arg6,
arg7, arg8);
@@ -97,7 +110,7 @@ Tcl_PanicVA (format, argList)
/*
*----------------------------------------------------------------------
*
- * panic --
+ * Tcl_Panic --
*
* Print an error message and kill the process.
*
@@ -112,12 +125,12 @@ Tcl_PanicVA (format, argList)
/* VARARGS ARGSUSED */
void
-panic TCL_VARARGS_DEF(char *,arg1)
+Tcl_Panic TCL_VARARGS_DEF(CONST char *,arg1)
{
va_list argList;
- char *format;
+ CONST char *format;
- format = TCL_VARARGS_START(char *,arg1,argList);
+ format = TCL_VARARGS_START(CONST char *,arg1,argList);
Tcl_PanicVA(format, argList);
va_end (argList);
}
diff --git a/tcl/generic/tclParse.c b/tcl/generic/tclParse.c
index 1422cd02336..c39f8f57156 100644
--- a/tcl/generic/tclParse.c
+++ b/tcl/generic/tclParse.c
@@ -4,12 +4,11 @@
* This file contains procedures that parse Tcl scripts. They
* do so in a general-purpose fashion that can be used for many
* different purposes, including compilation, direct execution,
- * code analysis, etc. This file also includes a few additional
- * procedures such as Tcl_EvalObjv, Tcl_Eval, and Tcl_EvalEx, which
- * allow scripts to be evaluated directly, without compiling.
+ * code analysis, etc.
*
* Copyright (c) 1997 Sun Microsystems, Inc.
- * Copyright (c) 1998 by Scriptics Corporation.
+ * Copyright (c) 1998-2000 Ajuba Solutions.
+ * 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.
@@ -33,32 +32,32 @@
* information about its character argument. The following return
* values are defined.
*
- * TYPE_NORMAL - All characters that don't have special significance
- * to the Tcl parser.
- * TYPE_SPACE - The character is a whitespace character other
- * than newline.
- * TYPE_COMMAND_END - Character is newline or semicolon.
- * TYPE_SUBS - Character begins a substitution or has other
- * special meaning in ParseTokens: backslash, dollar
- * sign, open bracket, or null.
- * TYPE_QUOTE - Character is a double quote.
- * TYPE_CLOSE_PAREN - Character is a right parenthesis.
- * TYPE_CLOSE_BRACK - Character is a right square bracket.
- * TYPE_BRACE - Character is a curly brace (either left or right).
+ * TYPE_NORMAL - All characters that don't have special significance
+ * to the Tcl parser.
+ * TYPE_SPACE - The character is a whitespace character other
+ * than newline.
+ * TYPE_COMMAND_END - Character is newline or semicolon.
+ * TYPE_SUBS - Character begins a substitution or has other
+ * special meaning in ParseTokens: backslash, dollar
+ * sign, or open bracket.
+ * TYPE_QUOTE - Character is a double quote.
+ * TYPE_CLOSE_PAREN - Character is a right parenthesis.
+ * TYPE_CLOSE_BRACK - Character is a right square bracket.
+ * 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 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) (typeTable+128)[(int)(c)]
+#define CHAR_TYPE(c) (charTypeTable+128)[(int)(c)]
-char typeTable[] = {
+static CONST char charTypeTable[] = {
/*
* Negative character values, from -128 to -1:
*/
@@ -175,14 +174,13 @@ char typeTable[] = {
* Prototypes for local procedures defined in this file:
*/
-static int CommandComplete _ANSI_ARGS_((char *script,
- int length));
-static int ParseTokens _ANSI_ARGS_((char *src, int mask,
+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 EvalObjv _ANSI_ARGS_((Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[], char *command, int length,
- int flags));
-
+static int ParseTokens _ANSI_ARGS_((CONST char *src, int numBytes,
+ int mask, Tcl_Parse *parsePtr));
+
/*
*----------------------------------------------------------------------
*
@@ -214,14 +212,9 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
Tcl_Interp *interp; /* Interpreter to use for error reporting;
* if NULL, then no error message is
* provided. */
- char *string; /* First character of string containing
- * one or more Tcl commands. The string
- * must be in writable memory and must
- * have one additional byte of space at
- * string[length] where we can
- * temporarily store a 0 sentinel
- * character. */
- int numBytes; /* Total number of bytes in string. If < 0,
+ CONST char *string; /* First character of string containing
+ * one or more Tcl commands. */
+ 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:
@@ -234,21 +227,25 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
* information in the structure is
* ignored. */
{
- register char *src; /* Points to current character
+ register CONST char *src; /* Points to current character
* in the command. */
- int type; /* Result returned by CHAR_TYPE(*src). */
+ 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. */
- char utfBytes[TCL_UTF_MAX]; /* Holds result of backslash substitution. */
int terminators; /* CHAR_TYPE bits that indicate the end
* of a command. */
- char *termPtr; /* Set by Tcl_ParseBraces/QuotedString to
+ CONST char *termPtr; /* Set by Tcl_ParseBraces/QuotedString to
* point to char after terminating one. */
- int length, savedChar;
-
-
+ int scanned;
+
+ if ((string == NULL) && (numBytes>0)) {
+ if (interp != NULL) {
+ Tcl_SetResult(interp, "can't parse a NULL pointer", TCL_STATIC);
+ }
+ return TCL_ERROR;
+ }
if (numBytes < 0) {
- numBytes = (string? strlen(string) : 0);
+ numBytes = strlen(string);
}
parsePtr->commentStart = NULL;
parsePtr->commentSize = 0;
@@ -271,66 +268,15 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
}
/*
- * Temporarily overwrite the character just after the end of the
- * string with a 0 byte. This acts as a sentinel and reduces the
- * number of places where we have to check for the end of the
- * input string. The original value of the byte is restored at
- * the end of the parse.
- */
-
- savedChar = string[numBytes];
- if (savedChar != 0) {
- string[numBytes] = 0;
- }
-
- /*
* Parse any leading space and comments before the first word of the
* command.
*/
- src = string;
- while (1) {
- while ((CHAR_TYPE(*src) == TYPE_SPACE) || (*src == '\n')) {
- src++;
- }
- if ((*src == '\\') && (src[1] == '\n')) {
- /*
- * Skip backslash-newline sequence: it should be treated
- * just like white space.
- */
-
- if ((src + 2) == parsePtr->end) {
- parsePtr->incomplete = 1;
- }
- src += 2;
- continue;
- }
- if (*src != '#') {
- break;
- }
- if (parsePtr->commentStart == NULL) {
- parsePtr->commentStart = src;
- }
- while (1) {
- if (src == parsePtr->end) {
- if (nested) {
- parsePtr->incomplete = nested;
- }
- parsePtr->commentSize = src - parsePtr->commentStart;
- break;
- } else if (*src == '\\') {
- if ((src[1] == '\n') && ((src + 2) == parsePtr->end)) {
- parsePtr->incomplete = 1;
- }
- Tcl_UtfBackslash(src, &length, utfBytes);
- src += length;
- } else if (*src == '\n') {
- src++;
- parsePtr->commentSize = src - parsePtr->commentStart;
- break;
- } else {
- src++;
- }
+ scanned = ParseComment(string, numBytes, parsePtr);
+ src = (string + scanned); numBytes -= scanned;
+ if (numBytes == 0) {
+ if (nested) {
+ parsePtr->incomplete = nested;
}
}
@@ -357,19 +303,9 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
* sequence: it should be treated just like white space.
*/
- while (1) {
- type = CHAR_TYPE(*src);
- if (type == TYPE_SPACE) {
- src++;
- continue;
- } else if ((*src == '\\') && (src[1] == '\n')) {
- if ((src + 2) == parsePtr->end) {
- parsePtr->incomplete = 1;
- }
- Tcl_UtfBackslash(src, &length, utfBytes);
- src += length;
- continue;
- }
+ scanned = TclParseWhiteSpace(src, numBytes, parsePtr, &type);
+ src += scanned; numBytes -= scanned;
+ if (numBytes == 0) {
break;
}
if ((type & terminators) != 0) {
@@ -377,9 +313,6 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
src++;
break;
}
- if (src == parsePtr->end) {
- break;
- }
tokenPtr->start = src;
parsePtr->numTokens++;
parsePtr->numWords++;
@@ -391,28 +324,28 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
*/
if (*src == '"') {
- if (Tcl_ParseQuotedString(interp, src, (parsePtr->end - src),
- parsePtr, 1, &termPtr) != TCL_OK) {
+ if (Tcl_ParseQuotedString(interp, src, numBytes,
+ parsePtr, 1, &termPtr) != TCL_OK) {
goto error;
}
- src = termPtr;
+ src = termPtr; numBytes = parsePtr->end - src;
} else if (*src == '{') {
- if (Tcl_ParseBraces(interp, src, (parsePtr->end - src),
- parsePtr, 1, &termPtr) != TCL_OK) {
+ if (Tcl_ParseBraces(interp, src, numBytes,
+ parsePtr, 1, &termPtr) != TCL_OK) {
goto error;
}
- src = termPtr;
+ src = termPtr; numBytes = parsePtr->end - src;
} else {
/*
* This is an unquoted word. Call ParseTokens and let it do
* all of the work.
*/
- if (ParseTokens(src, TYPE_SPACE|terminators,
+ if (ParseTokens(src, numBytes, TYPE_SPACE|terminators,
parsePtr) != TCL_OK) {
goto error;
}
- src = parsePtr->term;
+ src = parsePtr->term; numBytes = parsePtr->end - src;
}
/*
@@ -436,32 +369,18 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
* command.
*/
- type = CHAR_TYPE(*src);
- if (type == TYPE_SPACE) {
- src++;
+ scanned = TclParseWhiteSpace(src, numBytes, parsePtr, &type);
+ if (scanned) {
+ src += scanned; numBytes -= scanned;
continue;
- } else {
- /*
- * Backslash-newline (and any following white space) must be
- * treated as if it were a space character.
- */
-
- if ((*src == '\\') && (src[1] == '\n')) {
- if ((src + 2) == parsePtr->end) {
- parsePtr->incomplete = 1;
- }
- Tcl_UtfBackslash(src, &length, utfBytes);
- src += length;
- continue;
- }
}
- if ((type & terminators) != 0) {
- parsePtr->term = src;
- src++;
+ if (numBytes == 0) {
break;
}
- if (src == parsePtr->end) {
+ if ((type & terminators) != 0) {
+ parsePtr->term = src;
+ src++;
break;
}
if (src[-1] == '"') {
@@ -481,17 +400,10 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
goto error;
}
-
parsePtr->commandSize = src - parsePtr->commandStart;
- if (savedChar != 0) {
- string[numBytes] = (char) savedChar;
- }
return TCL_OK;
error:
- if (savedChar != 0) {
- string[numBytes] = (char) savedChar;
- }
Tcl_FreeParse(parsePtr);
if (parsePtr->commandStart == NULL) {
parsePtr->commandStart = string;
@@ -499,17 +411,361 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
parsePtr->commandSize = parsePtr->term - parsePtr->commandStart;
return TCL_ERROR;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclParseWhiteSpace --
+ *
+ * Scans up to numBytes bytes starting at src, consuming white
+ * space as defined by Tcl's parsing rules.
+ *
+ * Results:
+ * Returns the number of bytes recognized as white space. Records
+ * at parsePtr, information about the parse. Records at typePtr
+ * the character type of the non-whitespace character that terminated
+ * the scan.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+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 of character that ends run
+ * of whitespace */
+{
+ register char type = TYPE_NORMAL;
+ register CONST char *p = src;
+
+ while (1) {
+ while (numBytes && ((type = CHAR_TYPE(*p)) & TYPE_SPACE)) {
+ numBytes--; p++;
+ }
+ if (numBytes && (type & TYPE_SUBS)) {
+ if (*p != '\\') {
+ break;
+ }
+ if (--numBytes == 0) {
+ break;
+ }
+ if (p[1] != '\n') {
+ break;
+ }
+ p+=2;
+ if (--numBytes == 0) {
+ parsePtr->incomplete = 1;
+ break;
+ }
+ continue;
+ }
+ break;
+ }
+ *typePtr = type;
+ return (p - src);
+}
/*
*----------------------------------------------------------------------
*
+ * TclParseHex --
+ *
+ * Scans a hexadecimal number as a Tcl_UniChar value.
+ * (e.g., for parsing \x and \u escape sequences).
+ * At most numBytes bytes are scanned.
+ *
+ * Results:
+ * The numeric value is stored in *resultPtr.
+ * Returns the number of bytes consumed.
+ *
+ * Notes:
+ * Relies on the following properties of the ASCII
+ * character set, with which UTF-8 is compatible:
+ *
+ * The digits '0' .. '9' and the letters 'A' .. 'Z' and 'a' .. 'z'
+ * occupy consecutive code points, and '0' < 'A' < 'a'.
+ *
+ *----------------------------------------------------------------------
+ */
+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 conversion is
+ * to be written. */
+{
+ Tcl_UniChar result = 0;
+ register CONST char *p = src;
+
+ while (numBytes--) {
+ unsigned char digit = UCHAR(*p);
+
+ if (!isxdigit(digit))
+ break;
+
+ ++p;
+ result <<= 4;
+
+ if (digit >= 'a') {
+ result |= (10 + digit - 'a');
+ } else if (digit >= 'A') {
+ result |= (10 + digit - 'A');
+ } else {
+ result |= (digit - '0');
+ }
+ }
+
+ *resultPtr = result;
+ return (p - src);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclParseBackslash --
+ *
+ * Scans up to numBytes bytes starting at src, consuming a
+ * backslash 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.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TclParseBackslash(src, numBytes, readPtr, dst)
+ 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 of bytes scanned should be written. */
+ 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;
+ int count;
+ char buf[TCL_UTF_MAX];
+
+ if (numBytes == 0) {
+ if (readPtr != NULL) {
+ *readPtr = 0;
+ }
+ return 0;
+ }
+
+ if (dst == NULL) {
+ dst = buf;
+ }
+
+ if (numBytes == 1) {
+ /* Can only scan the backslash. Return it. */
+ result = '\\';
+ count = 1;
+ goto done;
+ }
+
+ count = 2;
+ switch (*p) {
+ /*
+ * Note: in the conversions below, use absolute values (e.g.,
+ * 0xa) rather than symbolic values (e.g. \n) that get converted
+ * by the compiler. It's possible that compilers on some
+ * platforms will do the symbolic conversions differently, which
+ * could result in non-portable Tcl scripts.
+ */
+
+ case 'a':
+ result = 0x7;
+ break;
+ case 'b':
+ result = 0x8;
+ break;
+ case 'f':
+ result = 0xc;
+ break;
+ case 'n':
+ result = 0xa;
+ break;
+ case 'r':
+ result = 0xd;
+ break;
+ case 't':
+ result = 0x9;
+ break;
+ case 'v':
+ result = 0xb;
+ break;
+ case 'x':
+ count += TclParseHex(p+1, numBytes-1, &result);
+ if (count == 2) {
+ /* No hexadigits -> This is just "x". */
+ result = 'x';
+ } else {
+ /* Keep only the last byte (2 hex digits) */
+ result = (unsigned char) result;
+ }
+ break;
+ case 'u':
+ count += TclParseHex(p+1, (numBytes > 5) ? 4 : numBytes-1, &result);
+ if (count == 2) {
+ /* No hexadigits -> This is just "u". */
+ result = 'u';
+ }
+ break;
+ case '\n':
+ count--;
+ do {
+ p++; count++;
+ } while ((count < numBytes) && ((*p == ' ') || (*p == '\t')));
+ result = ' ';
+ break;
+ case 0:
+ result = '\\';
+ count = 1;
+ break;
+ default:
+ /*
+ * Check for an octal number \oo?o?
+ */
+ if (isdigit(UCHAR(*p)) && (UCHAR(*p) < '8')) { /* INTL: digit */
+ result = (unsigned char)(*p - '0');
+ p++;
+ if ((numBytes == 2) || !isdigit(UCHAR(*p)) /* INTL: digit */
+ || (UCHAR(*p) >= '8')) {
+ break;
+ }
+ count = 3;
+ result = (unsigned char)((result << 3) + (*p - '0'));
+ p++;
+ if ((numBytes == 3) || !isdigit(UCHAR(*p)) /* INTL: digit */
+ || (UCHAR(*p) >= '8')) {
+ break;
+ }
+ count = 4;
+ result = (unsigned char)((result << 3) + (*p - '0'));
+ break;
+ }
+ /*
+ * We have to convert here in case the user has put a
+ * backslash in front of a multi-byte utf-8 character.
+ * While this means nothing special, we shouldn't break up
+ * a correct utf-8 character. [Bug #217987] test subst-3.2
+ */
+ if (Tcl_UtfCharComplete(p, numBytes - 1)) {
+ count = Tcl_UtfToUniChar(p, &result) + 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;
+ }
+ break;
+ }
+
+ done:
+ if (readPtr != NULL) {
+ *readPtr = count;
+ }
+ return Tcl_UniCharToUtf((int) result, dst);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ParseComment --
+ *
+ * Scans up to numBytes bytes starting at src, consuming a
+ * Tcl comment as defined by Tcl's parsing rules.
+ *
+ * Results:
+ * Records in parsePtr information about the parse. Returns the
+ * number of bytes consumed.
+ *
+ * Side effects:
+ * 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.
+ * Updated if parsing indicates
+ * an incomplete command. */
+{
+ register CONST char *p = src;
+ while (numBytes) {
+ char type;
+ int scanned;
+ do {
+ scanned = TclParseWhiteSpace(p, numBytes, parsePtr, &type);
+ p += scanned; numBytes -= scanned;
+ } while (numBytes && (*p == '\n') && (p++,numBytes--));
+ if ((numBytes == 0) || (*p != '#')) {
+ break;
+ }
+ if (parsePtr->commentStart == NULL) {
+ parsePtr->commentStart = p;
+ }
+ while (numBytes) {
+ if (*p == '\\') {
+ scanned = TclParseWhiteSpace(p, numBytes, parsePtr, &type);
+ if (scanned) {
+ p += scanned; numBytes -= scanned;
+ } else {
+ /*
+ * General backslash substitution in comments isn't
+ * part of the formal spec, but test parse-15.47
+ * and history indicate that it has been the de facto
+ * rule. Don't change it now.
+ */
+ TclParseBackslash(p, numBytes, &scanned, NULL);
+ p += scanned; numBytes -= scanned;
+ }
+ } else {
+ p++; numBytes--;
+ if (p[-1] == '\n') {
+ break;
+ }
+ }
+ }
+ parsePtr->commentSize = p - parsePtr->commentStart;
+ }
+ return (p - src);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* ParseTokens --
*
* This procedure forms the heart of the Tcl parser. It parses one
* or more tokens from a string, up to a termination point
* specified by the caller. This procedure is used to parse
* unquoted command words (those not in quotes or braces), words in
- * quotes, and array indices for variables.
+ * quotes, and array indices for variables. No more than numBytes
+ * bytes will be scanned.
*
* Results:
* Tokens are added to parsePtr and parsePtr->term is filled in
@@ -527,8 +783,9 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
*/
static int
-ParseTokens(src, mask, parsePtr)
- register char *src; /* First character to parse. */
+ParseTokens(src, numBytes, mask, parsePtr)
+ 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
@@ -537,8 +794,8 @@ ParseTokens(src, mask, parsePtr)
* Updated with additional tokens and
* termination information. */
{
- int type, originalTokens, varToken;
- char utfBytes[TCL_UTF_MAX];
+ char type;
+ int originalTokens, varToken;
Tcl_Token *tokenPtr;
Tcl_Parse nested;
@@ -550,7 +807,7 @@ ParseTokens(src, mask, parsePtr)
*/
originalTokens = parsePtr->numTokens;
- while (1) {
+ while (numBytes && !((type = CHAR_TYPE(*src)) & mask)) {
if (parsePtr->numTokens == parsePtr->tokensAvailable) {
TclExpandTokenArray(parsePtr);
}
@@ -558,22 +815,15 @@ ParseTokens(src, mask, parsePtr)
tokenPtr->start = src;
tokenPtr->numComponents = 0;
- type = CHAR_TYPE(*src);
- if (type & mask) {
- break;
- }
-
if ((type & TYPE_SUBS) == 0) {
/*
* This is a simple range of characters. Scan to find the end
* of the range.
*/
- while (1) {
- src++;
- if (CHAR_TYPE(*src) & (mask | TYPE_SUBS)) {
- break;
- }
+ while ((++src, --numBytes)
+ && !(CHAR_TYPE(*src) & (mask | TYPE_SUBS))) {
+ /* empty loop */
}
tokenPtr->type = TCL_TOKEN_TEXT;
tokenPtr->size = src - tokenPtr->start;
@@ -585,11 +835,12 @@ ParseTokens(src, mask, parsePtr)
*/
varToken = parsePtr->numTokens;
- if (Tcl_ParseVarName(parsePtr->interp, src, parsePtr->end - src,
+ 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 == '[') {
/*
* Command substitution. Call Tcl_ParseCommand recursively
@@ -597,23 +848,24 @@ ParseTokens(src, mask, parsePtr)
* throw away the parse information.
*/
- src++;
+ src++; numBytes--;
while (1) {
if (Tcl_ParseCommand(parsePtr->interp, src,
- parsePtr->end - src, 1, &nested) != TCL_OK) {
+ numBytes, 1, &nested) != TCL_OK) {
parsePtr->errorType = nested.errorType;
parsePtr->term = nested.term;
parsePtr->incomplete = nested.incomplete;
return TCL_ERROR;
}
src = nested.commandStart + nested.commandSize;
+ numBytes = parsePtr->end - src;
if (nested.tokenPtr != nested.staticTokens) {
ckfree((char *) nested.tokenPtr);
}
if ((*nested.term == ']') && !nested.incomplete) {
break;
}
- if (src == parsePtr->end) {
+ if (numBytes == 0) {
if (parsePtr->interp != NULL) {
Tcl_SetResult(parsePtr->interp,
"missing close-bracket", TCL_STATIC);
@@ -631,9 +883,18 @@ ParseTokens(src, mask, parsePtr)
/*
* Backslash substitution.
*/
+ TclParseBackslash(src, numBytes, &tokenPtr->size, NULL);
+
+ if (tokenPtr->size == 1) {
+ /* Just a backslash, due to end of string */
+ tokenPtr->type = TCL_TOKEN_TEXT;
+ parsePtr->numTokens++;
+ src++; numBytes--;
+ continue;
+ }
if (src[1] == '\n') {
- if ((src + 2) == parsePtr->end) {
+ if (numBytes == 2) {
parsePtr->incomplete = 1;
}
@@ -644,28 +905,22 @@ ParseTokens(src, mask, parsePtr)
*/
if (mask & TYPE_SPACE) {
+ if (parsePtr->numTokens == originalTokens) {
+ goto finishToken;
+ }
break;
}
}
+
tokenPtr->type = TCL_TOKEN_BS;
- Tcl_UtfBackslash(src, &tokenPtr->size, utfBytes);
parsePtr->numTokens++;
src += tokenPtr->size;
+ numBytes -= tokenPtr->size;
} else if (*src == 0) {
- /*
- * We encountered a null character. If it is the null
- * character at the end of the string, then return.
- * Otherwise generate a text token for the single
- * character.
- */
-
- if (src == parsePtr->end) {
- break;
- }
tokenPtr->type = TCL_TOKEN_TEXT;
tokenPtr->size = 1;
parsePtr->numTokens++;
- src++;
+ src++; numBytes--;
} else {
panic("ParseTokens encountered unknown character");
}
@@ -676,7 +931,14 @@ ParseTokens(src, mask, parsePtr)
* for the empty range, so that there is always at least one
* token added.
*/
+ if (parsePtr->numTokens == parsePtr->tokensAvailable) {
+ TclExpandTokenArray(parsePtr);
+ }
+ tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
+ tokenPtr->start = src;
+ tokenPtr->numComponents = 0;
+ finishToken:
tokenPtr->type = TCL_TOKEN_TEXT;
tokenPtr->size = 0;
parsePtr->numTokens++;
@@ -684,7 +946,7 @@ ParseTokens(src, mask, parsePtr)
parsePtr->term = src;
return TCL_OK;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -713,7 +975,7 @@ Tcl_FreeParse(parsePtr)
parsePtr->tokenPtr = parsePtr->staticTokens;
}
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -751,819 +1013,15 @@ TclExpandTokenArray(parsePtr)
parsePtr->tokenPtr = newPtr;
parsePtr->tokensAvailable = newCount;
}
-
-/*
- *----------------------------------------------------------------------
- *
- * EvalObjv --
- *
- * This procedure evaluates a Tcl command that has already been
- * parsed into words, with one Tcl_Obj holding each word.
- *
- * 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.
- *
- * Side effects:
- * Depends on the command.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-EvalObjv(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. */
- 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. */
- 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 is currently
- * supported. */
-
-{
- Command *cmdPtr;
- Interp *iPtr = (Interp *) interp;
- Tcl_Obj **newObjv;
- int i, code;
- Trace *tracePtr, *nextPtr;
- char **argv, *commandCopy;
- CallFrame *savedVarFramePtr; /* Saves old copy of iPtr->varFramePtr
- * in case TCL_EVAL_GLOBAL was set. */
- Tcl_ResetResult(interp);
- if (objc == 0) {
- return TCL_OK;
- }
-
- /*
- * If the interpreter was deleted, return an error.
- */
-
- if (iPtr->flags & DELETED) {
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "attempt to call eval in deleted interpreter", -1);
- Tcl_SetErrorCode(interp, "CORE", "IDELETE",
- "attempt to call eval in deleted interpreter",
- (char *) NULL);
- return TCL_ERROR;
- }
-
- /*
- * Check depth of nested calls to Tcl_Eval: if this gets too large,
- * it's probably because of an infinite loop somewhere.
- */
-
- if (iPtr->numLevels >= iPtr->maxNestingDepth) {
- iPtr->result = "too many nested calls to Tcl_Eval (infinite loop?)";
- return TCL_ERROR;
- }
- iPtr->numLevels++;
-
- /*
- * On the Mac, we will never reach the default recursion limit before
- * blowing the stack. So we need to do a check here.
- */
-
- if (TclpCheckStackSpace() == 0) {
- /*NOTREACHED*/
- iPtr->numLevels--;
- iPtr->result = "too many nested calls to Tcl_Eval (infinite loop?)";
- return TCL_ERROR;
- }
-
- /*
- * 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.
- */
-
- cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]);
- 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_AppendStringsToObj(Tcl_GetObjResult(interp),
- "invalid command name \"", Tcl_GetString(objv[0]), "\"",
- (char *) NULL);
- code = TCL_ERROR;
- } else {
- code = EvalObjv(interp, objc+1, newObjv, command, length, 0);
- }
- Tcl_DecrRefCount(newObjv[0]);
- ckfree((char *) newObjv);
- goto done;
- }
-
- /*
- * Call trace procedures if needed.
- */
-
- argv = NULL;
- commandCopy = command;
-
- for (tracePtr = iPtr->tracePtr; tracePtr != NULL; tracePtr = nextPtr) {
- nextPtr = tracePtr->nextPtr;
- if (iPtr->numLevels > tracePtr->level) {
- continue;
- }
-
- /*
- * This is a bit messy because we have to emulate the old trace
- * interface, which uses strings for everything.
- */
-
- if (argv == NULL) {
- argv = (char **) ckalloc((unsigned) (objc + 1) * sizeof(char *));
- for (i = 0; i < objc; i++) {
- argv[i] = Tcl_GetString(objv[i]);
- }
- argv[objc] = 0;
-
- if (length < 0) {
- length = strlen(command);
- } else if ((size_t)length < strlen(command)) {
- commandCopy = (char *) ckalloc((unsigned) (length + 1));
- strncpy(commandCopy, command, (size_t) length);
- commandCopy[length] = 0;
- }
- }
- (*tracePtr->proc)(tracePtr->clientData, interp, iPtr->numLevels,
- commandCopy, cmdPtr->proc, cmdPtr->clientData,
- objc, argv);
- }
- if (argv != NULL) {
- ckfree((char *) argv);
- }
- if (commandCopy != command) {
- ckfree((char *) commandCopy);
- }
-
- /*
- * Finally, invoke the command's Tcl_ObjCmdProc.
- */
-
- iPtr->cmdCount++;
- savedVarFramePtr = iPtr->varFramePtr;
- if (flags & TCL_EVAL_GLOBAL) {
- iPtr->varFramePtr = NULL;
- }
- code = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
- iPtr->varFramePtr = savedVarFramePtr;
- if (Tcl_AsyncReady()) {
- code = Tcl_AsyncInvoke(interp, code);
- }
-
- /*
- * 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.
- */
-
- if (*(iPtr->result) != 0) {
- (void) Tcl_GetObjResult(interp);
- }
-
- done:
- iPtr->numLevels--;
- return code;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_EvalObjv --
- *
- * This procedure evaluates a Tcl command that has already been
- * parsed into words, with one Tcl_Obj holding each word.
- *
- * 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 command.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_EvalObjv(interp, objc, objv, 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. */
- int flags; /* Collection of OR-ed bits that control
- * the evaluation of the script. Only
- * TCL_EVAL_GLOBAL is currently
- * supported. */
-{
- Interp *iPtr = (Interp *)interp;
- Trace *tracePtr;
- Tcl_DString cmdBuf;
- char *cmdString = "";
- int cmdLen = 0;
- int code = TCL_OK;
-
- for (tracePtr = iPtr->tracePtr; tracePtr; tracePtr = tracePtr->nextPtr) {
- /*
- * EvalObjv will increment numLevels so use "<" rather than "<="
- */
- if (iPtr->numLevels < tracePtr->level) {
- int i;
- /*
- * The command will be needed for an execution trace or stack trace
- * generate a command string.
- */
- cmdtraced:
- 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;
- }
- }
-
- /*
- * Execute the command if we have not done so already
- */
- switch (code) {
- case TCL_OK:
- code = EvalObjv(interp, objc, objv, cmdString, cmdLen, flags);
- if (code == TCL_ERROR && cmdLen == 0)
- goto cmdtraced;
- break;
- case TCL_ERROR:
- Tcl_LogCommandInfo(interp, cmdString, cmdString, cmdLen);
- break;
- default:
- /*NOTREACHED*/
- break;
- }
-
- if (cmdLen != 0) {
- Tcl_DStringFree(&cmdBuf);
- }
- return code;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_LogCommandInfo --
- *
- * This procedure is invoked after an error occurs in an interpreter.
- * It adds information to the "errorInfo" variable to describe the
- * command that was being executed when the error occurred.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Information about the command is added to errorInfo and the
- * line number stored internally in the interpreter is set. If this
- * is the first call to this procedure or Tcl_AddObjErrorInfo since
- * an error occurred, then old information in errorInfo is
- * deleted.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_LogCommandInfo(interp, script, command, length)
- Tcl_Interp *interp; /* Interpreter in which to log information. */
- char *script; /* First character in script containing
- * command (must be <= command). */
- 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). */
-{
- char buffer[200];
- register char *p;
- char *ellipsis = "";
- Interp *iPtr = (Interp *) interp;
-
- if (iPtr->flags & ERR_ALREADY_LOGGED) {
- /*
- * Someone else has already logged error information for this
- * command; we shouldn't add anything more.
- */
-
- return;
- }
-
- /*
- * Compute the line number where the error occurred.
- */
-
- iPtr->errorLine = 1;
- for (p = script; p != command; p++) {
- if (*p == '\n') {
- iPtr->errorLine++;
- }
- }
-
- /*
- * Create an error message to add to errorInfo, including up to a
- * maximum number of characters of the command.
- */
-
- if (length < 0) {
- length = strlen(command);
- }
- if (length > 150) {
- length = 150;
- ellipsis = "...";
- }
- if (!(iPtr->flags & ERR_IN_PROGRESS)) {
- sprintf(buffer, "\n while executing\n\"%.*s%s\"",
- length, command, ellipsis);
- } else {
- sprintf(buffer, "\n invoked from within\n\"%.*s%s\"",
- length, command, ellipsis);
- }
- Tcl_AddObjErrorInfo(interp, buffer, -1);
- iPtr->flags &= ~ERR_ALREADY_LOGGED;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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 evaluates the tokens and concatenates their
- * values to form a single result value.
- *
- * Results:
- * The return value is a pointer to a newly allocated Tcl_Obj
- * containing the value of the array of tokens. The reference
- * count of the returned object has been incremented. If an error
- * occurs in evaluating the tokens then a NULL value is returned
- * and an error message is left in interp's result.
- *
- * Side effects:
- * A new object is allocated to hold the result.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Obj *
-Tcl_EvalTokens(interp, tokenPtr, count)
- 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 evaluate and concatenate. */
- int count; /* Number of tokens to consider at tokenPtr.
- * Must be at least 1. */
-{
- Tcl_Obj *resultPtr, *indexPtr, *valuePtr, *newPtr;
- char buffer[TCL_UTF_MAX];
-#ifdef TCL_MEM_DEBUG
-# define MAX_VAR_CHARS 5
-#else
-# define MAX_VAR_CHARS 30
-#endif
- char nameBuffer[MAX_VAR_CHARS+1];
- char *varName, *index;
- char *p = NULL; /* Initialized to avoid compiler warning. */
- int length, code;
-
- /*
- * The only tricky thing about this procedure is that it attempts to
- * avoid object creation and string copying whenever possible. For
- * example, if the value is just a nested command, then use the
- * command's result object directly.
- */
-
- resultPtr = NULL;
- for ( ; count > 0; count--, tokenPtr++) {
- valuePtr = NULL;
-
- /*
- * The switch statement below computes the next value to be
- * concat to the result, as either a range of text or an
- * object.
- */
-
- switch (tokenPtr->type) {
- case TCL_TOKEN_TEXT:
- p = tokenPtr->start;
- length = tokenPtr->size;
- break;
-
- case TCL_TOKEN_BS:
- length = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL,
- buffer);
- p = buffer;
- break;
-
- case TCL_TOKEN_COMMAND:
- code = Tcl_EvalEx(interp, tokenPtr->start+1, tokenPtr->size-2,
- 0);
- if (code != TCL_OK) {
- goto error;
- }
- valuePtr = Tcl_GetObjResult(interp);
- break;
-
- case TCL_TOKEN_VARIABLE:
- if (tokenPtr->numComponents == 1) {
- indexPtr = NULL;
- } else {
- indexPtr = Tcl_EvalTokens(interp, tokenPtr+2,
- tokenPtr->numComponents - 1);
- if (indexPtr == NULL) {
- goto error;
- }
- }
-
- /*
- * We have to make a copy of the variable name in order
- * to have a null-terminated string. We can't make a
- * temporary modification to the script to null-terminate
- * the name, because a trace callback might potentially
- * reuse the script and be affected by the null character.
- */
-
- if (tokenPtr[1].size <= MAX_VAR_CHARS) {
- varName = nameBuffer;
- } else {
- varName = ckalloc((unsigned) (tokenPtr[1].size + 1));
- }
- strncpy(varName, tokenPtr[1].start, (size_t) tokenPtr[1].size);
- varName[tokenPtr[1].size] = 0;
- if (indexPtr != NULL) {
- index = TclGetString(indexPtr);
- } else {
- index = NULL;
- }
- valuePtr = Tcl_GetVar2Ex(interp, varName, index,
- TCL_LEAVE_ERR_MSG);
- if (varName != nameBuffer) {
- ckfree(varName);
- }
- if (indexPtr != NULL) {
- Tcl_DecrRefCount(indexPtr);
- }
- if (valuePtr == NULL) {
- goto error;
- }
- count -= tokenPtr->numComponents;
- tokenPtr += tokenPtr->numComponents;
- break;
-
- default:
- panic("unexpected token type in Tcl_EvalTokens");
- }
-
- /*
- * If valuePtr isn't NULL, the next piece of text comes from that
- * object; otherwise, take length bytes starting at p.
- */
-
- if (resultPtr == NULL) {
- if (valuePtr != NULL) {
- resultPtr = valuePtr;
- } else {
- resultPtr = Tcl_NewStringObj(p, length);
- }
- Tcl_IncrRefCount(resultPtr);
- } else {
- if (Tcl_IsShared(resultPtr)) {
- newPtr = Tcl_DuplicateObj(resultPtr);
- Tcl_DecrRefCount(resultPtr);
- resultPtr = newPtr;
- Tcl_IncrRefCount(resultPtr);
- }
- if (valuePtr != NULL) {
- p = Tcl_GetStringFromObj(valuePtr, &length);
- }
- Tcl_AppendToObj(resultPtr, p, length);
- }
- }
- return resultPtr;
-
- error:
- if (resultPtr != NULL) {
- Tcl_DecrRefCount(resultPtr);
- }
- return NULL;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_EvalEx --
- *
- * This procedure 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.
- *
- * 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 script.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_EvalEx(interp, script, numBytes, flags)
- Tcl_Interp *interp; /* Interpreter in which to evaluate the
- * script. Also used for error reporting. */
- 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 evaluation of the script. Only
- * TCL_EVAL_GLOBAL is currently
- * supported. */
-{
- Interp *iPtr = (Interp *) interp;
- char *p, *next;
- Tcl_Parse parse;
-#define NUM_STATIC_OBJS 20
- Tcl_Obj *staticObjArray[NUM_STATIC_OBJS], **objv;
- Tcl_Token *tokenPtr;
- int i, code, commandLength, bytesLeft, nested;
- CallFrame *savedVarFramePtr; /* Saves old copy of iPtr->varFramePtr
- * in case TCL_EVAL_GLOBAL was set. */
-
- /*
- * 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;
-
- if (numBytes < 0) {
- numBytes = strlen(script);
- }
- Tcl_ResetResult(interp);
-
- savedVarFramePtr = iPtr->varFramePtr;
- if (flags & TCL_EVAL_GLOBAL) {
- iPtr->varFramePtr = NULL;
- }
-
- /*
- * Each iteration through the following loop parses the next
- * command from the script and then executes it.
- */
-
- objv = staticObjArray;
- p = script;
- bytesLeft = numBytes;
- if (iPtr->evalFlags & TCL_BRACKET_TERM) {
- nested = 1;
- } else {
- nested = 0;
- }
- iPtr->evalFlags = 0;
- do {
- if (Tcl_ParseCommand(interp, p, bytesLeft, nested, &parse)
- != TCL_OK) {
- code = TCL_ERROR;
- goto error;
- }
- gotParse = 1;
- if (parse.numWords > 0) {
- /*
- * Generate an array of objects for the words of the command.
- */
-
- if (parse.numWords <= NUM_STATIC_OBJS) {
- objv = staticObjArray;
- } else {
- objv = (Tcl_Obj **) ckalloc((unsigned)
- (parse.numWords * sizeof (Tcl_Obj *)));
- }
- for (objectsUsed = 0, tokenPtr = parse.tokenPtr;
- objectsUsed < parse.numWords;
- objectsUsed++, tokenPtr += (tokenPtr->numComponents + 1)) {
- objv[objectsUsed] = Tcl_EvalTokens(interp, tokenPtr+1,
- tokenPtr->numComponents);
- if (objv[objectsUsed] == NULL) {
- code = TCL_ERROR;
- goto error;
- }
- }
-
- /*
- * Execute the command and free the objects for its words.
- */
-
- code = EvalObjv(interp, objectsUsed, objv, p, bytesLeft, 0);
- if (code != TCL_OK) {
- goto error;
- }
- for (i = 0; i < objectsUsed; i++) {
- Tcl_DecrRefCount(objv[i]);
- }
- objectsUsed = 0;
- if (objv != staticObjArray) {
- ckfree((char *) objv);
- objv = staticObjArray;
- }
- }
-
- /*
- * Advance to the next command in the script.
- */
-
- next = parse.commandStart + parse.commandSize;
- bytesLeft -= next - p;
- p = next;
- Tcl_FreeParse(&parse);
- gotParse = 0;
- if ((nested != 0) && (p > script) && (p[-1] == ']')) {
- /*
- * We get here in the special case where the TCL_BRACKET_TERM
- * flag was set in the interpreter and we reached a close
- * bracket in the script. Return immediately.
- */
-
- iPtr->termOffset = (p - 1) - script;
- iPtr->varFramePtr = savedVarFramePtr;
- return TCL_OK;
- }
- } while (bytesLeft > 0);
- iPtr->termOffset = p - script;
- iPtr->varFramePtr = savedVarFramePtr;
- return TCL_OK;
-
- error:
- /*
- * Generate various pieces of error information, such as the line
- * number where the error occurred and information to add to the
- * errorInfo variable. Then free resources that had been allocated
- * to the command.
- */
-
- if ((code == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
- commandLength = parse.commandSize;
- if ((parse.commandStart + commandLength) != (script + numBytes)) {
- /*
- * The command where the error occurred didn't end at the end
- * of the script (i.e. it ended at a terminator character such
- * as ";". Reduce the length by one so that the error message
- * doesn't include the terminator character.
- */
-
- commandLength -= 1;
- }
- Tcl_LogCommandInfo(interp, script, parse.commandStart, commandLength);
- }
-
- for (i = 0; i < objectsUsed; i++) {
- Tcl_DecrRefCount(objv[i]);
- }
- if (gotParse) {
- p = parse.commandStart + parse.commandSize;
- Tcl_FreeParse(&parse);
- if ((nested != 0) && (p > script) && (p[-1] == ']')) {
- /*
- * We get here in the special case where the TCL_BRACKET_TERM
- * flag was set in the interpreter and we reached a close
- * bracket in the script. Return immediately.
- */
-
- iPtr->termOffset = (p - 1) - script;
- } else {
- iPtr->termOffset = p - script;
- }
- }
- if (objv != staticObjArray) {
- ckfree((char *) objv);
- }
- iPtr->varFramePtr = savedVarFramePtr;
- return code;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_Eval --
- *
- * Execute a Tcl command in a string. This procedure 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 for executing Tcl commands, but nowadays
- * it isn't used much.
- *
- * Results:
- * The return value is one of the return codes defined in tcl.h
- * (such as TCL_OK), and interp's result contains a value
- * to supplement the return code. The value of the result
- * will persist only until the next call to Tcl_Eval or Tcl_EvalObj:
- * you must copy it or lose it!
- *
- * Side effects:
- * Can be almost arbitrary, depending on the commands in the script.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_Eval(interp, string)
- Tcl_Interp *interp; /* Token for command interpreter (returned
- * by previous call to Tcl_CreateInterp). */
- char *string; /* Pointer to TCL command to execute. */
-{
- int code;
-
- code = Tcl_EvalEx(interp, string, -1, 0);
-
- /*
- * For backwards compatibility with old C code that predates the
- * object system in Tcl 8.0, we have to mirror the object result
- * back into the string result (some callers may expect it there).
- */
-
- Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
- TCL_VOLATILE);
- return code;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_EvalObj, Tcl_GlobalEvalObj --
- *
- * These functions are deprecated but we keep them around for backwards
- * compatibility reasons.
- *
- * Results:
- * See the functions they call.
- *
- * Side effects:
- * See the functions they call.
- *
- *----------------------------------------------------------------------
- */
-
-#undef Tcl_EvalObj
-int
-Tcl_EvalObj(interp, objPtr)
- 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;
-{
- return Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL);
-}
-
/*
*----------------------------------------------------------------------
*
* Tcl_ParseVarName --
*
* Given a string starting with a $ sign, parse off a variable
- * name and return information about the parse.
+ * name and return information about the parse. No more than
+ * numBytes bytes will be scanned.
*
* Results:
* The return value is TCL_OK if the command was parsed
@@ -1590,9 +1048,9 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
Tcl_Interp *interp; /* Interpreter to use for error reporting;
* if NULL, then no error message is
* provided. */
- char *string; /* String containing variable name. First
+ CONST char *string; /* String containing variable name. First
* character must be "$". */
- 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
@@ -1603,16 +1061,17 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
* it. */
{
Tcl_Token *tokenPtr;
- char *end, *src;
+ register CONST char *src;
unsigned char c;
int varIndex, offset;
Tcl_UniChar ch;
unsigned array;
- if (numBytes >= 0) {
- end = string + numBytes;
- } else {
- end = string + strlen(string);
+ if ((numBytes == 0) || (string == NULL)) {
+ return TCL_ERROR;
+ }
+ if (numBytes < 0) {
+ numBytes = strlen(string);
}
if (!append) {
@@ -1621,7 +1080,7 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
parsePtr->numTokens = 0;
parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
parsePtr->string = string;
- parsePtr->end = end;
+ parsePtr->end = (string + numBytes);
parsePtr->interp = interp;
parsePtr->errorType = TCL_PARSE_SUCCESS;
parsePtr->incomplete = 0;
@@ -1643,8 +1102,8 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
varIndex = parsePtr->numTokens;
parsePtr->numTokens++;
tokenPtr++;
- src++;
- if (src >= end) {
+ src++; numBytes--;
+ if (numBytes == 0) {
goto justADollarSign;
}
tokenPtr->type = TCL_TOKEN_TEXT;
@@ -1669,26 +1128,23 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
*/
if (*src == '{') {
- src++;
+ src++; numBytes--;
tokenPtr->type = TCL_TOKEN_TEXT;
tokenPtr->start = src;
tokenPtr->numComponents = 0;
- while (1) {
- if (src == end) {
- if (interp != NULL) {
- Tcl_SetResult(interp,
- "missing close-brace for variable name",
+
+ while (numBytes && (*src != '}')) {
+ numBytes--; src++;
+ }
+ if (numBytes == 0) {
+ if (interp != NULL) {
+ Tcl_SetResult(interp, "missing close-brace for variable name",
TCL_STATIC);
- }
- parsePtr->errorType = TCL_PARSE_MISSING_VAR_BRACE;
- parsePtr->term = tokenPtr->start-1;
- parsePtr->incomplete = 1;
- goto error;
}
- if (*src == '}') {
- break;
- }
- src++;
+ parsePtr->errorType = TCL_PARSE_MISSING_VAR_BRACE;
+ parsePtr->term = tokenPtr->start-1;
+ parsePtr->incomplete = 1;
+ goto error;
}
tokenPtr->size = src - tokenPtr->start;
tokenPtr[-1].size = src - tokenPtr[-1].start;
@@ -1698,17 +1154,24 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
tokenPtr->type = TCL_TOKEN_TEXT;
tokenPtr->start = src;
tokenPtr->numComponents = 0;
- while (src != end) {
- offset = Tcl_UtfToUniChar(src, &ch);
+ while (numBytes) {
+ if (Tcl_UtfCharComplete(src, numBytes)) {
+ offset = Tcl_UtfToUniChar(src, &ch);
+ } else {
+ char utfBytes[TCL_UTF_MAX];
+ memcpy(utfBytes, src, (size_t) numBytes);
+ utfBytes[numBytes] = '\0';
+ offset = Tcl_UtfToUniChar(utfBytes, &ch);
+ }
c = UCHAR(ch);
if (isalnum(c) || (c == '_')) { /* INTL: ISO only, UCHAR. */
- src += offset;
+ src += offset; numBytes -= offset;
continue;
}
- if ((c == ':') && (((src+1) != end) && (src[1] == ':'))) {
- src += 2;
- while ((src != end) && (*src == ':')) {
- src += 1;
+ if ((c == ':') && (numBytes != 1) && (src[1] == ':')) {
+ src += 2; numBytes -= 2;
+ while (numBytes && (*src == ':')) {
+ src++; numBytes--;
}
continue;
}
@@ -1718,9 +1181,9 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
/*
* Support for empty array names here.
*/
- array = ((src != end) && (*src == '('));
+ array = (numBytes && (*src == '('));
tokenPtr->size = src - tokenPtr->start;
- if (tokenPtr->size == 0 && !array) {
+ if ((tokenPtr->size == 0) && !array) {
goto justADollarSign;
}
parsePtr->numTokens++;
@@ -1731,11 +1194,12 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
* since it could contain any number of substitutions.
*/
- if (ParseTokens(src+1, TYPE_CLOSE_PAREN, parsePtr)
+ if (ParseTokens(src+1, numBytes-1, TYPE_CLOSE_PAREN, parsePtr)
!= TCL_OK) {
goto error;
}
- if ((parsePtr->term == end) || (*parsePtr->term != ')')) {
+ if ((parsePtr->term == (src + numBytes))
+ || (*parsePtr->term != ')')) {
if (parsePtr->interp != NULL) {
Tcl_SetResult(parsePtr->interp, "missing )",
TCL_STATIC);
@@ -1770,7 +1234,7 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
Tcl_FreeParse(parsePtr);
return TCL_ERROR;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -1793,18 +1257,19 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
*----------------------------------------------------------------------
*/
-char *
+CONST char *
Tcl_ParseVar(interp, string, termPtr)
Tcl_Interp *interp; /* Context for looking up variable. */
- register char *string; /* String containing variable name.
+ register CONST char *string; /* String containing variable name.
* First character must be "$". */
- char **termPtr; /* If non-NULL, points to word to fill
+ 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;
if (Tcl_ParseVarName(interp, string, -1, &parse, 0) != TCL_OK) {
return NULL;
@@ -1821,25 +1286,30 @@ Tcl_ParseVar(interp, string, termPtr)
return "$";
}
- objPtr = Tcl_EvalTokens(interp, parse.tokenPtr, parse.numTokens);
- if (objPtr == NULL) {
+ code = Tcl_EvalTokensStandard(interp, parse.tokenPtr, parse.numTokens);
+ if (code != TCL_OK) {
return NULL;
}
+ objPtr = Tcl_GetObjResult(interp);
/*
* 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
*/
-#ifdef TCL_COMPILE_DEBUG
- if (objPtr->refCount < 2) {
- panic("Tcl_ParseVar got temporary object from Tcl_EvalTokens");
+ if (!Tcl_IsShared(objPtr)) {
+ Tcl_IncrRefCount(objPtr);
}
-#endif /*TCL_COMPILE_DEBUG*/
- TclDecrRefCount(objPtr);
+ Tcl_ResetResult(interp);
return TclGetString(objPtr);
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -1847,7 +1317,8 @@ Tcl_ParseVar(interp, string, termPtr)
*
* Given a string in braces such as a Tcl command argument or a string
* value in a Tcl expression, this procedure parses the string and
- * returns information about the parse.
+ * returns information about the parse. No more than numBytes bytes
+ * will be scanned.
*
* Results:
* The return value is TCL_OK if the string was parsed successfully and
@@ -1873,9 +1344,9 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr)
Tcl_Interp *interp; /* Interpreter to use for error reporting;
* if NULL, then no error message is
* provided. */
- char *string; /* String containing the string in braces.
+ CONST char *string; /* String containing the string in braces.
* The first character must be '{'. */
- 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;
@@ -1885,35 +1356,35 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr)
* information in parsePtr; zero means
* ignore existing tokens in parsePtr and
* reinitialize it. */
- 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. */
{
- char utfBytes[TCL_UTF_MAX]; /* For result of backslash substitution. */
Tcl_Token *tokenPtr;
- register char *src, *end;
+ register CONST char *src;
int startIndex, level, length;
- if ((numBytes >= 0) || (string == NULL)) {
- end = string + numBytes;
- } else {
- end = string + strlen(string);
+ if ((numBytes == 0) || (string == NULL)) {
+ return TCL_ERROR;
}
-
+ if (numBytes < 0) {
+ numBytes = strlen(string);
+ }
+
if (!append) {
parsePtr->numWords = 0;
parsePtr->tokenPtr = parsePtr->staticTokens;
parsePtr->numTokens = 0;
parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
parsePtr->string = string;
- parsePtr->end = end;
+ parsePtr->end = (string + numBytes);
parsePtr->interp = interp;
parsePtr->errorType = TCL_PARSE_SUCCESS;
}
- src = string+1;
+ src = string;
startIndex = parsePtr->numTokens;
if (parsePtr->numTokens == parsePtr->tokensAvailable) {
@@ -1921,130 +1392,135 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr)
}
tokenPtr = &parsePtr->tokenPtr[startIndex];
tokenPtr->type = TCL_TOKEN_TEXT;
- tokenPtr->start = src;
+ tokenPtr->start = src+1;
tokenPtr->numComponents = 0;
level = 1;
while (1) {
- while (CHAR_TYPE(*src) == TYPE_NORMAL) {
- src++;
- }
- if (*src == '}') {
- level--;
- if (level == 0) {
+ while (++src, --numBytes) {
+ if (CHAR_TYPE(*src) != TYPE_NORMAL) {
break;
}
- src++;
- } else if (*src == '{') {
- level++;
- src++;
- } else if (*src == '\\') {
- Tcl_UtfBackslash(src, &length, utfBytes);
- if (src[1] == '\n') {
+ }
+ if (numBytes == 0) {
+ register int openBrace = 0;
+
+ parsePtr->errorType = TCL_PARSE_MISSING_BRACE;
+ parsePtr->term = string;
+ parsePtr->incomplete = 1;
+ if (interp == NULL) {
/*
- * A backslash-newline sequence must be collapsed, even
- * inside braces, so we have to split the word into
- * multiple tokens so that the backslash-newline can be
- * represented explicitly.
+ * Skip straight to the exit code since we have no
+ * interpreter to put error message in.
*/
-
- if ((src + 2) == end) {
- parsePtr->incomplete = 1;
- }
- tokenPtr->size = (src - tokenPtr->start);
- if (tokenPtr->size != 0) {
- parsePtr->numTokens++;
- }
- if ((parsePtr->numTokens+1) >= parsePtr->tokensAvailable) {
- TclExpandTokenArray(parsePtr);
- }
- tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
- tokenPtr->type = TCL_TOKEN_BS;
- tokenPtr->start = src;
- tokenPtr->size = length;
- tokenPtr->numComponents = 0;
- parsePtr->numTokens++;
-
- src += length;
- tokenPtr++;
- tokenPtr->type = TCL_TOKEN_TEXT;
- tokenPtr->start = src;
- tokenPtr->numComponents = 0;
- } else {
- src += length;
+ goto error;
}
- } else if (src == end) {
- int openBrace;
- if (interp != NULL) {
- Tcl_SetResult(interp, "missing close-brace", TCL_STATIC);
- }
+ Tcl_SetResult(interp, "missing close-brace", TCL_STATIC);
+
/*
- * Search the source string for a possible open
- * brace within the context of a comment. Since we
- * aren't performing a full Tcl parse, just look for
- * an open brace preceeded by a '<whitspace>#' on
- * the same line.
+ * Guess if the problem is due to comments by searching
+ * the source string for a possible open brace within the
+ * context of a comment. Since we aren't performing a
+ * full Tcl parse, just look for an open brace preceded
+ * by a '<whitespace>#' on the same line.
*/
- openBrace = 0;
- while (src > string ) {
+
+ for (; src > string; src--) {
switch (*src) {
- case '{':
- openBrace = 1;
+ case '{':
+ openBrace = 1;
break;
case '\n':
- openBrace = 0;
+ openBrace = 0;
break;
- case '#':
- if ((openBrace == 1) && (isspace(UCHAR(src[-1])))) {
- if (interp != NULL) {
- Tcl_AppendResult(interp,
- ": possible unbalanced brace in comment",
- (char *) NULL);
- }
- openBrace = -1;
- break;
+ case '#' :
+ if (openBrace && (isspace(UCHAR(src[-1])))) {
+ Tcl_AppendResult(interp,
+ ": possible unbalanced brace in comment",
+ (char *) NULL);
+ goto error;
}
break;
}
- if (openBrace == -1) {
- break;
- }
- src--;
}
- parsePtr->errorType = TCL_PARSE_MISSING_BRACE;
- parsePtr->term = string;
- parsePtr->incomplete = 1;
- goto error;
- } else {
- src++;
- }
- }
- /*
- * Decide if we need to finish emitting a partially-finished token.
- * There are 3 cases:
- * {abc \newline xyz} or {xyz} - finish emitting "xyz" token
- * {abc \newline} - don't emit token after \newline
- * {} - finish emitting zero-sized token
- * The last case ensures that there is a token (even if empty) that
- * describes the braced string.
- */
+ error:
+ Tcl_FreeParse(parsePtr);
+ return TCL_ERROR;
+ }
+ switch (*src) {
+ case '{':
+ level++;
+ break;
+ case '}':
+ if (--level == 0) {
+
+ /*
+ * Decide if we need to finish emitting a
+ * partially-finished token. There are 3 cases:
+ * {abc \newline xyz} or {xyz}
+ * - finish emitting "xyz" token
+ * {abc \newline}
+ * - don't emit token after \newline
+ * {} - finish emitting zero-sized token
+ *
+ * The last case ensures that there is a token
+ * (even if empty) that describes the braced string.
+ */
- if ((src != tokenPtr->start)
- || (parsePtr->numTokens == startIndex)) {
- tokenPtr->size = (src - tokenPtr->start);
- parsePtr->numTokens++;
- }
- if (termPtr != NULL) {
- *termPtr = src+1;
+ if ((src != tokenPtr->start)
+ || (parsePtr->numTokens == startIndex)) {
+ tokenPtr->size = (src - tokenPtr->start);
+ parsePtr->numTokens++;
+ }
+ if (termPtr != NULL) {
+ *termPtr = src+1;
+ }
+ return TCL_OK;
+ }
+ break;
+ case '\\':
+ TclParseBackslash(src, numBytes, &length, NULL);
+ if ((length > 1) && (src[1] == '\n')) {
+ /*
+ * A backslash-newline sequence must be collapsed, even
+ * inside braces, so we have to split the word into
+ * multiple tokens so that the backslash-newline can be
+ * represented explicitly.
+ */
+
+ if (numBytes == 2) {
+ parsePtr->incomplete = 1;
+ }
+ tokenPtr->size = (src - tokenPtr->start);
+ if (tokenPtr->size != 0) {
+ parsePtr->numTokens++;
+ }
+ if ((parsePtr->numTokens+1) >= parsePtr->tokensAvailable) {
+ TclExpandTokenArray(parsePtr);
+ }
+ tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
+ tokenPtr->type = TCL_TOKEN_BS;
+ tokenPtr->start = src;
+ tokenPtr->size = length;
+ tokenPtr->numComponents = 0;
+ parsePtr->numTokens++;
+
+ src += length - 1;
+ numBytes -= length - 1;
+ tokenPtr++;
+ tokenPtr->type = TCL_TOKEN_TEXT;
+ tokenPtr->start = src + 1;
+ tokenPtr->numComponents = 0;
+ } else {
+ src += length - 1;
+ numBytes -= length - 1;
+ }
+ break;
+ }
}
- return TCL_OK;
-
- error:
- Tcl_FreeParse(parsePtr);
- return TCL_ERROR;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -2052,7 +1528,8 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr)
*
* Given a double-quoted string such as a quoted Tcl command argument
* or a quoted value in a Tcl expression, this procedure parses the
- * string and returns information about the parse.
+ * string and returns information about the parse. No more than
+ * numBytes bytes will be scanned.
*
* Results:
* The return value is TCL_OK if the string was parsed successfully and
@@ -2078,9 +1555,9 @@ Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr)
Tcl_Interp *interp; /* Interpreter to use for error reporting;
* if NULL, then no error message is
* provided. */
- char *string; /* String containing the quoted string.
+ CONST char *string; /* String containing the quoted string.
* The first character must be '"'. */
- 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;
@@ -2090,31 +1567,30 @@ Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr)
* information in parsePtr; zero means
* ignore existing tokens in parsePtr and
* reinitialize it. */
- 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. */
{
- char *end;
-
- if ((numBytes >= 0) || (string == NULL)) {
- end = string + numBytes;
- } else {
- end = string + strlen(string);
+ if ((numBytes == 0) || (string == NULL)) {
+ return TCL_ERROR;
}
-
+ if (numBytes < 0) {
+ numBytes = strlen(string);
+ }
+
if (!append) {
parsePtr->numWords = 0;
parsePtr->tokenPtr = parsePtr->staticTokens;
parsePtr->numTokens = 0;
parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
parsePtr->string = string;
- parsePtr->end = end;
+ parsePtr->end = (string + numBytes);
parsePtr->interp = interp;
parsePtr->errorType = TCL_PARSE_SUCCESS;
}
- if (ParseTokens(string+1, TYPE_QUOTE, parsePtr) != TCL_OK) {
+ if (ParseTokens(string+1, numBytes-1, TYPE_QUOTE, parsePtr) != TCL_OK) {
goto error;
}
if (*parsePtr->term != '"') {
@@ -2135,7 +1611,7 @@ Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr)
Tcl_FreeParse(parsePtr);
return TCL_ERROR;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -2157,16 +1633,16 @@ Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr)
*/
static int
-CommandComplete(script, length)
- char *script; /* Script to check. */
- int length; /* Number of bytes in script. */
+CommandComplete(script, numBytes)
+ CONST char *script; /* Script to check. */
+ int numBytes; /* Number of bytes in script. */
{
Tcl_Parse parse;
- char *p, *end;
+ CONST char *p, *end;
int result;
p = script;
- end = p + length;
+ end = p + numBytes;
while (Tcl_ParseCommand((Tcl_Interp *) NULL, p, end - p, 0, &parse)
== TCL_OK) {
p = parse.commandStart + parse.commandSize;
@@ -2183,7 +1659,7 @@ CommandComplete(script, length)
Tcl_FreeParse(&parse);
return result;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -2206,11 +1682,11 @@ CommandComplete(script, length)
int
Tcl_CommandComplete(script)
- char *script; /* Script to check. */
+ CONST char *script; /* Script to check. */
{
return CommandComplete(script, (int) strlen(script));
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -2234,13 +1710,13 @@ TclObjCommandComplete(objPtr)
Tcl_Obj *objPtr; /* Points to object holding script
* to check. */
{
- char *script;
+ CONST char *script;
int length;
script = Tcl_GetStringFromObj(objPtr, &length);
return CommandComplete(script, length);
}
-
+
/*
*----------------------------------------------------------------------
*
diff --git a/tcl/generic/tclParseExpr.c b/tcl/generic/tclParseExpr.c
index 00612db7efa..cde02d2898b 100644
--- a/tcl/generic/tclParseExpr.c
+++ b/tcl/generic/tclParseExpr.c
@@ -7,6 +7,8 @@
* 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.
@@ -15,7 +17,6 @@
*/
#include "tclInt.h"
-#include "tclCompile.h"
/*
* The stuff below is a bit of a hack so that this file can be used in
@@ -55,22 +56,24 @@ typedef struct ParseInfo {
int lexeme; /* Type of last lexeme scanned in expr.
* See below for definitions. Corresponds to
* size characters beginning at start. */
- char *start; /* First character in lexeme. */
+ CONST char *start; /* First character in lexeme. */
int size; /* Number of bytes in lexeme. */
- char *next; /* Position of the next character to be
+ CONST char *next; /* Position of the next character to be
* scanned in the expression string. */
- char *prevEnd; /* Points to the character just after the
+ CONST char *prevEnd; /* Points to the character just after the
* last one in the previous lexeme. Used to
* compute size of subexpression tokens. */
- char *originalExpr; /* Points to the start of the expression
+ CONST char *originalExpr; /* Points to the start of the expression
* originally passed to Tcl_ParseExpr. */
- char *lastChar; /* Points just after last byte of expr. */
+ 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
@@ -84,62 +87,69 @@ typedef struct ParseInfo {
#define COMMA 8
#define END 9
#define UNKNOWN 10
+#define UNKNOWN_CHAR 11
/*
- * Binary operators:
+ * Binary numeric operators:
*/
-#define MULT 11
-#define DIVIDE 12
-#define MOD 13
-#define PLUS 14
-#define MINUS 15
-#define LEFT_SHIFT 16
-#define RIGHT_SHIFT 17
-#define LESS 18
-#define GREATER 19
-#define LEQ 20
-#define GEQ 21
-#define EQUAL 22
-#define NEQ 23
-#define BIT_AND 24
-#define BIT_XOR 25
-#define BIT_OR 26
-#define AND 27
-#define OR 28
-#define QUESTY 29
-#define COLON 30
+#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 31
-#define BIT_NOT 32
+#define NOT 32
+#define BIT_NOT 33
+
+/*
+ * Binary string operators:
+ */
+
+#define STREQ 34
+#define STRNEQ 35
/*
* Mapping from lexemes to strings; used for debugging messages. These
* entries must match the order and number of the lexeme definitions above.
*/
-#ifdef TCL_COMPILE_DEBUG
static char *lexemeStrings[] = {
"LITERAL", "FUNCNAME",
- "[", "{", "(", ")", "$", "\"", ",", "END", "UNKNOWN",
+ "[", "{", "(", ")", "$", "\"", ",", "END", "UNKNOWN", "UNKNOWN_CHAR",
"*", "/", "%", "+", "-",
"<<", ">>", "<", ">", "<=", ">=", "==", "!=",
"&", "^", "|", "&&", "||", "?", ":",
- "!", "~"
+ "!", "~", "eq", "ne",
};
-#endif /* TCL_COMPILE_DEBUG */
/*
* Declarations for local procedures to this file:
*/
static int GetLexeme _ANSI_ARGS_((ParseInfo *infoPtr));
-static void LogSyntaxError _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));
@@ -148,14 +158,16 @@ 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 ParseUnaryExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static void PrependSubExprTokens _ANSI_ARGS_((char *op,
- int opBytes, char *src, int srcBytes,
- int firstIndex, 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
@@ -181,7 +193,8 @@ static void PrependSubExprTokens _ANSI_ARGS_((char *op,
* Given a string, this procedure parses the first Tcl expression
* in the string and returns information about the structure of
* the expression. This procedure is the top-level interface to the
- * the expression parsing module.
+ * the expression parsing module. No more that numBytes bytes will
+ * be scanned.
*
* Results:
* The return value is TCL_OK if the command was parsed successfully
@@ -203,7 +216,7 @@ static void PrependSubExprTokens _ANSI_ARGS_((char *op,
int
Tcl_ParseExpr(interp, string, numBytes, parsePtr)
Tcl_Interp *interp; /* Used for error reporting. */
- char *string; /* The source string to parse. */
+ CONST char *string; /* The 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. */
@@ -214,7 +227,6 @@ Tcl_ParseExpr(interp, string, numBytes, parsePtr)
{
ParseInfo info;
int code;
- char savedChar;
if (numBytes < 0) {
numBytes = (string? strlen(string) : 0);
@@ -241,17 +253,6 @@ Tcl_ParseExpr(interp, string, numBytes, parsePtr)
parsePtr->incomplete = 0;
/*
- * Temporarily overwrite the character just after the end of the
- * string with a 0 byte. This acts as a sentinel and reduces the
- * number of places where we have to check for the end of the
- * input string. The original value of the byte is restored at
- * the end of the parse.
- */
-
- savedChar = string[numBytes];
- string[numBytes] = 0;
-
- /*
* Initialize the ParseInfo structure that holds state while parsing
* the expression.
*/
@@ -278,14 +279,12 @@ Tcl_ParseExpr(interp, string, numBytes, parsePtr)
goto error;
}
if (info.lexeme != END) {
- LogSyntaxError(&info);
+ LogSyntaxError(&info, "extra tokens at end of expression");
goto error;
}
- string[numBytes] = (char) savedChar;
return TCL_OK;
error:
- string[numBytes] = (char) savedChar;
if (parsePtr->tokenPtr != parsePtr->staticTokens) {
ckfree((char *) parsePtr->tokenPtr);
}
@@ -301,7 +300,7 @@ Tcl_ParseExpr(interp, string, numBytes, parsePtr)
* condExpr ::= lorExpr ['?' condExpr ':' condExpr]
*
* Note that this is the topmost recursive-descent parsing routine used
- * by TclParseExpr to parse expressions. This avoids an extra procedure
+ * by Tcl_ParseExpr to parse expressions. This avoids an extra procedure
* call since such a procedure would only return the result of calling
* ParseCondExpr. Other recursive-descent procedures that need to parse
* complete expressions also call ParseCondExpr.
@@ -327,7 +326,7 @@ ParseCondExpr(infoPtr)
Tcl_Parse *parsePtr = infoPtr->parsePtr;
Tcl_Token *tokenPtr, *firstTokenPtr, *condTokenPtr;
int firstIndex, numToMove, code;
- char *srcStart;
+ CONST char *srcStart;
HERE("condExpr", 1);
srcStart = infoPtr->start;
@@ -384,7 +383,7 @@ ParseCondExpr(infoPtr)
return code;
}
if (infoPtr->lexeme != COLON) {
- LogSyntaxError(infoPtr);
+ LogSyntaxError(infoPtr, "missing colon from ternary conditional");
return TCL_ERROR;
}
code = GetLexeme(infoPtr); /* skip over the ':' */
@@ -440,7 +439,7 @@ ParseLorExpr(infoPtr)
{
Tcl_Parse *parsePtr = infoPtr->parsePtr;
int firstIndex, code;
- char *srcStart, *operator;
+ CONST char *srcStart, *operator;
HERE("lorExpr", 2);
srcStart = infoPtr->start;
@@ -500,7 +499,7 @@ ParseLandExpr(infoPtr)
{
Tcl_Parse *parsePtr = infoPtr->parsePtr;
int firstIndex, code;
- char *srcStart, *operator;
+ CONST char *srcStart, *operator;
HERE("landExpr", 3);
srcStart = infoPtr->start;
@@ -560,7 +559,7 @@ ParseBitOrExpr(infoPtr)
{
Tcl_Parse *parsePtr = infoPtr->parsePtr;
int firstIndex, code;
- char *srcStart, *operator;
+ CONST char *srcStart, *operator;
HERE("bitOrExpr", 4);
srcStart = infoPtr->start;
@@ -621,7 +620,7 @@ ParseBitXorExpr(infoPtr)
{
Tcl_Parse *parsePtr = infoPtr->parsePtr;
int firstIndex, code;
- char *srcStart, *operator;
+ CONST char *srcStart, *operator;
HERE("bitXorExpr", 5);
srcStart = infoPtr->start;
@@ -682,7 +681,7 @@ ParseBitAndExpr(infoPtr)
{
Tcl_Parse *parsePtr = infoPtr->parsePtr;
int firstIndex, code;
- char *srcStart, *operator;
+ CONST char *srcStart, *operator;
HERE("bitAndExpr", 6);
srcStart = infoPtr->start;
@@ -720,7 +719,8 @@ ParseBitAndExpr(infoPtr)
* ParseEqualityExpr --
*
* This procedure parses a Tcl equality (inequality) expression:
- * equalityExpr ::= relationalExpr {('==' | '!=') relationalExpr}
+ * equalityExpr ::= relationalExpr
+ * {('==' | '!=' | 'ne' | 'eq') relationalExpr}
*
* Results:
* The return value is TCL_OK on a successful parse and TCL_ERROR
@@ -742,7 +742,7 @@ ParseEqualityExpr(infoPtr)
{
Tcl_Parse *parsePtr = infoPtr->parsePtr;
int firstIndex, lexeme, code;
- char *srcStart, *operator;
+ CONST char *srcStart, *operator;
HERE("equalityExpr", 7);
srcStart = infoPtr->start;
@@ -754,9 +754,10 @@ ParseEqualityExpr(infoPtr)
}
lexeme = infoPtr->lexeme;
- while ((lexeme == EQUAL) || (lexeme == NEQ)) {
+ while ((lexeme == EQUAL) || (lexeme == NEQ)
+ || (lexeme == STREQ) || (lexeme == STRNEQ)) {
operator = infoPtr->start;
- code = GetLexeme(infoPtr); /* skip over == or != */
+ code = GetLexeme(infoPtr); /* skip over ==, !=, 'eq' or 'ne' */
if (code != TCL_OK) {
return code;
}
@@ -766,7 +767,8 @@ ParseEqualityExpr(infoPtr)
}
/*
- * Generate tokens for the subexpression and '==' or '!=' operator.
+ * Generate tokens for the subexpression and '==', '!=', 'eq' or 'ne'
+ * operator.
*/
PrependSubExprTokens(operator, 2, srcStart,
@@ -804,7 +806,7 @@ ParseRelationalExpr(infoPtr)
{
Tcl_Parse *parsePtr = infoPtr->parsePtr;
int firstIndex, lexeme, operatorSize, code;
- char *srcStart, *operator;
+ CONST char *srcStart, *operator;
HERE("relationalExpr", 8);
srcStart = infoPtr->start;
@@ -872,7 +874,7 @@ ParseShiftExpr(infoPtr)
{
Tcl_Parse *parsePtr = infoPtr->parsePtr;
int firstIndex, lexeme, code;
- char *srcStart, *operator;
+ CONST char *srcStart, *operator;
HERE("shiftExpr", 9);
srcStart = infoPtr->start;
@@ -934,7 +936,7 @@ ParseAddExpr(infoPtr)
{
Tcl_Parse *parsePtr = infoPtr->parsePtr;
int firstIndex, lexeme, code;
- char *srcStart, *operator;
+ CONST char *srcStart, *operator;
HERE("addExpr", 10);
srcStart = infoPtr->start;
@@ -996,7 +998,7 @@ ParseMultiplyExpr(infoPtr)
{
Tcl_Parse *parsePtr = infoPtr->parsePtr;
int firstIndex, lexeme, code;
- char *srcStart, *operator;
+ CONST char *srcStart, *operator;
HERE("multiplyExpr", 11);
srcStart = infoPtr->start;
@@ -1058,7 +1060,7 @@ ParseUnaryExpr(infoPtr)
{
Tcl_Parse *parsePtr = infoPtr->parsePtr;
int firstIndex, lexeme, code;
- char *srcStart, *operator;
+ CONST char *srcStart, *operator;
HERE("unaryExpr", 12);
srcStart = infoPtr->start;
@@ -1123,7 +1125,7 @@ ParsePrimaryExpr(infoPtr)
Tcl_Interp *interp = parsePtr->interp;
Tcl_Token *tokenPtr, *exprTokenPtr;
Tcl_Parse nested;
- char *dollarPtr, *stringStart, *termPtr, *src;
+ CONST char *dollarPtr, *stringStart, *termPtr, *src;
int lexeme, exprIndex, firstIndex, numToMove, code;
/*
@@ -1142,7 +1144,8 @@ ParsePrimaryExpr(infoPtr)
return code;
}
if (infoPtr->lexeme != CLOSE_PAREN) {
- goto syntaxError;
+ LogSyntaxError(infoPtr, "looking for close parenthesis");
+ return TCL_ERROR;
}
code = GetLexeme(infoPtr); /* skip over the ')' */
if (code != TCL_OK) {
@@ -1192,7 +1195,7 @@ ParsePrimaryExpr(infoPtr)
exprTokenPtr->size = infoPtr->size;
exprTokenPtr->numComponents = 1;
break;
-
+
case DOLLAR:
/*
* $var variable reference.
@@ -1372,7 +1375,43 @@ ParsePrimaryExpr(infoPtr)
return code;
}
if (infoPtr->lexeme != OPEN_PAREN) {
- goto syntaxError;
+ /*
+ * Guess what kind of error we have by trying to tell
+ * whether we have a function or variable name here.
+ * Alas, this makes the parser more tightly bound with the
+ * rest of the interpreter, but that is the only way to
+ * give a sensible message here. Still, it is not too
+ * serious as this is only done when generating an error.
+ */
+ Interp *iPtr = (Interp *) infoPtr->parsePtr->interp;
+ Tcl_DString functionName;
+ Tcl_HashEntry *hPtr;
+
+ /*
+ * Look up the name as a function name. We need a writable
+ * copy (DString) so we can terminate it with a NULL for
+ * the benefit of Tcl_FindHashEntry which operates on
+ * NULL-terminated string keys.
+ */
+ Tcl_DStringInit(&functionName);
+ hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable,
+ Tcl_DStringAppend(&functionName, tokenPtr->start,
+ tokenPtr->size));
+ Tcl_DStringFree(&functionName);
+
+ /*
+ * Assume that we have an attempted variable reference
+ * unless we've got a function name, as the set of
+ * potential function names is typically much smaller.
+ */
+ if (hPtr != NULL) {
+ LogSyntaxError(infoPtr,
+ "expected parenthesis enclosing function arguments");
+ } else {
+ LogSyntaxError(infoPtr,
+ "variable references require preceding $");
+ }
+ return TCL_ERROR;
}
code = GetLexeme(infoPtr); /* skip over '(' */
if (code != TCL_OK) {
@@ -1391,7 +1430,9 @@ ParsePrimaryExpr(infoPtr)
return code;
}
} else if (infoPtr->lexeme != CLOSE_PAREN) {
- goto syntaxError;
+ LogSyntaxError(infoPtr,
+ "missing close parenthesis at end of function call");
+ return TCL_ERROR;
}
}
@@ -1399,9 +1440,37 @@ ParsePrimaryExpr(infoPtr)
exprTokenPtr->size = (infoPtr->next - exprTokenPtr->start);
exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex;
break;
-
- default:
- goto syntaxError;
+
+ 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;
+ }
}
/*
@@ -1414,10 +1483,6 @@ ParsePrimaryExpr(infoPtr)
}
parsePtr->term = infoPtr->next;
return TCL_OK;
-
- syntaxError:
- LogSyntaxError(infoPtr);
- return TCL_ERROR;
}
/*
@@ -1453,11 +1518,9 @@ GetLexeme(infoPtr)
ParseInfo *infoPtr; /* Holds state needed to parse the expr,
* including the resulting lexeme. */
{
- register char *src; /* Points to current source char. */
- char *termPtr; /* Points to char terminating a literal. */
- double doubleValue; /* Value of a scanned double literal. */
+ register CONST char *src; /* Points to current source char. */
char c;
- int startsWithDigit, offset;
+ int offset, length, numBytes;
Tcl_Parse *parsePtr = infoPtr->parsePtr;
Tcl_Interp *interp = parsePtr->interp;
Tcl_UniChar ch;
@@ -1471,26 +1534,18 @@ GetLexeme(infoPtr)
infoPtr->prevEnd = infoPtr->next;
/*
- * Scan over leading white space at the start of a lexeme. Note that a
- * backslash-newline is treated as a space.
+ * Scan over leading white space at the start of a lexeme.
*/
src = infoPtr->next;
- c = *src;
- while (isspace(UCHAR(c)) || (c == '\\')) { /* INTL: ISO space */
- if (c == '\\') {
- if (src[1] == '\n') {
- src += 2;
- } else {
- break; /* no longer white space */
- }
- } else {
- src++;
- }
- c = *src;
- }
+ 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 (src >= infoPtr->lastChar) {
+ if (numBytes == 0) {
infoPtr->lexeme = END;
infoPtr->next = src;
return TCL_OK;
@@ -1503,59 +1558,48 @@ GetLexeme(infoPtr)
* by mistake, which would eventually cause a syntax error.
*/
+ c = *src;
if ((c != '+') && (c != '-')) {
- startsWithDigit = isdigit(UCHAR(c)); /* INTL: digit */
- if (startsWithDigit && TclLooksLikeInt(src, -1)) {
- errno = 0;
- (void) strtoul(src, &termPtr, 0);
- if (errno == ERANGE) {
- if (interp != NULL) {
- char *s = "integer value too large to represent";
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
- Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s,
- (char *) NULL);
- }
+ 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;
}
- if (termPtr != src) {
- /*
- * src was the start of a valid integer, but was it
- * a bad octal? Stopping at a digit would cause that.
- */
- if (isdigit(UCHAR(*termPtr))) { /* INTL: digit. */
- /*
- * We only want to report an error for the number,
- * but we may have something like "08+1"
- */
- if (interp != NULL) {
- while (isdigit(UCHAR(*(++termPtr)))) {} /* INTL: digit. */
- Tcl_ResetResult(interp);
- offset = termPtr - src;
- c = src[offset];
- src[offset] = 0;
- Tcl_AppendResult(interp, "\"", src,
- "\" is an invalid octal number",
- (char *) NULL);
- src[offset] = c;
- }
- 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, *termPtr;
+ double doubleValue;
+ Tcl_DString toParse;
- infoPtr->lexeme = LITERAL;
- infoPtr->start = src;
- infoPtr->size = (termPtr - src);
- infoPtr->next = termPtr;
- parsePtr->term = termPtr;
- return TCL_OK;
- }
- } else if (startsWithDigit || (c == '.')
- || (c == 'n') || (c == 'N')) {
errno = 0;
- doubleValue = strtod(src, &termPtr);
- if (termPtr != src) {
+ Tcl_DStringInit(&toParse);
+ startPtr = Tcl_DStringAppend(&toParse, src, length);
+ doubleValue = strtod(startPtr, &termPtr);
+ Tcl_DStringFree(&toParse);
+ if (termPtr != startPtr) {
if (errno != 0) {
if (interp != NULL) {
TclExprFloatError(interp, doubleValue);
@@ -1565,14 +1609,19 @@ GetLexeme(infoPtr)
}
/*
- * src was the start of a valid double.
+ * startPtr was the start of a valid double, copied
+ * from src.
*/
infoPtr->lexeme = LITERAL;
infoPtr->start = src;
- infoPtr->size = (termPtr - src);
- infoPtr->next = termPtr;
- parsePtr->term = termPtr;
+ if ((termPtr - startPtr) > length) {
+ infoPtr->size = length;
+ } else {
+ infoPtr->size = (termPtr - startPtr);
+ }
+ infoPtr->next = src + infoPtr->size;
+ parsePtr->term = infoPtr->next;
return TCL_OK;
}
}
@@ -1646,72 +1695,69 @@ GetLexeme(infoPtr)
return TCL_OK;
case '<':
- 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;
- default:
- infoPtr->lexeme = LESS;
- break;
+ 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 '>':
- 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;
- default:
- infoPtr->lexeme = GREATER;
- break;
+ 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 '=':
- if (src[1] == '=') {
+ infoPtr->lexeme = UNKNOWN;
+ if ((src[1] == '=') && ((infoPtr->lastChar - src) > 1)) {
infoPtr->lexeme = EQUAL;
infoPtr->size = 2;
infoPtr->next = src+2;
- } else {
- infoPtr->lexeme = UNKNOWN;
}
parsePtr->term = infoPtr->next;
return TCL_OK;
case '!':
- if (src[1] == '=') {
+ infoPtr->lexeme = NOT;
+ if ((src[1] == '=') && ((infoPtr->lastChar - src) > 1)) {
infoPtr->lexeme = NEQ;
infoPtr->size = 2;
infoPtr->next = src+2;
- } else {
- infoPtr->lexeme = NOT;
}
parsePtr->term = infoPtr->next;
return TCL_OK;
case '&':
- if (src[1] == '&') {
+ infoPtr->lexeme = BIT_AND;
+ if ((src[1] == '&') && ((infoPtr->lastChar - src) > 1)) {
infoPtr->lexeme = AND;
infoPtr->size = 2;
infoPtr->next = src+2;
- } else {
- infoPtr->lexeme = BIT_AND;
}
parsePtr->term = infoPtr->next;
return TCL_OK;
@@ -1721,12 +1767,11 @@ GetLexeme(infoPtr)
return TCL_OK;
case '|':
- if (src[1] == '|') {
+ infoPtr->lexeme = BIT_OR;
+ if ((src[1] == '|') && ((infoPtr->lastChar - src) > 1)) {
infoPtr->lexeme = OR;
infoPtr->size = 2;
infoPtr->next = src+2;
- } else {
- infoPtr->lexeme = BIT_OR;
}
parsePtr->term = infoPtr->next;
return TCL_OK;
@@ -1735,22 +1780,104 @@ GetLexeme(infoPtr)
infoPtr->lexeme = BIT_NOT;
return TCL_OK;
+ case 'e':
+ if ((src[1] == 'q') && ((infoPtr->lastChar - src) > 1)) {
+ 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->lexeme = STRNEQ;
+ infoPtr->size = 2;
+ infoPtr->next = src+2;
+ parsePtr->term = infoPtr->next;
+ return TCL_OK;
+ } else {
+ goto checkFuncName;
+ }
+
default:
- offset = Tcl_UtfToUniChar(src, &ch);
+ 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;
- offset = Tcl_UtfToUniChar(src, &ch);
+ 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;
+ /*
+ * Check for boolean literals (true, false, yes, no, on, off)
+ */
+ switch (infoPtr->start[0]) {
+ case 'f':
+ if (infoPtr->size == 5 &&
+ strncmp("false", infoPtr->start, 5) == 0) {
+ infoPtr->lexeme = LITERAL;
+ return TCL_OK;
+ }
+ break;
+ case 'n':
+ if (infoPtr->size == 2 &&
+ strncmp("no", infoPtr->start, 2) == 0) {
+ infoPtr->lexeme = LITERAL;
+ return TCL_OK;
+ }
+ break;
+ case 'o':
+ if (infoPtr->size == 3 &&
+ strncmp("off", infoPtr->start, 3) == 0) {
+ infoPtr->lexeme = LITERAL;
+ return TCL_OK;
+ } else if (infoPtr->size == 2 &&
+ strncmp("on", infoPtr->start, 2) == 0) {
+ infoPtr->lexeme = LITERAL;
+ return TCL_OK;
+ }
+ break;
+ case 't':
+ if (infoPtr->size == 4 &&
+ strncmp("true", infoPtr->start, 4) == 0) {
+ infoPtr->lexeme = LITERAL;
+ return TCL_OK;
+ }
+ break;
+ case 'y':
+ if (infoPtr->size == 3 &&
+ strncmp("yes", infoPtr->start, 3) == 0) {
+ infoPtr->lexeme = LITERAL;
+ return TCL_OK;
+ }
+ break;
+ }
return TCL_OK;
}
- infoPtr->lexeme = UNKNOWN;
+ infoPtr->lexeme = UNKNOWN_CHAR;
return TCL_OK;
}
}
@@ -1758,6 +1885,107 @@ GetLexeme(infoPtr)
/*
*----------------------------------------------------------------------
*
+ * 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;
+ }
+ return 0;
+ }
+ 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, runing 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 '-':
+ p++;
+ break;
+ default:
+ goto done;
+ }
+ }
+ done:
+ return (p - string);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* PrependSubExprTokens --
*
* This procedure is called after the operands of an subexpression have
@@ -1777,10 +2005,10 @@ GetLexeme(infoPtr)
static void
PrependSubExprTokens(op, opBytes, src, srcBytes, firstIndex, infoPtr)
- char *op; /* Points to first byte of the operator
+ CONST char *op; /* Points to first byte of the operator
* in the source script. */
int opBytes; /* Number of bytes in the operator. */
- char *src; /* Points to first byte of the subexpression
+ CONST char *src; /* Points to first byte of the subexpression
* in the source script. */
int srcBytes; /* Number of bytes in subexpression's
* source. */
@@ -1830,23 +2058,32 @@ PrependSubExprTokens(op, opBytes, src, srcBytes, firstIndex, infoPtr)
*
* Side effects:
* Sets the interpreter result to an error message describing the
- * expression that was being parsed when the error occurred.
+ * 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)
+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. */
{
int numBytes = (infoPtr->lastChar - infoPtr->originalExpr);
char buffer[100];
- sprintf(buffer, "syntax error in expression \"%.*s\"",
- ((numBytes > 60)? 60 : numBytes), infoPtr->originalExpr);
+ if (numBytes > 60) {
+ sprintf(buffer, "syntax error in expression \"%.60s...\"",
+ infoPtr->originalExpr);
+ } else {
+ sprintf(buffer, "syntax error in expression \"%.*s\"",
+ numBytes, infoPtr->originalExpr);
+ }
+ Tcl_ResetResult(infoPtr->parsePtr->interp);
Tcl_AppendStringsToObj(Tcl_GetObjResult(infoPtr->parsePtr->interp),
- buffer, (char *) NULL);
+ buffer, ": ", extraInfo, (char *) NULL);
infoPtr->parsePtr->errorType = TCL_PARSE_SYNTAX;
infoPtr->parsePtr->term = infoPtr->start;
}
diff --git a/tcl/generic/tclPipe.c b/tcl/generic/tclPipe.c
index 09bcb486671..e47648fe887 100644
--- a/tcl/generic/tclPipe.c
+++ b/tcl/generic/tclPipe.c
@@ -39,8 +39,9 @@ TCL_DECLARE_MUTEX(pipeMutex) /* Guard access to detList. */
*/
static TclFile FileForRedirect _ANSI_ARGS_((Tcl_Interp *interp,
- char *spec, int atOk, char *arg, char *nextArg,
- int flags, int *skipPtr, int *closePtr, int *releasePtr));
+ CONST char *spec, int atOk, CONST char *arg,
+ CONST char *nextArg, int flags, int *skipPtr,
+ int *closePtr, int *releasePtr));
/*
*----------------------------------------------------------------------
@@ -67,14 +68,14 @@ static TclFile
FileForRedirect(interp, spec, atOK, arg, nextArg, flags, skipPtr, closePtr,
releasePtr)
Tcl_Interp *interp; /* Intepreter to use for error reporting. */
- char *spec; /* Points to character just after
+ CONST char *spec; /* Points to character just after
* redirection character. */
- char *arg; /* Pointer to entire argument containing
+ CONST char *arg; /* Pointer to entire argument containing
* spec: used for error reporting. */
int atOK; /* Non-zero means that '@' notation can be
* used to specify a channel, zero means that
* it isn't. */
- 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
@@ -123,7 +124,7 @@ FileForRedirect(interp, spec, atOK, arg, nextArg, flags, skipPtr, closePtr,
Tcl_Flush(chan);
}
} else {
- char *name;
+ CONST char *name;
Tcl_DString nameString;
if (*spec == '\0') {
@@ -278,7 +279,7 @@ TclCleanupChildren(interp, numPids, pidPtr, errorChan)
int i, abnormalExit, anyErrorInfo;
Tcl_Pid pid;
WAIT_STATUS_TYPE waitStatus;
- char *msg;
+ CONST char *msg;
abnormalExit = 0;
for (i = 0; i < numPids; i++) {
@@ -324,7 +325,7 @@ TclCleanupChildren(interp, numPids, pidPtr, errorChan)
abnormalExit = 1;
} else if (WIFSIGNALED(waitStatus)) {
if (interp != (Tcl_Interp *) NULL) {
- char *p;
+ CONST char *p;
p = Tcl_SignalMsg((int) (WTERMSIG(waitStatus)));
Tcl_SetErrorCode(interp, "CHILDKILLED", msg1,
@@ -335,7 +336,7 @@ TclCleanupChildren(interp, numPids, pidPtr, errorChan)
}
} else if (WIFSTOPPED(waitStatus)) {
if (interp != (Tcl_Interp *) NULL) {
- char *p;
+ CONST char *p;
p = Tcl_SignalMsg((int) (WSTOPSIG(waitStatus)));
Tcl_SetErrorCode(interp, "CHILDSUSP", msg1,
@@ -371,7 +372,7 @@ TclCleanupChildren(interp, numPids, pidPtr, errorChan)
int count;
Tcl_Obj *objPtr;
- Tcl_Seek(errorChan, 0L, SEEK_SET);
+ Tcl_Seek(errorChan, (Tcl_WideInt)0, SEEK_SET);
objPtr = Tcl_NewObj();
count = Tcl_ReadChars(errorChan, objPtr, -1, 0);
if (count < 0) {
@@ -439,7 +440,7 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
outPipePtr, errFilePtr)
Tcl_Interp *interp; /* Interpreter to use for error reporting. */
int argc; /* Number of entries in argv. */
- char **argv; /* Array of strings describing commands in
+ 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
@@ -476,7 +477,7 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
* at *pidPtr right now. */
int cmdCount; /* Count of number of distinct commands
* found in argc/argv. */
- char *inputLiteral = NULL; /* If non-null, then this points to a
+ 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 pipeline. */
@@ -498,7 +499,7 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
int errorClose = 0; /* If non-zero, then errorFile should be
* closed when cleaning up. */
int errorRelease = 0;
- char *p;
+ CONST char *p;
int skip, lastBar, lastArg, i, j, atOK, flags, errorToOutput;
Tcl_DString execBuffer;
TclFile pipeIn;
@@ -802,7 +803,7 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
for (i = 0; i < argc; i = lastArg + 1) {
int result, joinThisError;
Tcl_Pid pid;
- char *oldName;
+ CONST char *oldName;
/*
* Convert the program name into native form.
@@ -992,7 +993,7 @@ Tcl_OpenCommandChannel(interp, argc, argv, flags)
Tcl_Interp *interp; /* Interpreter for error reporting. Can
* NOT be NULL. */
int argc; /* How many arguments. */
- char **argv; /* Array of arguments for command pipe. */
+ 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. */
{
diff --git a/tcl/generic/tclPkg.c b/tcl/generic/tclPkg.c
index 1906e8dbafb..1bdfe18991a 100644
--- a/tcl/generic/tclPkg.c
+++ b/tcl/generic/tclPkg.c
@@ -51,11 +51,12 @@ typedef struct Package {
*/
static int CheckVersion _ANSI_ARGS_((Tcl_Interp *interp,
- char *string));
-static int ComparePkgVersions _ANSI_ARGS_((char *v1, char *v2,
+ CONST char *string));
+static int ComparePkgVersions _ANSI_ARGS_((CONST char *v1,
+ CONST char *v2,
int *satPtr));
static Package * FindPackage _ANSI_ARGS_((Tcl_Interp *interp,
- char *name));
+ CONST char *name));
/*
*----------------------------------------------------------------------
@@ -84,8 +85,8 @@ int
Tcl_PkgProvide(interp, name, version)
Tcl_Interp *interp; /* Interpreter in which package is now
* available. */
- char *name; /* Name of package. */
- 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);
}
@@ -94,8 +95,8 @@ int
Tcl_PkgProvideEx(interp, name, version, clientData)
Tcl_Interp *interp; /* Interpreter in which package is now
* available. */
- char *name; /* Name of package. */
- char *version; /* Version string for package. */
+ CONST char *name; /* Name of package. */
+ CONST char *version; /* Version string for package. */
ClientData clientData; /* clientdata for this package (normally
* used for C callback function table) */
{
@@ -148,12 +149,12 @@ Tcl_PkgProvideEx(interp, name, version, clientData)
*----------------------------------------------------------------------
*/
-char *
+CONST char *
Tcl_PkgRequire(interp, name, version, exact)
Tcl_Interp *interp; /* Interpreter in which package is now
* available. */
- char *name; /* Name of desired package. */
- char *version; /* Version string for desired version;
+ 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
@@ -163,12 +164,12 @@ Tcl_PkgRequire(interp, name, version, exact)
return Tcl_PkgRequireEx(interp, name, version, exact, (ClientData *) NULL);
}
-char *
+CONST char *
Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr)
Tcl_Interp *interp; /* Interpreter in which package is now
* available. */
- char *name; /* Name of desired package. */
- char *version; /* Version string for desired version;
+ 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
@@ -186,7 +187,7 @@ Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr)
Tcl_DString command;
/*
- * If an attempt is being made to load this into a standalong executable
+ * If an attempt is being made to load this into a standalone executable
* on a platform where backlinking is not supported then this must be
* a shared version of Tcl (Otherwise the load would have failed).
* Detect this situation by checking that this library has been correctly
@@ -194,7 +195,67 @@ Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr)
* work.
*/
- if (!tclEmptyStringRep) {
+ if (tclEmptyStringRep == NULL) {
+
+ /*
+ * OK, so what's going on here?
+ *
+ * First, what are we doing? We are performing a check on behalf of
+ * one particular caller, Tcl_InitStubs(). When a package is
+ * stub-enabled, it is statically linked to libtclstub.a, which
+ * contains a copy of Tcl_InitStubs(). When a stub-enabled package
+ * is loaded, its *_Init() function is supposed to call
+ * Tcl_InitStubs() before calling any other functions in the Tcl
+ * library. The first Tcl function called by Tcl_InitStubs() through
+ * the stub table is Tcl_PkgRequireEx(), so this code right here is
+ * the first code that is part of the original Tcl library in the
+ * executable that gets executed on behalf of a newly loaded
+ * stub-enabled package.
+ *
+ * One easy error for the developer/builder of a stub-enabled package
+ * to make is to forget to define USE_TCL_STUBS when compiling the
+ * package. When that happens, the package will contain symbols
+ * that are references to the Tcl library, rather than function
+ * pointers referencing the stub table. On platforms that lack
+ * backlinking, those unresolved references may cause the loading
+ * of the package to also load a second copy of the Tcl library,
+ * leading to all kinds of trouble. We would like to catch that
+ * error and report a useful message back to the user. That's
+ * what we're doing.
+ *
+ * Second, how does this work? If we reach this point, then the
+ * global variable tclEmptyStringRep has the value NULL. Compare
+ * that with the definition of tclEmptyStringRep near the top of
+ * the file generic/tclObj.c. It clearly should not have the value
+ * NULL; it should point to the char tclEmptyString. If we see it
+ * having the value NULL, then somehow we are seeing a Tcl library
+ * that isn't completely initialized, and that's an indicator for the
+ * error condition described above. (Further explanation is welcome.)
+ *
+ * Third, so what do we do about it? This situation indicates
+ * the package we just loaded wasn't properly compiled to be
+ * stub-enabled, yet it thinks it is stub-enabled (it called
+ * Tcl_InitStubs()). We want to report that the package just
+ * loaded is broken, so we want to place an error message in
+ * the interpreter result and return NULL to indicate failure
+ * to Tcl_InitStubs() so that it will also fail. (Further
+ * explanation why we don't want to Tcl_Panic() is welcome.
+ * After all, two Tcl libraries can't be a good thing!)
+ *
+ * Trouble is that's going to be tricky. We're now using a Tcl
+ * library that's not fully initialized. In particular, it
+ * doesn't have a proper value for tclEmptyStringRep. The
+ * Tcl_Obj system heavily depends on the value of tclEmptyStringRep
+ * and all of Tcl depends (increasingly) on the Tcl_Obj system, we
+ * need to correct that flaw before making the calls to set the
+ * interpreter result to the error message. That's the only flaw
+ * corrected; other problems with initialization of the Tcl library
+ * are not remedied, so be very careful about adding any other calls
+ * here without checking how they behave when initialization is
+ * incomplete.
+ */
+
+ tclEmptyStringRep = &tclEmptyString;
Tcl_AppendResult(interp, "Cannot load package \"", name,
"\" in standalone executable: This package is not ",
"compiled with stub support", NULL);
@@ -350,12 +411,12 @@ Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr)
*----------------------------------------------------------------------
*/
-char *
+CONST char *
Tcl_PkgPresent(interp, name, version, exact)
Tcl_Interp *interp; /* Interpreter in which package is now
* available. */
- char *name; /* Name of desired package. */
- char *version; /* Version string for desired version;
+ 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
@@ -365,12 +426,12 @@ Tcl_PkgPresent(interp, name, version, exact)
return Tcl_PkgPresentEx(interp, name, version, exact, (ClientData *) NULL);
}
-char *
+CONST char *
Tcl_PkgPresentEx(interp, name, version, exact, clientDataPtr)
Tcl_Interp *interp; /* Interpreter in which package is now
* available. */
- char *name; /* Name of desired package. */
- char *version; /* Version string for desired version;
+ 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
@@ -386,22 +447,6 @@ Tcl_PkgPresentEx(interp, name, version, exact, clientDataPtr)
Package *pkgPtr;
int satisfies, result;
- /*
- * If an attempt is being made to load this into a standalone executable
- * on a platform where backlinking is not supported then this must be
- * a shared version of Tcl (Otherwise the load would have failed).
- * Detect this situation by checking that this library has been correctly
- * initialised. If it has not been then return immediately as nothing will
- * work.
- */
-
- if (!tclEmptyStringRep) {
- Tcl_AppendResult(interp, "Cannot load package \"", name,
- "\" in standalone executable: This package is not ",
- "compiled with stub support", NULL);
- return NULL;
- }
-
hPtr = Tcl_FindHashEntry(&iPtr->packageTable, name);
if (hPtr) {
pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
@@ -469,7 +514,7 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- static char *pkgOptions[] = {
+ static CONST char *pkgOptions[] = {
"forget", "ifneeded", "names", "present", "provide", "require",
"unknown", "vcompare", "versions", "vsatisfies", (char *) NULL
};
@@ -485,7 +530,8 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
Tcl_HashTable *tablePtr;
- char *version, *argv2, *argv3, *argv4;
+ CONST char *version;
+ char *argv2, *argv3, *argv4;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
@@ -503,7 +549,7 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
keyString = Tcl_GetString(objv[i]);
hPtr = Tcl_FindHashEntry(&iPtr->packageTable, keyString);
if (hPtr == NULL) {
- return TCL_OK;
+ continue;
}
pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
Tcl_DeleteHashEntry(hPtr);
@@ -619,7 +665,7 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
if (version == NULL) {
return TCL_ERROR;
}
- Tcl_SetResult(interp, version, TCL_VOLATILE);
+ Tcl_SetObjResult( interp, Tcl_NewStringObj( version, -1 ) );
break;
}
case PKG_PROVIDE: {
@@ -674,7 +720,7 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
if (version == NULL) {
return TCL_ERROR;
}
- Tcl_SetResult(interp, version, TCL_VOLATILE);
+ Tcl_SetObjResult( interp, Tcl_NewStringObj( version, -1 ) );
break;
}
case PKG_UNKNOWN: {
@@ -776,7 +822,7 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
static Package *
FindPackage(interp, name)
Tcl_Interp *interp; /* Interpreter to use for package lookup. */
- char *name; /* Name of package to fine. */
+ CONST char *name; /* Name of package to fine. */
{
Interp *iPtr = (Interp *) interp;
Tcl_HashEntry *hPtr;
@@ -866,11 +912,11 @@ TclFreePackageInfo(iPtr)
static int
CheckVersion(interp, string)
Tcl_Interp *interp; /* Used for error reporting. */
- char *string; /* Supposedly a version number, which is
+ CONST char *string; /* Supposedly a version number, which is
* groups of decimal digits separated
* by dots. */
{
- char *p = string;
+ CONST char *p = string;
char prevChar;
if (!isdigit(UCHAR(*p))) { /* INTL: digit */
@@ -915,7 +961,8 @@ CheckVersion(interp, string)
static int
ComparePkgVersions(v1, v2, satPtr)
- char *v1, *v2; /* Versions strings, of form 2.1.3 (any
+ CONST char *v1;
+ CONST 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
diff --git a/tcl/generic/tclPlatDecls.h b/tcl/generic/tclPlatDecls.h
index 2aff8ad1b9f..a7e5e174866 100644
--- a/tcl/generic/tclPlatDecls.h
+++ b/tcl/generic/tclPlatDecls.h
@@ -12,6 +12,22 @@
#ifndef _TCLPLATDECLS
#define _TCLPLATDECLS
+/*
+ * Pull in the typedef of TCHAR for windows.
+ */
+#if 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;
+# endif
+#endif
+
/* !BEGIN!: Do not edit below this line. */
/*
@@ -35,12 +51,12 @@ EXTERN char * Tcl_MacConvertTextResource _ANSI_ARGS_((
Handle resource));
/* 2 */
EXTERN int Tcl_MacEvalResource _ANSI_ARGS_((Tcl_Interp * interp,
- char * resourceName, int resourceNumber,
- char * fileName));
+ CONST char * resourceName,
+ int resourceNumber, CONST char * fileName));
/* 3 */
EXTERN Handle Tcl_MacFindResource _ANSI_ARGS_((Tcl_Interp * interp,
- long resourceType, char * resourceName,
- int resourceNumber, char * resFileRef,
+ long resourceType, CONST char * resourceName,
+ int resourceNumber, CONST char * resFileRef,
int * releaseIt));
/* 4 */
EXTERN int Tcl_GetOSTypeFromObj _ANSI_ARGS_((
@@ -58,6 +74,13 @@ EXTERN int strncasecmp _ANSI_ARGS_((CONST char * s1,
EXTERN int strcasecmp _ANSI_ARGS_((CONST char * s1,
CONST char * s2));
#endif /* MAC_TCL */
+#ifdef MAC_OSX_TCL
+/* 0 */
+EXTERN int Tcl_MacOSXOpenBundleResources _ANSI_ARGS_((
+ Tcl_Interp * interp, CONST char * bundleName,
+ int hasResourceFile, int maxPathLen,
+ char * libraryPath));
+#endif /* MAC_OSX_TCL */
typedef struct TclPlatStubs {
int magic;
@@ -70,14 +93,17 @@ typedef struct TclPlatStubs {
#ifdef MAC_TCL
void (*tcl_MacSetEventProc) _ANSI_ARGS_((Tcl_MacConvertEventPtr procPtr)); /* 0 */
char * (*tcl_MacConvertTextResource) _ANSI_ARGS_((Handle resource)); /* 1 */
- int (*tcl_MacEvalResource) _ANSI_ARGS_((Tcl_Interp * interp, char * resourceName, int resourceNumber, char * fileName)); /* 2 */
- Handle (*tcl_MacFindResource) _ANSI_ARGS_((Tcl_Interp * interp, long resourceType, char * resourceName, int resourceNumber, char * resFileRef, int * releaseIt)); /* 3 */
+ int (*tcl_MacEvalResource) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * resourceName, int resourceNumber, CONST char * fileName)); /* 2 */
+ Handle (*tcl_MacFindResource) _ANSI_ARGS_((Tcl_Interp * interp, long resourceType, CONST char * resourceName, int resourceNumber, CONST char * resFileRef, int * releaseIt)); /* 3 */
int (*tcl_GetOSTypeFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, OSType * osTypePtr)); /* 4 */
void (*tcl_SetOSTypeObj) _ANSI_ARGS_((Tcl_Obj * objPtr, OSType osType)); /* 5 */
Tcl_Obj * (*tcl_NewOSTypeObj) _ANSI_ARGS_((OSType osType)); /* 6 */
int (*strncasecmp) _ANSI_ARGS_((CONST char * s1, CONST char * s2, size_t n)); /* 7 */
int (*strcasecmp) _ANSI_ARGS_((CONST char * s1, CONST char * s2)); /* 8 */
#endif /* MAC_TCL */
+#ifdef MAC_OSX_TCL
+ int (*tcl_MacOSXOpenBundleResources) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * bundleName, int hasResourceFile, int maxPathLen, char * libraryPath)); /* 0 */
+#endif /* MAC_OSX_TCL */
} TclPlatStubs;
#ifdef __cplusplus
@@ -142,6 +168,12 @@ extern TclPlatStubs *tclPlatStubsPtr;
(tclPlatStubsPtr->strcasecmp) /* 8 */
#endif
#endif /* MAC_TCL */
+#ifdef MAC_OSX_TCL
+#ifndef Tcl_MacOSXOpenBundleResources
+#define Tcl_MacOSXOpenBundleResources \
+ (tclPlatStubsPtr->tcl_MacOSXOpenBundleResources) /* 0 */
+#endif
+#endif /* MAC_OSX_TCL */
#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
diff --git a/tcl/generic/tclPort.h b/tcl/generic/tclPort.h
index 4c719340b0e..3e9ea2ed34c 100644
--- a/tcl/generic/tclPort.h
+++ b/tcl/generic/tclPort.h
@@ -22,10 +22,22 @@
# include "../win/tclWinPort.h"
#else
# if defined(MAC_TCL)
-# include "tclMacPort.h"
-# else
-# include "../unix/tclUnixPort.h"
-# endif
+# include "tclMacPort.h"
+# else
+# include "../unix/tclUnixPort.h"
+# endif
#endif
+#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(LLONG_MIN)
+# ifdef LLONG_BIT
+# define LLONG_MIN ((Tcl_WideInt)(Tcl_LongAsWide(1)<<(LLONG_BIT-1)))
+# else
+/* Assume we're on a system with a 64-bit 'long long' type */
+# define LLONG_MIN ((Tcl_WideInt)(Tcl_LongAsWide(1)<<63))
+# endif
+/* Assume that if LLONG_MIN is undefined, then so is LLONG_MAX */
+# define LLONG_MAX (~LLONG_MIN)
+#endif
+
+
#endif /* _TCLPORT */
diff --git a/tcl/generic/tclPosixStr.c b/tcl/generic/tclPosixStr.c
index 2055f19eb48..54ddcd74fe4 100644
--- a/tcl/generic/tclPosixStr.c
+++ b/tcl/generic/tclPosixStr.c
@@ -35,7 +35,7 @@
*----------------------------------------------------------------------
*/
-char *
+CONST char *
Tcl_ErrnoId()
{
switch (errno) {
@@ -339,6 +339,9 @@ 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) )
+ case EOVERFLOW: return "EOVERFLOW";
+#endif
#ifdef EPERM
case EPERM: return "EPERM";
#endif
@@ -480,7 +483,7 @@ Tcl_ErrnoId()
*----------------------------------------------------------------------
*/
-char *
+CONST char *
Tcl_ErrnoMsg(err)
int err; /* Error number (such as in errno variable). */
{
@@ -786,6 +789,9 @@ 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) )
+ case EOVERFLOW: return "file too big";
+#endif
#ifdef EPERM
case EPERM: return "not owner";
#endif
@@ -927,7 +933,7 @@ Tcl_ErrnoMsg(err)
*----------------------------------------------------------------------
*/
-char *
+CONST char *
Tcl_SignalId(sig)
int sig; /* Number of signal. */
{
@@ -1059,7 +1065,7 @@ Tcl_SignalId(sig)
*----------------------------------------------------------------------
*/
-char *
+CONST char *
Tcl_SignalMsg(sig)
int sig; /* Number of signal. */
{
@@ -1172,4 +1178,3 @@ Tcl_SignalMsg(sig)
}
return "unknown signal";
}
-
diff --git a/tcl/generic/tclProc.c b/tcl/generic/tclProc.c
index f9d19696ebe..cf5438f690d 100644
--- a/tcl/generic/tclProc.c
+++ b/tcl/generic/tclProc.c
@@ -27,6 +27,8 @@ static int ProcBodySetFromAny _ANSI_ARGS_((Tcl_Interp *interp,
static void ProcBodyUpdateString _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));
/*
* The ProcBodyObjType type
@@ -67,7 +69,8 @@ Tcl_ProcObjCmd(dummy, interp, objc, objv)
{
register Interp *iPtr = (Interp *) interp;
Proc *procPtr;
- char *fullName, *procName;
+ char *fullName;
+ CONST char *procName, *procArgs, *procBody;
Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
Tcl_Command cmd;
Tcl_DString ds;
@@ -145,6 +148,57 @@ Tcl_ProcObjCmd(dummy, interp, objc, objv)
procPtr->cmdPtr = (Command *) cmd;
+
+ /*
+ * Optimize for noop procs: if the argument list is just "args"
+ * and the body is empty, define a compileProc.
+ *
+ * Notes:
+ * - cannot be done for any argument list without having different
+ * compiled/not-compiled behaviour in the "wrong argument #" case,
+ * or making this code much more complicated. In any case, it doesn't
+ * seem to make a lot of sense to verify the number of arguments we
+ * are about to ignore ...
+ * - could be enhanced to handle also non-empty bodies that contain
+ * only comments; however, parsing the body will slow down the
+ * compilation of all procs whose argument list is just _args_
+ */
+
+ procArgs = Tcl_GetString(objv[2]);
+
+ while(*procArgs == ' ') {
+ procArgs++;
+ }
+
+ if ((procArgs[0] == 'a') && (strncmp(procArgs, "args", 4) == 0)) {
+ procArgs +=4;
+ while(*procArgs != '\0') {
+ if (*procArgs != ' ') {
+ goto done;
+ }
+ procArgs++;
+ }
+
+ /*
+ * The argument list is just "args"; check the body
+ */
+
+ procBody = Tcl_GetString(objv[3]);
+ while(*procBody != '\0') {
+ if (!isspace(UCHAR(*procBody))) {
+ goto done;
+ }
+ procBody++;
+ }
+
+ /*
+ * The body is just spaces: link the compileProc
+ */
+
+ ((Command *) cmd)->compileProc = TclCompileNoOp;
+ }
+
+ done:
return TCL_OK;
}
@@ -175,17 +229,17 @@ int
TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
Tcl_Interp *interp; /* interpreter containing proc */
Namespace *nsPtr; /* namespace containing this proc */
- char *procName; /* unqualified name of 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;
- char **argArray = NULL;
+ CONST char **argArray = NULL;
register Proc *procPtr;
int i, length, result, numArgs;
- char *args, *bytes, *p;
+ CONST char *args, *bytes, *p;
register CompiledLocal *localPtr = NULL;
Tcl_Obj *defPtr;
int precompiled = 0;
@@ -281,7 +335,7 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
}
for (i = 0; i < numArgs; i++) {
int fieldCount, nameLength, valueLength;
- char **fieldValues;
+ CONST char **fieldValues;
/*
* Now divide the specifier up into name and default.
@@ -321,7 +375,7 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
p = fieldValues[0];
while (*p != '\0') {
if (*p == '(') {
- char *q = p;
+ CONST char *q = p;
do {
q++;
} while (*q != '\0');
@@ -335,6 +389,14 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
ckfree((char *) fieldValues);
goto procError;
}
+ } else if ((*p == ':') && (*(p+1) == ':')) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "procedure \"", procName,
+ "\" has formal parameter \"", fieldValues[0],
+ "\" that is not a simple name",
+ (char *) NULL);
+ ckfree((char *) fieldValues);
+ goto procError;
}
p++;
}
@@ -415,6 +477,7 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
}
strcpy(localPtr->name, fieldValues[0]);
}
+
ckfree((char *) fieldValues);
}
@@ -481,7 +544,7 @@ procError:
int
TclGetFrame(interp, string, framePtrPtr)
Tcl_Interp *interp; /* Interpreter in which to find frame. */
- char *string; /* String describing frame. */
+ CONST char *string; /* String describing frame. */
CallFrame **framePtrPtr; /* Store pointer to frame here (or NULL
* if global frame indicated). */
{
@@ -653,7 +716,7 @@ Tcl_UplevelObjCmd(dummy, interp, objc, objv)
Proc *
TclFindProc(iPtr, procName)
Interp *iPtr; /* Interpreter in which to look. */
- char *procName; /* Name of desired procedure. */
+ CONST char *procName; /* Name of desired procedure. */
{
Tcl_Command cmd;
Tcl_Command origCmd;
@@ -735,7 +798,7 @@ TclProcInterpProc(clientData, interp, argc, argv)
* invoked. */
int argc; /* Count of number of arguments to this
* procedure. */
- register char **argv; /* Argument values. */
+ register CONST char **argv; /* Argument values. */
{
register Tcl_Obj *objPtr;
register int i;
@@ -839,6 +902,7 @@ TclObjInterpProc(clientData, interp, objc, objv)
register CompiledLocal *localPtr;
char *procName;
int nameLen, localCt, numArgs, argCt, i, result;
+ Tcl_Obj *objResult = Tcl_GetObjResult(interp);
/*
* This procedure generates an array "compiledLocals" that holds the
@@ -943,36 +1007,48 @@ TclObjInterpProc(clientData, interp, objc, objv)
Tcl_Obj *listPtr = Tcl_NewListObj(argCt, &(objv[i]));
varPtr->value.objPtr = listPtr;
Tcl_IncrRefCount(listPtr); /* local var is a reference */
- varPtr->flags &= ~VAR_UNDEFINED;
+ TclClearVarUndefined(varPtr);
argCt = 0;
break; /* done processing args */
} else if (argCt > 0) {
Tcl_Obj *objPtr = objv[i];
varPtr->value.objPtr = objPtr;
- varPtr->flags &= ~VAR_UNDEFINED;
+ TclClearVarUndefined(varPtr);
Tcl_IncrRefCount(objPtr); /* since the local variable now has
* another reference to object. */
} else if (localPtr->defValuePtr != NULL) {
Tcl_Obj *objPtr = localPtr->defValuePtr;
varPtr->value.objPtr = objPtr;
- varPtr->flags &= ~VAR_UNDEFINED;
+ TclClearVarUndefined(varPtr);
Tcl_IncrRefCount(objPtr); /* since the local variable now has
* another reference to object. */
} else {
- Tcl_ResetResult(interp);
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "no value given for parameter \"", localPtr->name,
- "\" to \"", Tcl_GetString(objv[0]), "\"", (char *) NULL);
- result = TCL_ERROR;
- goto procDone;
+ goto incorrectArgs;
}
varPtr++;
localPtr = localPtr->nextPtr;
}
if (argCt > 0) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "called \"", Tcl_GetString(objv[0]),
- "\" with too many arguments", (char *) NULL);
+ incorrectArgs:
+ /*
+ * Build up equivalent to Tcl_WrongNumArgs message for proc
+ */
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(objResult,
+ "wrong # args: should be \"", procName, (char *) NULL);
+ localPtr = procPtr->firstLocalPtr;
+ for (i = 1; i <= numArgs; i++) {
+ if (localPtr->defValuePtr != NULL) {
+ Tcl_AppendStringsToObj(objResult,
+ " ?", localPtr->name, "?", (char *) NULL);
+ } else {
+ Tcl_AppendStringsToObj(objResult,
+ " ", localPtr->name, (char *) NULL);
+ }
+ localPtr = localPtr->nextPtr;
+ }
+ Tcl_AppendStringsToObj(objResult, "\"", (char *) NULL);
+
result = TCL_ERROR;
goto procDone;
}
@@ -981,23 +1057,21 @@ TclObjInterpProc(clientData, interp, objc, objv)
* Invoke the commands in the procedure's body.
*/
- if (tclTraceExec >= 1) {
#ifdef TCL_COMPILE_DEBUG
+ if (tclTraceExec >= 1) {
fprintf(stdout, "Calling proc ");
for (i = 0; i < objc; i++) {
TclPrintObject(stdout, objv[i], 15);
fprintf(stdout, " ");
}
fprintf(stdout, "\n");
-#else /* TCL_COMPILE_DEBUG */
- fprintf(stdout, "Calling proc %.*s\n", nameLen, procName);
-#endif /*TCL_COMPILE_DEBUG*/
fflush(stdout);
}
+#endif /*TCL_COMPILE_DEBUG*/
iPtr->returnCode = TCL_OK;
procPtr->refCount++;
- result = Tcl_EvalObjEx(interp, procPtr->bodyPtr, 0);
+ result = TclCompEvalObj(interp, procPtr->bodyPtr);
procPtr->refCount--;
if (procPtr->refCount <= 0) {
TclProcCleanupProc(procPtr);
@@ -1095,6 +1169,7 @@ TclProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description, procName)
int numChars;
char *ellipsis;
+#ifdef TCL_COMPILE_DEBUG
if (tclTraceCompile >= 1) {
/*
* Display a line summarizing the top level command we
@@ -1110,6 +1185,7 @@ TclProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description, procName)
fprintf(stdout, "Compiling %s \"%.*s%s\"\n",
description, numChars, procName, ellipsis);
}
+#endif
/*
* Plug the current procPtr into the interpreter and coerce
@@ -1207,33 +1283,32 @@ ProcessProcResultCode(interp, procName, nameLen, returnCode)
int returnCode; /* The unexpected result code. */
{
Interp *iPtr = (Interp *) interp;
+ char msg[100 + TCL_INTEGER_SPACE];
+ char *ellipsis = "";
+ if (returnCode == TCL_OK) {
+ return TCL_OK;
+ }
+ if (returnCode > TCL_CONTINUE) {
+ return returnCode;
+ }
if (returnCode == TCL_RETURN) {
- returnCode = TclUpdateReturnInfo(iPtr);
- } else if (returnCode == TCL_ERROR) {
- char msg[100 + TCL_INTEGER_SPACE];
- char *ellipsis = "";
- int numChars = nameLen;
-
- if (numChars > 60) {
- numChars = 60;
- ellipsis = "...";
- }
- sprintf(msg, "\n (procedure \"%.*s%s\" line %d)",
- numChars, procName, ellipsis, iPtr->errorLine);
- Tcl_AddObjErrorInfo(interp, msg, -1);
- } else if (returnCode == TCL_BREAK) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "invoked \"break\" outside of a loop", -1);
- returnCode = TCL_ERROR;
- } else if (returnCode == TCL_CONTINUE) {
+ return TclUpdateReturnInfo(iPtr);
+ }
+ if (returnCode != TCL_ERROR) {
Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "invoked \"continue\" outside of a loop", -1);
- returnCode = TCL_ERROR;
+ Tcl_AppendToObj(Tcl_GetObjResult(interp), ((returnCode == TCL_BREAK)
+ ? "invoked \"break\" outside of a loop"
+ : "invoked \"continue\" outside of a loop"), -1);
}
- return returnCode;
+ if (nameLen > 60) {
+ nameLen = 60;
+ ellipsis = "...";
+ }
+ sprintf(msg, "\n (procedure \"%.*s%s\" line %d)", nameLen, procName,
+ ellipsis, iPtr->errorLine);
+ Tcl_AddObjErrorInfo(interp, msg, -1);
+ return TCL_ERROR;
}
/*
@@ -1346,17 +1421,20 @@ TclUpdateReturnInfo(iPtr)
* exception is being processed. */
{
int code;
+ char *errorCode;
code = iPtr->returnCode;
iPtr->returnCode = TCL_OK;
if (code == TCL_ERROR) {
- Tcl_SetVar2((Tcl_Interp *) iPtr, "errorCode", (char *) NULL,
- (iPtr->errorCode != NULL) ? iPtr->errorCode : "NONE",
+ errorCode = ((iPtr->errorCode != NULL) ? iPtr->errorCode : "NONE");
+ Tcl_ObjSetVar2((Tcl_Interp *) iPtr, iPtr->execEnvPtr->errorCode,
+ NULL, Tcl_NewStringObj(errorCode, -1),
TCL_GLOBAL_ONLY);
iPtr->flags |= ERROR_CODE_SET;
if (iPtr->errorInfo != NULL) {
- Tcl_SetVar2((Tcl_Interp *) iPtr, "errorInfo", (char *) NULL,
- iPtr->errorInfo, TCL_GLOBAL_ONLY);
+ Tcl_ObjSetVar2((Tcl_Interp *) iPtr, iPtr->execEnvPtr->errorInfo,
+ NULL, Tcl_NewStringObj(iPtr->errorInfo, -1),
+ TCL_GLOBAL_ONLY);
iPtr->flags |= ERR_IN_PROGRESS;
}
}
@@ -1568,3 +1646,53 @@ ProcBodyUpdateString(objPtr)
{
panic("called ProcBodyUpdateString");
}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileNoOp --
+ *
+ * Procedure called to compile noOp's
+ *
+ * Results:
+ * The return value is TCL_OK, indicating successful compilation.
+ *
+ * Side effects:
+ * Instructions are added to envPtr to execute a noOp at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+{
+ Tcl_Token *tokenPtr;
+ int i, code;
+ int savedStackDepth = envPtr->currStackDepth;
+
+ tokenPtr = parsePtr->tokenPtr;
+ for(i = 1; i < parsePtr->numWords; i++) {
+ tokenPtr = tokenPtr + tokenPtr->numComponents + 1;
+ envPtr->currStackDepth = savedStackDepth;
+
+ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ code = TclCompileTokens(interp, tokenPtr+1,
+ tokenPtr->numComponents, envPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+ TclEmitOpcode(INST_POP, envPtr);
+ }
+ }
+ envPtr->currStackDepth = savedStackDepth;
+ TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr);
+ return TCL_OK;
+}
+
+
+
diff --git a/tcl/generic/tclRegexp.c b/tcl/generic/tclRegexp.c
index 47254712ced..6fc4d0484c0 100644
--- a/tcl/generic/tclRegexp.c
+++ b/tcl/generic/tclRegexp.c
@@ -88,7 +88,7 @@ static Tcl_ThreadDataKey dataKey;
*/
static TclRegexp * CompileRegexp _ANSI_ARGS_((Tcl_Interp *interp,
- char *pattern, int length, int flags));
+ 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));
@@ -141,7 +141,7 @@ Tcl_RegExp
Tcl_RegExpCompile(interp, string)
Tcl_Interp *interp; /* For use in error reporting and
* to access the interp regexp cache. */
- char *string; /* String for which to produce
+ CONST char *string; /* String for which to produce
* compiled regular expression. */
{
return (Tcl_RegExp) CompileRegexp(interp, string, (int) strlen(string),
@@ -183,7 +183,7 @@ Tcl_RegExpExec(interp, re, string, start)
int flags, result, numChars;
TclRegexp *regexp = (TclRegexp *)re;
Tcl_DString ds;
- Tcl_UniChar *ustr;
+ CONST Tcl_UniChar *ustr;
/*
* If the starting point is offset from the beginning of the buffer,
@@ -243,9 +243,9 @@ Tcl_RegExpRange(re, index, startPtr, endPtr)
int index; /* 0 means give the range of the entire
* match, > 0 means give the range of
* a matching subrange. */
- char **startPtr; /* Store address of first character in
+ CONST char **startPtr; /* Store address of first character in
* (sub-) range here. */
- 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;
@@ -398,8 +398,8 @@ TclRegExpRangeUniChar(re, index, startPtr, endPtr)
int
Tcl_RegExpMatch(interp, string, pattern)
Tcl_Interp *interp; /* Used for error reporting. May be NULL. */
- char *string; /* String. */
- char *pattern; /* Regular expression to match against
+ CONST char *string; /* String. */
+ CONST char *pattern; /* Regular expression to match against
* string. */
{
Tcl_RegExp re;
@@ -455,8 +455,7 @@ Tcl_RegExpExecObj(interp, re, objPtr, offset, nmatches, flags)
regexpPtr->string = NULL;
regexpPtr->objPtr = objPtr;
- udata = Tcl_GetUnicode(objPtr);
- length = Tcl_GetCharLength(objPtr);
+ udata = Tcl_GetUnicodeFromObj(objPtr, &length);
if (offset > length) {
offset = length;
@@ -697,7 +696,7 @@ TclRegAbout(interp, re)
void
TclRegError(interp, msg, status)
Tcl_Interp *interp; /* Interpreter for error reporting. */
- char *msg; /* Message to prepend to error. */
+ CONST char *msg; /* Message to prepend to error. */
int status; /* Status code to report. */
{
char buf[100]; /* ample in practice */
@@ -832,12 +831,12 @@ SetRegexpFromAny(interp, objPtr)
static TclRegexp *
CompileRegexp(interp, string, length, flags)
Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- char *string; /* The regexp to compile (UTF-8). */
+ CONST char *string; /* The regexp to compile (UTF-8). */
int length; /* The length of the string in bytes. */
int flags; /* Compilation flags. */
{
TclRegexp *regexpPtr;
- Tcl_UniChar *uniString;
+ CONST Tcl_UniChar *uniString;
int numChars;
Tcl_DString stringBuf;
int status, i;
diff --git a/tcl/generic/tclResolve.c b/tcl/generic/tclResolve.c
index 7fea4acffea..c2235475507 100644
--- a/tcl/generic/tclResolve.c
+++ b/tcl/generic/tclResolve.c
@@ -63,7 +63,7 @@ Tcl_AddInterpResolvers(interp, name, cmdProc, varProc, compiledVarProc)
Tcl_Interp *interp; /* Interpreter whose name resolution
* rules are being modified. */
- char *name; /* Name of this resolution scheme. */
+ CONST char *name; /* Name of this resolution scheme. */
Tcl_ResolveCmdProc *cmdProc; /* New procedure for command
* resolution */
Tcl_ResolveVarProc *varProc; /* Procedure for variable resolution
@@ -142,7 +142,7 @@ Tcl_GetInterpResolvers(interp, name, resInfoPtr)
Tcl_Interp *interp; /* Interpreter whose name resolution
* rules are being queried. */
- char *name; /* Look for a scheme with this name. */
+ CONST char *name; /* Look for a scheme with this name. */
Tcl_ResolverInfo *resInfoPtr; /* Returns pointers to the procedures,
* if found */
{
@@ -194,7 +194,7 @@ Tcl_RemoveInterpResolvers(interp, name)
Tcl_Interp *interp; /* Interpreter whose name resolution
* rules are being modified. */
- char *name; /* Name of the scheme to be removed. */
+ CONST char *name; /* Name of the scheme to be removed. */
{
Interp *iPtr = (Interp*)interp;
ResolverScheme **prevPtrPtr, *resPtr;
@@ -291,7 +291,7 @@ BumpCmdRefEpochs(nsPtr)
* type:
*
* typedef int (Tcl_ResolveCmdProc) _ANSI_ARGS_((
- * Tcl_Interp* interp, char* name, Tcl_Namespace *context,
+ * Tcl_Interp* interp, CONST char* name, Tcl_Namespace *context,
* int flags, Tcl_Command *rPtr));
*
* Whenever a command is executed or Tcl_FindCommand is invoked
@@ -308,7 +308,7 @@ BumpCmdRefEpochs(nsPtr)
* time:
*
* typedef int (Tcl_ResolveCompiledVarProc) _ANSI_ARGS_((
- * Tcl_Interp* interp, char* name, Tcl_Namespace *context,
+ * Tcl_Interp* interp, CONST char* name, Tcl_Namespace *context,
* Tcl_ResolvedVarInfo *rPtr));
*
* If this procedure is able to resolve the name, it should return
@@ -325,7 +325,7 @@ BumpCmdRefEpochs(nsPtr)
* Tcl_FindNamespaceVar.) This procedure has the following type:
*
* typedef int (Tcl_ResolveVarProc) _ANSI_ARGS_((
- * Tcl_Interp* interp, char* name, Tcl_Namespace *context,
+ * Tcl_Interp* interp, CONST char* name, Tcl_Namespace *context,
* int flags, Tcl_Var *rPtr));
*
* This procedure is quite similar to the compile-time version.
diff --git a/tcl/generic/tclResult.c b/tcl/generic/tclResult.c
index 2b537b73e7a..15e07558b8b 100644
--- a/tcl/generic/tclResult.c
+++ b/tcl/generic/tclResult.c
@@ -297,7 +297,7 @@ Tcl_SetResult(interp, string, freeProc)
*----------------------------------------------------------------------
*/
-char *
+CONST char *
Tcl_GetStringResult(interp)
register Tcl_Interp *interp; /* Interpreter whose result to return. */
{
diff --git a/tcl/generic/tclScan.c b/tcl/generic/tclScan.c
index c5d4784dfe3..7d4e560e59c 100644
--- a/tcl/generic/tclScan.c
+++ b/tcl/generic/tclScan.c
@@ -12,6 +12,10 @@
*/
#include "tclInt.h"
+/*
+ * For strtoll() and strtoull() declarations on some platforms...
+ */
+#include "tclPort.h"
/*
* Flag values used by Tcl_ScanObjCmd.
@@ -29,6 +33,7 @@
#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. */
/*
* The following structure contains the information associated with
@@ -270,6 +275,7 @@ ValidateFormat(interp, format, numVars, totalSubs)
int staticAssign[STATIC_LIST_SIZE];
int *nassign = staticAssign;
int objIndex, xpgSize, nspace = STATIC_LIST_SIZE;
+ char buf[TCL_UTF_MAX+1];
/*
* Initialize an array that records the number of times a variable
@@ -359,10 +365,16 @@ ValidateFormat(interp, format, numVars, totalSubs)
}
/*
- * Ignore size specifier.
+ * Handle any size specifier.
*/
- if ((ch == 'l') || (ch == 'L') || (ch == 'h')) {
+ switch (ch) {
+ case 'l':
+ case 'L':
+#ifndef TCL_WIDE_INT_IS_LONG
+ flags |= SCAN_LONGER;
+#endif
+ case 'h':
format += Tcl_UtfToUniChar(format, &ch);
}
@@ -375,24 +387,45 @@ ValidateFormat(interp, format, numVars, totalSubs)
*/
switch (ch) {
+ case 'c':
+ if (flags & SCAN_WIDTH) {
+ Tcl_SetResult(interp,
+ "field width may not be specified in %c conversion",
+ TCL_STATIC);
+ goto error;
+ }
+ /*
+ * Fall through!
+ */
case 'n':
+ case 's':
+ if (flags & SCAN_LONGER) {
+ invalidLonger:
+ buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "'l' modifier may not be specified in %", buf,
+ " conversion", NULL);
+ goto error;
+ }
+ /*
+ * Fall through!
+ */
case 'd':
+ case 'e':
+ case 'f':
+ case 'g':
case 'i':
case 'o':
- case 'x':
case 'u':
- case 'f':
- case 'e':
- case 'g':
- case 's':
- break;
- case 'c':
- if (flags & SCAN_WIDTH) {
- Tcl_SetResult(interp, "field width may not be specified in %c conversion", TCL_STATIC);
- goto error;
- }
- break;
+ case 'x':
+ break;
+ /*
+ * Bracket terms need special checking
+ */
case '[':
+ if (flags & SCAN_LONGER) {
+ goto invalidLonger;
+ }
if (*format == '\0') {
goto badSet;
}
@@ -539,13 +572,18 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
{
char *format;
int numVars, nconversions, totalVars = -1;
- int objIndex, offset, i, value, result, code;
+ int objIndex, offset, i, result, code;
+ long value;
char *string, *end, *baseString;
char op = 0;
int base = 0;
int underflow = 0;
size_t width;
long (*fn)() = NULL;
+#ifndef TCL_WIDE_INT_IS_LONG
+ Tcl_WideInt (*lfn)() = NULL;
+ Tcl_WideInt wideValue;
+#endif
Tcl_UniChar ch, sch;
Tcl_Obj **objs = NULL, *objPtr = NULL;
int flags;
@@ -644,7 +682,7 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
if (*end == '$') {
format = end+1;
format += Tcl_UtfToUniChar(format, &ch);
- objIndex = value - 1;
+ objIndex = (int) value - 1;
}
}
@@ -660,10 +698,19 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
}
/*
- * Ignore size specifier.
+ * Handle any size specifier.
*/
- if ((ch == 'l') || (ch == 'L') || (ch == 'h')) {
+ switch (ch) {
+ case 'l':
+ case 'L':
+#ifndef TCL_WIDE_INT_IS_LONG
+ flags |= SCAN_LONGER;
+#endif
+ /*
+ * Fall through so we skip to the next character.
+ */
+ case 'h':
format += Tcl_UtfToUniChar(format, &ch);
}
@@ -685,27 +732,42 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
op = 'i';
base = 10;
fn = (long (*)())strtol;
+#ifndef TCL_WIDE_INT_IS_LONG
+ lfn = (Tcl_WideInt (*)())strtoll;
+#endif
break;
case 'i':
op = 'i';
base = 0;
fn = (long (*)())strtol;
+#ifndef TCL_WIDE_INT_IS_LONG
+ lfn = (Tcl_WideInt (*)())strtoll;
+#endif
break;
case 'o':
op = 'i';
base = 8;
- fn = (long (*)())strtol;
+ fn = (long (*)())strtoul;
+#ifndef TCL_WIDE_INT_IS_LONG
+ lfn = (Tcl_WideInt (*)())strtoull;
+#endif
break;
case 'x':
op = 'i';
base = 16;
- fn = (long (*)())strtol;
+ fn = (long (*)())strtoul;
+#ifndef TCL_WIDE_INT_IS_LONG
+ lfn = (Tcl_WideInt (*)())strtoull;
+#endif
break;
case 'u':
op = 'i';
base = 10;
flags |= SCAN_UNSIGNED;
fn = (long (*)())strtoul;
+#ifndef TCL_WIDE_INT_IS_LONG
+ lfn = (Tcl_WideInt (*)())strtoull;
+#endif
break;
case 'f':
@@ -854,12 +916,19 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
* 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);
@@ -954,13 +1023,33 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
if (!(flags & SCAN_SUPPRESS)) {
*end = '\0';
- value = (int) (*fn)(buf, NULL, base);
- if ((flags & SCAN_UNSIGNED) && (value < 0)) {
- sprintf(buf, "%u", value); /* INTL: ISO digit */
- objPtr = Tcl_NewStringObj(buf, -1);
+#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);
+ }
} else {
- objPtr = Tcl_NewIntObj(value);
+#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 ((unsigned long) value > UINT_MAX) {
+ objPtr = Tcl_NewLongObj(value);
+ } else {
+ objPtr = Tcl_NewIntObj(value);
+ }
+ }
+#ifndef TCL_WIDE_INT_IS_LONG
}
+#endif
Tcl_IncrRefCount(objPtr);
objs[objIndex++] = objPtr;
}
@@ -975,6 +1064,7 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
if ((width == 0) || (width > sizeof(buf) - 1)) {
width = sizeof(buf) - 1;
}
+ flags &= ~SCAN_LONGER;
flags |= SCAN_SIGNOK | SCAN_NODIGITS | SCAN_PTOK | SCAN_EXPOK;
for (end = buf; width > 0; width--) {
switch (*string) {
@@ -1112,7 +1202,9 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
}
}
}
- ckfree((char*) objs);
+ if (objs != NULL) {
+ ckfree((char*) objs);
+ }
if (code == TCL_OK) {
if (underflow && (nconversions == 0)) {
if (numVars) {
diff --git a/tcl/generic/tclStringObj.c b/tcl/generic/tclStringObj.c
index 7c435b508f6..c532e01afcd 100644
--- a/tcl/generic/tclStringObj.c
+++ b/tcl/generic/tclStringObj.c
@@ -33,8 +33,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id$
- */
+ * RCS: @(#) $Id$ */
#include "tclInt.h"
@@ -43,15 +42,15 @@
*/
static void AppendUnicodeToUnicodeRep _ANSI_ARGS_((
- Tcl_Obj *objPtr, Tcl_UniChar *unicode,
+ Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode,
int appendNumChars));
static void AppendUnicodeToUtfRep _ANSI_ARGS_((
- Tcl_Obj *objPtr, Tcl_UniChar *unicode,
+ Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode,
int numChars));
static void AppendUtfToUnicodeRep _ANSI_ARGS_((Tcl_Obj *objPtr,
- char *bytes, int numBytes));
+ CONST char *bytes, int numBytes));
static void AppendUtfToUtfRep _ANSI_ARGS_((Tcl_Obj *objPtr,
- char *bytes, int numBytes));
+ CONST char *bytes, int numBytes));
static void FillUnicodeRep _ANSI_ARGS_((Tcl_Obj *objPtr));
@@ -109,6 +108,44 @@ typedef struct String {
#define SET_STRING(objPtr, stringPtr) \
(objPtr)->internalRep.otherValuePtr = (VOID *) (stringPtr)
+/*
+ * TCL STRING GROWTH ALGORITHM
+ *
+ * When growing strings (during an append, for example), the following growth
+ * algorithm is used:
+ *
+ * Attempt to allocate 2 * (originalLength + appendLength)
+ * On failure:
+ * attempt to allocate originalLength + 2*appendLength +
+ * TCL_GROWTH_MIN_ALLOC
+ *
+ * This algorithm allows very good performance, as it rapidly increases the
+ * memory allocated for a given string, which minimizes the number of
+ * reallocations that must be performed. However, using only the doubling
+ * algorithm can lead to a significant waste of memory. In particular, it
+ * may fail even when there is sufficient memory available to complete the
+ * append request (but there is not 2 * totalLength memory available). So when
+ * the doubling fails (because there is not enough memory available), the
+ * algorithm requests a smaller amount of memory, which is still enough to
+ * 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 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.
+ *
+ * The growth algorithm can be tuned by adjusting the following parameters:
+ *
+ * TCL_GROWTH_MIN_ALLOC Additional space, in bytes, to allocate when
+ * the double allocation has failed.
+ * Default is 1024 (1 kilobyte).
+ */
+#ifndef TCL_GROWTH_MIN_ALLOC
+#define TCL_GROWTH_MIN_ALLOC 1024
+#endif
+
/*
*----------------------------------------------------------------------
@@ -182,9 +219,9 @@ Tcl_NewStringObj(bytes, length)
* TCL_MEM_DEBUG is defined. It creates new string objects. It is the
* same as the Tcl_NewStringObj procedure above except that it calls
* Tcl_DbCkalloc directly with the file name and line number from its
- * caller. This simplifies debugging since then the checkmem command
- * will report the correct file name and line number when reporting
- * objects that haven't been freed.
+ * 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
* result of calling Tcl_NewStringObj.
@@ -213,7 +250,7 @@ Tcl_DbNewStringObj(bytes, length, file, line)
* when initializing the new object. If
* negative, use bytes up to the first
* NULL byte. */
- 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 debugging. */
@@ -238,7 +275,7 @@ Tcl_DbNewStringObj(bytes, length, file, line)
* when initializing the new object. If
* negative, use bytes up to the first
* NULL byte. */
- 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 debugging. */
@@ -250,10 +287,10 @@ Tcl_DbNewStringObj(bytes, length, file, line)
/*
*---------------------------------------------------------------------------
*
- * TclNewUnicodeObj --
+ * Tcl_NewUnicodeObj --
*
* This procedure is creates a new String object and initializes
- * it from the given Utf String. If the Utf String is the same size
+ * it from the given Unicode String. If the Utf String is the same size
* as the Unicode string, don't duplicate the data.
*
* Results:
@@ -269,7 +306,7 @@ Tcl_DbNewStringObj(bytes, length, file, line)
Tcl_Obj *
Tcl_NewUnicodeObj(unicode, numChars)
- Tcl_UniChar *unicode; /* The unicode string used to initialize
+ CONST Tcl_UniChar *unicode; /* The unicode string used to initialize
* the new object. */
int numChars; /* Number of characters in the unicode
* string. */
@@ -483,6 +520,63 @@ Tcl_GetUnicode(objPtr)
/*
*----------------------------------------------------------------------
*
+ * Tcl_GetUnicodeFromObj --
+ *
+ * Get the Unicode form of the String object with length. If
+ * the object is not already a String object, it will be converted
+ * to one. If the String object does not have a Unicode rep, then
+ * one is create from the UTF string format.
+ *
+ * Results:
+ * Returns a pointer to the object's internal Unicode string.
+ *
+ * Side effects:
+ * Converts the object to have the String internal rep.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_UniChar *
+Tcl_GetUnicodeFromObj(objPtr, lengthPtr)
+ Tcl_Obj *objPtr; /* The object to find the unicode string for. */
+ int *lengthPtr; /* If non-NULL, the location where the
+ * string rep's unichar length should be
+ * stored. If NULL, no length is stored. */
+{
+ String *stringPtr;
+
+ SetStringFromAny(NULL, objPtr);
+ stringPtr = GET_STRING(objPtr);
+
+ if ((stringPtr->numChars == -1) || (stringPtr->uallocated == 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);
+ }
+
+ if (lengthPtr != NULL) {
+ *lengthPtr = stringPtr->numChars;
+ }
+ return stringPtr->unicode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_GetRange --
*
* Create a Tcl Object that contains the chars between first and last
@@ -499,10 +593,9 @@ Tcl_GetUnicode(objPtr)
*----------------------------------------------------------------------
*/
-Tcl_Obj*
+Tcl_Obj *
Tcl_GetRange(objPtr, first, last)
-
- Tcl_Obj *objPtr; /* The Tcl object to find the range of. */
+ 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. */
{
@@ -580,7 +673,7 @@ Tcl_GetRange(objPtr, first, last)
void
Tcl_SetStringObj(objPtr, bytes, length)
register Tcl_Obj *objPtr; /* Object whose internal rep to init. */
- char *bytes; /* Points to the first of the length bytes
+ 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"
* when initializing the object. If
@@ -668,12 +761,97 @@ Tcl_SetObjLength(objPtr, length)
* Not enough space in current string. Reallocate the string
* space and free the old string.
*/
+ if (objPtr->bytes != tclEmptyStringRep) {
+ 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);
+ }
+ }
+ objPtr->bytes = new;
+ stringPtr->allocated = length;
+ }
+
+ objPtr->length = length;
+ if ((objPtr->bytes != NULL) && (objPtr->bytes != tclEmptyStringRep)) {
+ objPtr->bytes[length] = 0;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AttemptSetObjLength --
+ *
+ * This procedure changes the length of the string representation
+ * of an object. It uses the attempt* (non-panic'ing) memory allocators.
+ *
+ * Results:
+ * 1 if the requested memory was allocated, 0 otherwise.
+ *
+ * Side effects:
+ * If the size of objPtr's string representation is greater than
+ * length, then it is reduced to length and a new terminating null
+ * byte is stored in the strength. If the length of the string
+ * representation is greater than length, the storage space is
+ * reallocated to the given length; a null byte is stored at the
+ * end, but other bytes past the end of the original string
+ * representation are undefined. The object's internal
+ * representation is changed to "expendable string".
+ *
+ *----------------------------------------------------------------------
+ */
- new = (char *) ckalloc((unsigned) (length+1));
- if (objPtr->bytes != NULL) {
- memcpy((VOID *) new, (VOID *) objPtr->bytes,
- (size_t) objPtr->length);
- Tcl_InvalidateStringRep(objPtr);
+int
+Tcl_AttemptSetObjLength(objPtr, length)
+ register Tcl_Obj *objPtr; /* Pointer to object. This object must
+ * not currently be shared. */
+ register int length; /* Number of bytes desired for string
+ * representation of object, not including
+ * terminating null byte. */
+{
+ char *new;
+ String *stringPtr;
+
+ if (Tcl_IsShared(objPtr)) {
+ panic("Tcl_AttemptSetObjLength called with shared object");
+ }
+ SetStringFromAny(NULL, objPtr);
+
+ /*
+ * Invalidate the unicode data.
+ */
+
+ stringPtr = GET_STRING(objPtr);
+ stringPtr->numChars = -1;
+ stringPtr->uallocated = 0;
+
+ if (length > (int) stringPtr->allocated) {
+
+ /*
+ * Not enough space in current string. Reallocate the string
+ * space and free the old string.
+ */
+ if (objPtr->bytes != tclEmptyStringRep) {
+ new = (char *) attemptckrealloc((char *)objPtr->bytes,
+ (unsigned)(length+1));
+ if (new == NULL) {
+ return 0;
+ }
+ } else {
+ new = (char *) attemptckalloc((unsigned) (length+1));
+ if (new == 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 = new;
stringPtr->allocated = length;
@@ -683,6 +861,7 @@ Tcl_SetObjLength(objPtr, length)
if ((objPtr->bytes != NULL) && (objPtr->bytes != tclEmptyStringRep)) {
objPtr->bytes[length] = 0;
}
+ return 1;
}
/*
@@ -704,7 +883,7 @@ Tcl_SetObjLength(objPtr, length)
void
Tcl_SetUnicodeObj(objPtr, unicode, numChars)
Tcl_Obj *objPtr; /* The object to set the string of. */
- Tcl_UniChar *unicode; /* The unicode string used to initialize
+ CONST Tcl_UniChar *unicode; /* The unicode string used to initialize
* the object. */
int numChars; /* Number of characters in the unicode
* string. */
@@ -766,7 +945,7 @@ Tcl_SetUnicodeObj(objPtr, unicode, numChars)
void
Tcl_AppendToObj(objPtr, bytes, length)
register Tcl_Obj *objPtr; /* Points to the object to append to. */
- char *bytes; /* Points to the bytes to append to the
+ 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
@@ -823,7 +1002,7 @@ Tcl_AppendToObj(objPtr, bytes, length)
void
Tcl_AppendUnicodeToObj(objPtr, unicode, length)
register Tcl_Obj *objPtr; /* Points to the object to append to. */
- Tcl_UniChar *unicode; /* The unicode string to append to the
+ CONST Tcl_UniChar *unicode; /* The unicode string to append to the
* object. */
int length; /* Number of chars in "unicode". */
{
@@ -838,15 +1017,7 @@ Tcl_AppendUnicodeToObj(objPtr, unicode, length)
}
SetStringFromAny(NULL, objPtr);
-
- /*
- * TEMPORARY!!! This is terribly inefficient, but it works, and Don
- * needs for me to check this stuff in ASAP. -Melissa
- */
-
-/* UpdateStringOfString(objPtr); */
-/* AppendUnicodeToUtfRep(objPtr, unicode, length); */
-/* return; */
+ stringPtr = GET_STRING(objPtr);
/*
* If objPtr has a valid Unicode rep, then append the "unicode"
@@ -854,7 +1025,6 @@ Tcl_AppendUnicodeToObj(objPtr, unicode, length)
* "unicode" to objPtr's string rep.
*/
- stringPtr = GET_STRING(objPtr);
if (stringPtr->uallocated > 0) {
AppendUnicodeToUnicodeRep(objPtr, unicode, length);
} else {
@@ -970,13 +1140,12 @@ Tcl_AppendObjToObj(objPtr, appendObjPtr)
static void
AppendUnicodeToUnicodeRep(objPtr, unicode, appendNumChars)
- Tcl_Obj *objPtr; /* Points to the object to append to. */
- Tcl_UniChar *unicode; /* String to append. */
- int appendNumChars; /* Number of chars of "unicode" to append. */
+ 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;
- int numChars;
- size_t newSize;
+ String *stringPtr, *tmpString;
+ size_t numChars;
if (appendNumChars < 0) {
appendNumChars = 0;
@@ -990,21 +1159,28 @@ AppendUnicodeToUnicodeRep(objPtr, unicode, appendNumChars)
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
-
+
/*
* If not enough space has been allocated for the unicode rep,
- * reallocate the internal rep object with double the amount of
- * space needed, so the unicode string can grow without being
- * reallocated.
+ * reallocate the internal rep object with additional space. First try to
+ * double the required allocation; if that fails, try a more modest
+ * increase. See the "TCL STRING GROWTH ALGORITHM" comment at the top of
+ * this file for an explanation of this growth algorithm.
*/
numChars = stringPtr->numChars + appendNumChars;
- newSize = (numChars + 1) * sizeof(Tcl_UniChar);
- if (newSize > stringPtr->uallocated) {
- stringPtr->uallocated = newSize * 2;
- stringPtr = (String *) ckrealloc((char*)stringPtr,
+ if (numChars >= stringPtr->uallocated) {
+ stringPtr->uallocated = 2 * numChars;
+ tmpString = (String *) attemptckrealloc((char *)stringPtr,
STRING_SIZE(stringPtr->uallocated));
+ if (tmpString == NULL) {
+ stringPtr->uallocated =
+ numChars + appendNumChars + TCL_GROWTH_MIN_ALLOC;
+ tmpString = (String *) ckrealloc((char *)stringPtr,
+ STRING_SIZE(stringPtr->uallocated));
+ }
+ stringPtr = tmpString;
SET_STRING(objPtr, stringPtr);
}
@@ -1018,7 +1194,6 @@ AppendUnicodeToUnicodeRep(objPtr, unicode, appendNumChars)
stringPtr->unicode[numChars] = 0;
stringPtr->numChars = numChars;
- SET_STRING(objPtr, stringPtr);
Tcl_InvalidateStringRep(objPtr);
}
@@ -1041,12 +1216,12 @@ AppendUnicodeToUnicodeRep(objPtr, unicode, appendNumChars)
static void
AppendUnicodeToUtfRep(objPtr, unicode, numChars)
- Tcl_Obj *objPtr; /* Points to the object to append to. */
- Tcl_UniChar *unicode; /* String to convert to UTF. */
- int numChars; /* Number of chars of "unicode" to convert. */
+ 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;
- char *bytes;
+ CONST char *bytes;
if (numChars < 0) {
numChars = 0;
@@ -1059,7 +1234,7 @@ AppendUnicodeToUtfRep(objPtr, unicode, numChars)
}
Tcl_DStringInit(&dsPtr);
- bytes = (char *)Tcl_UniCharToUtfDString(unicode, numChars, &dsPtr);
+ bytes = Tcl_UniCharToUtfDString(unicode, numChars, &dsPtr);
AppendUtfToUtfRep(objPtr, bytes, Tcl_DStringLength(&dsPtr));
Tcl_DStringFree(&dsPtr);
}
@@ -1085,7 +1260,7 @@ AppendUnicodeToUtfRep(objPtr, unicode, numChars)
static void
AppendUtfToUnicodeRep(objPtr, bytes, numBytes)
Tcl_Obj *objPtr; /* Points to the object to append to. */
- char *bytes; /* String to convert to Unicode. */
+ CONST char *bytes; /* String to convert to Unicode. */
int numBytes; /* Number of bytes of "bytes" to convert. */
{
Tcl_DString dsPtr;
@@ -1126,7 +1301,7 @@ AppendUtfToUnicodeRep(objPtr, bytes, numBytes)
static void
AppendUtfToUtfRep(objPtr, bytes, numBytes)
Tcl_Obj *objPtr; /* Points to the object to append to. */
- char *bytes; /* String to append. */
+ CONST char *bytes; /* String to append. */
int numBytes; /* Number of bytes of "bytes" to append. */
{
String *stringPtr;
@@ -1151,13 +1326,17 @@ AppendUtfToUtfRep(objPtr, bytes, numBytes)
if (newLength > (int) stringPtr->allocated) {
/*
- * There isn't currently enough space in the string
- * representation so allocate additional space. Overallocate the
- * space by doubling it so that we won't have to do as much
- * reallocation in the future.
+ * 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.
*/
- Tcl_SetObjLength(objPtr, 2*newLength);
+ if (Tcl_AttemptSetObjLength(objPtr, 2 * newLength) == 0) {
+ Tcl_SetObjLength(objPtr,
+ newLength + numBytes + TCL_GROWTH_MIN_ALLOC);
+ }
} else {
/*
@@ -1199,7 +1378,7 @@ Tcl_AppendStringsToObjVA (objPtr, argList)
{
#define STATIC_LIST_SIZE 16
String *stringPtr;
- int newLength, oldLength;
+ int newLength, oldLength, attemptLength;
register char *string, *dst;
char *static_list[STATIC_LIST_SIZE];
char **args = static_list;
@@ -1220,7 +1399,8 @@ Tcl_AppendStringsToObjVA (objPtr, argList)
*/
nargs = 0;
- newLength = oldLength = objPtr->length;
+ newLength = 0;
+ oldLength = objPtr->length;
while (1) {
string = va_arg(argList, char *);
if (string == NULL) {
@@ -1244,23 +1424,35 @@ Tcl_AppendStringsToObjVA (objPtr, argList)
newLength += strlen(string);
args[nargs++] = string;
}
- if (newLength == oldLength) {
+ if (newLength == 0) {
goto done;
}
stringPtr = GET_STRING(objPtr);
- if (newLength > (int) stringPtr->allocated) {
+ if (oldLength + newLength > (int) stringPtr->allocated) {
/*
* There isn't currently enough space in the string
- * representation so allocate additional space. If the current
+ * 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 overallocate the space so
- * that we won't have to do as much reallocation in the future.
+ * 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.
*/
- Tcl_SetObjLength(objPtr,
- (objPtr->length == 0) ? newLength : 2*newLength);
+ 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);
+ }
+ }
}
/*
@@ -1291,7 +1483,7 @@ Tcl_AppendStringsToObjVA (objPtr, argList)
if (dst != NULL) {
*dst = 0;
}
- objPtr->length = newLength;
+ objPtr->length = oldLength + newLength;
done:
/*
@@ -1486,10 +1678,8 @@ DupStringInternalRep(srcPtr, copyPtr)
static int
SetStringFromAny(interp, objPtr)
Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- Tcl_Obj *objPtr; /* The object to convert. */
+ register Tcl_Obj *objPtr; /* The object to convert. */
{
- String *stringPtr;
-
/*
* The Unicode object is opitmized for the case where each UTF char
* in a string is only one byte. In this case, we store the value of
@@ -1497,6 +1687,7 @@ SetStringFromAny(interp, objPtr)
*/
if (objPtr->typePtr != &tclStringType) {
+ String *stringPtr;
if (objPtr->typePtr != NULL) {
if (objPtr->bytes == NULL) {
diff --git a/tcl/generic/tclStubInit.c b/tcl/generic/tclStubInit.c
index fec95ec45f4..ae18983f7a7 100644
--- a/tcl/generic/tclStubInit.c
+++ b/tcl/generic/tclStubInit.c
@@ -31,6 +31,10 @@
#undef Tcl_NewStringObj
#undef Tcl_DumpActiveMemory
#undef Tcl_ValidateAllMemory
+#if TCL_PRESERVE_BINARY_COMPATABILITY
+# undef Tcl_FindHashEntry
+# undef Tcl_CreateHashEntry
+#endif
/*
* WARNING: The contents of this file is automatically generated by the
@@ -43,7 +47,7 @@
TclIntStubs tclIntStubs = {
TCL_STUB_MAGIC,
NULL,
- TclAccess, /* 0 */
+ NULL, /* 0 */
TclAccessDeleteProc, /* 1 */
TclAccessInsertProc, /* 2 */
TclAllocateFreeObjects, /* 3 */
@@ -76,11 +80,11 @@ TclIntStubs tclIntStubs = {
TclDumpMemoryInfo, /* 14 */
NULL, /* 15 */
TclExprFloatError, /* 16 */
- TclFileAttrsCmd, /* 17 */
- TclFileCopyCmd, /* 18 */
- TclFileDeleteCmd, /* 19 */
- TclFileMakeDirsCmd, /* 20 */
- TclFileRenameCmd, /* 21 */
+ NULL, /* 17 */
+ NULL, /* 18 */
+ NULL, /* 19 */
+ NULL, /* 20 */
+ NULL, /* 21 */
TclFindElement, /* 22 */
TclFindProc, /* 23 */
TclFormatInt, /* 24 */
@@ -88,13 +92,13 @@ TclIntStubs tclIntStubs = {
NULL, /* 26 */
TclGetDate, /* 27 */
TclpGetDefaultStdChannel, /* 28 */
- TclGetElementOfIndexedArray, /* 29 */
+ NULL, /* 29 */
NULL, /* 30 */
TclGetExtension, /* 31 */
TclGetFrame, /* 32 */
TclGetInterpProc, /* 33 */
TclGetIntForIndex, /* 34 */
- TclGetIndexedScalar, /* 35 */
+ NULL, /* 35 */
TclGetLong, /* 36 */
TclGetLoadedPackages, /* 37 */
TclGetNamespaceForQualName, /* 38 */
@@ -106,8 +110,8 @@ TclIntStubs tclIntStubs = {
TclGuessPackageName, /* 44 */
TclHideUnsafeCommands, /* 45 */
TclInExit, /* 46 */
- TclIncrElementOfIndexedArray, /* 47 */
- TclIncrIndexedScalar, /* 48 */
+ NULL, /* 47 */
+ NULL, /* 48 */
TclIncrVar2, /* 49 */
TclInitCompiledLocals, /* 50 */
TclInterpInit, /* 51 */
@@ -118,7 +122,7 @@ TclIntStubs tclIntStubs = {
NULL, /* 56 */
NULL, /* 57 */
TclLookupVar, /* 58 */
- TclpMatchFiles, /* 59 */
+ NULL, /* 59 */
TclNeedSpace, /* 60 */
TclNewProcBodyObj, /* 61 */
TclObjCommandComplete, /* 62 */
@@ -127,22 +131,22 @@ TclIntStubs tclIntStubs = {
TclObjInvokeGlobal, /* 65 */
TclOpenFileChannelDeleteProc, /* 66 */
TclOpenFileChannelInsertProc, /* 67 */
- TclpAccess, /* 68 */
+ NULL, /* 68 */
TclpAlloc, /* 69 */
- TclpCopyFile, /* 70 */
- TclpCopyDirectory, /* 71 */
- TclpCreateDirectory, /* 72 */
- TclpDeleteFile, /* 73 */
+ NULL, /* 70 */
+ NULL, /* 71 */
+ NULL, /* 72 */
+ NULL, /* 73 */
TclpFree, /* 74 */
TclpGetClicks, /* 75 */
TclpGetSeconds, /* 76 */
TclpGetTime, /* 77 */
TclpGetTimeZone, /* 78 */
- TclpListVolumes, /* 79 */
- TclpOpenFileChannel, /* 80 */
+ NULL, /* 79 */
+ NULL, /* 80 */
TclpRealloc, /* 81 */
- TclpRemoveDirectory, /* 82 */
- TclpRenameFile, /* 83 */
+ NULL, /* 82 */
+ NULL, /* 83 */
NULL, /* 84 */
NULL, /* 85 */
NULL, /* 86 */
@@ -154,12 +158,12 @@ TclIntStubs tclIntStubs = {
TclProcCompileProc, /* 92 */
TclProcDeleteProc, /* 93 */
TclProcInterpProc, /* 94 */
- TclpStat, /* 95 */
+ NULL, /* 95 */
TclRenameCommand, /* 96 */
TclResetShadowedCmdRefs, /* 97 */
TclServiceIdle, /* 98 */
- TclSetElementOfIndexedArray, /* 99 */
- TclSetIndexedScalar, /* 100 */
+ NULL, /* 99 */
+ NULL, /* 100 */
#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
TclSetPreInitScript, /* 101 */
#endif /* UNIX */
@@ -180,7 +184,7 @@ TclIntStubs tclIntStubs = {
#ifdef MAC_TCL
NULL, /* 104 */
#endif /* MAC_TCL */
- TclStat, /* 105 */
+ NULL, /* 105 */
TclStatDeleteProc, /* 106 */
TclStatInsertProc, /* 107 */
TclTeardownNamespace, /* 108 */
@@ -212,9 +216,9 @@ TclIntStubs tclIntStubs = {
TclpStrftime, /* 134 */
TclpCheckStackSpace, /* 135 */
NULL, /* 136 */
- TclpChdir, /* 137 */
+ NULL, /* 137 */
TclGetEnv, /* 138 */
- TclpLoadFile, /* 139 */
+ NULL, /* 139 */
TclLooksLikeInt, /* 140 */
TclpGetCwd, /* 141 */
TclSetByteCodeFromAny, /* 142 */
@@ -235,9 +239,18 @@ TclIntStubs tclIntStubs = {
TclVarTraceExists, /* 157 */
TclSetStartupScriptFileName, /* 158 */
TclGetStartupScriptFileName, /* 159 */
- TclpMatchFilesTypes, /* 160 */
+ NULL, /* 160 */
TclChannelTransform, /* 161 */
TclChannelEventScriptInvoker, /* 162 */
+ TclGetInstructionTable, /* 163 */
+ TclExpandCodeArray, /* 164 */
+ TclpSetInitialEncodings, /* 165 */
+ TclListObjSetElement, /* 166 */
+ TclSetStartupScriptPath, /* 167 */
+ TclGetStartupScriptPath, /* 168 */
+ TclpUtfNcmp2, /* 169 */
+ TclCheckInterpTraces, /* 170 */
+ TclCheckExecutionTraces, /* 171 */
};
TclIntPlatStubs tclIntPlatStubs = {
@@ -254,6 +267,10 @@ TclIntPlatStubs tclIntPlatStubs = {
TclpOpenFile, /* 7 */
TclUnixWaitForFile, /* 8 */
TclpCreateTempFile, /* 9 */
+ TclpReaddir, /* 10 */
+ TclpLocaltime, /* 11 */
+ TclpGmtime, /* 12 */
+ TclpInetNtoa, /* 13 */
#endif /* UNIX */
#ifdef __WIN32__
TclWinConvertError, /* 0 */
@@ -277,12 +294,13 @@ TclIntPlatStubs tclIntPlatStubs = {
TclpMakeFile, /* 18 */
TclpOpenFile, /* 19 */
TclWinAddProcess, /* 20 */
- TclpAsyncMark, /* 21 */
+ NULL, /* 21 */
TclpCreateTempFile, /* 22 */
TclpGetTZName, /* 23 */
TclWinNoBackslash, /* 24 */
TclWinGetPlatform, /* 25 */
TclWinSetInterfaces, /* 26 */
+ TclWinFlushDirtyChannels, /* 27 */
#endif /* __WIN32__ */
#ifdef MAC_TCL
TclpSysAlloc, /* 0 */
@@ -292,10 +310,10 @@ TclIntPlatStubs tclIntPlatStubs = {
FSpGetDefaultDir, /* 4 */
FSpSetDefaultDir, /* 5 */
FSpFindFolder, /* 6 */
- GetGlobalMouse, /* 7 */
- FSpGetDirectoryID, /* 8 */
- FSpOpenResFileCompat, /* 9 */
- FSpCreateResFileCompat, /* 10 */
+ GetGlobalMouseTcl, /* 7 */
+ FSpGetDirectoryIDTcl, /* 8 */
+ FSpOpenResFileCompatTcl, /* 9 */
+ FSpCreateResFileCompatTcl, /* 10 */
FSpLocationFromPath, /* 11 */
FSpPathFromLocation, /* 12 */
TclMacExitHandler, /* 13 */
@@ -309,8 +327,9 @@ TclIntPlatStubs tclIntPlatStubs = {
TclMacUnRegisterResourceFork, /* 21 */
TclMacCreateEnv, /* 22 */
TclMacFOpenHack, /* 23 */
- NULL, /* 24 */
+ TclpGetTZName, /* 24 */
TclMacChmod, /* 25 */
+ FSpLLocationFromPath, /* 26 */
#endif /* MAC_TCL */
};
@@ -332,6 +351,9 @@ TclPlatStubs tclPlatStubs = {
strncasecmp, /* 7 */
strcasecmp, /* 8 */
#endif /* MAC_TCL */
+#ifdef MAC_OSX_TCL
+ Tcl_MacOSXOpenBundleResources, /* 0 */
+#endif /* MAC_OSX_TCL */
};
static TclStubHooks tclStubHooks = {
@@ -611,7 +633,7 @@ TclStubs tclStubs = {
Tcl_ResetResult, /* 217 */
Tcl_ScanElement, /* 218 */
Tcl_ScanCountedElement, /* 219 */
- Tcl_Seek, /* 220 */
+ Tcl_SeekOld, /* 220 */
Tcl_ServiceAll, /* 221 */
Tcl_ServiceEvent, /* 222 */
Tcl_SetAssocData, /* 223 */
@@ -637,7 +659,7 @@ TclStubs tclStubs = {
Tcl_SplitPath, /* 243 */
Tcl_StaticPackage, /* 244 */
Tcl_StringMatch, /* 245 */
- Tcl_Tell, /* 246 */
+ Tcl_TellOld, /* 246 */
Tcl_TraceVar, /* 247 */
Tcl_TraceVar2, /* 248 */
Tcl_TranslateFileName, /* 249 */
@@ -669,21 +691,13 @@ TclStubs tclStubs = {
Tcl_SetErrorCodeVA, /* 275 */
Tcl_VarEvalVA, /* 276 */
Tcl_WaitPid, /* 277 */
-#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
- Tcl_PanicVA, /* 278 */
-#endif /* UNIX */
-#ifdef __WIN32__
Tcl_PanicVA, /* 278 */
-#endif /* __WIN32__ */
-#ifdef MAC_TCL
- NULL, /* 278 */
-#endif /* MAC_TCL */
Tcl_GetVersion, /* 279 */
Tcl_InitMemory, /* 280 */
Tcl_StackChannel, /* 281 */
Tcl_UnstackChannel, /* 282 */
Tcl_GetStackedChannel, /* 283 */
- NULL, /* 284 */
+ Tcl_SetMainLoop, /* 284 */
NULL, /* 285 */
Tcl_AppendObjToObj, /* 286 */
Tcl_CreateEncoding, /* 287 */
@@ -811,7 +825,88 @@ TclStubs tclStubs = {
Tcl_ChannelGetHandleProc, /* 409 */
Tcl_ChannelFlushProc, /* 410 */
Tcl_ChannelHandlerProc, /* 411 */
+ Tcl_JoinThread, /* 412 */
+ Tcl_IsChannelShared, /* 413 */
+ Tcl_IsChannelRegistered, /* 414 */
+ Tcl_CutChannel, /* 415 */
+ Tcl_SpliceChannel, /* 416 */
+ Tcl_ClearChannelHandlers, /* 417 */
+ Tcl_IsChannelExisting, /* 418 */
+ Tcl_UniCharNcasecmp, /* 419 */
+ Tcl_UniCharCaseMatch, /* 420 */
+ Tcl_FindHashEntry, /* 421 */
+ Tcl_CreateHashEntry, /* 422 */
+ Tcl_InitCustomHashTable, /* 423 */
+ Tcl_InitObjHashTable, /* 424 */
+ Tcl_CommandTraceInfo, /* 425 */
+ Tcl_TraceCommand, /* 426 */
+ Tcl_UntraceCommand, /* 427 */
+ Tcl_AttemptAlloc, /* 428 */
+ Tcl_AttemptDbCkalloc, /* 429 */
+ Tcl_AttemptRealloc, /* 430 */
+ Tcl_AttemptDbCkrealloc, /* 431 */
+ Tcl_AttemptSetObjLength, /* 432 */
+ Tcl_GetChannelThread, /* 433 */
+ Tcl_GetUnicodeFromObj, /* 434 */
+ Tcl_GetMathFuncInfo, /* 435 */
+ Tcl_ListMathFuncs, /* 436 */
+ Tcl_SubstObj, /* 437 */
+ Tcl_DetachChannel, /* 438 */
+ Tcl_IsStandardChannel, /* 439 */
+ Tcl_FSCopyFile, /* 440 */
+ Tcl_FSCopyDirectory, /* 441 */
+ Tcl_FSCreateDirectory, /* 442 */
+ Tcl_FSDeleteFile, /* 443 */
+ Tcl_FSLoadFile, /* 444 */
+ Tcl_FSMatchInDirectory, /* 445 */
+ Tcl_FSLink, /* 446 */
+ Tcl_FSRemoveDirectory, /* 447 */
+ Tcl_FSRenameFile, /* 448 */
+ Tcl_FSLstat, /* 449 */
+ Tcl_FSUtime, /* 450 */
+ Tcl_FSFileAttrsGet, /* 451 */
+ Tcl_FSFileAttrsSet, /* 452 */
+ Tcl_FSFileAttrStrings, /* 453 */
+ Tcl_FSStat, /* 454 */
+ Tcl_FSAccess, /* 455 */
+ Tcl_FSOpenFileChannel, /* 456 */
+ Tcl_FSGetCwd, /* 457 */
+ Tcl_FSChdir, /* 458 */
+ Tcl_FSConvertToPathType, /* 459 */
+ Tcl_FSJoinPath, /* 460 */
+ Tcl_FSSplitPath, /* 461 */
+ Tcl_FSEqualPaths, /* 462 */
+ Tcl_FSGetNormalizedPath, /* 463 */
+ Tcl_FSJoinToPath, /* 464 */
+ Tcl_FSGetInternalRep, /* 465 */
+ Tcl_FSGetTranslatedPath, /* 466 */
+ Tcl_FSEvalFile, /* 467 */
+ Tcl_FSNewNativePath, /* 468 */
+ Tcl_FSGetNativePath, /* 469 */
+ Tcl_FSFileSystemInfo, /* 470 */
+ Tcl_FSPathSeparator, /* 471 */
+ Tcl_FSListVolumes, /* 472 */
+ Tcl_FSRegister, /* 473 */
+ Tcl_FSUnregister, /* 474 */
+ Tcl_FSData, /* 475 */
+ Tcl_FSGetTranslatedStringPath, /* 476 */
+ Tcl_FSGetFileSystemForPath, /* 477 */
+ Tcl_FSGetPathType, /* 478 */
+ Tcl_OutputBuffered, /* 479 */
+ Tcl_FSMountsChanged, /* 480 */
+ Tcl_EvalTokensStandard, /* 481 */
+ Tcl_GetTime, /* 482 */
+ Tcl_CreateObjTrace, /* 483 */
+ Tcl_GetCommandInfoFromToken, /* 484 */
+ Tcl_SetCommandInfoFromToken, /* 485 */
+ Tcl_DbNewWideIntObj, /* 486 */
+ Tcl_GetWideIntFromObj, /* 487 */
+ Tcl_NewWideIntObj, /* 488 */
+ Tcl_SetWideIntObj, /* 489 */
+ Tcl_AllocStatBuf, /* 490 */
+ Tcl_Seek, /* 491 */
+ Tcl_Tell, /* 492 */
+ Tcl_ChannelWideSeekProc, /* 493 */
};
/* !END!: Do not edit above this line. */
-
diff --git a/tcl/generic/tclStubLib.c b/tcl/generic/tclStubLib.c
index 048fdd4d85f..b00211d2e77 100644
--- a/tcl/generic/tclStubLib.c
+++ b/tcl/generic/tclStubLib.c
@@ -80,13 +80,13 @@ HasStubSupport (interp)
#undef Tcl_InitStubs
#endif
-char *
+CONST char *
Tcl_InitStubs (interp, version, exact)
Tcl_Interp *interp;
- char *version;
+ CONST char *version;
int exact;
{
- char *actualVersion;
+ CONST char *actualVersion;
TclStubs *tmp;
if (!tclStubsPtr) {
diff --git a/tcl/generic/tclTest.c b/tcl/generic/tclTest.c
index 99f80d68bf1..20071d3d008 100644
--- a/tcl/generic/tclTest.c
+++ b/tcl/generic/tclTest.c
@@ -17,14 +17,25 @@
*/
#define TCL_TEST
-
#include "tclInt.h"
#include "tclPort.h"
+
+/*
+ * Required for Testregexp*Cmd
+ */
#include "tclRegexp.h"
-#include "tclIO.h"
+
+/*
+ * Required for TestlocaleCmd
+ */
#include <locale.h>
/*
+ * Required for the TestChannelCmd and TestChannelEventCmd
+ */
+#include "tclIO.h"
+
+/*
* Declare external functions used in Windows tests.
*/
@@ -95,6 +106,12 @@ typedef struct TclEncoding {
static int freeCount;
/*
+ * Boolean flag used by the "testsetmainloop" and "testexitmainloop"
+ * commands.
+ */
+static int exitMainLoop = 0;
+
+/*
* Forward declarations for procedures defined later in this file:
*/
@@ -106,9 +123,9 @@ static void CleanupTestSetassocdataTests _ANSI_ARGS_((
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, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int CmdProc2 _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static void CmdTraceDeleteProc _ANSI_ARGS_((
ClientData clientData, Tcl_Interp *interp,
int level, char *command, Tcl_CmdProc *cmdProc,
@@ -120,14 +137,14 @@ static void CmdTraceProc _ANSI_ARGS_((ClientData clientData,
int argc, char **argv));
static int CreatedCommandProc _ANSI_ARGS_((
ClientData clientData, Tcl_Interp *interp,
- int argc, char **argv));
+ int argc, CONST char **argv));
static int CreatedCommandProc2 _ANSI_ARGS_((
ClientData clientData, Tcl_Interp *interp,
- int argc, char **argv));
+ 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, char **argv));
+ 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,
@@ -143,18 +160,29 @@ static int EncodingFromUtfProc _ANSI_ARGS_((ClientData clientData,
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, char **argv));
+ 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, char **argv));
+ 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));
+ 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, char **argv));
+ 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,
@@ -162,25 +190,25 @@ static int TestAccessProc2 _ANSI_ARGS_((CONST char *path,
static int TestAccessProc3 _ANSI_ARGS_((CONST char *path,
int mode));
static int TestasyncCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestcmdinfoCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestcmdtokenCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestcmdtraceCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestchmodCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestcreatecommandCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestdcallCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestdelCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestdelassocdataCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestdstringCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestencodingObjCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]));
@@ -191,29 +219,31 @@ static int TestevalobjvObjCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]));
static int TestexithandlerCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestexprlongCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestexprparserObjCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]));
static int TestexprstringCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestfileCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ 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, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestgetassocdataCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestgetplatformCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestgetvarfullnameCmd _ANSI_ARGS_((
ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *CONST objv[]));
static int TestinterpdeleteCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestlinkCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestlocaleCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]));
@@ -223,14 +253,26 @@ static int TestMathFunc _ANSI_ARGS_((ClientData clientData,
static int TestMathFunc2 _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, Tcl_Value *args,
Tcl_Value *resultPtr));
-static Tcl_Channel TestOpenFileChannelProc1 _ANSI_ARGS_((Tcl_Interp *interp,
- char *filename, char *modeString, int permissions));
-static Tcl_Channel TestOpenFileChannelProc2 _ANSI_ARGS_((Tcl_Interp *interp,
- char *filename, char *modeString, int permissions));
-static Tcl_Channel TestOpenFileChannelProc3 _ANSI_ARGS_((Tcl_Interp *interp,
- char *filename, char *modeString, int permissions));
+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, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestparserObjCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]));
@@ -250,21 +292,21 @@ static int TestsaveresultCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Obj *CONST objv[]));
static void TestsaveresultFree _ANSI_ARGS_((char *blockPtr));
static int TestsetassocdataCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestsetCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestsetobjerrorcodeCmd _ANSI_ARGS_((
ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *CONST objv[]));
-static int TestopenfilechannelprocCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+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, char **argv));
-static int TestsetrecursionlimitCmd _ANSI_ARGS_((
- ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[]));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TeststaticpkgCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ 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,
@@ -272,16 +314,111 @@ static int TestStatProc2 _ANSI_ARGS_((CONST char *path,
static int TestStatProc3 _ANSI_ARGS_((CONST char *path,
struct stat *buf));
static int TeststatprocCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TesttranslatefilenameCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestupvarCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
-static int TestChannelCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
-static int TestChannelEventCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
+static int TestWrongNumArgsObjCmd _ANSI_ARGS_((
+ ClientData clientData, Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[]));
+static int TestGetIndexFromObjStructObjCmd _ANSI_ARGS_((
+ 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 void TestReport _ANSI_ARGS_((CONST char* cmd, Tcl_Obj* arg1, Tcl_Obj* arg2));
+
+static Tcl_Obj *TestReportGetNativePath(Tcl_Obj* pathObjPtr);
+
+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 Tcl_Filesystem testReportingFilesystem = {
+ "reporting",
+ sizeof(Tcl_Filesystem),
+ TCL_FILESYSTEM_VERSION_1,
+ &TestReportInFilesystem, /* path in */
+ &TestReportDupInternalRep,
+ &TestReportFreeInternalRep,
+ NULL, /* native to norm */
+ NULL, /* convert to native */
+ &TestReportNormalizePath,
+ NULL, /* path type */
+ NULL, /* separator */
+ &TestReportStat,
+ &TestReportAccess,
+ &TestReportOpenFileChannel,
+ &TestReportMatchInDirectory,
+ &TestReportUtime,
+ &TestReportLink,
+ NULL /* list volumes */,
+ &TestReportFileAttrStrings,
+ &TestReportFileAttrsGet,
+ &TestReportFileAttrsSet,
+ &TestReportCreateDirectory,
+ &TestReportRemoveDirectory,
+ &TestReportDeleteFile,
+ &TestReportCopyFile,
+ &TestReportRenameFile,
+ &TestReportCopyDirectory,
+ &TestReportLstat,
+ &TestReportLoadFile,
+ NULL /* cwd */,
+ &TestReportChdir
+};
+
/*
* External (platform specific) initialization routine, these declarations
* explicitly don't use EXTERN since this code does not get compiled
@@ -315,7 +452,15 @@ Tcltest_Init(interp)
Tcl_Interp *interp; /* Interpreter for application. */
{
Tcl_ValueType t3ArgTypes[2];
-
+
+ Tcl_Obj *listPtr;
+ Tcl_Obj **objv;
+ int objc, index;
+ static CONST char *specialOptions[] = {
+ "-appinitprocerror", "-appinitprocdeleteinterp",
+ "-appinitprocclosestderr", "-appinitprocsetrcfile", (char *) NULL
+ };
+
if (Tcl_PkgProvide(interp, "Tcltest", TCL_VERSION) == TCL_ERROR) {
return TCL_ERROR;
}
@@ -330,6 +475,13 @@ Tcltest_Init(interp)
(Tcl_CmdDeleteProc *) NULL);
Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, (ClientData) 0,
(Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "testwrongnumargs", TestWrongNumArgsObjCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "testfilesystem", TestFilesystemObjCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc *) 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,
@@ -373,7 +525,9 @@ Tcltest_Init(interp)
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "testfevent", TestfeventCmd, (ClientData) 0,
(Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateCommand(interp, "testfile", TestfileCmd,
+ Tcl_CreateObjCommand(interp, "testfilelink", TestfilelinkCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "testfile", TestfileCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "testgetassocdata", TestgetassocdataCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
@@ -414,9 +568,6 @@ Tcltest_Init(interp)
(Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateObjCommand(interp, "testsetrecursionlimit",
- TestsetrecursionlimitCmd,
- (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "teststaticpkg", TeststaticpkgCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "testtranslatefilename",
@@ -430,6 +581,12 @@ Tcltest_Init(interp)
(ClientData) 345);
Tcl_CreateCommand(interp, "teststatproc", TeststatprocCmd, (ClientData) 0,
(Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateCommand(interp, "testmainthread", TestmainthreadCmd, (ClientData) 0,
+ (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateCommand(interp, "testsetmainloop", TestsetmainloopCmd,
+ (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateCommand(interp, "testexitmainloop", TestexitmainloopCmd,
+ (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
t3ArgTypes[0] = TCL_EITHER;
t3ArgTypes[1] = TCL_EITHER;
Tcl_CreateMathFunc(interp, "T3", 2, t3ArgTypes, TestMathFunc2,
@@ -442,6 +599,42 @@ Tcltest_Init(interp)
#endif
/*
+ * Check for special options used in ../tests/main.test
+ */
+
+ listPtr = Tcl_GetVar2Ex(interp, "argv", NULL, TCL_GLOBAL_ONLY);
+ if (listPtr != NULL) {
+ if (Tcl_ListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ 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;
+ }
+ }
+ }
+ }
+
+ /*
* And finally add any platform specific test commands.
*/
@@ -471,7 +664,7 @@ TestasyncCmd(dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
TestAsyncHandler *asyncPtr, *prevPtr;
int id, code;
@@ -545,7 +738,7 @@ TestasyncCmd(dummy, interp, argc, argv)
break;
}
}
- Tcl_SetResult(interp, argv[3], TCL_VOLATILE);
+ Tcl_SetResult(interp, (char *)argv[3], TCL_VOLATILE);
return code;
} else {
Tcl_AppendResult(interp, "bad option \"", argv[1],
@@ -564,17 +757,25 @@ AsyncHandlerProc(clientData, interp, code)
int code; /* Current return code from command. */
{
TestAsyncHandler *asyncPtr = (TestAsyncHandler *) clientData;
- char *listArgv[4];
- char string[TCL_INTEGER_SPACE], *cmd;
+ CONST char *listArgv[4], *cmd;
+ char string[TCL_INTEGER_SPACE];
TclFormatInt(string, code);
listArgv[0] = asyncPtr->command;
- listArgv[1] = Tcl_GetStringResult(interp);
+ listArgv[1] = Tcl_GetString(Tcl_GetObjResult(interp));
listArgv[2] = string;
listArgv[3] = NULL;
cmd = Tcl_Merge(3, listArgv);
- code = Tcl_Eval(interp, cmd);
- ckfree(cmd);
+ if (interp != NULL) {
+ 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.
+ */
+ }
+ ckfree((char *)cmd);
return code;
}
@@ -602,7 +803,7 @@ TestcmdinfoCmd(dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
Tcl_CmdInfo info;
@@ -675,7 +876,7 @@ CmdProc1(clientData, interp, argc, argv)
ClientData clientData; /* String to return. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
Tcl_AppendResult(interp, "CmdProc1 ", (char *) clientData,
(char *) NULL);
@@ -688,7 +889,7 @@ CmdProc2(clientData, interp, argc, argv)
ClientData clientData; /* String to return. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
Tcl_AppendResult(interp, "CmdProc2 ", (char *) clientData,
(char *) NULL);
@@ -737,10 +938,10 @@ TestcmdtokenCmd(dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
Tcl_Command token;
- long int l;
+ int *l;
char buf[30];
if (argc != 3) {
@@ -751,12 +952,12 @@ TestcmdtokenCmd(dummy, interp, argc, argv)
if (strcmp(argv[1], "create") == 0) {
token = Tcl_CreateCommand(interp, argv[2], CmdProc1,
(ClientData) "original", (Tcl_CmdDeleteProc *) NULL);
- sprintf(buf, "%lx", (long int) token);
+ 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], "%lx", &l) != 1) {
+
+ if (sscanf(argv[2], "%p", &l) != 1) {
Tcl_AppendResult(interp, "bad command token \"", argv[2],
"\"", (char *) NULL);
return TCL_ERROR;
@@ -764,7 +965,7 @@ TestcmdtokenCmd(dummy, interp, argc, argv)
objPtr = Tcl_NewObj();
Tcl_GetCommandFullName(interp, (Tcl_Command) l, objPtr);
-
+
Tcl_AppendElement(interp,
Tcl_GetCommandName(interp, (Tcl_Command) l));
Tcl_AppendElement(interp, Tcl_GetString(objPtr));
@@ -801,7 +1002,7 @@ TestcmdtraceCmd(dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
Tcl_DString buffer;
int result;
@@ -834,9 +1035,30 @@ TestcmdtraceCmd(dummy, interp, argc, argv)
cmdTrace = Tcl_CreateTrace(interp, 50000,
(Tcl_CmdTraceProc *) CmdTraceDeleteProc, (ClientData) NULL);
Tcl_Eval(interp, argv[2]);
+ } 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 );
+ return TCL_ERROR;
+ } else {
+ return result;
+ }
+
} else {
Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": must be tracetest or deletetest", (char *) NULL);
+ "\": must be tracetest, deletetest or resulttest",
+ (char *) NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -893,6 +1115,41 @@ CmdTraceDeleteProc(clientData, interp, level, command, cmdProc,
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 ) );
+ return TCL_ERROR;
+ } else if ( !strcmp( word, "Break" ) ) {
+ return TCL_BREAK;
+ } else if ( !strcmp( word, "Continue" ) ) {
+ return TCL_CONTINUE;
+ } else if ( !strcmp( word, "Return" ) ) {
+ return TCL_RETURN;
+ } else if ( !strcmp( word, "OtherStatus" ) ) {
+ return 6;
+ } else {
+ return TCL_OK;
+ }
+}
+
+static void
+ObjTraceDeleteProc( clientData )
+ ClientData clientData;
+{
+ int * intPtr = (int *) clientData;
+ *intPtr = 1; /* Record that the trace was deleted */
+}
+
/*
*----------------------------------------------------------------------
*
@@ -919,7 +1176,7 @@ TestcreatecommandCmd(dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
@@ -952,7 +1209,7 @@ CreatedCommandProc(clientData, interp, argc, argv)
ClientData clientData; /* String to return. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
Tcl_CmdInfo info;
int found;
@@ -974,7 +1231,7 @@ CreatedCommandProc2(clientData, interp, argc, argv)
ClientData clientData; /* String to return. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
Tcl_CmdInfo info;
int found;
@@ -1013,7 +1270,7 @@ TestdcallCmd(dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
int i, id;
@@ -1079,7 +1336,7 @@ TestdelCmd(dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
DelCmd *dPtr;
Tcl_Interp *slave;
@@ -1109,7 +1366,7 @@ DelCmdProc(clientData, interp, argc, argv)
ClientData clientData; /* String result to return. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
DelCmd *dPtr = (DelCmd *) clientData;
@@ -1154,7 +1411,7 @@ TestdelassocdataCmd(clientData, interp, argc, argv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
@@ -1188,7 +1445,7 @@ TestdstringCmd(dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
int count;
@@ -1323,7 +1580,7 @@ TestencodingObjCmd(dummy, interp, objc, objv)
int index, length;
char *string;
TclEncoding *encodingPtr;
- static char *optionStrings[] = {
+ static CONST char *optionStrings[] = {
"create", "delete", "path",
NULL
};
@@ -1595,7 +1852,7 @@ TestexithandlerCmd(clientData, interp, argc, argv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
int value;
@@ -1663,7 +1920,7 @@ TestexprlongCmd(clientData, interp, argc, argv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
long exprResult;
char buf[4 + TCL_INTEGER_SPACE];
@@ -1700,7 +1957,7 @@ TestexprstringCmd(clientData, interp, argc, argv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
@@ -1713,6 +1970,74 @@ 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.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * May create a link on disk.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+{
+ Tcl_Obj *contents;
+
+ if (objc < 2 || objc > 3) {
+ 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);
+ 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);
+ 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);
+ 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
+ */
+ Tcl_DecrRefCount(contents);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TestgetassocdataCmd --
*
* This procedure implements the "testgetassocdata" command. It is
@@ -1732,7 +2057,7 @@ TestgetassocdataCmd(clientData, interp, argc, argv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
char *res;
@@ -1770,9 +2095,9 @@ TestgetplatformCmd(clientData, interp, argc, argv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
- static char *platformStrings[] = { "unix", "mac", "windows" };
+ static CONST char *platformStrings[] = { "unix", "mac", "windows" };
TclPlatformType *platform;
#ifdef __WIN32__
@@ -1815,7 +2140,7 @@ TestinterpdeleteCmd(dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
Tcl_Interp *slaveToDelete;
@@ -1824,11 +2149,6 @@ TestinterpdeleteCmd(dummy, interp, argc, argv)
" path\"", (char *) NULL);
return TCL_ERROR;
}
- if (argv[1][0] == '\0') {
- Tcl_AppendResult(interp, "cannot delete current interpreter",
- (char *) NULL);
- return TCL_ERROR;
- }
slaveToDelete = Tcl_GetSlave(interp, argv[1]);
if (slaveToDelete == (Tcl_Interp *) NULL) {
return TCL_ERROR;
@@ -1861,27 +2181,36 @@ TestlinkCmd(dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
static int intVar = 43;
static int boolVar = 4;
static double realVar = 1.23;
+ static Tcl_WideInt wideVar = Tcl_LongAsWide(79);
static char *stringVar = NULL;
static int created = 0;
- char buffer[TCL_DOUBLE_SPACE];
+ char buffer[2*TCL_DOUBLE_SPACE];
int writable, flag;
+ Tcl_Obj *tmp;
if (argc < 2) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " option ?arg arg arg?\"", (char *) NULL);
+ " option ?arg arg arg arg arg?\"", (char *) NULL);
return TCL_ERROR;
}
if (strcmp(argv[1], "create") == 0) {
+ if (argc != 7) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " ", argv[1],
+ " intRO realRO boolRO stringRO wideRO\"", (char *) NULL);
+ return TCL_ERROR;
+ }
if (created) {
Tcl_UnlinkVar(interp, "int");
Tcl_UnlinkVar(interp, "real");
Tcl_UnlinkVar(interp, "bool");
Tcl_UnlinkVar(interp, "string");
+ Tcl_UnlinkVar(interp, "wide");
}
created = 1;
if (Tcl_GetBoolean(interp, argv[2], &writable) != TCL_OK) {
@@ -1916,11 +2245,20 @@ TestlinkCmd(dummy, interp, argc, argv)
TCL_LINK_STRING | flag) != TCL_OK) {
return TCL_ERROR;
}
+ if (Tcl_GetBoolean(interp, argv[6], &writable) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
+ if (Tcl_LinkVar(interp, "wide", (char *) &wideVar,
+ TCL_LINK_WIDE_INT | flag) != TCL_OK) {
+ return TCL_ERROR;
+ }
} else if (strcmp(argv[1], "delete") == 0) {
Tcl_UnlinkVar(interp, "int");
Tcl_UnlinkVar(interp, "real");
Tcl_UnlinkVar(interp, "bool");
Tcl_UnlinkVar(interp, "string");
+ Tcl_UnlinkVar(interp, "wide");
created = 0;
} else if (strcmp(argv[1], "get") == 0) {
TclFormatInt(buffer, intVar);
@@ -1930,11 +2268,18 @@ TestlinkCmd(dummy, interp, argc, argv)
TclFormatInt(buffer, boolVar);
Tcl_AppendElement(interp, buffer);
Tcl_AppendElement(interp, (stringVar == NULL) ? "-" : stringVar);
+ /*
+ * Wide ints only have an object-based interface.
+ */
+ tmp = Tcl_NewWideIntObj(wideVar);
+ Tcl_AppendElement(interp, Tcl_GetString(tmp));
+ Tcl_DecrRefCount(tmp);
} else if (strcmp(argv[1], "set") == 0) {
- if (argc != 6) {
+ if (argc != 7) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " ", argv[1],
- "intValue realValue boolValue stringValue\"", (char *) NULL);
+ argv[0], " ", argv[1],
+ " intValue realValue boolValue stringValue wideValue\"",
+ (char *) NULL);
return TCL_ERROR;
}
if (argv[2][0] != 0) {
@@ -1963,11 +2308,20 @@ TestlinkCmd(dummy, interp, argc, argv)
strcpy(stringVar, argv[5]);
}
}
+ if (argv[6][0] != 0) {
+ tmp = Tcl_NewStringObj(argv[6], -1);
+ if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) {
+ Tcl_DecrRefCount(tmp);
+ return TCL_ERROR;
+ }
+ Tcl_DecrRefCount(tmp);
+ }
} else if (strcmp(argv[1], "update") == 0) {
- if (argc != 6) {
+ if (argc != 7) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " ", argv[1],
- "intValue realValue boolValue stringValue\"", (char *) NULL);
+ argv[0], " ", argv[1],
+ "intValue realValue boolValue stringValue wideValue\"",
+ (char *) NULL);
return TCL_ERROR;
}
if (argv[2][0] != 0) {
@@ -2000,6 +2354,15 @@ TestlinkCmd(dummy, interp, argc, argv)
}
Tcl_UpdateLinkedVar(interp, "string");
}
+ if (argv[6][0] != 0) {
+ tmp = Tcl_NewStringObj(argv[6], -1);
+ if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) {
+ Tcl_DecrRefCount(tmp);
+ return TCL_ERROR;
+ }
+ Tcl_DecrRefCount(tmp);
+ Tcl_UpdateLinkedVar(interp, "wide");
+ }
} else {
Tcl_AppendResult(interp, "bad option \"", argv[1],
"\": should be create, delete, get, set, or update",
@@ -2036,7 +2399,7 @@ TestlocaleCmd(clientData, interp, objc, objv)
int index;
char *locale;
- static char *optionStrings[] = {
+ static CONST char *optionStrings[] = {
"ctype", "numeric", "time", "collate", "monetary",
"all", NULL
};
@@ -2148,8 +2511,16 @@ TestMathFunc2(clientData, interp, args, resultPtr)
resultPtr->type = TCL_DOUBLE;
resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
+#ifndef TCL_WIDE_INT_IS_LONG
+ } else if (args[1].type == TCL_WIDE_INT) {
+ Tcl_WideInt w0 = Tcl_LongAsWide(i0);
+ Tcl_WideInt w1 = args[1].wideValue;
+
+ resultPtr->type = TCL_WIDE_INT;
+ resultPtr->wideValue = ((w0 > w1)? w0 : w1);
+#endif
} else {
- Tcl_SetResult(interp, "T2: wrong type for arg 2", TCL_STATIC);
+ Tcl_SetResult(interp, "T3: wrong type for arg 2", TCL_STATIC);
result = TCL_ERROR;
}
} else if (args[0].type == TCL_DOUBLE) {
@@ -2165,12 +2536,44 @@ TestMathFunc2(clientData, interp, args, resultPtr)
resultPtr->type = TCL_DOUBLE;
resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
+#ifndef TCL_WIDE_INT_IS_LONG
+ } else if (args[1].type == TCL_WIDE_INT) {
+ double d1 = Tcl_WideAsDouble(args[1].wideValue);
+
+ resultPtr->type = TCL_DOUBLE;
+ resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
+#endif
+ } else {
+ Tcl_SetResult(interp, "T3: wrong type for arg 2", TCL_STATIC);
+ result = TCL_ERROR;
+ }
+#ifndef TCL_WIDE_INT_IS_LONG
+ } 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) {
+ double d0 = Tcl_WideAsDouble(w0);
+ double d1 = args[1].doubleValue;
+
+ resultPtr->type = TCL_DOUBLE;
+ resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
+ } else if (args[1].type == TCL_WIDE_INT) {
+ Tcl_WideInt w1 = args[1].wideValue;
+
+ resultPtr->type = TCL_WIDE_INT;
+ resultPtr->wideValue = ((w0 > w1)? w0 : w1);
} else {
- Tcl_SetResult(interp, "T2: wrong type for arg 2", TCL_STATIC);
+ Tcl_SetResult(interp, "T3: wrong type for arg 2", TCL_STATIC);
result = TCL_ERROR;
}
+#endif
} else {
- Tcl_SetResult(interp, "T2: wrong type for arg 1", TCL_STATIC);
+ Tcl_SetResult(interp, "T3: wrong type for arg 1", TCL_STATIC);
result = TCL_ERROR;
}
return result;
@@ -2422,7 +2825,8 @@ TestparsevarObjCmd(clientData, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* The argument objects. */
{
- char *name, *value, *termPtr;
+ CONST char *value;
+ CONST char *name, *termPtr;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "varName");
@@ -2521,7 +2925,7 @@ TestparsevarnameObjCmd(clientData, interp, objc, objv)
*/
/* ARGSUSED */
-int
+static int
TestregexpObjCmd(dummy, interp, objc, objv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
@@ -2534,7 +2938,7 @@ TestregexpObjCmd(dummy, interp, objc, objv)
char *string;
Tcl_Obj *objPtr;
Tcl_RegExpInfo info;
- static char *options[] = {
+ static CONST char *options[] = {
"-indices", "-nocase", "-about", "-expanded",
"-line", "-linestop", "-lineanchor",
"-xflags",
@@ -2648,7 +3052,8 @@ TestregexpObjCmd(dummy, interp, objc, objv)
Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
if (objc > 2 && (cflags&REG_EXPECT) && indices) {
- char *varName, *value;
+ char *varName;
+ CONST char *value;
int start, end;
char info[TCL_INTEGER_SPACE * 2];
@@ -2858,7 +3263,7 @@ TestsetassocdataCmd(clientData, interp, argc, argv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
char *buf;
char *oldData;
@@ -2911,7 +3316,7 @@ TestsetplatformCmd(clientData, interp, argc, argv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
size_t length;
TclPlatformType *platform;
@@ -2946,47 +3351,6 @@ TestsetplatformCmd(clientData, interp, argc, argv)
/*
*----------------------------------------------------------------------
*
- * TestsetrecursionlimitCmd --
- *
- * This procedure implements the "testsetrecursionlimit" command. It is
- * used to change the interp recursion limit (to test the effects
- * of Tcl_SetRecursionLimit).
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * Sets the interp's recursion limit.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TestsetrecursionlimitCmd(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. */
-{
- int value;
-
- if (objc != 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "integer");
- return TCL_ERROR;
- }
- if (Tcl_GetIntFromObj(interp, objv[1], &value) != TCL_OK) {
- return TCL_ERROR;
- }
- value = Tcl_SetRecursionLimit(interp, value);
- Tcl_SetIntObj(Tcl_GetObjResult(interp), value);
- return TCL_OK;
-}
-
-
-
-/*
- *----------------------------------------------------------------------
- *
* TeststaticpkgCmd --
*
* This procedure implements the "teststaticpkg" command.
@@ -3007,7 +3371,7 @@ TeststaticpkgCmd(dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
int safe, loaded;
@@ -3058,10 +3422,10 @@ TesttranslatefilenameCmd(dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
Tcl_DString buffer;
- char *result;
+ CONST char *result;
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"",
@@ -3100,7 +3464,7 @@ TestupvarCmd(dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
int flags = 0;
@@ -3192,7 +3556,7 @@ TestfeventCmd(clientData, interp, argc, argv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
static Tcl_Interp *interp2 = NULL;
int code;
@@ -3224,7 +3588,7 @@ TestfeventCmd(clientData, interp, argc, argv)
Tcl_DeleteInterp(interp2);
}
interp2 = Tcl_CreateInterp();
- return TCL_OK;
+ return Tcl_Init(interp2);
} else if (strcmp(argv[1], "delete") == 0) {
if (interp2 != NULL) {
Tcl_DeleteInterp(interp2);
@@ -3264,9 +3628,9 @@ TestpanicCmd(dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
- char *argString;
+ CONST char *argString;
/*
* Put the arguments into a var args structure
@@ -3275,7 +3639,7 @@ TestpanicCmd(dummy, interp, argc, argv)
argString = Tcl_Merge(argc-1, argv+1);
panic(argString);
- ckfree(argString);
+ ckfree((char *)argString);
return TCL_OK;
}
@@ -3304,7 +3668,7 @@ TestchmodCmd(dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
int i, mode;
char *rest;
@@ -3323,13 +3687,14 @@ TestchmodCmd(dummy, interp, argc, argv)
for (i = 2; i < argc; i++) {
Tcl_DString buffer;
+ CONST char *translated;
- argv[i] = Tcl_TranslateFileName(interp, argv[i], &buffer);
- if (argv[i] == NULL) {
+ translated = Tcl_TranslateFileName(interp, argv[i], &buffer);
+ if (translated == NULL) {
return TCL_ERROR;
}
- if (chmod(argv[i], (unsigned) mode) != 0) {
- Tcl_AppendResult(interp, argv[i], ": ", Tcl_PosixError(interp),
+ if (chmod(translated, (unsigned) mode) != 0) {
+ Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp),
(char *) NULL);
return TCL_ERROR;
}
@@ -3342,11 +3707,12 @@ static int
TestfileCmd(dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int argc; /* Number of arguments. */
+ Tcl_Obj *CONST argv[]; /* The argument objects. */
{
int force, i, j, result;
- Tcl_DString error, name[2];
+ Tcl_Obj *error = NULL;
+ char *subcmd;
if (argc < 3) {
return TCL_ERROR;
@@ -3354,54 +3720,51 @@ TestfileCmd(dummy, interp, argc, argv)
force = 0;
i = 2;
- if (strcmp(argv[2], "-force") == 0) {
+ if (strcmp(Tcl_GetString(argv[2]), "-force") == 0) {
force = 1;
i = 3;
}
- Tcl_DStringInit(&name[0]);
- Tcl_DStringInit(&name[1]);
- Tcl_DStringInit(&error);
-
if (argc - i > 2) {
return TCL_ERROR;
}
for (j = i; j < argc; j++) {
- argv[j] = Tcl_TranslateFileName(interp, argv[j], &name[j - i]);
- if (argv[j] == NULL) {
+ if (Tcl_FSGetTranslatedPath(interp, argv[j]) == NULL) {
return TCL_ERROR;
}
}
- if (strcmp(argv[1], "mv") == 0) {
- result = TclpRenameFile(argv[i], argv[i + 1]);
- } else if (strcmp(argv[1], "cp") == 0) {
- result = TclpCopyFile(argv[i], argv[i + 1]);
- } else if (strcmp(argv[1], "rm") == 0) {
- result = TclpDeleteFile(argv[i]);
- } else if (strcmp(argv[1], "mkdir") == 0) {
- result = TclpCreateDirectory(argv[i]);
- } else if (strcmp(argv[1], "cpdir") == 0) {
- result = TclpCopyDirectory(argv[i], argv[i + 1], &error);
- } else if (strcmp(argv[1], "rmdir") == 0) {
- result = TclpRemoveDirectory(argv[i], force, &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]);
+ } else if (strcmp(subcmd, "rm") == 0) {
+ result = TclpObjDeleteFile(argv[i]);
+ } else if (strcmp(subcmd, "mkdir") == 0) {
+ result = TclpObjCreateDirectory(argv[i]);
+ } else if (strcmp(subcmd, "cpdir") == 0) {
+ result = TclpObjCopyDirectory(argv[i], argv[i + 1], &error);
+ } else if (strcmp(subcmd, "rmdir") == 0) {
+ result = TclpObjRemoveDirectory(argv[i], force, &error);
} else {
result = TCL_ERROR;
goto end;
}
if (result != TCL_OK) {
- if (Tcl_DStringValue(&error)[0] != '\0') {
- Tcl_AppendResult(interp, Tcl_DStringValue(&error), " ", NULL);
+ if (error != NULL) {
+ if (Tcl_GetString(error)[0] != '\0') {
+ Tcl_AppendResult(interp, Tcl_GetString(error), " ", NULL);
+ }
+ Tcl_DecrRefCount(error);
}
Tcl_AppendResult(interp, Tcl_ErrnoId(), (char *) NULL);
}
end:
- Tcl_DStringFree(&error);
- Tcl_DStringFree(&name[0]);
- Tcl_DStringFree(&name[1]);
return result;
}
@@ -3508,7 +3871,7 @@ GetTimesCmd(unused, interp, argc, argv)
ClientData unused; /* Unused. */
Tcl_Interp *interp; /* The current interpreter. */
int argc; /* The number of arguments. */
- char **argv; /* The argument strings. */
+ CONST char **argv; /* The argument strings. */
{
Interp *iPtr = (Interp *) interp;
int i, n;
@@ -3516,59 +3879,59 @@ GetTimesCmd(unused, interp, argc, argv)
Tcl_Time start, stop;
Tcl_Obj *objPtr;
Tcl_Obj **objv;
- char *s;
+ CONST char *s;
char newString[TCL_INTEGER_SPACE];
/* alloc & free 100000 times */
fprintf(stderr, "alloc & free 100000 6 word items\n");
- TclpGetTime(&start);
+ Tcl_GetTime(&start);
for (i = 0; i < 100000; i++) {
objPtr = (Tcl_Obj *) ckalloc(sizeof(Tcl_Obj));
ckfree((char *) objPtr);
}
- TclpGetTime(&stop);
+ 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 *));
- TclpGetTime(&start);
+ Tcl_GetTime(&start);
for (i = 0; i < 5000; i++) {
objv[i] = (Tcl_Obj *) ckalloc(sizeof(Tcl_Obj));
}
- TclpGetTime(&stop);
+ 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");
- TclpGetTime(&start);
+ Tcl_GetTime(&start);
for (i = 0; i < 5000; i++) {
ckfree((char *) objv[i]);
}
- TclpGetTime(&stop);
+ Tcl_GetTime(&stop);
timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
fprintf(stderr, " %.3f usec per free\n", timePer/5000);
/* Tcl_NewObj 5000 times */
fprintf(stderr, "Tcl_NewObj 5000 times\n");
- TclpGetTime(&start);
+ Tcl_GetTime(&start);
for (i = 0; i < 5000; i++) {
objv[i] = Tcl_NewObj();
}
- TclpGetTime(&stop);
+ 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");
- TclpGetTime(&start);
+ Tcl_GetTime(&start);
for (i = 0; i < 5000; i++) {
objPtr = objv[i];
Tcl_DecrRefCount(objPtr);
}
- TclpGetTime(&stop);
+ 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);
@@ -3576,24 +3939,24 @@ GetTimesCmd(unused, interp, argc, argv)
/* TclGetString 100000 times */
fprintf(stderr, "TclGetStringFromObj of \"12345\" 100000 times\n");
objPtr = Tcl_NewStringObj("12345", -1);
- TclpGetTime(&start);
+ Tcl_GetTime(&start);
for (i = 0; i < 100000; i++) {
(void) TclGetString(objPtr);
}
- TclpGetTime(&stop);
+ Tcl_GetTime(&stop);
timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
fprintf(stderr, " %.3f usec per TclGetStringFromObj of \"12345\"\n",
timePer/100000);
/* Tcl_GetIntFromObj 100000 times */
fprintf(stderr, "Tcl_GetIntFromObj of \"12345\" 100000 times\n");
- TclpGetTime(&start);
+ Tcl_GetTime(&start);
for (i = 0; i < 100000; i++) {
if (Tcl_GetIntFromObj(interp, objPtr, &n) != TCL_OK) {
return TCL_ERROR;
}
}
- TclpGetTime(&stop);
+ Tcl_GetTime(&stop);
timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
fprintf(stderr, " %.3f usec per Tcl_GetIntFromObj of \"12345\"\n",
timePer/100000);
@@ -3601,63 +3964,63 @@ GetTimesCmd(unused, interp, argc, argv)
/* Tcl_GetInt 100000 times */
fprintf(stderr, "Tcl_GetInt of \"12345\" 100000 times\n");
- TclpGetTime(&start);
+ Tcl_GetTime(&start);
for (i = 0; i < 100000; i++) {
if (Tcl_GetInt(interp, "12345", &n) != TCL_OK) {
return TCL_ERROR;
}
}
- TclpGetTime(&stop);
+ Tcl_GetTime(&stop);
timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
fprintf(stderr, " %.3f usec per Tcl_GetInt of \"12345\"\n",
timePer/100000);
/* sprintf 100000 times */
fprintf(stderr, "sprintf of 12345 100000 times\n");
- TclpGetTime(&start);
+ Tcl_GetTime(&start);
for (i = 0; i < 100000; i++) {
sprintf(newString, "%d", 12345);
}
- TclpGetTime(&stop);
+ Tcl_GetTime(&stop);
timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
fprintf(stderr, " %.3f usec per sprintf of 12345\n",
timePer/100000);
/* hashtable lookup 100000 times */
fprintf(stderr, "hashtable lookup of \"gettimes\" 100000 times\n");
- TclpGetTime(&start);
+ Tcl_GetTime(&start);
for (i = 0; i < 100000; i++) {
(void) Tcl_FindHashEntry(&iPtr->globalNsPtr->cmdTable, "gettimes");
}
- TclpGetTime(&stop);
+ Tcl_GetTime(&stop);
timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
fprintf(stderr, " %.3f usec per hashtable lookup of \"gettimes\"\n",
timePer/100000);
/* Tcl_SetVar 100000 times */
fprintf(stderr, "Tcl_SetVar of \"12345\" 100000 times\n");
- TclpGetTime(&start);
+ Tcl_GetTime(&start);
for (i = 0; i < 100000; i++) {
s = Tcl_SetVar(interp, "a", "12345", TCL_LEAVE_ERR_MSG);
if (s == NULL) {
return TCL_ERROR;
}
}
- TclpGetTime(&stop);
+ Tcl_GetTime(&stop);
timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
fprintf(stderr, " %.3f usec per Tcl_SetVar of a to \"12345\"\n",
timePer/100000);
/* Tcl_GetVar 100000 times */
fprintf(stderr, "Tcl_GetVar of a==\"12345\" 100000 times\n");
- TclpGetTime(&start);
+ Tcl_GetTime(&start);
for (i = 0; i < 100000; i++) {
s = Tcl_GetVar(interp, "a", TCL_LEAVE_ERR_MSG);
if (s == NULL) {
return TCL_ERROR;
}
}
- TclpGetTime(&stop);
+ Tcl_GetTime(&stop);
timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
fprintf(stderr, " %.3f usec per Tcl_GetVar of a==\"12345\"\n",
timePer/100000);
@@ -3688,7 +4051,7 @@ NoopCmd(unused, interp, argc, argv)
ClientData unused; /* Unused. */
Tcl_Interp *interp; /* The current interpreter. */
int argc; /* The number of arguments. */
- char **argv; /* The argument strings. */
+ CONST char **argv; /* The argument strings. */
{
return TCL_OK;
}
@@ -3743,10 +4106,10 @@ TestsetCmd(data, interp, argc, argv)
ClientData data; /* Additional flags for Get/SetVar2. */
register Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
int flags = (int) data;
- char *value;
+ CONST char *value;
if (argc == 2) {
Tcl_SetResult(interp, "before get", TCL_STATIC);
@@ -3800,7 +4163,7 @@ TestsaveresultCmd(dummy, interp, objc, objv)
int discard, result, index;
Tcl_SavedResult state;
Tcl_Obj *objPtr;
- static char *optionStrings[] = {
+ static CONST char *optionStrings[] = {
"append", "dynamic", "free", "object", "small", NULL
};
enum options {
@@ -3925,7 +4288,7 @@ TeststatprocCmd (dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
register Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
TclStatProc_ *proc;
int retVal;
@@ -3937,7 +4300,7 @@ TeststatprocCmd (dummy, interp, argc, argv)
}
if (strcmp(argv[2], "TclpStat") == 0) {
- proc = TclpStat;
+ proc = PretendTclpStat;
} else if (strcmp(argv[2], "TestStatProc1") == 0) {
proc = TestStatProc1;
} else if (strcmp(argv[2], "TestStatProc2") == 0) {
@@ -3953,7 +4316,7 @@ TeststatprocCmd (dummy, interp, argc, argv)
}
if (strcmp(argv[1], "insert") == 0) {
- if (proc == TclpStat) {
+ if (proc == PretendTclpStat) {
Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ",
"must be ",
"TestStatProc1, TestStatProc2, or TestStatProc3",
@@ -3977,16 +4340,94 @@ TeststatprocCmd (dummy, interp, argc, argv)
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 */
+}
+
/* Be careful in the compares in these tests, since the Macintosh puts a
* leading : in the beginning of non-absolute paths before passing them
* into the file command procedures.
*/
-
+
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);
}
@@ -3997,6 +4438,7 @@ 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);
}
@@ -4007,6 +4449,7 @@ 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);
}
@@ -4014,6 +4457,123 @@ TestStatProc3(path, buf)
/*
*----------------------------------------------------------------------
*
+ * 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;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MainLoop --
+ *
+ * A main loop set by TestsetmainloopCmd below.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Event handlers could do anything.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MainLoop(void)
+{
+ while (!exitMainLoop) {
+ Tcl_DoOneEvent(0);
+ }
+ fprintf(stdout,"Exit MainLoop\n");
+ fflush(stdout);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestsetmainloopCmd --
+ *
+ * Implements the "testsetmainloop" cmd that is used to test the
+ * 'Tcl_SetMainLoop' API.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+{
+ exitMainLoop = 0;
+ Tcl_SetMainLoop(MainLoop);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestexitmainloopCmd --
+ *
+ * Implements the "testexitmainloop" cmd that is used to test the
+ * 'Tcl_SetMainLoop' API.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+{
+ exitMainLoop = 1;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TestaccessprocCmd --
*
* Implements the "testTclAccessProc" cmd that is used to test the
@@ -4033,7 +4593,7 @@ TestaccessprocCmd (dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
register Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
TclAccessProc_ *proc;
int retVal;
@@ -4045,7 +4605,7 @@ TestaccessprocCmd (dummy, interp, argc, argv)
}
if (strcmp(argv[2], "TclpAccess") == 0) {
- proc = TclpAccess;
+ proc = PretendTclpAccess;
} else if (strcmp(argv[2], "TestAccessProc1") == 0) {
proc = TestAccessProc1;
} else if (strcmp(argv[2], "TestAccessProc2") == 0) {
@@ -4061,7 +4621,7 @@ TestaccessprocCmd (dummy, interp, argc, argv)
}
if (strcmp(argv[1], "insert") == 0) {
- if (proc == TclpAccess) {
+ if (proc == PretendTclpAccess) {
Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ",
"must be ",
"TestAccessProc1, TestAccessProc2, or TestAccessProc3",
@@ -4085,6 +4645,17 @@ TestaccessprocCmd (dummy, interp, argc, argv)
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)
@@ -4134,7 +4705,7 @@ TestopenfilechannelprocCmd (dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
register Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
TclOpenFileChannelProc_ *proc;
int retVal;
@@ -4146,7 +4717,7 @@ TestopenfilechannelprocCmd (dummy, interp, argc, argv)
}
if (strcmp(argv[2], "TclpOpenFileChannel") == 0) {
- proc = TclpOpenFileChannel;
+ proc = PretendTclpOpenFileChannel;
} else if (strcmp(argv[2], "TestOpenFileChannelProc1") == 0) {
proc = TestOpenFileChannelProc1;
} else if (strcmp(argv[2], "TestOpenFileChannelProc2") == 0) {
@@ -4163,7 +4734,7 @@ TestopenfilechannelprocCmd (dummy, interp, argc, argv)
}
if (strcmp(argv[1], "insert") == 0) {
- if (proc == TclpOpenFileChannel) {
+ if (proc == PretendTclpOpenFileChannel) {
Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ",
"must be ",
"TestOpenFileChannelProc1, TestOpenFileChannelProc2, or ",
@@ -4188,22 +4759,68 @@ TestopenfilechannelprocCmd (dummy, interp, argc, argv)
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. */
- char *fileName; /* Name of file to open. */
- char *modeString; /* A list of POSIX open modes or
+ 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? */
{
- if (!strcmp("testOpenFileChannel1%.fil", fileName)) {
- return (TclpOpenFileChannel(interp, "__testOpenFileChannel1%__.fil",
+ 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);
}
}
@@ -4213,17 +4830,25 @@ static Tcl_Channel
TestOpenFileChannelProc2(interp, fileName, modeString, permissions)
Tcl_Interp *interp; /* Interpreter for error reporting;
* can be NULL. */
- char *fileName; /* Name of file to open. */
- char *modeString; /* A list of POSIX open modes or
+ 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? */
{
- if (!strcmp("testOpenFileChannel2%.fil", fileName)) {
- return (TclpOpenFileChannel(interp, "__testOpenFileChannel2%__.fil",
+ 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);
}
}
@@ -4233,17 +4858,25 @@ static Tcl_Channel
TestOpenFileChannelProc3(interp, fileName, modeString, permissions)
Tcl_Interp *interp; /* Interpreter for error reporting;
* can be NULL. */
- char *fileName; /* Name of file to open. */
- char *modeString; /* A list of POSIX open modes or
+ 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? */
{
- if (!strcmp("testOpenFileChannel3%.fil", fileName)) {
- return (TclpOpenFileChannel(interp, "__testOpenFileChannel3%__.fil",
+ 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);
}
}
@@ -4266,14 +4899,14 @@ TestOpenFileChannelProc3(interp, fileName, modeString, permissions)
*/
/* ARGSUSED */
-int
+static int
TestChannelCmd(clientData, interp, argc, argv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Interpreter for result. */
int argc; /* Count of additional args. */
- char **argv; /* Additional arg strings. */
+ CONST char **argv; /* Additional arg strings. */
{
- 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. */
@@ -4311,6 +4944,27 @@ TestChannelCmd(clientData, interp, argc, argv)
chan = NULL;
}
+ if ((cmdName[0] == 'c') && (strncmp(cmdName, "cut", len) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " cut channelName\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tcl_CutChannel(chan);
+ 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 ((cmdName[0] == 'i') && (strncmp(cmdName, "info", len) == 0)) {
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
@@ -4318,7 +4972,7 @@ TestChannelCmd(clientData, interp, argc, argv)
return TCL_ERROR;
}
Tcl_AppendElement(interp, argv[2]);
- Tcl_AppendElement(interp, chanPtr->typePtr->typeName);
+ Tcl_AppendElement(interp, Tcl_ChannelName(chanPtr->typePtr));
if (statePtr->flags & TCL_READABLE) {
Tcl_AppendElement(interp, "read");
} else {
@@ -4407,7 +5061,7 @@ TestChannelCmd(clientData, interp, argc, argv)
TclFormatInt(buf, IOQueued);
Tcl_AppendElement(interp, buf);
- TclFormatInt(buf, Tcl_Tell((Tcl_Channel) chanPtr));
+ TclFormatInt(buf, (int)Tcl_Tell((Tcl_Channel) chanPtr));
Tcl_AppendElement(interp, buf);
TclFormatInt(buf, statePtr->refCount);
@@ -4434,6 +5088,28 @@ TestChannelCmd(clientData, interp, argc, argv)
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 ((cmdName[0] == 'i') && (strncmp(cmdName, "isstandard", len) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "channel name required", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ TclFormatInt(buf, Tcl_IsStandardChannel(chan));
+ Tcl_AppendResult(interp, buf, (char *) NULL);
+ return TCL_OK;
+ }
+
if ((cmdName[0] == 'm') && (strncmp(cmdName, "mode", len) == 0)) {
if (argc != 3) {
Tcl_AppendResult(interp, "channel name required",
@@ -4454,6 +5130,18 @@ TestChannelCmd(clientData, interp, argc, argv)
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;
+ }
+
+ TclFormatInt(buf, (long) Tcl_GetChannelThread(chan));
+ Tcl_AppendResult(interp, buf, (char *) NULL);
+ return TCL_OK;
+ }
+
if ((cmdName[0] == 'n') && (strncmp(cmdName, "name", len) == 0)) {
if (argc != 3) {
Tcl_AppendResult(interp, "channel name required",
@@ -4543,13 +5231,23 @@ TestChannelCmd(clientData, interp, argc, argv)
return TCL_OK;
}
+ if ((cmdName[0] == 's') && (strncmp(cmdName, "splice", len) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "channel name required", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ Tcl_SpliceChannel(chan);
+ 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, chanPtr->typePtr->typeName,
+ Tcl_AppendResult(interp, Tcl_ChannelName(chanPtr->typePtr),
(char *) NULL);
return TCL_OK;
}
@@ -4605,7 +5303,8 @@ TestChannelCmd(clientData, interp, argc, argv)
}
Tcl_AppendResult(interp, "bad option \"", cmdName, "\": should be ",
- "info, open, readable, writable, transform, unstack",
+ "cut, clearchannelhandlers, info, isshared, mode, open, "
+ "readable, splice, writable, transform, unstack",
(char *) NULL);
return TCL_ERROR;
}
@@ -4628,18 +5327,18 @@ TestChannelCmd(clientData, interp, argc, argv)
*/
/* ARGSUSED */
-int
+static int
TestChannelEventCmd(dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
Tcl_Obj *resultListPtr;
Channel *chanPtr;
ChannelState *statePtr; /* state info for channel */
EventScriptRecord *esPtr, *prevEsPtr, *nextEsPtr;
- char *cmd;
+ CONST char *cmd;
int index, i, mask, len;
if ((argc < 3) || (argc > 5)) {
@@ -4823,4 +5522,440 @@ TestChannelEventCmd(dummy, interp, argc, argv)
"add, delete, list, set, or removeall", (char *) NULL);
return TCL_ERROR;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestWrongNumArgsObjCmd --
+ *
+ * Test the Tcl_WrongNumArgs function.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * Sets interpreter result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+{
+ int i, length;
+ char *msg;
+
+ if (objc < 3) {
+ /*
+ * Don't use Tcl_WrongNumArgs here, as that is the function
+ * we want to test!
+ */
+ Tcl_SetResult(interp, "insufficient arguments", TCL_STATIC);
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIntFromObj(interp, objv[1], &i) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ msg = Tcl_GetStringFromObj(objv[2], &length);
+ if (length == 0) {
+ msg = NULL;
+ }
+
+ if (i > objc - 3) {
+ /*
+ * Asked for more arguments than were given.
+ */
+ Tcl_SetResult(interp, "insufficient arguments", TCL_STATIC);
+ return TCL_ERROR;
+ }
+
+ Tcl_WrongNumArgs(interp, i, &(objv[3]), msg);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestGetIndexFromObjStructObjCmd --
+ *
+ * Test the Tcl_GetIndexFromObjStruct function.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * Sets interpreter result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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
+ };
+ int idx,target;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "argument targetvalue");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], ary, 2*sizeof(char *),
+ "dummy", 0, &idx) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[2], &target) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (idx != target) {
+ char buffer[64];
+ sprintf(buffer, "%d", idx);
+ Tcl_AppendResult(interp, "index value comparison failed: got ",
+ buffer, NULL);
+ sprintf(buffer, "%d", target);
+ Tcl_AppendResult(interp, " when ", buffer, " expected", NULL);
+ return TCL_ERROR;
+ }
+ Tcl_WrongNumArgs(interp, 3, objv, NULL);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Inserts or removes a filesystem from Tcl's stack.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestFilesystemObjCmd(dummy, interp, objc, objv)
+ ClientData dummy;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+ int res, boolVal;
+ char *msg;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "boolean");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetBooleanFromObj(interp, objv[1], &boolVal) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (boolVal) {
+ res = Tcl_FSRegister((ClientData)interp, &testReportingFilesystem);
+ msg = (res == TCL_OK) ? "registered" : "failed";
+ } else {
+ res = Tcl_FSUnregister(&testReportingFilesystem);
+ msg = (res == TCL_OK) ? "unregistered" : "failed";
+ }
+ Tcl_SetResult(interp, msg, TCL_VOLATILE);
+ return res;
+}
+
+static int
+TestReportInFilesystem(Tcl_Obj *pathPtr, ClientData *clientDataPtr)
+{
+ static Tcl_Obj* lastPathPtr = NULL;
+
+ 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;
+ }
+ }
+}
+
+/*
+ * 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* pathObjPtr) {
+ return (Tcl_Obj*) Tcl_FSGetInternalRep(pathObjPtr, &testReportingFilesystem);
+}
+
+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;
+ Tcl_IncrRefCount(original);
+ return clientData;
+}
+static void
+TestReport(cmd, path, arg2)
+ CONST char* cmd;
+ Tcl_Obj* path;
+ Tcl_Obj* arg2;
+{
+ 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.
+ */
+ Tcl_SavedResult savedResult;
+ Tcl_DString ds;
+ Tcl_DStringInit(&ds);
+ Tcl_DStringAppend(&ds, "lappend filesystemReport ",-1);
+ Tcl_DStringStartSublist(&ds);
+ Tcl_DStringAppendElement(&ds, cmd);
+ if (path != NULL) {
+ Tcl_DStringAppendElement(&ds, Tcl_GetString(path));
+ }
+ if (arg2 != NULL) {
+ Tcl_DStringAppendElement(&ds, Tcl_GetString(arg2));
+ }
+ Tcl_DStringEndSublist(&ds);
+ Tcl_SaveResult(interp, &savedResult);
+ Tcl_Eval(interp, Tcl_DStringValue(&ds));
+ Tcl_DStringFree(&ds);
+ Tcl_RestoreResult(interp, &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. */
+{
+ 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. */
+{
+ 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. */
+{
+ 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);
+ return TclpOpenFileChannel(interp, TestReportGetNativePath(fileName),
+ mode, permissions);
+}
+
+static int
+TestReportMatchInDirectory(interp, resultPtr, dirPtr, pattern, types)
+ Tcl_Interp *interp; /* Interpreter to receive results. */
+ Tcl_Obj *resultPtr; /* Directory separators to pass to TclDoGlob. */
+ 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. */
+{
+ TestReport("matchindirectory",dirPtr, NULL);
+ return Tcl_FSMatchInDirectory(interp, resultPtr,
+ TestReportGetNativePath(dirPtr), pattern,
+ types);
+}
+static int
+TestReportChdir(dirName)
+ Tcl_Obj *dirName;
+{
+ 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
+ * code. */
+ Tcl_LoadHandle *handlePtr; /* 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. */
+{
+ 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;
+{
+ 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
+ * (UTF-8). */
+ Tcl_Obj *dst; /* New pathname of file or directory
+ * (UTF-8). */
+{
+ 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). */
+{
+ 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). */
+{
+ TestReport("deletefile",path,NULL);
+ return Tcl_FSDeleteFile(TestReportGetNativePath(path));
+}
+static int
+TestReportCreateDirectory(path)
+ Tcl_Obj *path; /* Pathname of directory to create (UTF-8). */
+{
+ TestReport("createdirectory",path,NULL);
+ return Tcl_FSCreateDirectory(TestReportGetNativePath(path));
+}
+static int
+TestReportCopyDirectory(src, dst, errorPtr)
+ 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. */
+{
+ 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
+ * (UTF-8). */
+ 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. */
+{
+ TestReport("removedirectory",path,NULL);
+ return Tcl_FSRemoveDirectory(TestReportGetNativePath(path), recursive,
+ errorPtr);
+}
+static CONST char**
+TestReportFileAttrStrings(fileName, objPtrRef)
+ Tcl_Obj* fileName;
+ Tcl_Obj** objPtrRef;
+{
+ 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. */
+{
+ 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);
+ return Tcl_FSUtime(TestReportGetNativePath(fileName), tval);
+}
+static int
+TestReportNormalizePath(interp, pathPtr, nextCheckpoint)
+ Tcl_Interp *interp;
+ Tcl_Obj *pathPtr;
+ int nextCheckpoint;
+{
+ TestReport("normalizepath",pathPtr,NULL);
+ return nextCheckpoint;
+}
diff --git a/tcl/generic/tclTestObj.c b/tcl/generic/tclTestObj.c
index 3f583ff9af3..1724730c4ee 100644
--- a/tcl/generic/tclTestObj.c
+++ b/tcl/generic/tclTestObj.c
@@ -404,8 +404,17 @@ TestindexobjCmd(clientData, interp, objc, objv)
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
int allowAbbrev, index, index2, setError, i, result;
- char **argv;
- static char *tablePtr[] = {"a", "b", "check", (char *) NULL};
+ CONST char **argv;
+ static CONST char *tablePtr[] = {"a", "b", "check", (char *) 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. */
+ };
+ struct IndexRep *indexRep;
if ((objc == 3) && (strcmp(Tcl_GetString(objv[1]),
"check") == 0)) {
@@ -415,12 +424,14 @@ TestindexobjCmd(clientData, interp, objc, objv)
* returned on subsequent lookups.
*/
- Tcl_GetIndexFromObj((Tcl_Interp *) NULL, objv[1], tablePtr,
- "token", 0, &index);
if (Tcl_GetIntFromObj(interp, objv[2], &index2) != TCL_OK) {
return TCL_ERROR;
}
- objv[1]->internalRep.twoPtrValue.ptr2 = (VOID *) index2;
+
+ Tcl_GetIndexFromObj((Tcl_Interp *) NULL, objv[1], tablePtr,
+ "token", 0, &index);
+ indexRep = (struct IndexRep *) objv[1]->internalRep.otherValuePtr;
+ indexRep->index = index2;
result = Tcl_GetIndexFromObj((Tcl_Interp *) NULL, objv[1],
tablePtr, "token", 0, &index);
if (result == TCL_OK) {
@@ -441,7 +452,7 @@ TestindexobjCmd(clientData, interp, objc, objv)
return TCL_ERROR;
}
- argv = (char **) ckalloc((unsigned) ((objc-3) * sizeof(char *)));
+ argv = (CONST char **) ckalloc((unsigned) ((objc-3) * sizeof(char *)));
for (i = 4; i < objc; i++) {
argv[i-4] = Tcl_GetString(objv[i]);
}
@@ -454,9 +465,13 @@ TestindexobjCmd(clientData, interp, objc, objv)
* the index object, clear out the object's cached state.
*/
- if ((objv[3]->typePtr == Tcl_GetObjType("index"))
- && (objv[3]->internalRep.twoPtrValue.ptr1 == (VOID *) argv)) {
- objv[3]->typePtr = NULL;
+ 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;
+ }
}
result = Tcl_GetIndexFromObj((setError? interp : NULL), objv[3],
@@ -773,6 +788,19 @@ TestobjCmd(clientData, interp, objc, objv)
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 ) {
+ return TCL_ERROR;
+ }
+ if (CheckIfVarUnset(interp, varIndex)) {
+ return TCL_ERROR;
+ }
+ Tcl_InvalidateStringRep( varPtr[varIndex] );
+ Tcl_SetObjResult( interp, varPtr[varIndex] );
} else if (strcmp(subCmd, "newobj") == 0) {
if (objc != 3) {
goto wrongNumArgs;
@@ -881,7 +909,7 @@ TeststringobjCmd(clientData, interp, objc, objv)
#define MAX_STRINGS 11
char *index, *string, *strings[MAX_STRINGS+1];
TestString *strPtr;
- static char *options[] = {
+ static CONST char *options[] = {
"append", "appendstrings", "get", "get2", "length", "length2",
"set", "set2", "setlength", "ualloc", (char *) NULL
};
diff --git a/tcl/generic/tclThread.c b/tcl/generic/tclThread.c
index f7c3a39b786..bd7c569716a 100644
--- a/tcl/generic/tclThread.c
+++ b/tcl/generic/tclThread.c
@@ -577,4 +577,3 @@ Tcl_MutexUnlock(mutexPtr)
{
}
#endif
-
diff --git a/tcl/generic/tclThreadAlloc.c b/tcl/generic/tclThreadAlloc.c
new file mode 100644
index 00000000000..54dbfde588f
--- /dev/null
+++ b/tcl/generic/tclThreadAlloc.c
@@ -0,0 +1,955 @@
+/*
+ * tclThreadAlloc.c --
+ *
+ * This is a very fast storage allocator for used with threads (designed
+ * avoid lock contention). The basic strategy is to allocate memory in
+ * fixed size blocks from block caches.
+ *
+ * The Initial Developer of the Original Code is America Online, Inc.
+ * Portions created by AOL are Copyright (C) 1999 America Online, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$ */
+
+#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
+
+#include "tclInt.h"
+
+#ifdef WIN32
+#include "tclWinInt.h"
+#else
+extern Tcl_Mutex *TclpNewAllocMutex(void);
+extern void *TclpGetAllocCache(void);
+extern void TclpSetAllocCache(void *);
+#endif
+
+/*
+ * If range checking is enabled, an additional byte will be allocated
+ * to store the magic number at the end of the requested memory.
+ */
+
+#ifndef RCHECK
+#ifdef NDEBUG
+#define RCHECK 0
+#else
+#define RCHECK 1
+#endif
+#endif
+
+/*
+ * The following define the number of Tcl_Obj's to allocate/move
+ * at a time and the high water mark to prune a per-thread cache.
+ * On a 32 bit system, sizeof(Tcl_Obj) = 24 so 800 * 24 = ~16k.
+ *
+ */
+
+#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
+
+/*
+ * The following union stores accounting information for
+ * each block including two small magic numbers and
+ * a bucket number when in use or a next pointer when
+ * free. The original requested size (not including
+ * the Block overhead) 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. */
+ } b_s;
+ } b_u;
+ size_t b_reqsize; /* Requested allocation size. */
+} Block;
+#define b_next b_u.next
+#define b_bucket b_u.b_s.bucket
+#define b_magic1 b_u.b_s.magic1
+#define b_magic2 b_u.b_s.magic2
+#define MAGIC 0xef
+
+/*
+ * The following structure defines a bucket of blocks with
+ * various accounting and statistics information.
+ */
+
+typedef struct Bucket {
+ Block *firstPtr;
+ int nfree;
+ int nget;
+ int nput;
+ int nwait;
+ int nlock;
+ int nrequest;
+} Bucket;
+
+/*
+ * The following structure defines a cache of buckets and objs.
+ */
+
+typedef struct Cache {
+ struct Cache *nextPtr;
+ Tcl_ThreadId owner;
+ Tcl_Obj *firstObjPtr;
+ int nobjs;
+ int nsysalloc;
+ Bucket buckets[NBUCKETS];
+} Cache;
+
+/*
+ * The following array specifies various per-bucket
+ * limits and locks. The values are statically initialized
+ * to avoid calculating them repeatedly.
+ */
+
+struct binfo {
+ size_t blocksize; /* Bucket blocksize. */
+ int maxblocks; /* Max blocks before move to share. */
+ int nmove; /* Num blocks to move to share. */
+ Tcl_Mutex *lockPtr; /* Share bucket lock. */
+} binfo[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},
+};
+
+/*
+ * Static functions defined in this file.
+ */
+
+static void LockBucket(Cache *cachePtr, int bucket);
+static void UnlockBucket(Cache *cachePtr, int bucket);
+static void PutBlocks(Cache *cachePtr, int bucket, int nmove);
+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 nmove);
+
+/*
+ * Local variables defined in this file and initialized at
+ * startup.
+ */
+
+static Tcl_Mutex *listLockPtr;
+static Tcl_Mutex *objLockPtr;
+static Cache sharedCache;
+static Cache *sharedPtr = &sharedCache;
+static Cache *firstCachePtr = &sharedCache;
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetCache ---
+ *
+ * Gets per-thread memory cache, allocating it if necessary.
+ *
+ * Results:
+ * Pointer to cache.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Cache *
+GetCache(void)
+{
+ Cache *cachePtr;
+
+ /*
+ * Check for first-time initialization.
+ */
+
+ if (listLockPtr == NULL) {
+ Tcl_Mutex *initLockPtr;
+ int i;
+
+ initLockPtr = Tcl_GetAllocMutex();
+ Tcl_MutexLock(initLockPtr);
+ if (listLockPtr == NULL) {
+ listLockPtr = TclpNewAllocMutex();
+ objLockPtr = TclpNewAllocMutex();
+ for (i = 0; i < NBUCKETS; ++i) {
+ binfo[i].lockPtr = TclpNewAllocMutex();
+ }
+ }
+ Tcl_MutexUnlock(initLockPtr);
+ }
+
+ /*
+ * Get this thread's cache, allocating if necessary.
+ */
+
+ cachePtr = TclpGetAllocCache();
+ if (cachePtr == NULL) {
+ cachePtr = calloc(1, sizeof(Cache));
+ if (cachePtr == NULL) {
+ panic("alloc: could not allocate new cache");
+ }
+ Tcl_MutexLock(listLockPtr);
+ cachePtr->nextPtr = firstCachePtr;
+ firstCachePtr = cachePtr;
+ Tcl_MutexUnlock(listLockPtr);
+ cachePtr->owner = Tcl_GetCurrentThread();
+ TclpSetAllocCache(cachePtr);
+ }
+ return cachePtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFreeAllocCache --
+ *
+ * Flush and delete a cache, removing from list of caches.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFreeAllocCache(void *arg)
+{
+ Cache *cachePtr = arg;
+ Cache **nextPtrPtr;
+ register int bucket;
+
+ /*
+ * Flush blocks.
+ */
+
+ for (bucket = 0; bucket < NBUCKETS; ++bucket) {
+ if (cachePtr->buckets[bucket].nfree > 0) {
+ PutBlocks(cachePtr, bucket, cachePtr->buckets[bucket].nfree);
+ }
+ }
+
+ /*
+ * Flush objs.
+ */
+
+ if (cachePtr->nobjs > 0) {
+ Tcl_MutexLock(objLockPtr);
+ MoveObjs(cachePtr, sharedPtr, cachePtr->nobjs);
+ Tcl_MutexUnlock(objLockPtr);
+ }
+
+ /*
+ * Remove from pool list.
+ */
+
+ Tcl_MutexLock(listLockPtr);
+ nextPtrPtr = &firstCachePtr;
+ while (*nextPtrPtr != cachePtr) {
+ nextPtrPtr = &(*nextPtrPtr)->nextPtr;
+ }
+ *nextPtrPtr = cachePtr->nextPtr;
+ cachePtr->nextPtr = NULL;
+ Tcl_MutexUnlock(listLockPtr);
+#ifdef WIN32
+ TlsFree((DWORD) cachePtr);
+#else
+ free(cachePtr);
+#endif
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpAlloc --
+ *
+ * Allocate memory.
+ *
+ * Results:
+ * Pointer to memory just beyond Block pointer.
+ *
+ * Side effects:
+ * May allocate more blocks for a bucket.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TclpAlloc(unsigned int reqsize)
+{
+ Cache *cachePtr = TclpGetAllocCache();
+ Block *blockPtr;
+ register int bucket;
+ size_t size;
+
+ if (cachePtr == NULL) {
+ cachePtr = GetCache();
+ }
+
+ /*
+ * Increment the requested size to include room for
+ * the Block structure. Call malloc() directly if the
+ * required amount is greater than the largest block,
+ * otherwise pop the smallest block large enough,
+ * allocating more blocks if necessary.
+ */
+
+ blockPtr = NULL;
+ size = reqsize + sizeof(Block);
+#if RCHECK
+ ++size;
+#endif
+ if (size > MAXALLOC) {
+ bucket = NBUCKETS;
+ blockPtr = malloc(size);
+ if (blockPtr != NULL) {
+ cachePtr->nsysalloc += reqsize;
+ }
+ } else {
+ bucket = 0;
+ while (binfo[bucket].blocksize < size) {
+ ++bucket;
+ }
+ if (cachePtr->buckets[bucket].nfree || GetBlocks(cachePtr, bucket)) {
+ blockPtr = cachePtr->buckets[bucket].firstPtr;
+ cachePtr->buckets[bucket].firstPtr = blockPtr->b_next;
+ --cachePtr->buckets[bucket].nfree;
+ ++cachePtr->buckets[bucket].nget;
+ cachePtr->buckets[bucket].nrequest += reqsize;
+ }
+ }
+ if (blockPtr == NULL) {
+ return NULL;
+ }
+ return Block2Ptr(blockPtr, bucket, reqsize);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpFree --
+ *
+ * Return blocks to the thread block cache.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May move blocks to shared cache.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpFree(char *ptr)
+{
+ if (ptr != NULL) {
+ Cache *cachePtr = TclpGetAllocCache();
+ Block *blockPtr;
+ int bucket;
+
+ if (cachePtr == NULL) {
+ cachePtr = GetCache();
+ }
+
+ /*
+ * Get the block back from the user pointer and
+ * call system free directly for large blocks.
+ * Otherwise, push the block back on the bucket and
+ * move blocks to the shared cache if there are now
+ * too many free.
+ */
+
+ blockPtr = Ptr2Block(ptr);
+ bucket = blockPtr->b_bucket;
+ if (bucket == NBUCKETS) {
+ cachePtr->nsysalloc -= blockPtr->b_reqsize;
+ free(blockPtr);
+ } else {
+ cachePtr->buckets[bucket].nrequest -= blockPtr->b_reqsize;
+ blockPtr->b_next = cachePtr->buckets[bucket].firstPtr;
+ cachePtr->buckets[bucket].firstPtr = blockPtr;
+ ++cachePtr->buckets[bucket].nfree;
+ ++cachePtr->buckets[bucket].nput;
+ if (cachePtr != sharedPtr &&
+ cachePtr->buckets[bucket].nfree > binfo[bucket].maxblocks) {
+ PutBlocks(cachePtr, bucket, binfo[bucket].nmove);
+ }
+ }
+ }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpRealloc --
+ *
+ * Re-allocate memory to a larger or smaller size.
+ *
+ * Results:
+ * Pointer to memory just beyond Block pointer.
+ *
+ * Side effects:
+ * Previous memory, if any, may be freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TclpRealloc(char *ptr, unsigned int reqsize)
+{
+ Cache *cachePtr = TclpGetAllocCache();
+ Block *blockPtr;
+ void *new;
+ size_t size, min;
+ int bucket;
+
+ if (ptr == NULL) {
+ return TclpAlloc(reqsize);
+ }
+
+ if (cachePtr == NULL) {
+ cachePtr = GetCache();
+ }
+
+ /*
+ * If the block is not a system block and fits in place,
+ * simply return the existing pointer. Otherwise, if the block
+ * is a system block and the new size would also require a system
+ * block, call realloc() directly.
+ */
+
+ blockPtr = Ptr2Block(ptr);
+ size = reqsize + sizeof(Block);
+#if RCHECK
+ ++size;
+#endif
+ bucket = blockPtr->b_bucket;
+ if (bucket != NBUCKETS) {
+ if (bucket > 0) {
+ min = binfo[bucket-1].blocksize;
+ } else {
+ min = 0;
+ }
+ if (size > min && size <= binfo[bucket].blocksize) {
+ cachePtr->buckets[bucket].nrequest -= blockPtr->b_reqsize;
+ cachePtr->buckets[bucket].nrequest += reqsize;
+ return Block2Ptr(blockPtr, bucket, reqsize);
+ }
+ } else if (size > MAXALLOC) {
+ cachePtr->nsysalloc -= blockPtr->b_reqsize;
+ cachePtr->nsysalloc += reqsize;
+ blockPtr = realloc(blockPtr, size);
+ if (blockPtr == NULL) {
+ return NULL;
+ }
+ return Block2Ptr(blockPtr, NBUCKETS, reqsize);
+ }
+
+ /*
+ * Finally, perform an expensive malloc/copy/free.
+ */
+
+ new = TclpAlloc(reqsize);
+ if (new != NULL) {
+ if (reqsize > blockPtr->b_reqsize) {
+ reqsize = blockPtr->b_reqsize;
+ }
+ memcpy(new, ptr, reqsize);
+ TclpFree(ptr);
+ }
+ return new;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclThreadAllocObj --
+ *
+ * Allocate a Tcl_Obj from the per-thread cache.
+ *
+ * Results:
+ * Pointer to uninitialized Tcl_Obj.
+ *
+ * Side effects:
+ * May move Tcl_Obj's from shared cached or allocate new Tcl_Obj's
+ * if list is empty.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclThreadAllocObj(void)
+{
+ register Cache *cachePtr = TclpGetAllocCache();
+ register int nmove;
+ register Tcl_Obj *objPtr;
+ Tcl_Obj *newObjsPtr;
+
+ if (cachePtr == NULL) {
+ cachePtr = GetCache();
+ }
+
+ /*
+ * Get this thread's obj list structure and move
+ * or allocate new objs if necessary.
+ */
+
+ if (cachePtr->nobjs == 0) {
+ Tcl_MutexLock(objLockPtr);
+ nmove = sharedPtr->nobjs;
+ if (nmove > 0) {
+ if (nmove > NOBJALLOC) {
+ nmove = NOBJALLOC;
+ }
+ MoveObjs(sharedPtr, cachePtr, nmove);
+ }
+ Tcl_MutexUnlock(objLockPtr);
+ if (cachePtr->nobjs == 0) {
+ cachePtr->nobjs = nmove = NOBJALLOC;
+ newObjsPtr = malloc(sizeof(Tcl_Obj) * nmove);
+ if (newObjsPtr == NULL) {
+ panic("alloc: could not allocate %d new objects", nmove);
+ }
+ while (--nmove >= 0) {
+ objPtr = &newObjsPtr[nmove];
+ objPtr->internalRep.otherValuePtr = cachePtr->firstObjPtr;
+ cachePtr->firstObjPtr = objPtr;
+ }
+ }
+ }
+
+ /*
+ * Pop the first object.
+ */
+
+ objPtr = cachePtr->firstObjPtr;
+ cachePtr->firstObjPtr = objPtr->internalRep.otherValuePtr;
+ --cachePtr->nobjs;
+ return objPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclThreadFreeObj --
+ *
+ * Return a free Tcl_Obj to the per-thread cache.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May move free Tcl_Obj's to shared list upon hitting high
+ * water mark.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclThreadFreeObj(Tcl_Obj *objPtr)
+{
+ Cache *cachePtr = TclpGetAllocCache();
+
+ if (cachePtr == NULL) {
+ cachePtr = GetCache();
+ }
+
+ /*
+ * Get this thread's list and push on the free Tcl_Obj.
+ */
+
+ objPtr->internalRep.otherValuePtr = cachePtr->firstObjPtr;
+ cachePtr->firstObjPtr = objPtr;
+ ++cachePtr->nobjs;
+
+ /*
+ * If the number of free objects has exceeded the high
+ * water mark, move some blocks to the shared list.
+ */
+
+ if (cachePtr->nobjs > NOBJHIGH) {
+ Tcl_MutexLock(objLockPtr);
+ MoveObjs(cachePtr, sharedPtr, NOBJALLOC);
+ Tcl_MutexUnlock(objLockPtr);
+ }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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)
+{
+ Cache *cachePtr;
+ char buf[200];
+ int n;
+
+ Tcl_MutexLock(listLockPtr);
+ cachePtr = firstCachePtr;
+ while (cachePtr != NULL) {
+ Tcl_DStringStartSublist(dsPtr);
+ if (cachePtr == sharedPtr) {
+ Tcl_DStringAppendElement(dsPtr, "shared");
+ } else {
+ sprintf(buf, "thread%d", (int) cachePtr->owner);
+ Tcl_DStringAppendElement(dsPtr, buf);
+ }
+ for (n = 0; n < NBUCKETS; ++n) {
+ sprintf(buf, "%d %d %d %d %d %d %d",
+ (int) binfo[n].blocksize,
+ cachePtr->buckets[n].nfree,
+ cachePtr->buckets[n].nget,
+ cachePtr->buckets[n].nput,
+ cachePtr->buckets[n].nrequest,
+ cachePtr->buckets[n].nlock,
+ cachePtr->buckets[n].nwait);
+ Tcl_DStringAppendElement(dsPtr, buf);
+ }
+ Tcl_DStringEndSublist(dsPtr);
+ cachePtr = cachePtr->nextPtr;
+ }
+ Tcl_MutexUnlock(listLockPtr);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MoveObjs --
+ *
+ * Move Tcl_Obj's between caches.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MoveObjs(Cache *fromPtr, Cache *toPtr, int nmove)
+{
+ register Tcl_Obj *objPtr = fromPtr->firstObjPtr;
+ Tcl_Obj *fromFirstObjPtr = objPtr;
+
+ toPtr->nobjs += nmove;
+ fromPtr->nobjs -= nmove;
+
+ /*
+ * Find the last object to be moved; set the next one
+ * (the first one not to be moved) as the first object
+ * in the 'from' cache.
+ */
+
+ while (--nmove) {
+ objPtr = objPtr->internalRep.otherValuePtr;
+ }
+ fromPtr->firstObjPtr = objPtr->internalRep.otherValuePtr;
+
+ /*
+ * 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;
+ toPtr->firstObjPtr = fromFirstObjPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Block2Ptr, Ptr2Block --
+ *
+ * Convert between internal blocks and user pointers.
+ *
+ * Results:
+ * User pointer or internal block.
+ *
+ * Side effects:
+ * Invalid blocks will abort the server.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+Block2Ptr(Block *blockPtr, int bucket, unsigned int reqsize)
+{
+ register void *ptr;
+
+ blockPtr->b_magic1 = blockPtr->b_magic2 = MAGIC;
+ blockPtr->b_bucket = bucket;
+ blockPtr->b_reqsize = reqsize;
+ ptr = ((void *) (blockPtr + 1));
+#if RCHECK
+ ((unsigned char *)(ptr))[reqsize] = MAGIC;
+#endif
+ return (char *) ptr;
+}
+
+static Block *
+Ptr2Block(char *ptr)
+{
+ register Block *blockPtr;
+
+ blockPtr = (((Block *) ptr) - 1);
+ if (blockPtr->b_magic1 != MAGIC
+#if RCHECK
+ || ((unsigned char *) ptr)[blockPtr->b_reqsize] != MAGIC
+#endif
+ || blockPtr->b_magic2 != MAGIC) {
+ panic("alloc: invalid block: %p: %x %x %x\n",
+ blockPtr, blockPtr->b_magic1, blockPtr->b_magic2,
+ ((unsigned char *) ptr)[blockPtr->b_reqsize]);
+ }
+ return blockPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * LockBucket, UnlockBucket --
+ *
+ * Set/unset the lock to access a bucket in the shared cache.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Lock activity and contention are monitored globally and on
+ * a per-cache basis.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+LockBucket(Cache *cachePtr, int bucket)
+{
+#if 0
+ if (Tcl_MutexTryLock(binfo[bucket].lockPtr) != TCL_OK) {
+ Tcl_MutexLock(binfo[bucket].lockPtr);
+ ++cachePtr->buckets[bucket].nwait;
+ ++sharedPtr->buckets[bucket].nwait;
+ }
+#else
+ Tcl_MutexLock(binfo[bucket].lockPtr);
+#endif
+ ++cachePtr->buckets[bucket].nlock;
+ ++sharedPtr->buckets[bucket].nlock;
+}
+
+
+static void
+UnlockBucket(Cache *cachePtr, int bucket)
+{
+ Tcl_MutexUnlock(binfo[bucket].lockPtr);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PutBlocks --
+ *
+ * Return unused blocks to the shared cache.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PutBlocks(Cache *cachePtr, int bucket, int nmove)
+{
+ register Block *lastPtr, *firstPtr;
+ register int n = nmove;
+
+ /*
+ * Before acquiring the lock, walk the block list to find
+ * the last block to be moved.
+ */
+
+ firstPtr = lastPtr = cachePtr->buckets[bucket].firstPtr;
+ while (--n > 0) {
+ lastPtr = lastPtr->b_next;
+ }
+ cachePtr->buckets[bucket].firstPtr = lastPtr->b_next;
+ cachePtr->buckets[bucket].nfree -= nmove;
+
+ /*
+ * Aquire the lock and place the list of blocks at the front
+ * of the shared cache bucket.
+ */
+
+ LockBucket(cachePtr, bucket);
+ lastPtr->b_next = sharedPtr->buckets[bucket].firstPtr;
+ sharedPtr->buckets[bucket].firstPtr = firstPtr;
+ sharedPtr->buckets[bucket].nfree += nmove;
+ UnlockBucket(cachePtr, bucket);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetBlocks --
+ *
+ * Get more blocks for a bucket.
+ *
+ * Results:
+ * 1 if blocks where allocated, 0 otherwise.
+ *
+ * Side effects:
+ * Cache may be filled with available blocks.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetBlocks(Cache *cachePtr, int bucket)
+{
+ register Block *blockPtr;
+ register int n;
+ register size_t size;
+
+ /*
+ * First, atttempt to move blocks from the shared cache. Note
+ * the potentially dirty read of nfree before acquiring the lock
+ * which is a slight performance enhancement. The value is
+ * verified after the lock is actually acquired.
+ */
+
+ if (cachePtr != sharedPtr && sharedPtr->buckets[bucket].nfree > 0) {
+ LockBucket(cachePtr, bucket);
+ if (sharedPtr->buckets[bucket].nfree > 0) {
+
+ /*
+ * Either move the entire list or walk the list to find
+ * the last block to move.
+ */
+
+ n = binfo[bucket].nmove;
+ if (n >= sharedPtr->buckets[bucket].nfree) {
+ cachePtr->buckets[bucket].firstPtr =
+ sharedPtr->buckets[bucket].firstPtr;
+ cachePtr->buckets[bucket].nfree =
+ sharedPtr->buckets[bucket].nfree;
+ sharedPtr->buckets[bucket].firstPtr = NULL;
+ sharedPtr->buckets[bucket].nfree = 0;
+ } else {
+ blockPtr = sharedPtr->buckets[bucket].firstPtr;
+ cachePtr->buckets[bucket].firstPtr = blockPtr;
+ sharedPtr->buckets[bucket].nfree -= n;
+ cachePtr->buckets[bucket].nfree = n;
+ while (--n > 0) {
+ blockPtr = blockPtr->b_next;
+ }
+ sharedPtr->buckets[bucket].firstPtr = blockPtr->b_next;
+ blockPtr->b_next = NULL;
+ }
+ }
+ UnlockBucket(cachePtr, bucket);
+ }
+
+ if (cachePtr->buckets[bucket].nfree == 0) {
+
+ /*
+ * If no blocks could be moved from shared, first look for a
+ * larger block in this cache to split up.
+ */
+
+ blockPtr = NULL;
+ n = NBUCKETS;
+ size = 0; /* lint */
+ while (--n > bucket) {
+ if (cachePtr->buckets[n].nfree > 0) {
+ size = binfo[n].blocksize;
+ blockPtr = cachePtr->buckets[n].firstPtr;
+ cachePtr->buckets[n].firstPtr = blockPtr->b_next;
+ --cachePtr->buckets[n].nfree;
+ break;
+ }
+ }
+
+ /*
+ * Otherwise, allocate a big new block directly.
+ */
+
+ if (blockPtr == NULL) {
+ size = MAXALLOC;
+ blockPtr = malloc(size);
+ if (blockPtr == NULL) {
+ return 0;
+ }
+ }
+
+ /*
+ * Split the larger block into smaller blocks for this bucket.
+ */
+
+ n = size / binfo[bucket].blocksize;
+ cachePtr->buckets[bucket].nfree = n;
+ cachePtr->buckets[bucket].firstPtr = blockPtr;
+ while (--n > 0) {
+ blockPtr->b_next = (Block *)
+ ((char *) blockPtr + binfo[bucket].blocksize);
+ blockPtr = blockPtr->b_next;
+ }
+ blockPtr->b_next = NULL;
+ }
+ return 1;
+}
+
+#endif /* TCL_THREADS */
diff --git a/tcl/generic/tclThreadJoin.c b/tcl/generic/tclThreadJoin.c
new file mode 100644
index 00000000000..d06c4dee016
--- /dev/null
+++ b/tcl/generic/tclThreadJoin.c
@@ -0,0 +1,311 @@
+/*
+ * tclThreadJoin.c --
+ *
+ * This file implements a platform independent emulation layer for
+ * the handling of joinable threads. The Mac and Windows platforms
+ * use this code to provide the functionality of joining threads.
+ * This code is currently not necessary on Unix.
+ *
+ * Copyright (c) 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$
+ */
+
+#include "tclInt.h"
+
+#if defined(WIN32) || defined(MAC_TCL)
+
+/* The information about each joinable thread is remembered in a
+ * structure as defined below.
+ */
+
+typedef struct JoinableThread {
+ Tcl_ThreadId id; /* The id of the joinable thread */
+ int result; /* A place for the result after the
+ * demise of the thread */
+ int done; /* Boolean flag. Initialized to 0
+ * and set to 1 after the exit of
+ * the thread. This allows a thread
+ * requesting a join to detect when
+ * waiting is not necessary. */
+ int waitedUpon; /* Boolean flag. Initialized to 0
+ * and set to 1 by the thread waiting
+ * for this one via Tcl_JoinThread.
+ * Used to lock any other thread
+ * trying to wait on this one.
+ */
+ Tcl_Mutex threadMutex; /* The mutex used to serialize access
+ * to this structure. */
+ Tcl_Condition cond; /* This is the condition a thread has
+ * to wait upon to get notified of the
+ * end of the described thread. It is
+ * signaled indirectly by
+ * Tcl_ExitThread. */
+ struct JoinableThread* nextThreadPtr; /* Reference to the next thread in the
+ * list of joinable threads */
+} JoinableThread;
+
+/* The following variable is used to maintain the global list of all
+ * joinable threads. Usage by a thread is allowed only if the
+ * thread acquired the 'joinMutex'.
+ */
+
+TCL_DECLARE_MUTEX(joinMutex)
+
+static JoinableThread* firstThreadPtr;
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclJoinThread --
+ *
+ * This procedure waits for the exit of the thread with the specified
+ * id and returns its result.
+ *
+ * Results:
+ * A standard tcl result signaling the overall success/failure of the
+ * operation and an integer result delivered by the thread which was
+ * waited upon.
+ *
+ * Side effects:
+ * Deallocates the memory allocated by TclRememberJoinableThread.
+ * Removes the data associated to the thread waited upon from the
+ * list of joinable threads.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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 the thread we are waiting upon. */
+{
+ /* Steps done here:
+ * i. Acquire the joinMutex and search for the thread.
+ * ii. Error out if it could not be found.
+ * iii. If found, switch from exclusive access to the list to exclusive
+ * access to the thread structure.
+ * iv. Error out if some other is already waiting.
+ * v. Skip the waiting part of the thread is already done.
+ * vi. Wait for the thread to exit, mark it as waited upon too.
+ * vii. Get the result form the structure,
+ * viii. switch to exclusive access of the list,
+ * ix. remove the structure from the list,
+ * x. then switch back to exclusive access to the structure
+ * xi. and delete it.
+ */
+
+ JoinableThread* threadPtr;
+
+ Tcl_MutexLock (&joinMutex);
+
+ for (threadPtr = firstThreadPtr;
+ (threadPtr != (JoinableThread*) NULL) && (threadPtr->id != id);
+ threadPtr = threadPtr->nextThreadPtr)
+ /* empty body */
+ ;
+
+ if (threadPtr == (JoinableThread*) NULL) {
+ /* Thread not found. Either not joinable, or already waited
+ * upon and exited. Whatever, an error is in order.
+ */
+
+ Tcl_MutexUnlock (&joinMutex);
+ return TCL_ERROR;
+ }
+
+ /* [1] If we don't lock the structure before giving up exclusive access
+ * to the list some other thread just completing its wait on the same
+ * thread can delete the structure from under us, leaving us with a
+ * dangling pointer.
+ */
+
+ Tcl_MutexLock (&threadPtr->threadMutex);
+ Tcl_MutexUnlock (&joinMutex);
+
+ /* [2] Now that we have the structure mutex any other thread that just
+ * tries to delete structure will wait at location [3] until we are
+ * done with the structure. And in that case we are done with it
+ * rather quickly as 'waitedUpon' will be set and we will have to
+ * error out.
+ */
+
+ if (threadPtr->waitedUpon) {
+ Tcl_MutexUnlock (&threadPtr->threadMutex);
+ return TCL_ERROR;
+ }
+
+ /* We are waiting now, let other threads recognize this
+ */
+
+ threadPtr->waitedUpon = 1;
+
+ while (!threadPtr->done) {
+ Tcl_ConditionWait (&threadPtr->cond, &threadPtr->threadMutex, NULL);
+ }
+
+ /* We have to release the structure before trying to access the list
+ * again or we can run into deadlock with a thread at [1] (see above)
+ * because of us holding the structure and the other holding the list.
+ * There is no problem with dangling pointers here as 'waitedUpon == 1'
+ * is still valid and any other thread will error out and not come to
+ * this place. IOW, the fact that we are here also means that no other
+ * thread came here before us and is able to delete the structure.
+ */
+
+ Tcl_MutexUnlock (&threadPtr->threadMutex);
+ Tcl_MutexLock (&joinMutex);
+
+ /* We have to search the list again as its structure may (may, almost
+ * certainly) have changed while we were waiting. Especially now is the
+ * time to compute the predecessor in the list. Any earlier result can
+ * be dangling by now.
+ */
+
+ if (firstThreadPtr == threadPtr) {
+ firstThreadPtr = threadPtr->nextThreadPtr;
+ } else {
+ JoinableThread* prevThreadPtr;
+
+ for (prevThreadPtr = firstThreadPtr;
+ prevThreadPtr->nextThreadPtr != threadPtr;
+ prevThreadPtr = prevThreadPtr->nextThreadPtr)
+ /* empty body */
+ ;
+
+ prevThreadPtr->nextThreadPtr = threadPtr->nextThreadPtr;
+ }
+
+ Tcl_MutexUnlock (&joinMutex);
+
+ /* [3] Now that the structure is not part of the list anymore no other
+ * thread can acquire its mutex from now on. But it is possible that
+ * another thread is still holding the mutex though, see location [2].
+ * So we have to acquire the mutex one more time to wait for that thread
+ * to finish. We can (and have to) release the mutex immediately.
+ */
+
+ Tcl_MutexLock (&threadPtr->threadMutex);
+ Tcl_MutexUnlock (&threadPtr->threadMutex);
+
+ /* Copy the result to us, finalize the synchronisation objects, then
+ * free the structure and return.
+ */
+
+ *result = threadPtr->result;
+
+ Tcl_ConditionFinalize (&threadPtr->cond);
+ Tcl_MutexFinalize (&threadPtr->threadMutex);
+ ckfree ((VOID*) threadPtr);
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclRememberJoinableThread --
+ *
+ * This procedure remebers a thread as joinable. Only a call to
+ * TclJoinThread will remove the structre created (and initialized)
+ * here. IOW, not waiting upon a joinable thread will cause memory
+ * leaks.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Allocates memory, adds it to the global list of all joinable
+ * threads.
+ *
+ *----------------------------------------------------------------------
+ */
+
+VOID
+TclRememberJoinableThread(id)
+ Tcl_ThreadId id; /* The thread to remember as joinable */
+{
+ JoinableThread* threadPtr;
+
+ threadPtr = (JoinableThread*) ckalloc (sizeof (JoinableThread));
+ threadPtr->id = id;
+ threadPtr->done = 0;
+ threadPtr->waitedUpon = 0;
+ threadPtr->threadMutex = (Tcl_Mutex) NULL;
+ threadPtr->cond = (Tcl_Condition) NULL;
+
+ Tcl_MutexLock (&joinMutex);
+
+ threadPtr->nextThreadPtr = firstThreadPtr;
+ firstThreadPtr = threadPtr;
+
+ Tcl_MutexUnlock (&joinMutex);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSignalExitThread --
+ *
+ * This procedure signals that the specified thread is done with
+ * its work. If the thread is joinable this signal is propagated
+ * to the thread waiting upon it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Modifies the associated structure to hold the result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+VOID
+TclSignalExitThread(id,result)
+ Tcl_ThreadId id; /* Id of the thread signaling its exit */
+ int result; /* The result from the thread */
+{
+ JoinableThread* threadPtr;
+
+ Tcl_MutexLock (&joinMutex);
+
+ for (threadPtr = firstThreadPtr;
+ (threadPtr != (JoinableThread*) NULL) && (threadPtr->id != id);
+ threadPtr = threadPtr->nextThreadPtr)
+ /* empty body */
+ ;
+
+ if (threadPtr == (JoinableThread*) NULL) {
+ /* Thread not found. Not joinable. No problem, nothing to do.
+ */
+
+ Tcl_MutexUnlock (&joinMutex);
+ return;
+ }
+
+ /* Switch over the exclusive access from the list to the structure,
+ * then store the result, set the flag and notify the waiting thread,
+ * provided that it exists. The order of lock/unlock ensures that a
+ * thread entering 'TclJoinThread' will not interfere with us.
+ */
+
+ Tcl_MutexLock (&threadPtr->threadMutex);
+ Tcl_MutexUnlock (&joinMutex);
+
+ threadPtr->done = 1;
+ threadPtr->result = result;
+
+ if (threadPtr->waitedUpon) {
+ Tcl_ConditionNotify (&threadPtr->cond);
+ }
+
+ Tcl_MutexUnlock (&threadPtr->threadMutex);
+}
+
+#endif /* WIN32 || MAC_TCL */
diff --git a/tcl/generic/tclThreadTest.c b/tcl/generic/tclThreadTest.c
index 25a3938a009..4f73ce7c55d 100644
--- a/tcl/generic/tclThreadTest.c
+++ b/tcl/generic/tclThreadTest.c
@@ -118,7 +118,7 @@ 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,
- CONST char *script));
+ 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));
@@ -126,7 +126,7 @@ EXTERN int TclThreadSend _ANSI_ARGS_((Tcl_Interp *interp, Tcl_ThreadId id,
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT
-Tcl_ThreadCreateType NewThread _ANSI_ARGS_((ClientData clientData));
+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));
@@ -175,13 +175,14 @@ TclThread_Init(interp)
* This procedure is invoked to process the "testthread" Tcl command.
* See the user documentation for details on what it does.
*
- * thread create
+ * thread create ?-joinable? ?script?
* thread send id ?-async? script
* thread exit
* thread info id
* thread names
* thread wait
* thread errorproc proc
+ * thread join id
*
* Results:
* A standard Tcl result.
@@ -202,10 +203,11 @@ Tcl_ThreadObjCmd(dummy, interp, objc, objv)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
int option;
- static char *threadOptions[] = {"create", "exit", "id", "names",
- "send", "wait", "errorproc", (char *) NULL};
- enum options {THREAD_CREATE, THREAD_EXIT, THREAD_ID, THREAD_NAMES,
- THREAD_SEND, THREAD_WAIT, THREAD_ERRORPROC};
+ 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};
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?args?");
@@ -231,15 +233,51 @@ Tcl_ThreadObjCmd(dummy, interp, objc, objv)
switch ((enum options)option) {
case THREAD_CREATE: {
char *script;
+ int joinable, len;
+
if (objc == 2) {
- script = "testthread wait"; /* Just enter the event loop */
+ /* Neither joinable nor special script
+ */
+
+ joinable = 0;
+ script = "testthread wait"; /* Just enter the event loop */
+
} else if (objc == 3) {
- script = Tcl_GetString(objv[2]);
+ /* Possibly -joinable, then no special script,
+ * no joinable, then its a script.
+ */
+
+ 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 ?
+ */
+
+ 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, "?script?");
+ Tcl_WrongNumArgs(interp, 2, objv, "?-joinable? ?script?");
return TCL_ERROR;
}
- return TclCreateThread(interp, script);
+ return TclCreateThread(interp, script, joinable);
}
case THREAD_EXIT: {
if (objc > 2) {
@@ -259,6 +297,28 @@ Tcl_ThreadObjCmd(dummy, interp, objc, objv)
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;
+ }
+
+ 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;
+ }
case THREAD_NAMES: {
if (objc > 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
@@ -343,20 +403,23 @@ Tcl_ThreadObjCmd(dummy, interp, objc, objv)
/* ARGSUSED */
int
-TclCreateThread(interp, script)
+TclCreateThread(interp, script, joinable)
Tcl_Interp *interp; /* Current interpreter. */
- CONST char *script; /* Script to execute */
+ char *script; /* Script to execute */
+ int joinable; /* Flag, joinable thread or not */
{
ThreadCtrl ctrl;
Tcl_ThreadId id;
- ctrl.script = (char *) script;
+ ctrl.script = script;
ctrl.condWait = NULL;
ctrl.flags = 0;
+ joinable = joinable ? TCL_THREAD_JOINABLE : TCL_THREAD_NOFLAGS;
+
Tcl_MutexLock(&threadMutex);
- if (Tcl_CreateThread(&id, NewThread, (ClientData) &ctrl,
- TCL_THREAD_STACK_DEFAULT, TCL_THREAD_NOFLAGS) != TCL_OK) {
+ if (Tcl_CreateThread(&id, NewTestThread, (ClientData) &ctrl,
+ TCL_THREAD_STACK_DEFAULT, joinable) != TCL_OK) {
Tcl_MutexUnlock(&threadMutex);
Tcl_AppendResult(interp,"can't create a new thread",0);
ckfree((void*)ctrl.script);
@@ -377,7 +440,7 @@ TclCreateThread(interp, script)
/*
*------------------------------------------------------------------------
*
- * NewThread --
+ * 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
@@ -403,7 +466,7 @@ TclCreateThread(interp, script)
*------------------------------------------------------------------------
*/
Tcl_ThreadCreateType
-NewThread(clientData)
+NewTestThread(clientData)
ClientData clientData;
{
ThreadCtrl *ctrlPtr = (ThreadCtrl*)clientData;
@@ -483,8 +546,8 @@ ThreadErrorProc(interp)
Tcl_Interp *interp; /* Interp that failed */
{
Tcl_Channel errChannel;
- char *errorInfo, *script;
- char *argv[3];
+ CONST char *errorInfo, *argv[3];
+ char *script;
char buf[TCL_DOUBLE_SPACE+1];
sprintf(buf, "%ld", (long) Tcl_GetCurrentThread());
@@ -780,7 +843,7 @@ TclThreadSend(interp, id, script, wait)
*
*------------------------------------------------------------------------
*/
-int
+static int
ThreadEventProc(evPtr, mask)
Tcl_Event *evPtr; /* Really ThreadEvent */
int mask;
@@ -790,7 +853,7 @@ ThreadEventProc(evPtr, mask)
ThreadEventResult *resultPtr = threadEventPtr->resultPtr;
Tcl_Interp *interp = tsdPtr->interp;
int code;
- char *result, *errorCode, *errorInfo;
+ CONST char *result, *errorCode, *errorInfo;
if (interp == NULL) {
code = TCL_ERROR;
@@ -853,7 +916,7 @@ ThreadEventProc(evPtr, mask)
*------------------------------------------------------------------------
*/
/* ARGSUSED */
-void
+static void
ThreadFreeProc(clientData)
ClientData clientData;
{
@@ -879,7 +942,7 @@ ThreadFreeProc(clientData)
*------------------------------------------------------------------------
*/
/* ARGSUSED */
-int
+static int
ThreadDeleteEvent(eventPtr, clientData)
Tcl_Event *eventPtr; /* Really ThreadEvent */
ClientData clientData; /* dummy */
@@ -912,7 +975,7 @@ ThreadDeleteEvent(eventPtr, clientData)
*------------------------------------------------------------------------
*/
/* ARGSUSED */
-void
+static void
ThreadExitProc(clientData)
ClientData clientData;
{
@@ -964,4 +1027,3 @@ ThreadExitProc(clientData)
}
#endif /* TCL_THREADS */
-
diff --git a/tcl/generic/tclTimer.c b/tcl/generic/tclTimer.c
index 4c39fe23c2a..84be1bbf37f 100644
--- a/tcl/generic/tclTimer.c
+++ b/tcl/generic/tclTimer.c
@@ -174,7 +174,7 @@ InitTimer()
* None.
*
* Side effects:
- * Removes the timer and idle event sources.
+ * Removes the timer and idle event sources and remaining events.
*
*----------------------------------------------------------------------
*/
@@ -183,7 +183,19 @@ static void
TimerExitProc(clientData)
ClientData clientData; /* Not used. */
{
+ ThreadSpecificData *tsdPtr =
+ (ThreadSpecificData *) TclThreadDataKeyGet(&dataKey);
+
Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL);
+ if (tsdPtr != NULL) {
+ register TimerHandler *timerHandlerPtr;
+ timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
+ while (timerHandlerPtr != NULL) {
+ tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr;
+ ckfree((char *) timerHandlerPtr);
+ timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
+ }
+ }
}
/*
@@ -224,7 +236,7 @@ Tcl_CreateTimerHandler(milliseconds, proc, clientData)
* Compute when the event should fire.
*/
- TclpGetTime(&time);
+ Tcl_GetTime(&time);
timerHandlerPtr->time.sec = time.sec + milliseconds/1000;
timerHandlerPtr->time.usec = time.usec + (milliseconds%1000)*1000;
if (timerHandlerPtr->time.usec >= 1000000) {
@@ -350,7 +362,7 @@ TimerSetupProc(data, flags)
* Compute the timeout for the next timer on the list.
*/
- TclpGetTime(&blockTime);
+ Tcl_GetTime(&blockTime);
blockTime.sec = tsdPtr->firstTimerHandlerPtr->time.sec - blockTime.sec;
blockTime.usec = tsdPtr->firstTimerHandlerPtr->time.usec -
blockTime.usec;
@@ -401,7 +413,7 @@ TimerCheckProc(data, flags)
* Compute the timeout for the next timer on the list.
*/
- TclpGetTime(&blockTime);
+ Tcl_GetTime(&blockTime);
blockTime.sec = tsdPtr->firstTimerHandlerPtr->time.sec - blockTime.sec;
blockTime.usec = tsdPtr->firstTimerHandlerPtr->time.usec -
blockTime.usec;
@@ -500,7 +512,7 @@ TimerHandlerEventProc(evPtr, flags)
tsdPtr->timerPending = 0;
currentTimerId = tsdPtr->lastTimerId;
- TclpGetTime(&time);
+ Tcl_GetTime(&time);
while (1) {
nextPtrPtr = &tsdPtr->firstTimerHandlerPtr;
timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
@@ -735,7 +747,9 @@ Tcl_AfterObjCmd(clientData, interp, objc, objv)
char *argString;
int index;
char buf[16 + TCL_INTEGER_SPACE];
- static char *afterSubCmds[] = {"cancel", "idle", "info", (char *) NULL};
+ static CONST char *afterSubCmds[] = {
+ "cancel", "idle", "info", (char *) NULL
+ };
enum afterSubCmds {AFTER_CANCEL, AFTER_IDLE, AFTER_INFO};
ThreadSpecificData *tsdPtr = InitTimer();
diff --git a/tcl/generic/tclUniData.c b/tcl/generic/tclUniData.c
index 612aba8e864..9f0c6e05ae0 100644
--- a/tcl/generic/tclUniData.c
+++ b/tcl/generic/tclUniData.c
@@ -1,5 +1,5 @@
/*
- * tclUtfData.c --
+ * tclUniData.c --
*
* Declarations of Unicode character information tables. This file is
* automatically generated by the tools/uniParse.tcl script. Do not
@@ -26,44 +26,33 @@
*/
static unsigned char pageMap[] = {
- 0, 1, 2, 3, 0, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18,
- 19, 20, 21, 22, 23, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 7, 33,
- 7, 34, 35, 16, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48,
- 49, 50, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
- 16, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66,
- 55, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 77, 78,
- 81, 82, 77, 16, 16, 16, 16, 83, 84, 85, 16, 86, 87, 88, 16, 89, 90,
- 91, 92, 93, 94, 16, 16, 16, 16, 16, 16, 16, 95, 96, 97, 47, 47, 98,
- 47, 47, 99, 47, 100, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
- 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
- 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
- 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
- 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
- 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 7,
- 7, 7, 7, 101, 7, 7, 102, 103, 104, 105, 106, 104, 107, 108, 109, 110,
- 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, 123, 124,
- 125, 126, 126, 126, 126, 126, 126, 126, 127, 128, 129, 123, 130, 16,
- 16, 16, 16, 123, 131, 125, 132, 133, 134, 135, 136, 123, 123, 123,
- 123, 137, 123, 123, 138, 139, 123, 123, 138, 16, 16, 16, 16, 140, 141,
- 142, 143, 144, 145, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
- 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
- 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
- 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
- 16, 16, 16, 146, 147, 83, 47, 148, 83, 47, 149, 150, 151, 47, 47, 152,
- 16, 16, 16, 153, 154, 155, 156, 154, 157, 158, 159, 123, 123, 123,
- 160, 123, 123, 161, 159, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
- 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
- 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
- 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
- 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
- 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
- 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
- 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
- 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
- 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
- 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
- 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
- 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 47, 47, 47, 47, 47, 47, 47,
+ 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,
@@ -75,6 +64,7 @@ static unsigned char pageMap[] = {
47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 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,
@@ -102,12 +92,6 @@ static unsigned char pageMap[] = {
47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 162, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
- 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
- 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
- 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
- 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16,
- 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 47, 47, 47,
47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
@@ -118,8 +102,13 @@ static unsigned char pageMap[] = {
47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
47, 47, 47, 47, 47, 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,
@@ -128,29 +117,269 @@ static unsigned char pageMap[] = {
47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 163, 16, 16, 164, 164, 164, 164, 164, 164,
- 164, 164, 164, 164, 164, 164, 164, 164, 164, 164, 164, 164, 164, 164,
- 164, 164, 164, 164, 164, 164, 164, 164, 164, 164, 164, 164, 164, 164,
- 164, 164, 164, 164, 164, 164, 164, 164, 164, 164, 164, 164, 164, 164,
- 164, 164, 164, 164, 164, 164, 164, 164, 164, 164, 164, 164, 164, 164,
- 164, 164, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165,
- 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165,
- 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165,
- 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165,
- 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165,
- 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165,
- 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165,
- 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165,
- 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165,
- 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165,
- 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165,
- 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165,
- 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165,
- 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165, 165,
- 165, 165, 165, 165, 165, 165, 47, 47, 47, 47, 47, 47, 47, 47, 47, 166,
- 16, 16, 16, 16, 16, 16, 167, 168, 169, 47, 47, 170, 171, 47, 47, 47,
- 47, 47, 47, 47, 47, 47, 47, 172, 173, 47, 174, 47, 175, 176, 16, 177,
- 178, 179, 47, 47, 47, 180, 181, 2, 182, 183, 184, 185, 186, 187
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47,
+ 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 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
};
/*
@@ -167,326 +396,413 @@ static unsigned char groupMap[] = {
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, 15, 14, 3, 11, 17, 15, 18, 17, 17,
+ 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, 19, 20, 21,
- 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20,
- 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21,
- 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 22, 23, 20, 21, 20,
- 21, 20, 21, 15, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20,
- 21, 20, 21, 15, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20,
- 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21,
- 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 24,
- 20, 21, 20, 21, 20, 21, 25, 15, 26, 20, 21, 20, 21, 27, 20, 21, 28,
- 28, 20, 21, 15, 29, 30, 31, 20, 21, 28, 32, 15, 33, 34, 20, 21, 15,
- 15, 33, 35, 15, 36, 20, 21, 20, 21, 20, 21, 37, 20, 21, 37, 38, 15,
- 20, 21, 37, 20, 21, 39, 39, 20, 21, 20, 21, 40, 20, 21, 15, 38, 20,
- 21, 38, 38, 38, 38, 38, 38, 41, 42, 43, 41, 42, 43, 41, 42, 43, 20,
- 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 44, 20,
- 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21,
- 15, 41, 42, 43, 20, 21, 0, 0, 0, 0, 20, 21, 20, 21, 20, 21, 20, 21,
- 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20,
- 21, 20, 21, 20, 21, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 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, 45,
- 46, 15, 47, 47, 15, 48, 15, 49, 15, 15, 15, 15, 47, 15, 15, 50, 15,
- 15, 15, 15, 51, 52, 15, 15, 15, 15, 15, 52, 15, 15, 53, 15, 15, 54,
- 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 55, 15, 15, 55, 15, 15, 15,
- 15, 55, 15, 56, 56, 15, 15, 15, 15, 15, 15, 57, 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, 58, 58, 58, 58, 58, 58, 58, 58, 58, 11, 11, 58,
- 58, 58, 58, 58, 58, 58, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11,
- 11, 11, 11, 58, 58, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11,
- 11, 0, 58, 58, 58, 58, 58, 11, 11, 11, 11, 11, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 59, 59, 59, 59, 59, 59,
- 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59,
- 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 60, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 59, 59, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 11, 11,
- 0, 0, 0, 0, 58, 0, 0, 0, 3, 0, 0, 0, 0, 0, 11, 11, 61, 3, 62, 62, 62,
- 0, 63, 0, 64, 64, 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, 65, 66,
- 66, 66, 15, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13,
- 13, 13, 13, 67, 13, 13, 13, 13, 13, 13, 13, 13, 13, 68, 69, 69, 0,
- 70, 71, 72, 72, 72, 73, 74, 0, 0, 0, 72, 0, 72, 0, 72, 0, 72, 0, 20,
- 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 75, 76, 44, 38,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 77, 77, 77, 77, 77, 77, 77,
- 77, 77, 77, 77, 77, 0, 77, 77, 10, 10, 10, 10, 10, 10, 10, 10, 10,
+ 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, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13,
+ 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, 0, 76, 76, 76, 76, 76, 76, 76, 76, 76, 76, 76, 76,
- 0, 76, 76, 20, 21, 14, 59, 59, 59, 59, 0, 0, 0, 0, 0, 0, 0, 0, 0, 20,
- 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 38, 20,
- 21, 20, 21, 0, 0, 20, 21, 0, 0, 20, 21, 0, 0, 0, 20, 21, 20, 21, 20,
- 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21,
- 20, 21, 20, 21, 20, 21, 0, 0, 20, 21, 20, 21, 20, 21, 20, 21, 0, 0,
- 20, 21, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78,
- 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78,
- 78, 78, 78, 78, 78, 78, 0, 0, 58, 3, 3, 3, 3, 3, 3, 0, 79, 79, 79,
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79,
- 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, 79,
- 79, 15, 0, 3, 0, 0, 0, 0, 0, 0, 0, 59, 59, 59, 59, 59, 59, 59, 59,
- 59, 59, 59, 59, 59, 59, 59, 59, 59, 0, 59, 59, 59, 59, 59, 59, 59,
- 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 0,
- 59, 59, 59, 3, 59, 3, 59, 59, 3, 59, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 0, 0, 0, 0, 0, 38, 38,
- 38, 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, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 0, 0, 0, 0, 0, 58, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 59, 59, 59, 59, 59, 59, 59, 59, 0,
- 0, 0, 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, 59, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 0, 0, 38, 38, 38, 38, 38, 0, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 0, 38, 38, 38,
- 38, 3, 38, 59, 59, 59, 59, 59, 59, 59, 80, 80, 59, 59, 59, 59, 59,
- 59, 58, 58, 59, 59, 14, 59, 59, 59, 59, 0, 0, 9, 9, 9, 9, 9, 9, 9,
- 9, 9, 9, 0, 0, 0, 0, 0, 0, 0, 59, 59, 81, 0, 38, 38, 38, 38, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 0, 0, 59, 38, 81,
- 81, 81, 59, 59, 59, 59, 59, 59, 59, 59, 81, 81, 81, 81, 59, 0, 0, 38,
- 59, 59, 59, 59, 0, 0, 0, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 59,
- 59, 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, 59, 81, 81, 0, 38, 38, 38, 38, 38, 38, 38,
- 38, 0, 0, 38, 38, 0, 0, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 0, 38, 38, 38, 38, 38,
- 38, 38, 0, 38, 0, 0, 0, 38, 38, 38, 38, 0, 0, 59, 0, 81, 81, 81, 59,
- 59, 59, 59, 0, 0, 81, 81, 0, 0, 81, 81, 59, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 81, 0, 0, 0, 0, 38, 38, 0, 38, 38, 38, 59, 59, 0, 0, 9, 9, 9, 9,
- 9, 9, 9, 9, 9, 9, 38, 38, 4, 4, 17, 17, 17, 17, 17, 17, 14, 0, 0, 0,
- 0, 0, 0, 0, 59, 0, 0, 38, 38, 38, 38, 38, 38, 0, 0, 0, 0, 38, 38, 0,
- 0, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 38, 38, 38, 38, 38, 38, 0, 38, 38, 38, 38, 38, 38, 38, 0, 38, 38, 0,
- 38, 38, 0, 38, 38, 0, 0, 59, 0, 81, 81, 81, 59, 59, 0, 0, 0, 0, 59,
- 59, 0, 0, 59, 59, 59, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 38, 38, 38,
- 38, 0, 38, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 59, 59,
- 38, 38, 38, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 59, 59, 81, 0, 38,
- 38, 38, 38, 38, 38, 38, 0, 38, 0, 38, 38, 38, 0, 38, 38, 38, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 0, 38, 38, 38, 38, 38, 38, 38, 0, 38, 38, 0, 38, 38, 38, 38, 38, 0,
- 0, 59, 38, 81, 81, 81, 59, 59, 59, 59, 59, 0, 59, 59, 81, 0, 81, 81,
- 59, 0, 0, 38, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 38, 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, 38, 38, 38, 38, 38, 38, 38, 38, 38, 0, 38, 38, 38,
- 38, 38, 38, 38, 0, 38, 38, 0, 0, 38, 38, 38, 38, 0, 0, 59, 38, 81,
- 59, 81, 59, 59, 59, 0, 0, 0, 81, 81, 0, 0, 81, 81, 59, 0, 0, 0, 0,
- 0, 0, 0, 0, 59, 81, 0, 0, 0, 0, 38, 38, 0, 38, 38, 38, 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, 59, 81, 0, 38, 38, 38, 38, 38, 38, 0, 0, 0, 38, 38,
- 38, 0, 38, 38, 38, 38, 0, 0, 0, 38, 38, 0, 38, 0, 38, 38, 0, 0, 0,
- 38, 38, 0, 0, 0, 38, 38, 38, 0, 0, 0, 38, 38, 38, 38, 38, 38, 38, 38,
- 0, 38, 38, 38, 0, 0, 0, 0, 81, 81, 59, 81, 81, 0, 0, 0, 81, 81, 81,
- 0, 81, 81, 81, 59, 0, 0, 0, 0, 0, 0, 0, 0, 0, 81, 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, 81, 81, 81, 0, 38, 38, 38, 38,
- 38, 38, 38, 38, 0, 38, 38, 38, 0, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 0, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 0, 38, 38, 38, 38, 38, 0, 0, 0, 0,
- 59, 59, 59, 81, 81, 81, 81, 0, 59, 59, 59, 0, 59, 59, 59, 59, 0, 0,
- 0, 0, 0, 0, 0, 59, 59, 0, 0, 0, 0, 0, 0, 0, 0, 0, 38, 38, 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, 81, 81, 0, 38, 38, 38, 38, 38, 38, 38, 38, 0, 38,
- 38, 38, 0, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 0, 38, 38, 38, 38, 38, 38, 38,
- 38, 38, 38, 0, 38, 38, 38, 38, 38, 0, 0, 0, 0, 81, 59, 81, 81, 81,
- 81, 81, 0, 59, 81, 81, 0, 81, 81, 59, 59, 0, 0, 0, 0, 0, 0, 0, 81,
- 81, 0, 0, 0, 0, 0, 0, 0, 38, 0, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 0, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 0, 0, 0, 0, 81, 81, 81, 59, 59, 59, 0, 0, 81, 81, 81, 0, 81, 81, 81,
- 59, 0, 0, 0, 0, 0, 0, 0, 0, 0, 81, 0, 0, 0, 0, 0, 0, 0, 0, 0, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 59, 38, 38, 59, 59,
- 59, 59, 59, 59, 59, 0, 0, 0, 0, 4, 38, 38, 38, 38, 38, 38, 58, 59,
- 59, 59, 59, 59, 59, 59, 59, 14, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3,
- 0, 0, 0, 0, 0, 38, 38, 0, 38, 0, 0, 38, 38, 0, 38, 0, 0, 38, 0, 0,
- 0, 0, 0, 0, 38, 38, 38, 38, 0, 38, 38, 38, 38, 38, 38, 38, 0, 38, 38,
- 38, 0, 38, 0, 38, 0, 0, 38, 38, 0, 38, 38, 38, 38, 59, 38, 38, 59,
- 59, 59, 59, 59, 59, 0, 59, 59, 38, 0, 0, 38, 38, 38, 38, 38, 0, 58,
- 0, 59, 59, 59, 59, 59, 59, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0,
- 38, 38, 0, 0, 38, 14, 14, 14, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
- 3, 3, 14, 14, 14, 14, 14, 59, 59, 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, 59,
- 14, 59, 14, 59, 5, 6, 5, 6, 81, 81, 38, 38, 38, 38, 38, 38, 38, 38,
- 0, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 0, 0, 0, 0, 0, 0, 0, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59,
- 59, 59, 81, 59, 59, 59, 59, 59, 3, 59, 59, 38, 38, 38, 38, 0, 0, 0,
- 0, 59, 59, 59, 59, 59, 59, 0, 59, 0, 59, 59, 59, 59, 59, 59, 59, 59,
- 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 0, 0, 0, 59, 59,
- 59, 59, 59, 59, 59, 0, 59, 0, 0, 0, 0, 0, 0, 78, 78, 78, 78, 78, 78,
- 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78,
- 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, 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, 0, 0, 0, 0, 3, 0, 0, 0, 0,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 0, 0, 0, 0, 0, 38, 38, 38, 38,
- 0, 0, 0, 0, 0, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 38, 38, 38, 0, 0, 0, 0, 0, 0, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21,
- 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 15, 15, 15, 15, 15,
- 82, 0, 0, 0, 0, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20,
- 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 0, 0, 0, 0, 0,
- 0, 83, 83, 83, 83, 83, 83, 83, 83, 84, 84, 84, 84, 84, 84, 84, 84,
- 83, 83, 83, 83, 83, 83, 0, 0, 84, 84, 84, 84, 84, 84, 0, 0, 83, 83,
- 83, 83, 83, 83, 83, 83, 84, 84, 84, 84, 84, 84, 84, 84, 83, 83, 83,
- 83, 83, 83, 83, 83, 84, 84, 84, 84, 84, 84, 84, 84, 83, 83, 83, 83,
- 83, 83, 0, 0, 84, 84, 84, 84, 84, 84, 0, 0, 15, 83, 15, 83, 15, 83,
- 15, 83, 0, 84, 0, 84, 0, 84, 0, 84, 83, 83, 83, 83, 83, 83, 83, 83,
- 84, 84, 84, 84, 84, 84, 84, 84, 85, 85, 86, 86, 86, 86, 87, 87, 88,
- 88, 89, 89, 90, 90, 0, 0, 83, 83, 83, 83, 83, 83, 83, 83, 84, 84, 84,
- 84, 84, 84, 84, 84, 83, 83, 15, 91, 15, 0, 15, 15, 84, 84, 92, 92,
- 93, 11, 94, 11, 11, 11, 15, 91, 15, 0, 15, 15, 95, 95, 95, 95, 93,
- 11, 11, 11, 83, 83, 15, 15, 0, 0, 15, 15, 84, 84, 96, 96, 0, 11, 11,
- 11, 83, 83, 15, 15, 15, 97, 15, 15, 84, 84, 98, 98, 99, 11, 11, 11,
- 0, 0, 15, 91, 15, 0, 15, 15, 100, 100, 101, 101, 93, 11, 11, 0, 2,
- 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 102, 102, 102, 102, 8, 8, 8, 8, 8,
- 8, 3, 3, 16, 18, 5, 16, 16, 18, 5, 16, 3, 3, 3, 3, 3, 3, 3, 3, 103,
- 104, 102, 102, 102, 102, 102, 0, 3, 3, 3, 3, 3, 3, 3, 3, 3, 16, 18,
- 3, 3, 3, 3, 12, 12, 3, 3, 3, 7, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 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, 102, 102, 102, 102, 102, 102, 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, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 59,
- 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 59, 80, 80, 80, 80, 59,
+ 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, 14, 14, 72, 14, 14, 14, 14, 72, 14, 14, 15, 72,
- 72, 72, 15, 15, 72, 72, 72, 15, 14, 72, 14, 14, 15, 72, 72, 72, 72,
- 72, 14, 14, 14, 14, 14, 14, 72, 14, 72, 14, 72, 14, 72, 72, 72, 72,
- 15, 15, 72, 72, 14, 72, 15, 38, 38, 38, 38, 0, 0, 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, 105, 105, 105, 105, 105, 105, 105,
- 105, 105, 105, 105, 105, 105, 105, 105, 105, 106, 106, 106, 106, 106,
- 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 107, 107, 107,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 7, 7, 7, 7, 7, 14, 14, 14, 14,
+ 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, 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, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 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, 0, 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, 0, 0, 0, 0, 0, 14,
- 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17,
+ 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, 14,
- 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 14, 14, 14, 14, 14, 14, 108, 108, 108, 108, 108, 108, 108,
- 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108,
- 108, 108, 108, 108, 108, 109, 109, 109, 109, 109, 109, 109, 109, 109,
- 109, 109, 109, 109, 109, 109, 109, 109, 109, 109, 109, 109, 109, 109,
- 109, 109, 109, 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,
+ 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, 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, 0, 0, 0, 0, 0,
- 0, 14, 14, 14, 14, 14, 14, 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,
+ 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, 17, 17, 17, 17, 17, 17, 17, 17, 14, 0, 0, 0, 14, 14, 14,
+ 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, 14, 14, 14, 14, 14, 14, 14,
- 14, 14, 0, 2, 3, 3, 3, 14, 58, 38, 107, 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, 107, 107, 107, 107,
- 107, 107, 107, 107, 107, 59, 59, 59, 59, 59, 59, 8, 58, 58, 58, 58,
- 58, 14, 14, 0, 0, 0, 0, 0, 0, 0, 14, 38, 38, 38, 38, 38, 38, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 0, 0, 0, 0, 59,
- 59, 11, 11, 58, 58, 0, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 12,
- 58, 58, 58, 0, 0, 0, 0, 0, 0, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 0, 0, 0, 0, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 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, 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, 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, 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, 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, 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,
- 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, 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, 0, 0, 38, 38, 38, 38, 38,
- 38, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 38, 38, 38, 38, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 110, 110, 110, 110,
- 110, 110, 110, 110, 110, 110, 110, 110, 110, 110, 110, 110, 110, 110,
- 110, 110, 110, 110, 110, 110, 110, 110, 110, 110, 110, 110, 110, 110,
- 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111,
- 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, 111,
- 111, 111, 111, 111, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 38, 38, 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, 0, 59, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 7, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 0, 38, 38, 38,
- 38, 38, 0, 38, 0, 38, 38, 0, 38, 38, 0, 38, 38, 38, 38, 38, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 38, 38, 38, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 38, 38, 38, 38, 38, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 38, 38, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 0, 0, 38, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 38, 38, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 0, 0, 0, 0, 59, 59, 59, 59,
+ 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, 38, 38, 38, 0, 38, 0, 38, 38, 38, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 0, 0, 102, 0, 3, 3, 3, 4, 3, 3, 3, 5, 6, 3, 7, 3, 8, 3, 3, 9, 9, 9,
+ 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, 38, 38, 38, 38, 38, 38,
- 38, 38, 38, 38, 58, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 58,
- 58, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38,
- 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 0, 0, 0,
- 38, 38, 38, 38, 38, 38, 0, 0, 38, 38, 38, 38, 38, 38, 0, 0, 38, 38,
- 38, 38, 38, 38, 0, 0, 38, 38, 38, 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, 0, 0, 0, 14,
- 14, 0, 0
+ 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
};
/*
@@ -510,21 +826,23 @@ static unsigned char groupMap[] = {
static int groups[] = {
0, 15, 12, 25, 27, 21, 22, 26, 20, 9, 134217793, 28, 19, 134217858,
- 29, 2, 23, 11, 24, -507510654, 4194369, 4194434, -834666431, 973078658,
- -507510719, 1258291330, 880803905, 864026689, 859832385, 331350081,
- 847249473, 851443777, 868220993, 884998209, 876609601, 893386817,
- 897581121, 914358337, 5, 910164033, 918552641, 8388705, 4194499,
- 8388770, 331350146, 880803970, 864026754, 859832450, 847249538,
- 851443842, 868221058, 876609666, 884998274, 893386882, 897581186,
- 914358402, 910164098, 918552706, 4, 6, -352321338, 159383617,
- 155189313, 268435521, 264241217, 159383682, 155189378, 130023554,
- 268435586, 264241282, 260046978, 239075458, 1, 197132418, 226492546,
- 360710274, 335544450, 335544385, 201326657, 201326722, 7, 8, 247464066,
- -33554302, -33554367, -310378366, -360710014, -419430270, -536870782,
- -469761918, -528482174, -37748606, -310378431, -37748671, 155189442,
- -360710079, -419430335, -29359998, -469761983, -29360063, -536870847,
- -528482239, 16, 13, 14, 67108938, 67109002, 10, 109051997, 109052061,
- 18, 17
+ 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
};
/*
@@ -575,7 +893,7 @@ enum {
#define GetCaseType(info) (((info) & 0xE0) >> 5)
#define GetCategory(info) ((info) & 0x1F)
-#define GetDelta(infO) (((info) > 0) ? ((info) >> 22) : (~(~((info)) >> 22)))
+#define GetDelta(info) (((info) > 0) ? ((info) >> 22) : (~(~((info)) >> 22)))
/*
* This macro extracts the information about a character from the
diff --git a/tcl/generic/tclUtf.c b/tcl/generic/tclUtf.c
index 5f6826ddf01..8ba7bb56655 100644
--- a/tcl/generic/tclUtf.c
+++ b/tcl/generic/tclUtf.c
@@ -61,8 +61,8 @@
* The following structures are used when mapping between Unicode (UCS-2)
* and UTF-8.
*/
-
-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,
@@ -111,7 +111,7 @@ static int UtfCount _ANSI_ARGS_((int ch));
*---------------------------------------------------------------------------
*/
-static int
+INLINE static int
UtfCount(ch)
int ch; /* The Tcl_UniChar whose size is returned. */
{
@@ -309,7 +309,7 @@ Tcl_UtfToUniChar(str, chPtr)
* Also treats \0 and naked trail bytes 0x80 to 0xBF as valid
* characters representing themselves.
*/
-
+
*chPtr = (Tcl_UniChar) byte;
return 1;
} else if (byte < 0xE0) {
@@ -317,7 +317,7 @@ Tcl_UtfToUniChar(str, chPtr)
/*
* Two-byte-character lead-byte followed by a trail-byte.
*/
-
+
*chPtr = (Tcl_UniChar) (((byte & 0x1F) << 6) | (str[1] & 0x3F));
return 2;
}
@@ -325,7 +325,7 @@ Tcl_UtfToUniChar(str, chPtr)
* A two-byte-character lead-byte not followed by trail-byte
* represents itself.
*/
-
+
*chPtr = (Tcl_UniChar) byte;
return 1;
} else if (byte < 0xF0) {
@@ -536,7 +536,7 @@ Tcl_NumUtfChars(str, len)
*
*---------------------------------------------------------------------------
*/
-char *
+CONST char *
Tcl_UtfFindFirst(string, ch)
CONST char *string; /* The UTF-8 string to be searched. */
int ch; /* The Tcl_UniChar to search for. */
@@ -547,7 +547,7 @@ Tcl_UtfFindFirst(string, ch)
while (1) {
len = Tcl_UtfToUniChar(string, &find);
if (find == ch) {
- return (char *) string;
+ return string;
}
if (*string == '\0') {
return NULL;
@@ -576,7 +576,7 @@ Tcl_UtfFindFirst(string, ch)
*---------------------------------------------------------------------------
*/
-char *
+CONST char *
Tcl_UtfFindLast(string, ch)
CONST char *string; /* The UTF-8 string to be searched. */
int ch; /* The Tcl_UniChar to search for. */
@@ -596,7 +596,7 @@ Tcl_UtfFindLast(string, ch)
}
string += len;
}
- return (char *) last;
+ return last;
}
/*
@@ -619,13 +619,13 @@ Tcl_UtfFindLast(string, ch)
*---------------------------------------------------------------------------
*/
-char *
+CONST char *
Tcl_UtfNext(str)
CONST char *str; /* The current location in the string. */
{
Tcl_UniChar ch;
- return (char *) str + Tcl_UtfToUniChar(str, &ch);
+ return str + Tcl_UtfToUniChar(str, &ch);
}
/*
@@ -634,7 +634,8 @@ Tcl_UtfNext(str)
* Tcl_UtfPrev --
*
* Given a pointer to some current location in a UTF-8 string,
- * move backwards one character.
+ * move backwards one character. This works correctly when the
+ * pointer is in the middle of a UTF-8 character.
*
* Results:
* The return value is a pointer to the previous character in the
@@ -648,7 +649,7 @@ Tcl_UtfNext(str)
*---------------------------------------------------------------------------
*/
-char *
+CONST char *
Tcl_UtfPrev(str, start)
CONST char *str; /* The current location in the string. */
CONST char *start; /* Pointer to the beginning of the
@@ -670,16 +671,13 @@ Tcl_UtfPrev(str, start)
byte = *((unsigned char *) look);
if (byte < 0x80) {
break;
- }
+ }
if (byte >= 0xC0) {
- if (totalBytes[byte] != i + 1) {
- break;
- }
- return (char *) look;
+ return look;
}
look--;
}
- return (char *) str;
+ return str;
}
/*
@@ -730,7 +728,7 @@ Tcl_UniCharAtIndex(src, index)
*---------------------------------------------------------------------------
*/
-char *
+CONST char *
Tcl_UtfAtIndex(src, index)
register CONST char *src; /* The UTF-8 string. */
register int index; /* The position of the desired character. */
@@ -741,7 +739,7 @@ Tcl_UtfAtIndex(src, index)
index--;
src += Tcl_UtfToUniChar(src, &ch);
}
- return (char *) src;
+ return src;
}
/*
@@ -780,118 +778,19 @@ Tcl_UtfBackslash(src, readPtr, dst)
char *dst; /* Filled with the bytes represented by the
* backslash sequence. */
{
- register CONST char *p = src+1;
- int result, count, n;
- char buf[TCL_UTF_MAX];
-
- if (dst == NULL) {
- dst = buf;
+#define LINE_LENGTH 128
+ int numRead;
+ int result;
+
+ result = TclParseBackslash(src, LINE_LENGTH, &numRead, dst);
+ if (numRead == LINE_LENGTH) {
+ /* We ate a whole line. Pay the price of a strlen() */
+ result = TclParseBackslash(src, (int)strlen(src), &numRead, dst);
}
-
- count = 2;
- switch (*p) {
- /*
- * Note: in the conversions below, use absolute values (e.g.,
- * 0xa) rather than symbolic values (e.g. \n) that get converted
- * by the compiler. It's possible that compilers on some
- * platforms will do the symbolic conversions differently, which
- * could result in non-portable Tcl scripts.
- */
-
- case 'a':
- result = 0x7;
- break;
- case 'b':
- result = 0x8;
- break;
- case 'f':
- result = 0xc;
- break;
- case 'n':
- result = 0xa;
- break;
- case 'r':
- result = 0xd;
- break;
- case 't':
- result = 0x9;
- break;
- case 'v':
- result = 0xb;
- break;
- case 'x':
- if (isxdigit(UCHAR(p[1]))) { /* INTL: digit */
- char *end;
-
- result = (unsigned char) strtoul(p+1, &end, 16);
- count = end - src;
- } else {
- count = 2;
- result = 'x';
- }
- break;
- case 'u':
- result = 0;
- for (count = 0; count < 4; count++) {
- p++;
- if (!isxdigit(UCHAR(*p))) { /* INTL: digit */
- break;
- }
- n = *p - '0';
- if (n > 9) {
- n = n + '0' + 10 - 'A';
- }
- if (n > 16) {
- n = n + 'A' - 'a';
- }
- result = (result << 4) + n;
- }
- if (count == 0) {
- result = 'u';
- }
- count += 2;
- break;
-
- case '\n':
- do {
- p++;
- } while ((*p == ' ') || (*p == '\t'));
- result = ' ';
- count = p - src;
- break;
- case 0:
- result = '\\';
- count = 1;
- break;
- default:
- /*
- * Check for an octal number \oo?o?
- */
- if (isdigit(UCHAR(*p)) && (UCHAR(*p) < '8')) { /* INTL: digit */
- result = (unsigned char)(*p - '0');
- p++;
- if (!isdigit(UCHAR(*p)) || (UCHAR(*p) >= '8')) { /* INTL: digit */
- break;
- }
- count = 3;
- result = (unsigned char)((result << 3) + (*p - '0'));
- p++;
- if (!isdigit(UCHAR(*p)) || (UCHAR(*p) >= '8')) { /* INTL: digit */
- break;
- }
- count = 4;
- result = (unsigned char)((result << 3) + (*p - '0'));
- break;
- }
- result = *p;
- count = 2;
- break;
- }
-
if (readPtr != NULL) {
- *readPtr = count;
+ *readPtr = numRead;
}
- return Tcl_UniCharToUtf(result, dst);
+ return result;
}
/*
@@ -1065,6 +964,51 @@ 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.
+ *
+ * Results:
+ * Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+{
+ /*
+ * 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.
+ */
+ register int result = 0;
+
+ for ( ; n != 0; n--, cs++, ct++) {
+ if (*cs != *ct) {
+ result = UCHAR(*cs) - UCHAR(*ct);
+ break;
+ }
+ }
+ if (n && ((UCHAR(*cs) == 0xC0) || (UCHAR(*ct) == 0xC0))) {
+ unsigned char c1, c2;
+ c1 = ((UCHAR(*cs) == 0xC0) && (UCHAR(cs[1]) == 0x80)) ? 0 : UCHAR(*cs);
+ c2 = ((UCHAR(*ct) == 0xC0) && (UCHAR(ct[1]) == 0x80)) ? 0 : UCHAR(*ct);
+ result = (c1 - c2);
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_UtfNcmp --
*
* Compare at most n UTF chars of string cs to string ct. Both cs
@@ -1087,11 +1031,9 @@ Tcl_UtfNcmp(cs, ct, n)
{
Tcl_UniChar ch1, ch2;
/*
- * Another approach that should work is:
- * return memcmp(cs, ct, (unsigned) (Tcl_UtfAtIndex(cs, n) - cs));
- * That assumes that ct is a properly formed UTF, so we will just
- * be comparing the bytes that compromise those strings to the
- * char length n.
+ * Cannot use 'memcmp(cs, ct, n);' as byte representation of
+ * \u0000 (the pair of bytes 0xc0,0x80) is larger than byte
+ * representation of \u0001 (the byte 0x01.)
*/
while (n-- > 0) {
/*
@@ -1265,7 +1207,7 @@ Tcl_UniCharToTitle(ch)
int
Tcl_UniCharLen(str)
- Tcl_UniChar *str; /* Unicode string to find length of. */
+ CONST Tcl_UniChar *str; /* Unicode string to find length of. */
{
int len = 0;
@@ -1299,12 +1241,53 @@ Tcl_UniCharNcmp(cs, ct, n)
CONST Tcl_UniChar *ct; /* Unicode string cs is compared to. */
unsigned long n; /* Number of unichars to compare. */
{
- for ( ; n != 0; n--, cs++, ct++) {
+#ifdef WORDS_BIGENDIAN
+ /*
+ * We are definitely on a big-endian machine; memcmp() is safe
+ */
+ return memcmp(cs, ct, n*sizeof(Tcl_UniChar));
+
+#else /* !WORDS_BIGENDIAN */
+ /*
+ * We can't simply call memcmp() because that is not lexically correct.
+ */
+ for ( ; n != 0; cs++, ct++, n--) {
if (*cs != *ct) {
- return *cs - *ct;
+ return (*cs - *ct);
}
- if (*cs == '\0') {
- break;
+ }
+ return 0;
+#endif /* WORDS_BIGENDIAN */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UniCharNcasecmp --
+ *
+ * Compare at most n unichars of string cs to string ct case
+ * insensitive. Both cs and ct are assumed to be at least n
+ * unichars long.
+ *
+ * Results:
+ * Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_UniCharNcasecmp(cs, ct, n)
+ CONST Tcl_UniChar *cs; /* Unicode string to compare to ct. */
+ CONST Tcl_UniChar *ct; /* Unicode string cs is compared to. */
+ unsigned long n; /* Number of unichars to compare. */
+{
+ for ( ; n != 0; n--, cs++, ct++) {
+ if ((*cs != *ct) &&
+ (Tcl_UniCharToLower(*cs) != Tcl_UniCharToLower(*ct))) {
+ return (*cs - *ct);
}
}
return 0;
@@ -1584,3 +1567,182 @@ Tcl_UniCharIsWordChar(ch)
return (((ALPHA_BITS | DIGIT_BITS | CONNECTOR_BITS) >> category) & 1);
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UniCharCaseMatch --
+ *
+ * See if a particular Unicode string matches a particular pattern.
+ * Allows case insensitivity. This is the Unicode equivalent of
+ * the char* Tcl_StringCaseMatch.
+ *
+ * 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
+Tcl_UniCharCaseMatch(string, pattern, nocase)
+ CONST Tcl_UniChar *string; /* Unicode String. */
+ CONST Tcl_UniChar *pattern; /* Pattern, which may contain special
+ * characters. */
+ int nocase; /* 0 for case sensitive, 1 for insensitive */
+{
+ Tcl_UniChar ch1, p;
+
+ while (1) {
+ p = *pattern;
+
+ /*
+ * 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 (*string == 0);
+ }
+ if ((*string == 0) && (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) == '*') {}
+ p = *pattern;
+ if (p == 0) {
+ return 1;
+ }
+ if (nocase) {
+ p = Tcl_UniCharToLower(p);
+ }
+ 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 != '\\')) {
+ if (nocase) {
+ while (*string && (p != *string)
+ && (p != Tcl_UniCharToLower(*string))) {
+ string++;
+ }
+ } else {
+ while (*string && (p != *string)) { string++; }
+ }
+ }
+ if (Tcl_UniCharCaseMatch(string, pattern, nocase)) {
+ return 1;
+ }
+ if (*string == 0) {
+ 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 == '[') {
+ Tcl_UniChar startChar, endChar;
+
+ pattern++;
+ ch1 = (nocase ? Tcl_UniCharToLower(*string) : *string);
+ string++;
+ while (1) {
+ if ((*pattern == ']') || (*pattern == 0)) {
+ return 0;
+ }
+ startChar = (nocase ? Tcl_UniCharToLower(*pattern) : *pattern);
+ pattern++;
+ if (*pattern == '-') {
+ pattern++;
+ if (*pattern == 0) {
+ return 0;
+ }
+ endChar = (nocase ? Tcl_UniCharToLower(*pattern)
+ : *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 == 0) {
+ 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) == '\0') {
+ return 0;
+ }
+ }
+
+ /*
+ * There's no special character. Just make sure that the next
+ * bytes of each string match.
+ */
+
+ if (nocase) {
+ if (Tcl_UniCharToLower(*string) != Tcl_UniCharToLower(*pattern)) {
+ return 0;
+ }
+ } else if (*string != *pattern) {
+ return 0;
+ }
+ string++;
+ pattern++;
+ }
+}
diff --git a/tcl/generic/tclUtil.c b/tcl/generic/tclUtil.c
index 041036b80fd..4e71f668f96 100644
--- a/tcl/generic/tclUtil.c
+++ b/tcl/generic/tclUtil.c
@@ -6,6 +6,7 @@
*
* 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.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -62,6 +63,30 @@ static char precisionFormat[10] = "%.12g";
* to sprintf. */
TCL_DECLARE_MUTEX(precisionMutex)
+/*
+ * Prototypes for procedures defined later in this file.
+ */
+
+static void UpdateStringOfEndOffset _ANSI_ARGS_((Tcl_Obj* objPtr));
+static int SetEndOffsetFromAny _ANSI_ARGS_((Tcl_Interp* interp,
+ Tcl_Obj* objPtr));
+
+/*
+ * The following is the Tcl object type definition for an object
+ * that represents a list index in the form, "end-offset". It is
+ * used as a performance optimization in TclGetIntForIndex. The
+ * internal rep is an integer, so no memory management is required
+ * for it.
+ */
+
+Tcl_ObjType tclEndOffsetType = {
+ "end-offset", /* name */
+ (Tcl_FreeInternalRepProc*) NULL, /* freeIntRepProc */
+ (Tcl_DupInternalRepProc*) NULL, /* dupIntRepProc */
+ UpdateStringOfEndOffset, /* updateStringProc */
+ SetEndOffsetFromAny
+};
+
/*
*----------------------------------------------------------------------
@@ -318,11 +343,11 @@ TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,
* Copy a string and eliminate any backslashes that aren't in braces.
*
* Results:
- * There is no return value. 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 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.
*
* Side effects:
* None.
@@ -395,10 +420,10 @@ Tcl_SplitList(interp, list, argcPtr, argvPtr)
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. */
- char ***argvPtr; /* Pointer to place to store pointer to
+ CONST char ***argvPtr; /* Pointer to place to store pointer to
* array of pointers to list elements. */
{
- char **argv;
+ CONST char **argv;
CONST char *l;
char *p;
int length, size, i, result, elSize, brace;
@@ -417,7 +442,7 @@ Tcl_SplitList(interp, list, argcPtr, argvPtr)
}
}
size++; /* Leave space for final NULL pointer. */
- argv = (char **) ckalloc((unsigned)
+ argv = (CONST char **) ckalloc((unsigned)
((size * sizeof(char *)) + (l - list) + 1));
length = strlen(list);
for (i = 0, p = ((char *) argv) + size*sizeof(char *);
@@ -822,7 +847,7 @@ Tcl_ConvertCountedElement(src, length, dst, flags)
char *
Tcl_Merge(argc, argv)
int argc; /* How many strings to merge. */
- char **argv; /* Array of string values. */
+ CONST char * CONST *argv; /* Array of string values. */
{
# define LOCAL_SIZE 20
int localFlags[LOCAL_SIZE], *flagPtr;
@@ -925,7 +950,7 @@ Tcl_Backslash(src, readPtr)
char *
Tcl_Concat(argc, argv)
int argc; /* Number of strings to concatenate. */
- char **argv; /* Array of strings to concatenate. */
+ CONST char * CONST *argv; /* Array of strings to concatenate. */
{
int totalSize, i;
char *p;
@@ -940,7 +965,7 @@ Tcl_Concat(argc, argv)
return result;
}
for (p = result, i = 0; i < argc; i++) {
- char *element;
+ CONST char *element;
int length;
/*
@@ -1071,8 +1096,8 @@ Tcl_ConcatObj(objc, objv)
for (i = 0; i < objc; i++) {
objPtr = objv[i];
element = Tcl_GetStringFromObj(objPtr, &elemLength);
- while ((elemLength > 0)
- && (isspace(UCHAR(*element)))) { /* INTL: ISO space. */
+ while ((elemLength > 0) && (UCHAR(*element) < 127)
+ && isspace(UCHAR(*element))) { /* INTL: ISO C space. */
element++;
elemLength--;
}
@@ -1083,8 +1108,8 @@ Tcl_ConcatObj(objc, objv)
* this case it could be significant.
*/
- while ((elemLength > 0)
- && isspace(UCHAR(element[elemLength-1])) /* INTL: ISO space. */
+ while ((elemLength > 0) && (UCHAR(element[elemLength-1]) < 127)
+ && isspace(UCHAR(element[elemLength-1])) /* INTL: ISO C space. */
&& ((elemLength < 2) || (element[elemLength-2] != '\\'))) {
elemLength--;
}
@@ -1136,131 +1161,7 @@ Tcl_StringMatch(string, pattern)
CONST char *pattern; /* Pattern, which may contain special
* characters. */
{
- int p, s;
- CONST char *pstart = pattern;
-
- while (1) {
- p = *pattern;
- s = *string;
-
- /*
- * 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') {
- if (s == '\0') {
- return 1;
- } else {
- return 0;
- }
- }
- if ((s == '\0') && (p != '*')) {
- return 0;
- }
-
- /* Check for a "*" as the next pattern character. It matches
- * any substring. We handle this by calling ourselves
- * recursively for each postfix of string, until either we
- * match or we reach the end of the string.
- */
-
- if (p == '*') {
- pattern++;
- if (*pattern == '\0') {
- return 1;
- }
- while (1) {
- if (Tcl_StringMatch(string, pattern)) {
- return 1;
- }
- if (*string == '\0') {
- return 0;
- }
- string++;
- }
- }
-
- /* Check for a "?" as the next pattern character. It matches
- * any single character.
- */
-
- if (p == '?') {
- Tcl_UniChar ch;
-
- pattern++;
- string += Tcl_UtfToUniChar(string, &ch);
- 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 == '[') {
- Tcl_UniChar ch, startChar, endChar;
-
- pattern++;
- string += Tcl_UtfToUniChar(string, &ch);
-
- while (1) {
- if ((*pattern == ']') || (*pattern == '\0')) {
- return 0;
- }
- pattern += Tcl_UtfToUniChar(pattern, &startChar);
- if (*pattern == '-') {
- pattern++;
- if (*pattern == '\0') {
- return 0;
- }
- pattern += Tcl_UtfToUniChar(pattern, &endChar);
- if (((startChar <= ch) && (ch <= endChar))
- || ((endChar <= ch) && (ch <= startChar))) {
- /*
- * Matches ranges of form [a-z] or [z-a].
- */
-
- break;
- }
- } else if (startChar == ch) {
- break;
- }
- }
- while (*pattern != ']') {
- if (*pattern == '\0') {
- pattern = Tcl_UtfPrev(pattern, pstart);
- 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 == '\\') {
- pattern++;
- p = *pattern;
- if (p == '\0') {
- return 0;
- }
- }
-
- /* There's no special character. Just make sure that the next
- * bytes of each string match.
- */
-
- if (s != p) {
- return 0;
- }
- pattern++;
- string++;
- }
+ return Tcl_StringCaseMatch(string, pattern, 0);
}
/*
@@ -1290,13 +1191,12 @@ Tcl_StringCaseMatch(string, pattern, nocase)
* characters. */
int nocase; /* 0 for case sensitive, 1 for insensitive */
{
- int p, s;
+ int p;
CONST char *pstart = pattern;
Tcl_UniChar ch1, ch2;
while (1) {
p = *pattern;
- s = *string;
/*
* See if we're at the end of both the pattern and the string. If
@@ -1305,35 +1205,74 @@ Tcl_StringCaseMatch(string, pattern, nocase)
*/
if (p == '\0') {
- return (s == '\0');
+ return (*string == '\0');
}
- if ((s == '\0') && (p != '*')) {
+ if ((*string == '\0') && (p != '*')) {
return 0;
}
- /* Check for a "*" as the next pattern character. It matches
+ /*
+ * Check for a "*" as the next pattern character. It matches
* any substring. We handle this by calling ourselves
* recursively for each postfix of string, until either we
* match or we reach the end of the string.
*/
if (p == '*') {
- pattern++;
- if (*pattern == '\0') {
+ /*
+ * Skip all successive *'s in the pattern
+ */
+ while (*(++pattern) == '*') {}
+ p = *pattern;
+ if (p == '\0') {
return 1;
}
+ Tcl_UtfToUniChar(pattern, &ch2);
+ if (nocase) {
+ ch2 = Tcl_UniCharToLower(ch2);
+ }
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 != '\\')) {
+ if (nocase) {
+ while (*string) {
+ int charLen = Tcl_UtfToUniChar(string, &ch1);
+ if (ch2==ch1 || ch2==Tcl_UniCharToLower(ch1)) {
+ break;
+ }
+ string += charLen;
+ }
+ } else {
+ /*
+ * There's no point in trying to make this code
+ * shorter, as the number of bytes you want to
+ * compare each time is non-constant.
+ */
+ while (*string) {
+ int charLen = Tcl_UtfToUniChar(string, &ch1);
+ if (ch2 == ch1) {
+ break;
+ }
+ string += charLen;
+ }
+ }
+ }
if (Tcl_StringCaseMatch(string, pattern, nocase)) {
return 1;
}
if (*string == '\0') {
return 0;
}
- string++;
+ string += Tcl_UtfToUniChar(string, &ch1);
}
}
- /* Check for a "?" as the next pattern character. It matches
+ /*
+ * Check for a "?" as the next pattern character. It matches
* any single character.
*/
@@ -1343,11 +1282,12 @@ Tcl_StringCaseMatch(string, pattern, nocase)
continue;
}
- /* Check for a "[" as the next pattern character. It is followed
+ /*
+ * 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 == '[') {
Tcl_UniChar startChar, endChar;
@@ -1396,22 +1336,23 @@ Tcl_StringCaseMatch(string, pattern, nocase)
continue;
}
- /* If the next pattern character is '\', just strip off the '\'
+ /*
+ * If the next pattern character is '\', just strip off the '\'
* so we do exact matching on the character that follows.
*/
-
+
if (p == '\\') {
pattern++;
- p = *pattern;
- if (p == '\0') {
+ if (*pattern == '\0') {
return 0;
}
}
- /* There's no special character. Just make sure that the next
+ /*
+ * There's no special character. Just make sure that the next
* bytes of each string match.
*/
-
+
string += Tcl_UtfToUniChar(string, &ch1);
pattern += Tcl_UtfToUniChar(pattern, &ch2);
if (nocase) {
@@ -1547,10 +1488,12 @@ Tcl_DStringAppendElement(dsPtr, string)
CONST char *string; /* String to append. Must be
* null-terminated. */
{
- int newSize, flags;
+ int newSize, flags, strSize;
char *dst;
- newSize = Tcl_ScanElement(string, &flags) + dsPtr->length + 1;
+ strSize = ((string == NULL) ? 0 : strlen(string));
+ newSize = Tcl_ScanCountedElement(string, strSize, &flags)
+ + dsPtr->length + 1;
/*
* Allocate a larger buffer for the string if the current one isn't
@@ -1587,7 +1530,7 @@ Tcl_DStringAppendElement(dsPtr, string)
dst++;
dsPtr->length++;
}
- dsPtr->length += Tcl_ConvertElement(string, dst, flags);
+ dsPtr->length += Tcl_ConvertCountedElement(string, strSize, dst, flags);
return dsPtr->string;
}
@@ -1935,11 +1878,12 @@ char *
TclPrecTraceProc(clientData, interp, name1, name2, flags)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Interpreter containing variable. */
- char *name1; /* Name of variable. */
- char *name2; /* Second part of variable name. */
+ CONST char *name1; /* Name of variable. */
+ CONST char *name2; /* Second part of variable name. */
int flags; /* Information about what happened. */
{
- char *value, *end;
+ CONST char *value;
+ char *end;
int prec;
/*
@@ -2022,10 +1966,12 @@ TclPrecTraceProc(clientData, interp, name1, name2, flags)
int
TclNeedSpace(start, end)
- char *start; /* First character in string. */
- char *end; /* End of string (place where space will
+ CONST char *start; /* First character in string. */
+ CONST char *end; /* End of string (place where space will
* be added, if appropriate). */
{
+ Tcl_UniChar ch;
+
/*
* A space is needed unless either
* (a) we're at the start of the string, or
@@ -2039,10 +1985,14 @@ TclNeedSpace(start, end)
if (end == start) {
return 0;
}
- end--;
+ end = Tcl_UtfPrev(end, start);
if (*end != '{') {
- if (isspace(UCHAR(*end)) /* INTL: ISO space. */
- && ((end == start) || (end[-1] != '\\'))) {
+ Tcl_UtfToUniChar(end, &ch);
+ /*
+ * Direct char comparison on next line is safe as it is with
+ * a character in the ASCII subset, and so single-byte in UTF8.
+ */
+ if (Tcl_UniCharIsSpace(ch) && ((end == start) || (end[-1] != '\\'))) {
return 0;
}
return 1;
@@ -2051,9 +2001,10 @@ TclNeedSpace(start, end)
if (end == start) {
return 0;
}
- end--;
+ end = Tcl_UtfPrev(end, start);
} while (*end == '{');
- if (isspace(UCHAR(*end))) { /* INTL: ISO space. */
+ Tcl_UtfToUniChar(end, &ch);
+ if (Tcl_UniCharIsSpace(ch)) {
return 0;
}
return 1;
@@ -2167,44 +2118,34 @@ TclFormatInt(buffer, n)
int
TclLooksLikeInt(bytes, length)
- register char *bytes; /* Points to first byte of the string. */
+ 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). */
{
- register char *p, *end;
+ register CONST char *p;
+
+ if ((bytes == NULL) && (length > 0)) {
+ Tcl_Panic("TclLooksLikeInt: cannot scan %d bytes from NULL", length);
+ }
if (length < 0) {
- length = (bytes? strlen(bytes) : 0);
+ length = (bytes? strlen(bytes) : 0);
}
- end = (bytes + length);
p = bytes;
- while ((p < end) && isspace(UCHAR(*p))) { /* INTL: ISO space. */
- p++;
+ while (length && isspace(UCHAR(*p))) { /* INTL: ISO space. */
+ length--; p++;
}
- if (p == end) {
- return 0;
+ if (length == 0) {
+ return 0;
}
-
if ((*p == '+') || (*p == '-')) {
- p++;
- }
- if ((p == end) || !isdigit(UCHAR(*p))) { /* INTL: digit */
- return 0;
- }
- p++;
- while ((p < end) && isdigit(UCHAR(*p))) { /* INTL: digit */
- p++;
- }
- if (p == end) {
- return 1;
- }
- if ((*p != '.') && (*p != 'e') && (*p != 'E')) {
- return 1;
+ p++; length--;
}
- return 0;
+
+ return (0 != TclParseInteger(p, length));
}
/*
@@ -2228,7 +2169,7 @@ TclLooksLikeInt(bytes, length)
*
* Side effects:
* The object referenced by "objPtr" might be converted to an
- * integer object.
+ * integer, wide integer, or end-based-index object.
*
*----------------------------------------------------------------------
*/
@@ -2246,26 +2187,193 @@ TclGetIntForIndex(interp, objPtr, endValue, indexPtr)
* representing an index. */
{
char *bytes;
- int length, offset;
+ int offset;
+#ifndef TCL_WIDE_INT_IS_LONG
+ Tcl_WideInt wideOffset;
+#endif
+
+ /*
+ * If the object is already an integer, use it.
+ */
if (objPtr->typePtr == &tclIntType) {
*indexPtr = (int)objPtr->internalRep.longValue;
return TCL_OK;
}
- bytes = Tcl_GetStringFromObj(objPtr, &length);
+ /*
+ * If the object is already a wide-int, and it is not out of range
+ * for an integer, use it. [Bug #526717]
+ */
+#ifndef TCL_WIDE_INT_IS_LONG
+ if (objPtr->typePtr == &tclWideIntType) {
+ Tcl_WideInt wideOffset = objPtr->internalRep.wideValue;
+ if (wideOffset >= Tcl_LongAsWide(INT_MIN)
+ && wideOffset <= Tcl_LongAsWide(INT_MAX)) {
+ *indexPtr = (int) Tcl_WideAsLong(wideOffset);
+ return TCL_OK;
+ }
+ }
+#endif /* TCL_WIDE_INT_IS_LONG */
- if ((*bytes != 'e') || (strncmp(bytes, "end",
- (size_t)((length > 3) ? 3 : length)) != 0)) {
- if (Tcl_GetIntFromObj(NULL, objPtr, &offset) != TCL_OK) {
- goto intforindex_error;
+ if (SetEndOffsetFromAny(NULL, objPtr) == TCL_OK) {
+ /*
+ * If the object is already an offset from the end of the
+ * list, or can be converted to one, use it.
+ */
+
+ *indexPtr = endValue + objPtr->internalRep.longValue;
+
+#ifdef TCL_WIDE_INT_IS_LONG
+ } else if (Tcl_GetIntFromObj(NULL, objPtr, &offset) == TCL_OK) {
+ /*
+ * If the object can be converted to an integer, use that.
+ */
+
+ *indexPtr = offset;
+
+#else /* !TCL_WIDE_INT_IS_LONG */
+ } else if (Tcl_GetWideIntFromObj(NULL, objPtr, &wideOffset) == TCL_OK) {
+ /*
+ * If the object can be converted to a wide integer, use
+ * that. [Bug #526717]
+ */
+
+ offset = (int) Tcl_WideAsLong(wideOffset);
+ if (Tcl_LongAsWide(offset) == wideOffset) {
+ /*
+ * But it is representable as a narrow integer, so we
+ * prefer that (so preserving old behaviour in the
+ * majority of cases.)
+ */
+ objPtr->typePtr = &tclIntType;
+ objPtr->internalRep.longValue = offset;
}
*indexPtr = offset;
+
+#endif /* TCL_WIDE_INT_IS_LONG */
+ } else {
+ /*
+ * Report a parse error.
+ */
+
+ if (interp != NULL) {
+ 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.
+ */
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "bad index \"", bytes,
+ "\": must be integer or end?-integer?",
+ (char *) NULL);
+ if (!strncmp(bytes, "end-", 3)) {
+ bytes += 3;
+ }
+ TclCheckBadOctal(interp, bytes);
+ }
+
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfEndOffset --
+ *
+ * Update the string rep of a Tcl object holding an "end-offset"
+ * expression.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Stores a valid string in the object's string rep.
+ *
+ * This procedure does NOT free any earlier string rep. If it is
+ * called on an object that already has a valid string rep, it will
+ * leak memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfEndOffset(objPtr)
+ register Tcl_Obj* objPtr;
+{
+ char buffer[TCL_INTEGER_SPACE + sizeof("end") + 1];
+ register int len;
+
+ strcpy(buffer, "end");
+ len = sizeof("end") - 1;
+ 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->length = len;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetEndOffsetFromAny --
+ *
+ * Look for a string of the form "end-offset" and convert it
+ * to an internal representation holding the offset.
+ *
+ * Results:
+ * Returns TCL_OK if ok, TCL_ERROR if the string was badly formed.
+ *
+ * Side effects:
+ * If interp is not NULL, stores an error message in the
+ * interpreter result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetEndOffsetFromAny(interp, objPtr)
+ Tcl_Interp* interp; /* Tcl interpreter or NULL */
+ Tcl_Obj* objPtr; /* Pointer to the object to parse */
+{
+ int offset; /* Offset in the "end-offset" expression */
+ Tcl_ObjType* oldTypePtr = objPtr->typePtr;
+ /* Old internal rep type of the object */
+ register char* bytes; /* String rep of the object */
+ int length; /* Length of the object's string rep */
+
+ /* If it's already the right type, we're fine. */
+
+ if (objPtr->typePtr == &tclEndOffsetType) {
return TCL_OK;
}
+ /* Check for a string rep of the right form. */
+
+ bytes = Tcl_GetStringFromObj(objPtr, &length);
+ if ((*bytes != 'e') || (strncmp(bytes, "end",
+ (size_t)((length > 3) ? 3 : length)) != 0)) {
+ if (interp != NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "bad index \"", bytes,
+ "\": must be end?-integer?",
+ (char*) NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ /* Convert the string rep */
+
if (length <= 3) {
- *indexPtr = endValue;
+ offset = 0;
} else if (bytes[3] == '-') {
/*
* This is our limited string expression evaluator
@@ -2273,19 +2381,35 @@ TclGetIntForIndex(interp, objPtr, endValue, indexPtr)
if (Tcl_GetInt(interp, bytes+3, &offset) != TCL_OK) {
return TCL_ERROR;
}
- *indexPtr = endValue + offset;
+
} else {
- intforindex_error:
- if ((Interp *)interp != NULL) {
+ /*
+ * Conversion failed. Report the error.
+ */
+ if (interp != NULL) {
+ Tcl_ResetResult(interp);
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "bad index \"", bytes,
- "\": must be integer or end?-integer?", (char *) NULL);
- TclCheckBadOctal(interp, bytes);
+ "bad index \"", bytes,
+ "\": must be integer or end?-integer?",
+ (char *) NULL);
}
return TCL_ERROR;
}
+
+ /*
+ * The conversion succeeded. Free the old internal rep and set
+ * the new one.
+ */
+
+ if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
+ oldTypePtr->freeIntRepProc(objPtr);
+ }
+
+ objPtr->internalRep.longValue = offset;
+ objPtr->typePtr = &tclEndOffsetType;
+
return TCL_OK;
-}
+}
/*
*----------------------------------------------------------------------
@@ -2309,9 +2433,9 @@ TclCheckBadOctal(interp, value)
Tcl_Interp *interp; /* Interpreter to use for error reporting.
* If NULL, then no error message is left
* after errors. */
- char *value; /* String to check. */
+ CONST char *value; /* String to check. */
{
- register char *p = value;
+ register CONST char *p = value;
/*
* A frequent mistake is invalid octal values due to an unwanted
@@ -2334,6 +2458,10 @@ TclCheckBadOctal(interp, value)
if (*p == '\0') {
/* Reached end of string */
if (interp != NULL) {
+ /*
+ * 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);
}
@@ -2367,105 +2495,31 @@ TclCheckBadOctal(interp, value)
CONST char *
Tcl_GetNameOfExecutable()
{
- return (tclExecutableName);
+ return tclExecutableName;
}
/*
*----------------------------------------------------------------------
*
- * Tcl_GetCwd --
+ * TclpGetTime --
*
- * This function replaces the library version of getcwd().
+ * Deprecated synonym for Tcl_GetTime.
*
* Results:
- * The result is 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. Storage for the result string is allocated in
- * bufferPtr; the caller must call Tcl_DStringFree() when the result
- * is no longer needed.
- *
- * Side effects:
* None.
*
- *----------------------------------------------------------------------
- */
-
-char *
-Tcl_GetCwd(interp, cwdPtr)
- Tcl_Interp *interp;
- Tcl_DString *cwdPtr;
-{
- return TclpGetCwd(interp, cwdPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_Chdir --
- *
- * This function replaces the library version of chdir().
- *
- * Results:
- * See chdir() documentation.
- *
- * Side effects:
- * See chdir() documentation.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_Chdir(dirName)
- CONST char *dirName;
-{
- return TclpChdir(dirName);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_Access --
- *
- * This function replaces the library version of access().
- *
- * Results:
- * See access() documentation.
- *
* Side effects:
- * See access() documentation.
+ * Stores current time in the buffer designated by "timePtr"
*
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_Access(path, mode)
- CONST char *path; /* Path of file to access (UTF-8). */
- int mode; /* Permission setting. */
-{
- return TclAccess(path, mode);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_Stat --
- *
- * This function replaces the library version of stat().
- *
- * Results:
- * See stat() documentation.
- *
- * Side effects:
- * See stat() documentation.
+ * This procedure is provided for the benefit of extensions written
+ * before Tcl_GetTime was exported from the library.
*
*----------------------------------------------------------------------
*/
-int
-Tcl_Stat(path, bufPtr)
- CONST char *path; /* Path of file to stat (in UTF-8). */
- struct stat *bufPtr; /* Filled with results of stat call. */
+void
+TclpGetTime(timePtr)
+ Tcl_Time* timePtr;
{
- return TclStat(path, bufPtr);
+ Tcl_GetTime(timePtr);
}
diff --git a/tcl/generic/tclVar.c b/tcl/generic/tclVar.c
index fce00ab6138..3bbbcc3ac25 100644
--- a/tcl/generic/tclVar.c
+++ b/tcl/generic/tclVar.c
@@ -10,6 +10,7 @@
* 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.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -25,46 +26,130 @@
* variable access is denied.
*/
-static char *noSuchVar = "no such variable";
-static char *isArray = "variable is array";
-static char *needArray = "variable isn't array";
-static char *noSuchElement = "no such element in array";
-static char *danglingElement = "upvar refers to element in deleted array";
-static char *danglingVar = "upvar refers to variable in deleted namespace";
-static char *badNamespace = "parent namespace doesn't exist";
-static char *missingName = "missing variable name";
-static char *isArrayElement = "name refers to an element in an array";
+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 =
+ "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 = "name refers to an element in an array";
/*
* Forward references to procedures defined later in this file:
*/
-static char * CallTraces _ANSI_ARGS_((Interp *iPtr, Var *arrayPtr,
- Var *varPtr, char *part1, char *part2,
- int flags));
+static int CallVarTraces _ANSI_ARGS_((Interp *iPtr, Var *arrayPtr,
+ Var *varPtr, CONST char *part1, CONST char *part2,
+ int flags, CONST int leaveErrMsg));
static void CleanupVar _ANSI_ARGS_((Var *varPtr,
Var *arrayPtr));
static void DeleteSearches _ANSI_ARGS_((Var *arrayVarPtr));
static void DeleteArray _ANSI_ARGS_((Interp *iPtr,
- char *arrayName, Var *varPtr, int flags));
-static int MakeUpvar _ANSI_ARGS_((
- Interp *iPtr, CallFrame *framePtr,
- char *otherP1, char *otherP2, int otherFlags,
- char *myName, int myFlags));
+ CONST char *arrayName, Var *varPtr, int flags));
+static void DisposeTraceResult _ANSI_ARGS_((int flags,
+ char *result));
+static int ObjMakeUpvar _ANSI_ARGS_((Tcl_Interp *interp,
+ CallFrame *framePtr, Tcl_Obj *otherP1Ptr,
+ CONST char *otherP2, CONST int otherFlags,
+ CONST char *myName, CONST int myFlags, int index));
static Var * NewVar _ANSI_ARGS_((void));
static ArraySearch * ParseSearchId _ANSI_ARGS_((Tcl_Interp *interp,
- Var *varPtr, char *varName, char *string));
+ CONST Var *varPtr, CONST char *varName,
+ Tcl_Obj *handleObj));
static void VarErrMsg _ANSI_ARGS_((Tcl_Interp *interp,
- char *part1, char *part2, char *operation,
- char *reason));
+ CONST char *part1, CONST char *part2,
+ CONST char *operation, CONST char *reason));
+static int SetArraySearchObj _ANSI_ARGS_((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));
+
+static Tcl_FreeInternalRepProc FreeLocalVarName;
+static Tcl_DupInternalRepProc DupLocalVarName;
+static Tcl_UpdateStringProc UpdateLocalVarName;
+static Tcl_FreeInternalRepProc FreeNsVarName;
+static Tcl_DupInternalRepProc DupNsVarName;
+static Tcl_FreeInternalRepProc FreeParsedVarName;
+static Tcl_DupInternalRepProc DupParsedVarName;
+static Tcl_UpdateStringProc UpdateParsedVarName;
+
+/*
+ * Types of Tcl_Objs used to cache variable lookups.
+ *
+ *
+ * localVarName - INTERNALREP DEFINITION:
+ * twoPtrValue.ptr1 = pointer to the corresponding Proc
+ * twoPtrValue.ptr2 = index into locals table
+ *
+ * nsVarName - INTERNALREP DEFINITION:
+ * twoPtrValue.ptr1: pointer to the namespace containing the
+ * reference
+ * twoPtrValue.ptr2: pointer to the corresponding Var
+ *
+ * parsedVarName - INTERNALREP DEFINITION:
+ * twoPtrValue.ptr1 = pointer to the array name Tcl_Obj,
+ * or NULL if it is a scalar variable
+ * twoPtrValue.ptr2 = pointer to the element name string
+ * (owned by this Tcl_Obj), or NULL if
+ * it is a scalar variable
+ */
+
+Tcl_ObjType tclLocalVarNameType = {
+ "localVarName",
+ FreeLocalVarName, DupLocalVarName, UpdateLocalVarName, NULL
+};
+
+Tcl_ObjType tclNsVarNameType = {
+ "namespaceVarName",
+ FreeNsVarName, DupNsVarName, NULL, NULL
+};
+
+Tcl_ObjType tclParsedVarNameType = {
+ "parsedVarName",
+ FreeParsedVarName, DupParsedVarName, UpdateParsedVarName, NULL
+};
+
+/*
+ * 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
+ *
+ * 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 = {
+ "array search",
+ NULL, NULL, NULL, SetArraySearchObj
+};
+
/*
*----------------------------------------------------------------------
*
* TclLookupVar --
*
- * This procedure is used by virtually all of the variable code to
- * locate a variable given its name(s).
+ * This procedure 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.
*
* Results:
* The return value is a pointer to the variable structure indicated by
@@ -93,19 +178,18 @@ static void VarErrMsg _ANSI_ARGS_((Tcl_Interp *interp,
*
*----------------------------------------------------------------------
*/
-
Var *
TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
arrayPtrPtr)
Tcl_Interp *interp; /* Interpreter to use for lookup. */
- register char *part1; /* If part2 isn't NULL, this is the name of
+ 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. */
- char *part2; /* Name of element within array, or NULL. */
+ 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. */
- char *msg; /* Verb to use in error messages, e.g.
+ 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
@@ -119,35 +203,24 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
* address of array variable. Otherwise
* this is set to NULL. */
{
- Interp *iPtr = (Interp *) interp;
- CallFrame *varFramePtr = iPtr->varFramePtr;
- /* Points to the procedure call frame whose
- * 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
- * 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. */
- char *elName; /* Name of array element or NULL; may be
+ Var *varPtr;
+ CONST char *elName; /* Name of array element or NULL; may be
* same as part2, or may be openParen+1. */
- char *openParen, *closeParen;
+ int openParen, closeParen;
/* If this procedure parses a name into
- * array and index, these point to the
- * parens around the index. Otherwise they
- * are NULL. These are needed to restore
- * the parens after parsing the name. */
- Namespace *varNsPtr, *cxtNsPtr, *dummy1Ptr, *dummy2Ptr;
- ResolverScheme *resPtr;
- Tcl_HashEntry *hPtr;
- register char *p;
- int new, i, result;
+ * 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;
varPtr = NULL;
*arrayPtrPtr = NULL;
- openParen = closeParen = NULL;
- varNsPtr = NULL; /* set non-NULL if a nonlocal variable */
+ openParen = closeParen = -1;
/*
* Parse part1 into array name and index.
@@ -162,28 +235,439 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
elName = part2;
for (p = part1; *p ; p++) {
if (*p == '(') {
- openParen = p;
+ openParen = p - part1;
do {
p++;
} while (*p != '\0');
p--;
if (*p == ')') {
if (part2 != NULL) {
- openParen = NULL;
if (flags & TCL_LEAVE_ERR_MSG) {
VarErrMsg(interp, part1, part2, msg, needArray);
}
- goto done;
+ return NULL;
}
- closeParen = p;
- *openParen = 0;
- elName = openParen+1;
+ closeParen = p - part1;
} else {
- openParen = NULL;
+ 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;
+ }
+
+ varPtr = TclLookupSimpleVar(interp, part1, flags,
+ createPart1, &errMsg, &index);
+ if (varPtr == NULL) {
+ if ((errMsg != NULL) && (flags & TCL_LEAVE_ERR_MSG)) {
+ VarErrMsg(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);
+ }
+
+ return varPtr;
+
+#undef VAR_NAME_BUF_SIZE
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclObjLookupVar --
+ *
+ * This procedure 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.
+ *
+ * Results:
+ * The return value is a pointer to the variable structure indicated by
+ * part1Ptr and part2, or NULL if the variable couldn't be found. If
+ * the variable is found, *arrayPtrPtr is filled with the address of the
+ * variable structure for the array that contains the variable (or NULL
+ * if the variable is a scalar). If the variable can't be found and
+ * either createPart1 or createPart2 are 1, a new as-yet-undefined
+ * (VAR_UNDEFINED) variable structure is created, entered into a hash
+ * table, and returned.
+ *
+ * If the variable isn't found and creation wasn't specified, or some
+ * other error occurs, NULL is returned and an error message is left in
+ * the interp's result if TCL_LEAVE_ERR_MSG is set in flags.
+ *
+ * Note: it's possible for the variable returned to be VAR_UNDEFINED
+ * even if createPart1 or createPart2 are 1 (these only cause the hash
+ * table entry or array to be created). For example, the variable might
+ * be a global that has been unset but is still referenced by a
+ * procedure, or a variable that has been unset but it only being kept
+ * in existence (if VAR_UNDEFINED) by a trace.
+ *
+ * Side effects:
+ * New hashtable entries may be created if createPart1 or createPart2
+ * are 1.
+ * The object part1Ptr is converted to one of tclLocalVarNameType,
+ * tclNsVarNameType or tclParsedVarNameType and caches as much of the
+ * lookup as it can.
+ *
+ *----------------------------------------------------------------------
+ */
+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 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,
+ * 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. */
+{
+ Interp *iPtr = (Interp *) interp;
+ register Var *varPtr; /* Points to the variable's in-frame Var
+ * structure. */
+ char *part1;
+ int index, len1, len2;
+ int parsed = 0;
+ Tcl_Obj *objPtr;
+ Tcl_ObjType *typePtr = part1Ptr->typePtr;
+ CONST char *errMsg = NULL;
+ CallFrame *varFramePtr = iPtr->varFramePtr;
+ Namespace *nsPtr;
+
+ /*
+ * If part1Ptr is a tclParsedVarNameType, separate it into the
+ * pre-parsed parts.
+ */
+
+ *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);
+ VarErrMsg(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);
+
+ nsPtr = ((varFramePtr == NULL)? iPtr->globalNsPtr : varFramePtr->nsPtr);
+ if (nsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) {
+ goto doParse;
+ }
+
+ if (typePtr == &tclLocalVarNameType) {
+ Proc *procPtr = (Proc *) part1Ptr->internalRep.twoPtrValue.ptr1;
+ int localIndex = (int) part1Ptr->internalRep.twoPtrValue.ptr2;
+ int useLocal;
+
+ useLocal = ((varFramePtr != NULL) && varFramePtr->isProcCallFrame
+ && !(flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY)));
+ if (useLocal && (procPtr == varFramePtr->procPtr)) {
+ /*
+ * part1Ptr points to an indexed local variable of the
+ * correct procedure: use the cached value.
+ */
+
+ varPtr = &(varFramePtr->compiledLocals[localIndex]);
+ goto donePart1;
+ }
+ goto doneParsing;
+ } else if (typePtr == &tclNsVarNameType) {
+ Namespace *cachedNsPtr;
+ int useGlobal, useReference;
+
+ varPtr = (Var *) part1Ptr->internalRep.twoPtrValue.ptr2;
+ cachedNsPtr = (Namespace *) part1Ptr->internalRep.twoPtrValue.ptr1;
+ useGlobal = (cachedNsPtr == iPtr->globalNsPtr)
+ && ((flags & TCL_GLOBAL_ONLY)
+ || ((*part1 == ':') && (*(part1+1) == ':'))
+ || (varFramePtr == NULL)
+ || (!varFramePtr->isProcCallFrame
+ && (nsPtr == iPtr->globalNsPtr)));
+ useReference = useGlobal || ((cachedNsPtr == nsPtr)
+ && ((flags & TCL_NAMESPACE_ONLY)
+ || (varFramePtr && !varFramePtr->isProcCallFrame
+ && !(flags & TCL_GLOBAL_ONLY)
+ /* careful: an undefined ns variable could
+ * be hiding a valid global reference. */
+ && !(varPtr->flags & VAR_UNDEFINED))));
+ if (useReference && (varPtr->hPtr != NULL)) {
+ /*
+ * 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
+ * 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 we test for a valid hPtr.
+ */
+ goto donePart1;
+ }
+ goto doneParsing;
+ }
+
+ doParse:
+ 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 (flags & TCL_LEAVE_ERR_MSG) {
+ VarErrMsg(interp, part1, part2, msg, needArray);
+ }
+ }
+
+ /*
+ * part1Ptr points to an array element; first copy
+ * the element name to a new string part2.
+ */
+
+ part2 = part1 + i + 1;
+ len2 = len1 - i - 2;
+ len1 = i;
+
+ newPart2 = ckalloc((unsigned int) (len2+1));
+ memcpy(newPart2, part2, (unsigned int) len2);
+ *(newPart2+len2) = '\0';
+ part2 = newPart2;
+
+ /*
+ * Free the internal rep of the original part1Ptr, now
+ * renamed objPtr, and set it to tclParsedVarNameType.
+ */
+
+ objPtr = part1Ptr;
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ typePtr->freeIntRepProc(objPtr);
+ }
+ objPtr->typePtr = &tclParsedVarNameType;
+
+ /*
+ * Define a new string object to hold the new part1Ptr, i.e.,
+ * the array name. Set the internal rep of objPtr, reset
+ * typePtr and part1 to contain the references to the
+ * array name.
+ */
+
+ part1Ptr = Tcl_NewStringObj(part1, len1);
+ Tcl_IncrRefCount(part1Ptr);
+
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) part1Ptr;
+ objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) part2;
+
+ typePtr = part1Ptr->typePtr;
+ part1 = TclGetString(part1Ptr);
+ break;
+ }
+ }
+ }
+
+ doneParsing:
+ /*
+ * part1Ptr is not an array element; look it up, and convert
+ * it to one of the cached types if possible.
+ */
+
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ typePtr->freeIntRepProc(part1Ptr);
+ part1Ptr->typePtr = NULL;
+ }
+
+ varPtr = TclLookupSimpleVar(interp, part1, flags,
+ createPart1, &errMsg, &index);
+ if (varPtr == NULL) {
+ if ((errMsg != NULL) && (flags & TCL_LEAVE_ERR_MSG)) {
+ VarErrMsg(interp, part1, part2, msg, errMsg);
+ }
+ return NULL;
+ }
+
+ /*
+ * Cache the newly found variable if possible.
+ */
+
+ if (index >= 0) {
+ /*
+ * An indexed local variable.
+ */
+
+ Proc *procPtr = ((Interp *) interp)->varFramePtr->procPtr;
+
+ part1Ptr->typePtr = &tclLocalVarNameType;
+ procPtr->refCount++;
+ part1Ptr->internalRep.twoPtrValue.ptr1 = (VOID *) procPtr;
+ part1Ptr->internalRep.twoPtrValue.ptr2 = (VOID *) index;
+ } else if (index > -3) {
+ Namespace *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;
+ } else {
+ /*
+ * At least mark part1Ptr as already parsed.
+ */
+ part1Ptr->typePtr = &tclParsedVarNameType;
+ part1Ptr->internalRep.twoPtrValue.ptr1 = NULL;
+ part1Ptr->internalRep.twoPtrValue.ptr2 = NULL;
+ }
+
+ donePart1:
+#if 0
+ if (varPtr == NULL) {
+ if (flags & TCL_LEAVE_ERR_MSG) {
+ part1 = TclGetString(part1Ptr);
+ VarErrMsg(interp, part1, part2, msg,
+ "Cached variable reference is NULL.");
+ }
+ return NULL;
+ }
+#endif
+ while (TclIsVarLink(varPtr)) {
+ varPtr = varPtr->value.linkPtr;
+ }
+
+ if (part2 != NULL) {
+ /*
+ * Array element sought: look it up.
+ */
+
+ part1 = TclGetString(part1Ptr);
+ *arrayPtrPtr = varPtr;
+ varPtr = TclLookupArrayElement(interp, part1, part2,
+ flags, msg, createPart1, createPart2, varPtr);
+ }
+ return varPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLookupSimpleVar --
+ *
+ * This procedure is used by to locate a simple variable (i.e., not
+ * an array element) given its name.
+ *
+ * Results:
+ * The return value is a pointer to the variable structure indicated by
+ * varName, or NULL if the variable couldn't be found. If the variable
+ * can't be found and create is 1, a new as-yet-undefined (VAR_UNDEFINED)
+ * variable structure is created, entered into a hash table, and returned.
+ *
+ * If the current CallFrame corresponds to a proc and the variable found is
+ * one of the compiledLocals, its index is placed in *indexPtr. Otherwise,
+ * *indexPtr will be set to (according to the needs of TclObjLookupVar):
+ * -1 a global reference
+ * -2 a reference to a namespace variable
+ * -3 a non-cachable reference, i.e., one of:
+ * . non-indexed local var
+ * . a reference of unknown origin;
+ * . resolution by a namespace or interp resolver
+ *
+ * If the variable isn't found and creation wasn't specified, or some
+ * other error occurs, NULL is returned and the corresponding error
+ * message is left in *errMsgPtr.
+ *
+ * Note: it's possible for the variable returned to be VAR_UNDEFINED
+ * even if create is 1 (this only causes the hash table entry to be
+ * created). For example, the variable might be a global that has been
+ * unset but is still referenced by a procedure, or a variable that has
+ * been unset but it only being kept in existence (if VAR_UNDEFINED) by
+ * a trace.
+ *
+ * Side effects:
+ * A new hashtable entry may be created 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
+ * representa scalar or an array. */
+ int flags; /* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
+ * and TCL_LEAVE_ERR_MSG bits matter. */
+ 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;
+{
+ Interp *iPtr = (Interp *) interp;
+ CallFrame *varFramePtr = iPtr->varFramePtr;
+ /* Points to the procedure call frame whose
+ * 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
+ * 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;
+
+ varPtr = NULL;
+ varNsPtr = NULL; /* set non-NULL if a nonlocal variable */
+ *indexPtr = -3;
/*
* If this namespace has a variable resolver, then give it first
@@ -191,7 +675,7 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
* value, it may signal to continue onward, or it may signal
* an error.
*/
- if ((flags & TCL_GLOBAL_ONLY) != 0 || iPtr->varFramePtr == NULL) {
+ if ((flags & TCL_GLOBAL_ONLY) || iPtr->varFramePtr == NULL) {
cxtNsPtr = iPtr->globalNsPtr;
} else {
cxtNsPtr = iPtr->varFramePtr->nsPtr;
@@ -201,7 +685,7 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
resPtr = iPtr->resolverPtr;
if (cxtNsPtr->varResProc) {
- result = (*cxtNsPtr->varResProc)(interp, part1,
+ result = (*cxtNsPtr->varResProc)(interp, varName,
(Tcl_Namespace *) cxtNsPtr, flags, &var);
} else {
result = TCL_CONTINUE;
@@ -209,7 +693,7 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
while (result == TCL_CONTINUE && resPtr) {
if (resPtr->varResProc) {
- result = (*resPtr->varResProc)(interp, part1,
+ result = (*resPtr->varResProc)(interp, varName,
(Tcl_Namespace *) cxtNsPtr, flags, &var);
}
resPtr = resPtr->nextPtr;
@@ -217,71 +701,85 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
if (result == TCL_OK) {
varPtr = (Var *) var;
- goto lookupVarPart2;
+ return varPtr;
} else if (result != TCL_CONTINUE) {
- return (Var *) NULL;
+ return NULL;
}
}
/*
- * Look up part1. Look it up as either a namespace variable or as a
+ * Look up varName. Look it up as either a namespace variable or as a
* local variable in a procedure call frame (varFramePtr).
- * Interpret part1 as a namespace variable if:
+ * 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),
* 3) the active frame was pushed to define the namespace context
* for a "namespace eval" or "namespace inscope" command,
* 4) the name has namespace qualifiers ("::"s).
- * Otherwise, if part1 is a local variable, search first in the
+ * Otherwise, if varName is a local variable, search first in the
* frame's array of compiler-allocated local variables, then in its
* hashtable for runtime-created local variables.
*
- * If createPart1 and the variable isn't found, create the variable and,
+ * If create and the variable isn't found, create the variable and,
* if necessary, create varFramePtr's local var hashtable.
*/
if (((flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY)) != 0)
|| (varFramePtr == NULL)
|| !varFramePtr->isProcCallFrame
- || (strstr(part1, "::") != NULL)) {
- char *tail;
+ || (strstr(varName, "::") != NULL)) {
+ CONST char *tail;
+ int lookGlobal;
+ lookGlobal = (flags & TCL_GLOBAL_ONLY)
+ || (cxtNsPtr == iPtr->globalNsPtr)
+ || ((*varName == ':') && (*(varName+1) == ':'));
+ if (lookGlobal) {
+ *indexPtr = -1;
+ flags = (flags | TCL_GLOBAL_ONLY) & ~TCL_NAMESPACE_ONLY;
+ } else if (flags & TCL_NAMESPACE_ONLY) {
+ *indexPtr = -2;
+ }
+
/*
* Don't pass TCL_LEAVE_ERR_MSG, we may yet create the variable,
* or otherwise generate our own error!
*/
- var = Tcl_FindNamespaceVar(interp, part1, (Tcl_Namespace *) NULL,
+ var = Tcl_FindNamespaceVar(interp, varName, (Tcl_Namespace *) cxtNsPtr,
flags & ~TCL_LEAVE_ERR_MSG);
if (var != (Tcl_Var) NULL) {
varPtr = (Var *) var;
}
if (varPtr == NULL) {
- if (createPart1) { /* var wasn't found so create it */
- TclGetNamespaceForQualName(interp, part1, (Namespace *) NULL,
+ if (create) { /* var wasn't found so create it */
+ TclGetNamespaceForQualName(interp, varName, cxtNsPtr,
flags, &varNsPtr, &dummy1Ptr, &dummy2Ptr, &tail);
-
if (varNsPtr == NULL) {
- if (flags & TCL_LEAVE_ERR_MSG) {
- VarErrMsg(interp, part1, part2, msg, badNamespace);
- }
- goto done;
+ *errMsgPtr = badNamespace;
+ return NULL;
}
if (tail == NULL) {
- if (flags & TCL_LEAVE_ERR_MSG) {
- VarErrMsg(interp, part1, part2, msg, missingName);
- }
- goto done;
+ *errMsgPtr = missingName;
+ return NULL;
}
hPtr = Tcl_CreateHashEntry(&varNsPtr->varTable, tail, &new);
varPtr = NewVar();
Tcl_SetHashValue(hPtr, varPtr);
varPtr->hPtr = hPtr;
varPtr->nsPtr = varNsPtr;
- } else { /* var wasn't found and not to create it */
- if (flags & TCL_LEAVE_ERR_MSG) {
- VarErrMsg(interp, part1, part2, msg, noSuchVar);
+ if ((lookGlobal) || (varNsPtr == NULL)) {
+ /*
+ * The variable was created starting from the global
+ * namespace: a global reference is returned even if
+ * it wasn't explicitly requested.
+ */
+ *indexPtr = -1;
+ } else {
+ *indexPtr = -2;
}
- goto done;
+ } else { /* var wasn't found and not to create it */
+ *errMsgPtr = noSuchVar;
+ return NULL;
}
}
} else { /* local var: look in frame varFramePtr */
@@ -289,156 +787,170 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
int localCt = procPtr->numCompiledLocals;
CompiledLocal *localPtr = procPtr->firstLocalPtr;
Var *localVarPtr = varFramePtr->compiledLocals;
- int part1Len = strlen(part1);
+ int varNameLen = strlen(varName);
for (i = 0; i < localCt; i++) {
if (!TclIsVarTemporary(localPtr)) {
register char *localName = localVarPtr->name;
- if ((part1[0] == localName[0])
- && (part1Len == localPtr->nameLength)
- && (strcmp(part1, localName) == 0)) {
- varPtr = localVarPtr;
- break;
+ if ((varName[0] == localName[0])
+ && (varNameLen == localPtr->nameLength)
+ && (strcmp(varName, localName) == 0)) {
+ *indexPtr = i;
+ return localVarPtr;
}
}
localVarPtr++;
localPtr = localPtr->nextPtr;
}
- if (varPtr == NULL) { /* look in the frame's var hash table */
- tablePtr = varFramePtr->varTablePtr;
- if (createPart1) {
- if (tablePtr == NULL) {
- tablePtr = (Tcl_HashTable *)
- ckalloc(sizeof(Tcl_HashTable));
- Tcl_InitHashTable(tablePtr, TCL_STRING_KEYS);
- varFramePtr->varTablePtr = tablePtr;
- }
- hPtr = Tcl_CreateHashEntry(tablePtr, part1, &new);
- if (new) {
- varPtr = NewVar();
- Tcl_SetHashValue(hPtr, varPtr);
- varPtr->hPtr = hPtr;
- varPtr->nsPtr = NULL; /* a local variable */
- } else {
- varPtr = (Var *) Tcl_GetHashValue(hPtr);
- }
+ tablePtr = varFramePtr->varTablePtr;
+ if (create) {
+ if (tablePtr == NULL) {
+ tablePtr = (Tcl_HashTable *)
+ ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(tablePtr, TCL_STRING_KEYS);
+ 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 {
- hPtr = NULL;
- if (tablePtr != NULL) {
- hPtr = Tcl_FindHashEntry(tablePtr, part1);
- }
- if (hPtr == NULL) {
- if (flags & TCL_LEAVE_ERR_MSG) {
- VarErrMsg(interp, part1, part2, msg, noSuchVar);
- }
- goto done;
- }
varPtr = (Var *) Tcl_GetHashValue(hPtr);
}
+ } else {
+ hPtr = NULL;
+ if (tablePtr != NULL) {
+ hPtr = Tcl_FindHashEntry(tablePtr, varName);
+ }
+ if (hPtr == NULL) {
+ *errMsgPtr = noSuchVar;
+ return NULL;
+ }
+ varPtr = (Var *) Tcl_GetHashValue(hPtr);
}
}
+ return varPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLookupArrayElement --
+ *
+ * This procedure 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.
+ *
+ * Results:
+ * The return value is a pointer to the variable structure , or NULL if
+ * the variable couldn't be found.
+ *
+ * If arrayPtr points to a variable that isn't an array and createPart1
+ * is 1, the corresponding variable will be converted to an array.
+ * Otherwise, NULL is returned and an error message is left in
+ * the interp's result if TCL_LEAVE_ERR_MSG is set in flags.
+ *
+ * If the variable is not found and createPart2 is 1, the variable is
+ * created. Otherwise, NULL is returned and an error message is left in
+ * the interp's result if TCL_LEAVE_ERR_MSG is set in flags.
+ *
+ * Note: it's possible for the variable returned to be VAR_UNDEFINED
+ * even if createPart1 or createPart2 are 1 (these only cause the hash
+ * table entry or array to be created). For example, the variable might
+ * be a global that has been unset but is still referenced by a
+ * procedure, or a variable that has been unset but it only being kept
+ * in existence (if VAR_UNDEFINED) by a trace.
+ *
+ * Side effects:
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
- lookupVarPart2:
- if (openParen != NULL) {
- *openParen = '(';
- openParen = NULL;
- }
-
- /*
- * If varPtr is a link variable, we have a reference to some variable
- * that was created through an "upvar" or "global" command. Traverse
- * through any links until we find the referenced variable.
- */
-
- while (TclIsVarLink(varPtr)) {
- varPtr = varPtr->value.linkPtr;
- }
-
- /*
- * If we're not dealing with an array element, return varPtr.
- */
-
- if (elName == NULL) {
- goto done;
- }
+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" 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 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
+ * 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. */
+{
+ Tcl_HashEntry *hPtr;
+ int new;
+ Var *varPtr;
/*
* We're dealing with an array element. Make sure the variable is an
* array and look up the element (create the element if desired).
*/
- if (TclIsVarUndefined(varPtr) && !TclIsVarArrayElement(varPtr)) {
- if (!createPart1) {
+ if (TclIsVarUndefined(arrayPtr) && !TclIsVarArrayElement(arrayPtr)) {
+ if (!createArray) {
if (flags & TCL_LEAVE_ERR_MSG) {
- VarErrMsg(interp, part1, part2, msg, noSuchVar);
+ VarErrMsg(interp, arrayName, elName, msg, noSuchVar);
}
- varPtr = NULL;
- goto done;
+ return NULL;
}
/*
* Make sure we are not resurrecting a namespace variable from a
* deleted namespace!
*/
- if ((varPtr->flags & VAR_IN_HASHTABLE) && (varPtr->hPtr == NULL)) {
+ if ((arrayPtr->flags & VAR_IN_HASHTABLE) && (arrayPtr->hPtr == NULL)) {
if (flags & TCL_LEAVE_ERR_MSG) {
- VarErrMsg(interp, part1, part2, msg, danglingVar);
+ VarErrMsg(interp, arrayName, elName, msg, danglingVar);
}
- varPtr = NULL;
- goto done;
+ return NULL;
}
- TclSetVarArray(varPtr);
- TclClearVarUndefined(varPtr);
- varPtr->value.tablePtr =
+ TclSetVarArray(arrayPtr);
+ TclClearVarUndefined(arrayPtr);
+ arrayPtr->value.tablePtr =
(Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
- Tcl_InitHashTable(varPtr->value.tablePtr, TCL_STRING_KEYS);
- } else if (!TclIsVarArray(varPtr)) {
+ Tcl_InitHashTable(arrayPtr->value.tablePtr, TCL_STRING_KEYS);
+ } else if (!TclIsVarArray(arrayPtr)) {
if (flags & TCL_LEAVE_ERR_MSG) {
- VarErrMsg(interp, part1, part2, msg, needArray);
+ VarErrMsg(interp, arrayName, elName, msg, needArray);
}
- varPtr = NULL;
- goto done;
- }
- *arrayPtrPtr = varPtr;
- if (closeParen != NULL) {
- *closeParen = 0;
+ return NULL;
}
- if (createPart2) {
- hPtr = Tcl_CreateHashEntry(varPtr->value.tablePtr, elName, &new);
- if (closeParen != NULL) {
- *closeParen = ')';
- }
+
+ if (createElem) {
+ hPtr = Tcl_CreateHashEntry(arrayPtr->value.tablePtr, elName, &new);
if (new) {
- if (varPtr->searchPtr != NULL) {
- DeleteSearches(varPtr);
+ if (arrayPtr->searchPtr != NULL) {
+ DeleteSearches(arrayPtr);
}
varPtr = NewVar();
Tcl_SetHashValue(hPtr, varPtr);
varPtr->hPtr = hPtr;
- varPtr->nsPtr = varNsPtr;
+ varPtr->nsPtr = arrayPtr->nsPtr;
TclSetVarArrayElement(varPtr);
}
} else {
- hPtr = Tcl_FindHashEntry(varPtr->value.tablePtr, elName);
- if (closeParen != NULL) {
- *closeParen = ')';
- }
+ hPtr = Tcl_FindHashEntry(arrayPtr->value.tablePtr, elName);
if (hPtr == NULL) {
if (flags & TCL_LEAVE_ERR_MSG) {
- VarErrMsg(interp, part1, part2, msg, noSuchElement);
+ VarErrMsg(interp, arrayName, elName, msg, noSuchElement);
}
- varPtr = NULL;
- goto done;
+ return NULL;
}
}
- varPtr = (Var *) Tcl_GetHashValue(hPtr);
-
- done:
- if (openParen != NULL) {
- *openParen = '(';
- }
- return varPtr;
+ return (Var *) Tcl_GetHashValue(hPtr);
}
/*
@@ -463,11 +975,11 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
*----------------------------------------------------------------------
*/
-char *
+CONST char *
Tcl_GetVar(interp, varName, flags)
Tcl_Interp *interp; /* Command interpreter in which varName is
* to be looked up. */
- char *varName; /* Name of a variable in interp. */
+ 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. */
@@ -498,13 +1010,13 @@ Tcl_GetVar(interp, varName, flags)
*----------------------------------------------------------------------
*/
-char *
+CONST char *
Tcl_GetVar2(interp, part1, part2, flags)
Tcl_Interp *interp; /* Command interpreter in which variable is
* to be looked up. */
- char *part1; /* Name of an array (if part2 is non-NULL)
+ CONST char *part1; /* Name of an array (if part2 is non-NULL)
* or the name of a variable. */
- 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,
* TCL_NAMESPACE_ONLY and TCL_LEAVE_ERR_MSG
@@ -518,54 +1030,6 @@ Tcl_GetVar2(interp, part1, part2, flags)
}
return TclGetString(objPtr);
}
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_ObjGetVar2 --
- *
- * Return the value of a Tcl variable as a Tcl object, given a
- * two-part name consisting of array name and element within array.
- *
- * Results:
- * The return value points to the current object value of the variable
- * given by part1Ptr and part2Ptr. If the specified variable doesn't
- * exist, or if there is a clash in array usage, then NULL is returned
- * and a message will be left in the interpreter's result if the
- * TCL_LEAVE_ERR_MSG flag is set.
- *
- * Side effects:
- * 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.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Obj *
-Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags)
- 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 array (if part2 is non-NULL) or the
- * name of a variable. */
- 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,
- * TCL_LEAVE_ERR_MSG, and
- * TCL_PARSE_PART1 bits. */
-{
- char *part1, *part2;
-
- part1 = Tcl_GetString(part1Ptr);
- if (part2Ptr != NULL) {
- part2 = Tcl_GetString(part2Ptr);
- } else {
- part2 = NULL;
- }
-
- return Tcl_GetVar2Ex(interp, part1, part2, flags);
-}
/*
*----------------------------------------------------------------------
@@ -594,87 +1058,44 @@ Tcl_Obj *
Tcl_GetVar2Ex(interp, part1, part2, flags)
Tcl_Interp *interp; /* Command interpreter in which variable is
* to be looked up. */
- char *part1; /* Name of an array (if part2 is non-NULL)
+ CONST char *part1; /* Name of an array (if part2 is non-NULL)
* or the name of a variable. */
- 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 TCL_LEAVE_ERR_MSG bits. */
{
- Interp *iPtr = (Interp *) interp;
- register Var *varPtr;
- Var *arrayPtr;
- char *msg;
+ Var *varPtr, *arrayPtr;
+ /*
+ * 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.
+ */
varPtr = TclLookupVar(interp, part1, part2, flags, "read",
- /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr);
+ /*createPart1*/ (flags & TCL_TRACE_READS),
+ /*createPart2*/ 1, &arrayPtr);
if (varPtr == NULL) {
return NULL;
}
- /*
- * Invoke any traces that have been set for the variable.
- */
-
- if ((varPtr->tracePtr != NULL)
- || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
- msg = CallTraces(iPtr, arrayPtr, varPtr, part1, part2,
- (flags & (TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY)) | TCL_TRACE_READS);
- if (msg != NULL) {
- if (flags & TCL_LEAVE_ERR_MSG) {
- VarErrMsg(interp, part1, part2, "read", msg);
- }
- goto errorReturn;
- }
- }
-
- /*
- * Return the element if it's an existing scalar variable.
- */
-
- if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)) {
- return varPtr->value.objPtr;
- }
-
- if (flags & TCL_LEAVE_ERR_MSG) {
- if (TclIsVarUndefined(varPtr) && (arrayPtr != NULL)
- && !TclIsVarUndefined(arrayPtr)) {
- msg = noSuchElement;
- } else if (TclIsVarArray(varPtr)) {
- msg = isArray;
- } else {
- msg = noSuchVar;
- }
- VarErrMsg(interp, part1, part2, "read", msg);
- }
-
- /*
- * An error. If the variable doesn't exist anymore and no-one's using
- * it, then free up the relevant structures and hash table entries.
- */
-
- errorReturn:
- if (TclIsVarUndefined(varPtr)) {
- CleanupVar(varPtr, arrayPtr);
- }
- return NULL;
+ return TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags);
}
/*
*----------------------------------------------------------------------
*
- * TclGetIndexedScalar --
+ * Tcl_ObjGetVar2 --
*
- * Return the Tcl object value of a local scalar variable in the active
- * procedure, given its index in the procedure's array of compiler
- * allocated local variables.
+ * Return the value of a Tcl variable as a Tcl object, given a
+ * two-part name consisting of array name and element within array.
*
* Results:
* The return value points to the current object value of the variable
- * given by localIndex. 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 if leaveErrorMsg is 1.
+ * given by part1Ptr and part2Ptr. If the specified variable doesn't
+ * exist, or if there is a clash in array usage, then NULL is returned
+ * and a message will be left in the interpreter's result if the
+ * TCL_LEAVE_ERR_MSG flag is set.
*
* Side effects:
* The ref count for the returned object is _not_ incremented to
@@ -685,109 +1106,53 @@ Tcl_GetVar2Ex(interp, part1, part2, flags)
*/
Tcl_Obj *
-TclGetIndexedScalar(interp, localIndex, leaveErrorMsg)
+Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags)
Tcl_Interp *interp; /* Command interpreter in which variable is
* to be looked up. */
- register int localIndex; /* Index of variable in procedure's array
- * of local variables. */
- int leaveErrorMsg; /* 1 if to leave an error message in
- * interpreter's result on an error.
- * Otherwise no error message is left. */
+ 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
+ * the name of an element in the array
+ * part1Ptr. */
+ int flags; /* OR-ed combination of TCL_GLOBAL_ONLY and
+ * TCL_LEAVE_ERR_MSG bits. */
{
- Interp *iPtr = (Interp *) interp;
- CallFrame *varFramePtr = iPtr->varFramePtr;
- /* Points to the procedure call frame whose
- * variables are currently in use. Same as
- * the current procedure's frame, if any,
- * unless an "uplevel" is executing. */
- Var *compiledLocals = varFramePtr->compiledLocals;
- register Var *varPtr; /* Points to the variable's in-frame Var
- * structure. */
- char *varName; /* Name of the local variable. */
- char *msg;
-
-#ifdef TCL_COMPILE_DEBUG
- int localCt = varFramePtr->procPtr->numCompiledLocals;
+ Var *varPtr, *arrayPtr;
+ char *part1, *part2;
- if (compiledLocals == NULL) {
- fprintf(stderr, "\nTclGetIndexedScalar: can't get local %i in frame 0x%x, no compiled locals\n",
- localIndex, (unsigned int) varFramePtr);
- panic("TclGetIndexedScalar: no compiled locals in frame 0x%x",
- (unsigned int) varFramePtr);
- }
- if ((localIndex < 0) || (localIndex >= localCt)) {
- fprintf(stderr, "\nTclGetIndexedScalar: can't get local %i in frame 0x%x with %i locals\n",
- localIndex, (unsigned int) varFramePtr, localCt);
- panic("TclGetIndexedScalar: bad local index %i in frame 0x%x",
- localIndex, (unsigned int) varFramePtr);
- }
-#endif /* TCL_COMPILE_DEBUG */
+ part1 = Tcl_GetString(part1Ptr);
+ part2 = ((part2Ptr == NULL) ? NULL : Tcl_GetString(part2Ptr));
- varPtr = &(compiledLocals[localIndex]);
- varName = varPtr->name;
-
- /*
- * If varPtr is a link variable, we have a reference to some variable
- * that was created through an "upvar" or "global" command, or we have a
- * reference to a variable in an enclosing namespace. Traverse through
- * any links until we find the referenced variable.
- */
-
- while (TclIsVarLink(varPtr)) {
- varPtr = varPtr->value.linkPtr;
- }
-
/*
- * Invoke any traces that have been set for the variable.
+ * 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 (varPtr->tracePtr != NULL) {
- msg = CallTraces(iPtr, /*arrayPtr*/ NULL, varPtr, varName, NULL,
- TCL_TRACE_READS);
- if (msg != NULL) {
- if (leaveErrorMsg) {
- VarErrMsg(interp, varName, NULL, "read", msg);
- }
- return NULL;
- }
- }
-
- /*
- * Make sure we're dealing with a scalar variable and not an array, and
- * that the variable exists (isn't undefined).
- */
-
- if (!TclIsVarScalar(varPtr) || TclIsVarUndefined(varPtr)) {
- if (leaveErrorMsg) {
- if (TclIsVarArray(varPtr)) {
- msg = isArray;
- } else {
- msg = noSuchVar;
- }
- VarErrMsg(interp, varName, NULL, "read", msg);
-
- }
+ varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "read",
+ /*createPart1*/ (flags & TCL_TRACE_READS),
+ /*createPart2*/ 1, &arrayPtr);
+ if (varPtr == NULL) {
return NULL;
}
- return varPtr->value.objPtr;
+
+ return TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags);
}
/*
*----------------------------------------------------------------------
*
- * TclGetElementOfIndexedArray --
+ * TclPtrGetVar --
*
- * Return the Tcl object value for an element in a local array
- * variable. The element is named by the object elemPtr while the
- * array is specified by its index in the active procedure's array
- * of compiler allocated local variables.
+ * Return the value of a Tcl variable as a Tcl object, given the
+ * pointers to the variable's (and possibly containing array's)
+ * VAR structure.
*
* Results:
- * The return value points to the current object value of the
- * element. If the specified array or element 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 if leaveErrorMsg is 1.
+ * The return value points to the current object value of the variable
+ * given by varPtr. If the specified variable doesn't exist, or if there
+ * is a clash in array usage, then NULL is returned and a message will be
+ * left in the interpreter's result if the TCL_LEAVE_ERR_MSG flag is set.
*
* Side effects:
* The ref count for the returned object is _not_ incremented to
@@ -798,114 +1163,31 @@ TclGetIndexedScalar(interp, localIndex, leaveErrorMsg)
*/
Tcl_Obj *
-TclGetElementOfIndexedArray(interp, localIndex, elemPtr, leaveErrorMsg)
+TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags)
Tcl_Interp *interp; /* Command interpreter in which variable is
* to be looked up. */
- int localIndex; /* Index of array variable in procedure's
- * array of local variables. */
- Tcl_Obj *elemPtr; /* Points to an object holding the name of
- * an element to get in the array. */
- int leaveErrorMsg; /* 1 if to leave an error message in
- * the interpreter's result on an error.
- * Otherwise no error message is left. */
+ 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 the name of a variable. */
+ CONST char *part2; /* If non-NULL, gives the name of an element
+ * in the array part1. */
+ CONST int flags; /* OR-ed combination of TCL_GLOBAL_ONLY,
+ * and TCL_LEAVE_ERR_MSG bits. */
{
Interp *iPtr = (Interp *) interp;
- CallFrame *varFramePtr = iPtr->varFramePtr;
- /* Points to the procedure call frame whose
- * variables are currently in use. Same as
- * the current procedure's frame, if any,
- * unless an "uplevel" is executing. */
- Var *compiledLocals = varFramePtr->compiledLocals;
- Var *arrayPtr; /* Points to the array's in-frame Var
- * structure. */
- char *arrayName; /* Name of the local array. */
- Tcl_HashEntry *hPtr;
- Var *varPtr = NULL; /* Points to the element's Var structure
- * that we return. Initialized to avoid
- * compiler warning. */
- char *elem, *msg;
- int new;
-
-#ifdef TCL_COMPILE_DEBUG
- Proc *procPtr = varFramePtr->procPtr;
- int localCt = procPtr->numCompiledLocals;
-
- if (compiledLocals == NULL) {
- fprintf(stderr, "\nTclGetElementOfIndexedArray: can't get element of local %i in frame 0x%x, no compiled locals\n",
- localIndex, (unsigned int) varFramePtr);
- panic("TclGetIndexedScalar: no compiled locals in frame 0x%x",
- (unsigned int) varFramePtr);
- }
- if ((localIndex < 0) || (localIndex >= localCt)) {
- fprintf(stderr, "\nTclGetIndexedScalar: can't get element of local %i in frame 0x%x with %i locals\n",
- localIndex, (unsigned int) varFramePtr, localCt);
- panic("TclGetElementOfIndexedArray: bad local index %i in frame 0x%x",
- localIndex, (unsigned int) varFramePtr);
- }
-#endif /* TCL_COMPILE_DEBUG */
-
- elem = TclGetString(elemPtr);
- arrayPtr = &(compiledLocals[localIndex]);
- arrayName = arrayPtr->name;
+ CONST char *msg;
/*
- * If arrayPtr is a link variable, we have a reference to some variable
- * that was created through an "upvar" or "global" command, or we have a
- * reference to a variable in an enclosing namespace. Traverse through
- * any links until we find the referenced variable.
- */
-
- while (TclIsVarLink(arrayPtr)) {
- arrayPtr = arrayPtr->value.linkPtr;
- }
-
- /*
- * Make sure we're dealing with an array and that the array variable
- * exists (isn't undefined).
- */
-
- if (!TclIsVarArray(arrayPtr) || TclIsVarUndefined(arrayPtr)) {
- if (leaveErrorMsg) {
- VarErrMsg(interp, arrayName, elem, "read", noSuchVar);
- }
- goto errorReturn;
- }
-
- /*
- * Look up the element. Note that we must create the element (but leave
- * it marked undefined) if it does not already exist. This allows a
- * trace to create new array elements "on the fly" that did not exist
- * before. A trace is always passed a variable for the array element. If
- * the trace does not define the variable, it will be deleted below (at
- * errorReturn) and an error returned.
- */
-
- hPtr = Tcl_CreateHashEntry(arrayPtr->value.tablePtr, elem, &new);
- if (new) {
- if (arrayPtr->searchPtr != NULL) {
- DeleteSearches(arrayPtr);
- }
- varPtr = NewVar();
- Tcl_SetHashValue(hPtr, varPtr);
- varPtr->hPtr = hPtr;
- varPtr->nsPtr = varFramePtr->nsPtr;
- TclSetVarArrayElement(varPtr);
- } else {
- varPtr = (Var *) Tcl_GetHashValue(hPtr);
- }
-
- /*
- * Invoke any traces that have been set for the element variable.
+ * Invoke any traces that have been set for the variable.
*/
if ((varPtr->tracePtr != NULL)
- || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
- msg = CallTraces(iPtr, arrayPtr, varPtr, arrayName, elem,
- TCL_TRACE_READS);
- if (msg != NULL) {
- if (leaveErrorMsg) {
- VarErrMsg(interp, arrayName, elem, "read", msg);
- }
+ || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
+ if (TCL_ERROR == CallVarTraces(iPtr, arrayPtr, varPtr, part1, part2,
+ (flags & (TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY))
+ | TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG))) {
goto errorReturn;
}
}
@@ -918,13 +1200,16 @@ TclGetElementOfIndexedArray(interp, localIndex, elemPtr, leaveErrorMsg)
return varPtr->value.objPtr;
}
- if (leaveErrorMsg) {
- if (TclIsVarArray(varPtr)) {
+ if (flags & TCL_LEAVE_ERR_MSG) {
+ if (TclIsVarUndefined(varPtr) && (arrayPtr != NULL)
+ && !TclIsVarUndefined(arrayPtr)) {
+ msg = noSuchElement;
+ } else if (TclIsVarArray(varPtr)) {
msg = isArray;
} else {
msg = noSuchVar;
}
- VarErrMsg(interp, arrayName, elem, "read", msg);
+ VarErrMsg(interp, part1, part2, "read", msg);
}
/*
@@ -933,8 +1218,8 @@ TclGetElementOfIndexedArray(interp, localIndex, elemPtr, leaveErrorMsg)
*/
errorReturn:
- if ((varPtr != NULL) && TclIsVarUndefined(varPtr)) {
- CleanupVar(varPtr, NULL); /* the array is not in a hashtable */
+ if (TclIsVarUndefined(varPtr)) {
+ CleanupVar(varPtr, arrayPtr);
}
return NULL;
}
@@ -1012,12 +1297,12 @@ Tcl_SetObjCmd(dummy, interp, objc, objv)
*----------------------------------------------------------------------
*/
-char *
+CONST char *
Tcl_SetVar(interp, varName, newValue, flags)
Tcl_Interp *interp; /* Command interpreter in which varName is
* to be looked up. */
- char *varName; /* Name of a variable in interp. */
- char *newValue; /* New value for varName. */
+ 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,
@@ -1053,16 +1338,16 @@ Tcl_SetVar(interp, varName, newValue, flags)
*----------------------------------------------------------------------
*/
-char *
+CONST char *
Tcl_SetVar2(interp, part1, part2, newValue, flags)
Tcl_Interp *interp; /* Command interpreter in which variable is
* to be looked up. */
- 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. */
- char *part2; /* Name of an element within an array, or
+ CONST char *part2; /* Name of an element within an array, or
* NULL. */
- char *newValue; /* New value for variable. */
+ 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,
@@ -1091,9 +1376,73 @@ Tcl_SetVar2(interp, part1, part2, newValue, flags)
/*
*----------------------------------------------------------------------
*
+ * Tcl_SetVar2Ex --
+ *
+ * Given a two-part variable name, which may refer either to a scalar
+ * variable or an element of an array, change the value of the variable
+ * to a new Tcl object value. If the named scalar or array or element
+ * doesn't exist then create one.
+ *
+ * Results:
+ * Returns a pointer to the Tcl_Obj holding the new value of the
+ * variable. If the write operation was disallowed because an array was
+ * expected but not found (or vice versa), then NULL is returned; if
+ * the TCL_LEAVE_ERR_MSG flag is set, then an explanatory message will
+ * be left in the interpreter's result. Note that the returned object
+ * may not be the same one referenced by newValuePtr; this is because
+ * variable traces may modify the variable's value.
+ *
+ * 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.
+ *
+ * The reference count is decremented for any old value of the variable
+ * and incremented for its new value. If the new value for the variable
+ * is not the same one referenced by newValuePtr (perhaps as a result
+ * of a variable trace), then newValuePtr's ref count is left unchanged
+ * by Tcl_SetVar2Ex. newValuePtr's ref count is also left unchanged if
+ * we are appending it as a string value: that is, if "flags" includes
+ * TCL_APPEND_VALUE but not TCL_LIST_ELEMENT.
+ *
+ * The reference count for the returned object is _not_ incremented: if
+ * you want to keep a reference to the object you must increment its
+ * ref count yourself.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_SetVar2Ex(interp, part1, part2, newValuePtr, flags)
+ 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 the name of a variable. */
+ 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:
+ * any of TCL_GLOBAL_ONLY,
+ * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE,
+ * TCL_LIST_ELEMENT or TCL_LEAVE_ERR_MSG. */
+{
+ Var *varPtr, *arrayPtr;
+
+ varPtr = TclLookupVar(interp, part1, part2, flags, "set",
+ /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
+ if (varPtr == NULL) {
+ return NULL;
+ }
+
+ return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2,
+ newValuePtr, flags);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_ObjSetVar2 --
*
- * This function is the same as Tcl_SetVar2Ex below, except the
+ * This function is the same as Tcl_SetVar2Ex above, except the
* variable names are passed in Tcl object instead of strings.
*
* Results:
@@ -1108,7 +1457,6 @@ Tcl_SetVar2(interp, part1, part2, newValue, 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.
-
*
*----------------------------------------------------------------------
*/
@@ -1127,30 +1475,33 @@ Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, newValuePtr, flags)
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, or
- * TCL_PARSE_PART1. */
+ * TCL_LIST_ELEMENT, or TCL_LEAVE_ERR_MSG. */
{
+ Var *varPtr, *arrayPtr;
char *part1, *part2;
- part1 = Tcl_GetString(part1Ptr);
- if (part2Ptr != NULL) {
- part2 = Tcl_GetString(part2Ptr);
- } else {
- part2 = NULL;
+ part1 = TclGetString(part1Ptr);
+ part2 = ((part2Ptr == NULL) ? NULL : Tcl_GetString(part2Ptr));
+
+ varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "set",
+ /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
+ if (varPtr == NULL) {
+ return NULL;
}
-
- return Tcl_SetVar2Ex(interp, part1, part2, newValuePtr, flags);
+
+ return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2,
+ newValuePtr, flags);
}
+
/*
*----------------------------------------------------------------------
*
- * Tcl_SetVar2Ex --
+ * TclPtrSetVar --
*
- * Given a two-part variable name, which may refer either to a scalar
- * variable or an element of an array, change the value of the variable
- * to a new Tcl object value. If the named scalar or array or element
- * doesn't exist then create one.
+ * This function is the same as Tcl_SetVar2Ex above, except that
+ * it requires pointers to the variable's Var structs in addition
+ * to the variable names.
*
* Results:
* Returns a pointer to the Tcl_Obj holding the new value of the
@@ -1164,49 +1515,29 @@ Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, 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.
- *
- * The reference count is decremented for any old value of the variable
- * and incremented for its new value. If the new value for the variable
- * is not the same one referenced by newValuePtr (perhaps as a result
- * of a variable trace), then newValuePtr's ref count is left unchanged
- * by Tcl_SetVar2Ex. newValuePtr's ref count is also left unchanged if
- * we are appending it as a string value: that is, if "flags" includes
- * TCL_APPEND_VALUE but not TCL_LIST_ELEMENT.
- *
- * The reference count for the returned object is _not_ incremented: if
- * you want to keep a reference to the object you must increment its
- * ref count yourself.
+
*
*----------------------------------------------------------------------
*/
Tcl_Obj *
-Tcl_SetVar2Ex(interp, part1, part2, newValuePtr, flags)
+TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags)
Tcl_Interp *interp; /* Command interpreter in which variable is
- * to be found. */
- char *part1; /* Name of an array (if part2 is non-NULL)
+ * 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. */
- 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:
- * any of TCL_GLOBAL_ONLY,
- * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE,
- * TCL_LIST_ELEMENT or TCL_LEAVE_ERR_MSG. */
+ CONST int flags; /* OR-ed combination of TCL_GLOBAL_ONLY,
+ * and TCL_LEAVE_ERR_MSG bits. */
{
Interp *iPtr = (Interp *) interp;
- register Var *varPtr;
- Var *arrayPtr;
Tcl_Obj *oldValuePtr;
Tcl_Obj *resultPtr = NULL;
- char *bytes;
- int length, result;
-
- varPtr = TclLookupVar(interp, part1, part2, flags, "set",
- /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
- if (varPtr == NULL) {
- return NULL;
- }
+ int result;
/*
* If the variable is in a hashtable and its hPtr field is NULL, then we
@@ -1239,12 +1570,18 @@ Tcl_SetVar2Ex(interp, part1, part2, newValuePtr, flags)
}
/*
- * At this point, if we were appending, we used to call read traces: we
- * treated append as a read-modify-write. However, it seemed unlikely to
- * us that a real program would be interested in such reads being done
- * during a set operation.
+ * Invoke any read traces that have been set for the variable if it
+ * is requested; this is only done in the core when lappending.
*/
+ if ((flags & TCL_TRACE_READS) && ((varPtr->tracePtr != NULL)
+ || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL)))) {
+ if (TCL_ERROR == CallVarTraces(iPtr, arrayPtr, varPtr, part1, part2,
+ TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG))) {
+ return NULL;
+ }
+ }
+
/*
* Set the variable's new value. If appending, append the new value to
* the variable, either as a list element or as a string. Also, if
@@ -1281,10 +1618,9 @@ Tcl_SetVar2Ex(interp, part1, part2, newValuePtr, flags)
* We append newValuePtr's bytes but don't change its ref count.
*/
- bytes = Tcl_GetStringFromObj(newValuePtr, &length);
if (oldValuePtr == NULL) {
- varPtr->value.objPtr = Tcl_NewStringObj(bytes, length);
- Tcl_IncrRefCount(varPtr->value.objPtr);
+ varPtr->value.objPtr = newValuePtr;
+ Tcl_IncrRefCount(newValuePtr);
} else {
if (Tcl_IsShared(oldValuePtr)) { /* append to copy */
varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
@@ -1295,34 +1631,16 @@ Tcl_SetVar2Ex(interp, part1, part2, newValuePtr, flags)
Tcl_AppendObjToObj(oldValuePtr, newValuePtr);
}
}
- } else {
- if (flags & TCL_LIST_ELEMENT) { /* set var to list element */
- int neededBytes, listFlags;
-
- /*
- * We set the variable to the result of converting newValuePtr's
- * string rep to a list element. We do not change newValuePtr's
- * ref count.
- */
+ } else if (newValuePtr != oldValuePtr) {
+ /*
+ * In this case we are replacing the value, so we don't need to
+ * do more than swap the objects.
+ */
- if (oldValuePtr != NULL) {
- Tcl_DecrRefCount(oldValuePtr); /* discard old value */
- }
- bytes = Tcl_GetStringFromObj(newValuePtr, &length);
- neededBytes = Tcl_ScanElement(bytes, &listFlags);
- oldValuePtr = Tcl_NewObj();
- oldValuePtr->bytes = (char *)
- ckalloc((unsigned) (neededBytes + 1));
- oldValuePtr->length = Tcl_ConvertElement(bytes,
- oldValuePtr->bytes, listFlags);
- varPtr->value.objPtr = oldValuePtr;
- Tcl_IncrRefCount(varPtr->value.objPtr);
- } else if (newValuePtr != oldValuePtr) {
- varPtr->value.objPtr = newValuePtr;
- Tcl_IncrRefCount(newValuePtr); /* var is another ref */
- if (oldValuePtr != NULL) {
- TclDecrRefCount(oldValuePtr); /* discard old value */
- }
+ varPtr->value.objPtr = newValuePtr;
+ Tcl_IncrRefCount(newValuePtr); /* var is another ref */
+ if (oldValuePtr != NULL) {
+ TclDecrRefCount(oldValuePtr); /* discard old value */
}
}
TclSetVarScalar(varPtr);
@@ -1337,12 +1655,9 @@ Tcl_SetVar2Ex(interp, part1, part2, newValuePtr, flags)
if ((varPtr->tracePtr != NULL)
|| ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
- char *msg = CallTraces(iPtr, arrayPtr, varPtr, part1, part2,
- (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) | TCL_TRACE_WRITES);
- if (msg != NULL) {
- if (flags & TCL_LEAVE_ERR_MSG) {
- VarErrMsg(interp, part1, part2, "set", msg);
- }
+ if (TCL_ERROR == CallVarTraces(iPtr, arrayPtr, varPtr, part1, part2,
+ (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY))
+ | TCL_TRACE_WRITES, (flags & TCL_LEAVE_ERR_MSG))) {
goto cleanup;
}
}
@@ -1379,403 +1694,6 @@ Tcl_SetVar2Ex(interp, part1, part2, newValuePtr, flags)
/*
*----------------------------------------------------------------------
*
- * TclSetIndexedScalar --
- *
- * Change the Tcl object value of a local scalar variable in the active
- * procedure, given its compile-time allocated index in the procedure's
- * array of local variables.
- *
- * Results:
- * Returns a pointer to the Tcl_Obj holding the new value of the
- * variable given by localIndex. 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 if leaveErrorMsg is 1. Note
- * that the returned object may not be the same one referenced by
- * newValuePtr; this is because variable traces may modify the
- * variable's value.
- *
- * Side effects:
- * The value of the given variable is set. The reference count is
- * decremented for any old value of the variable and incremented for
- * its new value. If as a result of a variable trace the new value for
- * the variable is not the same one referenced by newValuePtr, then
- * newValuePtr's ref count is left unchanged. 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. This procedure does not create
- * new variables, but only sets those recognized at compile time.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Obj *
-TclSetIndexedScalar(interp, localIndex, newValuePtr, leaveErrorMsg)
- Tcl_Interp *interp; /* Command interpreter in which variable is
- * to be found. */
- int localIndex; /* Index of variable in procedure's array
- * of local variables. */
- Tcl_Obj *newValuePtr; /* New value for variable. */
- int leaveErrorMsg; /* 1 if to leave an error message in
- * the interpreter's result on an error.
- * Otherwise no error message is left. */
-{
- Interp *iPtr = (Interp *) interp;
- CallFrame *varFramePtr = iPtr->varFramePtr;
- /* Points to the procedure call frame whose
- * variables are currently in use. Same as
- * the current procedure's frame, if any,
- * unless an "uplevel" is executing. */
- Var *compiledLocals = varFramePtr->compiledLocals;
- register Var *varPtr; /* Points to the variable's in-frame Var
- * structure. */
- char *varName; /* Name of the local variable. */
- Tcl_Obj *oldValuePtr;
- Tcl_Obj *resultPtr = NULL;
-
-#ifdef TCL_COMPILE_DEBUG
- Proc *procPtr = varFramePtr->procPtr;
- int localCt = procPtr->numCompiledLocals;
-
- if (compiledLocals == NULL) {
- fprintf(stderr, "\nTclSetIndexedScalar: can't set local %i in frame 0x%x, no compiled locals\n",
- localIndex, (unsigned int) varFramePtr);
- panic("TclSetIndexedScalar: no compiled locals in frame 0x%x",
- (unsigned int) varFramePtr);
- }
- if ((localIndex < 0) || (localIndex >= localCt)) {
- fprintf(stderr, "\nTclSetIndexedScalar: can't set local %i in frame 0x%x with %i locals\n",
- localIndex, (unsigned int) varFramePtr, localCt);
- panic("TclSetIndexedScalar: bad local index %i in frame 0x%x",
- localIndex, (unsigned int) varFramePtr);
- }
-#endif /* TCL_COMPILE_DEBUG */
-
- varPtr = &(compiledLocals[localIndex]);
- varName = varPtr->name;
-
- /*
- * If varPtr is a link variable, we have a reference to some variable
- * that was created through an "upvar" or "global" command, or we have a
- * reference to a variable in an enclosing namespace. Traverse through
- * any links until we find the referenced variable.
- */
-
- while (TclIsVarLink(varPtr)) {
- varPtr = varPtr->value.linkPtr;
- }
-
- /*
- * 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 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 (leaveErrorMsg) {
- if (TclIsVarArrayElement(varPtr)) {
- VarErrMsg(interp, varName, NULL, "set", danglingElement);
- } else {
- VarErrMsg(interp, varName, NULL, "set", danglingVar);
- }
- }
- return NULL;
- }
-
- /*
- * It's an error to try to set an array variable itself.
- */
-
- if (TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
- if (leaveErrorMsg) {
- VarErrMsg(interp, varName, NULL, "set", isArray);
- }
- return NULL;
- }
-
- /*
- * Set the variable's new value and discard its old value. We don't
- * append with this "set" procedure so the old value isn't needed.
- */
-
- oldValuePtr = varPtr->value.objPtr;
- if (newValuePtr != oldValuePtr) { /* set new value */
- varPtr->value.objPtr = newValuePtr;
- Tcl_IncrRefCount(newValuePtr); /* var is another ref to obj */
- if (oldValuePtr != NULL) {
- TclDecrRefCount(oldValuePtr); /* discard old value */
- }
- }
- TclSetVarScalar(varPtr);
- TclClearVarUndefined(varPtr);
-
- /*
- * Invoke any write traces for the variable.
- */
-
- if (varPtr->tracePtr != NULL) {
- char *msg = CallTraces(iPtr, /*arrayPtr*/ NULL, varPtr,
- varName, (char *) NULL, TCL_TRACE_WRITES);
- if (msg != NULL) {
- if (leaveErrorMsg) {
- VarErrMsg(interp, varName, NULL, "set", msg);
- }
- goto cleanup;
- }
- }
-
- /*
- * Return the variable's value unless the variable was changed in some
- * gross way by a trace (e.g. it was unset and then recreated as an
- * array). If it was changed is a gross way, just return an empty string
- * object.
- */
-
- if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)) {
- return varPtr->value.objPtr;
- }
-
- resultPtr = Tcl_NewObj();
-
- /*
- * If the variable doesn't exist anymore and no-one's using it, then
- * free up the relevant structures and hash table entries.
- */
-
- cleanup:
- if (TclIsVarUndefined(varPtr)) {
- CleanupVar(varPtr, NULL);
- }
- return resultPtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclSetElementOfIndexedArray --
- *
- * Change the Tcl object value of an element in a local array
- * variable. The element is named by the object elemPtr while the array
- * is specified by its index in the active procedure's array of
- * compiler allocated local variables.
- *
- * Results:
- * Returns a pointer to the Tcl_Obj holding the new value of the
- * element. If the specified array or element 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 if leaveErrorMsg is 1. Note that the
- * returned object may not be the same one referenced by newValuePtr;
- * this is because variable traces may modify the variable's value.
- *
- * Side effects:
- * The value of the given array element is set. The reference count is
- * decremented for any old value of the element and incremented for its
- * new value. If as a result of a variable trace the new value for the
- * element is not the same one referenced by newValuePtr, then
- * newValuePtr's ref count is left unchanged. 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. This procedure will not create new
- * array variables, but only sets elements of those arrays recognized
- * at compile time. However, if the entry doesn't exist then a new
- * variable is created.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Obj *
-TclSetElementOfIndexedArray(interp, localIndex, elemPtr, newValuePtr,
- leaveErrorMsg)
- Tcl_Interp *interp; /* Command interpreter in which the array is
- * to be found. */
- int localIndex; /* Index of array variable in procedure's
- * array of local variables. */
- Tcl_Obj *elemPtr; /* Points to an object holding the name of
- * an element to set in the array. */
- Tcl_Obj *newValuePtr; /* New value for variable. */
- int leaveErrorMsg; /* 1 if to leave an error message in
- * the interpreter's result on an error.
- * Otherwise no error message is left. */
-{
- Interp *iPtr = (Interp *) interp;
- CallFrame *varFramePtr = iPtr->varFramePtr;
- /* Points to the procedure call frame whose
- * variables are currently in use. Same as
- * the current procedure's frame, if any,
- * unless an "uplevel" is executing. */
- Var *compiledLocals = varFramePtr->compiledLocals;
- Var *arrayPtr; /* Points to the array's in-frame Var
- * structure. */
- char *arrayName; /* Name of the local array. */
- char *elem;
- Tcl_HashEntry *hPtr;
- Var *varPtr = NULL; /* Points to the element's Var structure
- * that we return. */
- Tcl_Obj *resultPtr = NULL;
- Tcl_Obj *oldValuePtr;
- int new;
-
-#ifdef TCL_COMPILE_DEBUG
- Proc *procPtr = varFramePtr->procPtr;
- int localCt = procPtr->numCompiledLocals;
-
- if (compiledLocals == NULL) {
- fprintf(stderr, "\nTclSetElementOfIndexedArray: can't set element of local %i in frame 0x%x, no compiled locals\n",
- localIndex, (unsigned int) varFramePtr);
- panic("TclSetIndexedScalar: no compiled locals in frame 0x%x",
- (unsigned int) varFramePtr);
- }
- if ((localIndex < 0) || (localIndex >= localCt)) {
- fprintf(stderr, "\nTclSetIndexedScalar: can't set elememt of local %i in frame 0x%x with %i locals\n",
- localIndex, (unsigned int) varFramePtr, localCt);
- panic("TclSetElementOfIndexedArray: bad local index %i in frame 0x%x",
- localIndex, (unsigned int) varFramePtr);
- }
-#endif /* TCL_COMPILE_DEBUG */
-
- elem = TclGetString(elemPtr);
- arrayPtr = &(compiledLocals[localIndex]);
- arrayName = arrayPtr->name;
-
- /*
- * If arrayPtr is a link variable, we have a reference to some variable
- * that was created through an "upvar" or "global" command, or we have a
- * reference to a variable in an enclosing namespace. Traverse through
- * any links until we find the referenced variable.
- */
-
- while (TclIsVarLink(arrayPtr)) {
- arrayPtr = arrayPtr->value.linkPtr;
- }
-
- /*
- * 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 error (allowing the variable to be reset would screw up
- * our storage allocation and is meaningless anyway).
- */
-
- if ((arrayPtr->flags & VAR_IN_HASHTABLE) && (arrayPtr->hPtr == NULL)) {
- if (leaveErrorMsg) {
- if (TclIsVarArrayElement(arrayPtr)) {
- VarErrMsg(interp, arrayName, elem, "set", danglingElement);
- } else {
- VarErrMsg(interp, arrayName, elem, "set", danglingVar);
- }
- }
- goto errorReturn;
- }
-
- /*
- * Make sure we're dealing with an array.
- */
-
- if (TclIsVarUndefined(arrayPtr) && !TclIsVarArrayElement(arrayPtr)) {
- TclSetVarArray(arrayPtr);
- arrayPtr->value.tablePtr =
- (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
- Tcl_InitHashTable(arrayPtr->value.tablePtr, TCL_STRING_KEYS);
- TclClearVarUndefined(arrayPtr);
- } else if (!TclIsVarArray(arrayPtr)) {
- if (leaveErrorMsg) {
- VarErrMsg(interp, arrayName, elem, "set", needArray);
- }
- goto errorReturn;
- }
-
- /*
- * Look up the element.
- */
-
- hPtr = Tcl_CreateHashEntry(arrayPtr->value.tablePtr, elem, &new);
- if (new) {
- if (arrayPtr->searchPtr != NULL) {
- DeleteSearches(arrayPtr);
- }
- varPtr = NewVar();
- Tcl_SetHashValue(hPtr, varPtr);
- varPtr->hPtr = hPtr;
- varPtr->nsPtr = varFramePtr->nsPtr;
- TclSetVarArrayElement(varPtr);
- }
- varPtr = (Var *) Tcl_GetHashValue(hPtr);
-
- /*
- * It's an error to try to set an array variable itself.
- */
-
- if (TclIsVarArray(varPtr)) {
- if (leaveErrorMsg) {
- VarErrMsg(interp, arrayName, elem, "set", isArray);
- }
- goto errorReturn;
- }
-
- /*
- * Set the variable's new value and discard the old one. We don't
- * append with this "set" procedure so the old value isn't needed.
- */
-
- oldValuePtr = varPtr->value.objPtr;
- if (newValuePtr != oldValuePtr) { /* set new value */
- varPtr->value.objPtr = newValuePtr;
- Tcl_IncrRefCount(newValuePtr); /* var is another ref to obj */
- if (oldValuePtr != NULL) {
- TclDecrRefCount(oldValuePtr); /* discard old value */
- }
- }
- TclSetVarScalar(varPtr);
- TclClearVarUndefined(varPtr);
-
- /*
- * Invoke any write traces for the element variable.
- */
-
- if ((varPtr->tracePtr != NULL)
- || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
- char *msg = CallTraces(iPtr, arrayPtr, varPtr, arrayName, elem,
- TCL_TRACE_WRITES);
- if (msg != NULL) {
- if (leaveErrorMsg) {
- VarErrMsg(interp, arrayName, elem, "set", msg);
- }
- goto errorReturn;
- }
- }
-
- /*
- * Return the element's value unless it was changed in some gross way by
- * a trace (e.g. it was unset and then recreated as an array). If it was
- * changed is a gross way, just return an empty string object.
- */
-
- if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)) {
- return varPtr->value.objPtr;
- }
-
- resultPtr = Tcl_NewObj();
-
- /*
- * An error. If the variable doesn't exist anymore and no-one's using
- * it, then free up the relevant structures and hash table entries.
- */
-
- errorReturn:
- if (varPtr != NULL) {
- if (TclIsVarUndefined(varPtr)) {
- CleanupVar(varPtr, NULL); /* note: array isn't in hashtable */
- }
- }
- return resultPtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* TclIncrVar2 --
*
* Given a two-part variable name, which may refer either to a scalar
@@ -1815,96 +1733,75 @@ TclIncrVar2(interp, part1Ptr, part2Ptr, incrAmount, flags)
* TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE,
* TCL_LIST_ELEMENT, TCL_LEAVE_ERR_MSG. */
{
- register Tcl_Obj *varValuePtr;
- Tcl_Obj *resultPtr;
- int createdNewObj; /* Set 1 if var's value object is shared
- * so we must increment a copy (i.e. copy
- * on write). */
- long i;
- int result;
+ Var *varPtr, *arrayPtr;
+ char *part1, *part2;
- varValuePtr = Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags);
- if (varValuePtr == NULL) {
+ part1 = TclGetString(part1Ptr);
+ part2 = ((part2Ptr == NULL)? NULL : TclGetString(part2Ptr));
+
+ 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;
}
-
- /*
- * 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)) {
- varValuePtr = Tcl_DuplicateObj(varValuePtr);
- createdNewObj = 1;
- }
- result = Tcl_GetLongFromObj(interp, varValuePtr, &i);
- if (result != TCL_OK) {
- if (createdNewObj) {
- Tcl_DecrRefCount(varValuePtr); /* free unneeded copy */
- }
- return NULL;
- }
- Tcl_SetLongObj(varValuePtr, (i + incrAmount));
-
- /*
- * Store the variable's new value and run any write traces.
- */
-
- resultPtr = Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, varValuePtr, flags);
- if (resultPtr == NULL) {
- return NULL;
- }
- return resultPtr;
+ return TclPtrIncrVar(interp, varPtr, arrayPtr, part1, part2,
+ incrAmount, flags);
}
/*
*----------------------------------------------------------------------
*
- * TclIncrIndexedScalar --
+ * TclPtrIncrVar --
*
- * Increments the Tcl object value of a local scalar variable in the
- * active procedure, given its compile-time allocated index in the
- * procedure's array of local variables.
+ * Given the pointers to a variable and possible containing array,
+ * increment the Tcl object value of the variable by a specified
+ * amount.
*
* Results:
* Returns a pointer to the Tcl_Obj holding the new value of the
- * variable given by localIndex. 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
- * amount. 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.
+ * 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.
*
*----------------------------------------------------------------------
*/
Tcl_Obj *
-TclIncrIndexedScalar(interp, localIndex, incrAmount)
+TclPtrIncrVar(interp, varPtr, arrayPtr, part1, part2, incrAmount, flags)
Tcl_Interp *interp; /* Command interpreter in which variable is
* to be found. */
- int localIndex; /* Index of variable in procedure's array
- * of local variables. */
- long incrAmount; /* Amount to be added to variable. */
+ 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 long 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, TCL_LEAVE_ERR_MSG. */
{
register Tcl_Obj *varValuePtr;
- Tcl_Obj *resultPtr;
int createdNewObj; /* Set 1 if var's value object is shared
* so we must increment a copy (i.e. copy
* on write). */
long i;
- int result;
- varValuePtr = TclGetIndexedScalar(interp, localIndex,
- /*leaveErrorMsg*/ 1);
+ varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags);
+
if (varValuePtr == NULL) {
Tcl_AddObjErrorInfo(interp,
"\n (reading value of variable to increment)", -1);
@@ -1912,125 +1809,58 @@ TclIncrIndexedScalar(interp, localIndex, incrAmount)
}
/*
- * Reach into the object's representation to extract and 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.
+ * 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)) {
- createdNewObj = 1;
varValuePtr = Tcl_DuplicateObj(varValuePtr);
+ createdNewObj = 1;
}
- result = Tcl_GetLongFromObj(interp, varValuePtr, &i);
- if (result != TCL_OK) {
+#ifdef TCL_WIDE_INT_IS_LONG
+ if (Tcl_GetLongFromObj(interp, varValuePtr, &i) != TCL_OK) {
if (createdNewObj) {
Tcl_DecrRefCount(varValuePtr); /* free unneeded copy */
}
return NULL;
}
Tcl_SetLongObj(varValuePtr, (i + incrAmount));
-
- /*
- * Store the variable's new value and run any write traces.
- */
-
- resultPtr = TclSetIndexedScalar(interp, localIndex, varValuePtr,
- /*leaveErrorMsg*/ 1);
- if (resultPtr == NULL) {
- return NULL;
- }
- return resultPtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclIncrElementOfIndexedArray --
- *
- * Increments the Tcl object value of an element in a local array
- * variable. The element is named by the object elemPtr while the array
- * is specified by its index in the active procedure's array of
- * compiler allocated local variables.
- *
- * Results:
- * Returns a pointer to the Tcl_Obj holding the new value of the
- * element. If the specified array or element 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 array element is incremented by the specified
- * amount. 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 the
- * entry doesn't exist then a new variable is created.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Obj *
-TclIncrElementOfIndexedArray(interp, localIndex, elemPtr, incrAmount)
- Tcl_Interp *interp; /* Command interpreter in which the array is
- * to be found. */
- int localIndex; /* Index of array variable in procedure's
- * array of local variables. */
- Tcl_Obj *elemPtr; /* Points to an object holding the name of
- * an element to increment in the array. */
- long incrAmount; /* Amount to be added to variable. */
-{
- register Tcl_Obj *varValuePtr;
- Tcl_Obj *resultPtr;
- int createdNewObj; /* Set 1 if var's value object is shared
- * so we must increment a copy (i.e. copy
- * on write). */
- long i;
- int result;
-
- varValuePtr = TclGetElementOfIndexedArray(interp, localIndex, elemPtr,
- /*leaveErrorMsg*/ 1);
- if (varValuePtr == NULL) {
- Tcl_AddObjErrorInfo(interp,
- "\n (reading value of variable to increment)", -1);
- return NULL;
- }
-
- /*
- * Reach into the object's representation to extract and 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)) {
- createdNewObj = 1;
- varValuePtr = Tcl_DuplicateObj(varValuePtr);
- }
- result = Tcl_GetLongFromObj(interp, varValuePtr, &i);
- if (result != TCL_OK) {
- if (createdNewObj) {
- Tcl_DecrRefCount(varValuePtr); /* free unneeded copy */
+#else
+ if (varValuePtr->typePtr == &tclWideIntType) {
+ Tcl_WideInt wide = varValuePtr->internalRep.wideValue;
+ Tcl_SetWideIntObj(varValuePtr, wide + Tcl_LongAsWide(incrAmount));
+ } else if (varValuePtr->typePtr == &tclIntType) {
+ i = varValuePtr->internalRep.longValue;
+ Tcl_SetIntObj(varValuePtr, i + incrAmount);
+ } else {
+ /*
+ * Not an integer or wide internal-rep...
+ */
+ Tcl_WideInt wide;
+ if (Tcl_GetWideIntFromObj(interp, varValuePtr, &wide) != TCL_OK) {
+ if (createdNewObj) {
+ Tcl_DecrRefCount(varValuePtr); /* free unneeded copy */
+ }
+ return NULL;
+ }
+ if (wide <= Tcl_LongAsWide(LONG_MAX)
+ && wide >= Tcl_LongAsWide(LONG_MIN)) {
+ Tcl_SetLongObj(varValuePtr, Tcl_WideAsLong(wide) + incrAmount);
+ } else {
+ Tcl_SetWideIntObj(varValuePtr, wide + Tcl_LongAsWide(incrAmount));
}
- return NULL;
}
- Tcl_SetLongObj(varValuePtr, (i + incrAmount));
-
+#endif
+
/*
* Store the variable's new value and run any write traces.
*/
- resultPtr = TclSetElementOfIndexedArray(interp, localIndex, elemPtr,
- varValuePtr,
- /*leaveErrorMsg*/ 1);
- if (resultPtr == NULL) {
- return NULL;
- }
- return resultPtr;
+ return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2,
+ varValuePtr, flags);
}
/*
@@ -2057,7 +1887,7 @@ int
Tcl_UnsetVar(interp, varName, flags)
Tcl_Interp *interp; /* Command interpreter in which varName is
* to be looked up. */
- char *varName; /* Name of a variable in interp. May be
+ 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
@@ -2092,8 +1922,51 @@ int
Tcl_UnsetVar2(interp, part1, part2, flags)
Tcl_Interp *interp; /* Command interpreter in which varName is
* to be looked up. */
- char *part1; /* Name of variable or array. */
- char *part2; /* Name of element within array or NULL. */
+ 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. */
+{
+ int result;
+ Tcl_Obj *part1Ptr;
+
+ part1Ptr = Tcl_NewStringObj(part1, -1);
+ Tcl_IncrRefCount(part1Ptr);
+ result = TclObjUnsetVar2(interp, part1Ptr, part2, flags);
+ TclDecrRefCount(part1Ptr);
+
+ return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclObjUnsetVar2 --
+ *
+ * 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 TCL_LEAVE_ERR_MSG flag is set then an error message
+ * is left in the interp's result.
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
@@ -2105,12 +1978,15 @@ Tcl_UnsetVar2(interp, part1, part2, flags)
ActiveVarTrace *activePtr;
Tcl_Obj *objPtr;
int result;
+ char *part1;
- varPtr = TclLookupVar(interp, part1, part2, flags, "unset",
+ part1 = TclGetString(part1Ptr);
+ varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "unset",
/*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
if (varPtr == NULL) {
return TCL_ERROR;
}
+
result = (TclIsVarUndefined(varPtr)? TCL_ERROR : TCL_OK);
if ((arrayPtr != NULL) && (arrayPtr->searchPtr != NULL)) {
@@ -2141,7 +2017,7 @@ Tcl_UnsetVar2(interp, part1, part2, flags)
* Call trace procedures 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: CallTraces
+ * 1. We need to increment varPtr's refCount around this: CallVarTraces
* will use dummyVar so it won't increment varPtr's refCount itself.
* 2. Turn off the VAR_TRACE_ACTIVE flag in dummyVar: we want to
* call unset traces even if other traces are pending.
@@ -2151,14 +2027,15 @@ Tcl_UnsetVar2(interp, part1, part2, flags)
|| ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
varPtr->refCount++;
dummyVar.flags &= ~VAR_TRACE_ACTIVE;
- (void) CallTraces(iPtr, arrayPtr, &dummyVar, part1, part2,
- (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) | TCL_TRACE_UNSETS);
+ CallVarTraces(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;
- ckfree((char *) tracePtr);
+ Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC);
}
- for (activePtr = iPtr->activeTracePtr; activePtr != NULL;
+ for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL;
activePtr = activePtr->nextPtr) {
if (activePtr->varPtr == varPtr) {
activePtr->nextTracePtr = NULL;
@@ -2190,7 +2067,8 @@ Tcl_UnsetVar2(interp, part1, part2, flags)
*/
varPtr->refCount++;
DeleteArray(iPtr, part1, dummyVarPtr,
- (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) | TCL_TRACE_UNSETS);
+ (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY))
+ | TCL_TRACE_UNSETS);
/* Decr ref count */
varPtr->refCount--;
}
@@ -2256,7 +2134,7 @@ int
Tcl_TraceVar(interp, varName, flags, proc, clientData)
Tcl_Interp *interp; /* Interpreter in which variable is
* to be traced. */
- char *varName; /* Name of variable; may end with "(index)"
+ 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 TCL_TRACE_READS, TCL_TRACE_WRITES,
@@ -2295,8 +2173,8 @@ int
Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData)
Tcl_Interp *interp; /* Interpreter in which variable is
* to be traced. */
- char *part1; /* Name of scalar variable or array. */
- 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
@@ -2309,25 +2187,46 @@ Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData)
{
Var *varPtr, *arrayPtr;
register VarTrace *tracePtr;
-
- varPtr = TclLookupVar(interp, part1, part2, (flags | TCL_LEAVE_ERR_MSG),
+ int flagMask;
+
+ /*
+ * We strip 'flags' down to just the parts which are relevant to
+ * TclLookupVar, to avoid conflicts between trace flags and
+ * internal namespace flags such as 'FIND_ONLY_NS'. This can
+ * now occur since we have trace flags with values 0x1000 and higher.
+ */
+ flagMask = TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY;
+ varPtr = TclLookupVar(interp, part1, part2,
+ (flags & flagMask) | TCL_LEAVE_ERR_MSG,
"trace", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
if (varPtr == NULL) {
return TCL_ERROR;
}
/*
+ * Check for a nonsense flag combination. Note that this is a
+ * panic() because there should be no code path that ever sets
+ * both flags.
+ */
+ if ((flags&TCL_TRACE_RESULT_DYNAMIC) && (flags&TCL_TRACE_RESULT_OBJECT)) {
+ panic("bad result flag combination");
+ }
+
+ /*
* Set up trace information.
*/
+ flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
+ TCL_TRACE_ARRAY | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT;
+#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 & (TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
- TCL_TRACE_ARRAY);
- tracePtr->nextPtr = varPtr->tracePtr;
- varPtr->tracePtr = tracePtr;
+ tracePtr->traceProc = proc;
+ tracePtr->clientData = clientData;
+ tracePtr->flags = flags & flagMask;
+ tracePtr->nextPtr = varPtr->tracePtr;
+ varPtr->tracePtr = tracePtr;
return TCL_OK;
}
@@ -2352,7 +2251,7 @@ Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData)
void
Tcl_UntraceVar(interp, varName, flags, proc, clientData)
Tcl_Interp *interp; /* Interpreter containing variable. */
- char *varName; /* Name of variable; may end with "(index)"
+ CONST char *varName; /* Name of variable; may end with "(index)"
* to signify an array reference. */
int flags; /* OR-ed collection of bits describing
* current trace, including any of
@@ -2386,8 +2285,8 @@ Tcl_UntraceVar(interp, varName, flags, proc, clientData)
void
Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
Tcl_Interp *interp; /* Interpreter containing variable. */
- char *part1; /* Name of variable or array. */
- char *part2; /* Name of element within array; NULL means
+ 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
@@ -2403,17 +2302,31 @@ Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
Var *varPtr, *arrayPtr;
Interp *iPtr = (Interp *) interp;
ActiveVarTrace *activePtr;
-
- varPtr = TclLookupVar(interp, part1, part2,
- flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY),
+ int flagMask;
+
+ /*
+ * Set up a mask to mask out the parts of the flags that we are not
+ * interested in now.
+ */
+ flagMask = TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY;
+ varPtr = TclLookupVar(interp, part1, part2, flags & flagMask,
/*msg*/ (char *) NULL,
/*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
if (varPtr == NULL) {
return;
}
- flags &= (TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
- TCL_TRACE_ARRAY);
+
+ /*
+ * Set up a mask to mask out the parts of the flags that we are not
+ * interested in now.
+ */
+ flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
+ TCL_TRACE_ARRAY | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT;
+#ifndef TCL_REMOVE_OBSOLETE_TRACES
+ flagMask |= TCL_TRACE_OLD_STYLE;
+#endif
+ flags &= flagMask;
for (tracePtr = varPtr->tracePtr, prevPtr = NULL; ;
prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
if (tracePtr == NULL) {
@@ -2428,10 +2341,10 @@ Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
/*
* 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 CallTraces.
+ * processed by CallVarTraces.
*/
- for (activePtr = iPtr->activeTracePtr; activePtr != NULL;
+ for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL;
activePtr = activePtr->nextPtr) {
if (activePtr->nextTracePtr == tracePtr) {
activePtr->nextTracePtr = tracePtr->nextPtr;
@@ -2442,7 +2355,7 @@ Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
} else {
prevPtr->nextPtr = tracePtr->nextPtr;
}
- ckfree((char *) tracePtr);
+ Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC);
/*
* If this is the last trace on the variable, and the variable is
@@ -2483,7 +2396,7 @@ Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
ClientData
Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData)
Tcl_Interp *interp; /* Interpreter containing variable. */
- char *varName; /* Name of variable; may end with "(index)"
+ CONST char *varName; /* Name of variable; may end with "(index)"
* to signify an array reference. */
int flags; /* OR-ed combo or TCL_GLOBAL_ONLY,
* TCL_NAMESPACE_ONLY (can be 0). */
@@ -2518,8 +2431,8 @@ Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData)
ClientData
Tcl_VarTraceInfo2(interp, part1, part2, flags, proc, prevClientData)
Tcl_Interp *interp; /* Interpreter containing variable. */
- char *part1; /* Name of variable or array. */
- char *part2; /* Name of element within array; NULL means
+ 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,
@@ -2589,18 +2502,45 @@ Tcl_UnsetObjCmd(dummy, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- register int i;
+ register int i, flags = TCL_LEAVE_ERR_MSG;
register char *name;
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "varName ?varName ...?");
+ if (objc < 1) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "?-nocomplain? ?--? ?varName varName ...?");
return TCL_ERROR;
+ } else if (objc == 1) {
+ /*
+ * Do nothing if no arguments supplied, so as to match
+ * command documentation.
+ */
+ return TCL_OK;
}
-
- for (i = 1; i < objc; i++) {
- name = TclGetString(objv[i]);
- if (Tcl_UnsetVar2(interp, name, (char *) NULL,
- TCL_LEAVE_ERR_MSG) != TCL_OK) {
+
+ /*
+ * Simple, restrictive argument parsing. The only options are --
+ * and -nocomplain (which must come first and be given exactly to
+ * be an option).
+ */
+ i = 1;
+ name = TclGetString(objv[i]);
+ if (name[0] == '-') {
+ if (strcmp("-nocomplain", name) == 0) {
+ i++;
+ if (i == objc) {
+ return TCL_OK;
+ }
+ flags = 0;
+ name = TclGetString(objv[i]);
+ }
+ if (strcmp("--", name) == 0) {
+ i++;
+ }
+ }
+
+ for (; i < objc; i++) {
+ if ((TclObjUnsetVar2(interp, objv[i], NULL, flags) != TCL_OK)
+ && (flags == TCL_LEAVE_ERR_MSG)) {
return TCL_ERROR;
}
}
@@ -2632,6 +2572,9 @@ Tcl_AppendObjCmd(dummy, interp, objc, objv)
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. */
@@ -2641,15 +2584,29 @@ Tcl_AppendObjCmd(dummy, interp, objc, objv)
Tcl_WrongNumArgs(interp, 1, objv, "varName ?value value ...?");
return TCL_ERROR;
}
+
if (objc == 2) {
varValuePtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
if (varValuePtr == NULL) {
return TCL_ERROR;
}
} else {
- for (i = 2; i < objc; i++) {
- varValuePtr = Tcl_ObjSetVar2(interp, objv[1], (Tcl_Obj *) NULL,
- objv[i], (TCL_APPEND_VALUE | TCL_LEAVE_ERR_MSG));
+ varPtr = TclObjLookupVar(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++) {
+ /*
+ * 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.
+ */
+
+ varValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1, NULL,
+ objv[i], (TCL_APPEND_VALUE | TCL_LEAVE_ERR_MSG));
if (varValuePtr == NULL) {
return TCL_ERROR;
}
@@ -2688,25 +2645,26 @@ Tcl_LappendObjCmd(dummy, interp, objc, objv)
register List *listRepPtr;
register Tcl_Obj **elemPtrs;
int numElems, numRequired, createdNewObj, createVar, i, j;
+ Var *varPtr, *arrayPtr;
+ char *part1;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "varName ?value value ...?");
return TCL_ERROR;
}
if (objc == 2) {
- newValuePtr = Tcl_ObjGetVar2(interp, objv[1], (Tcl_Obj *) NULL,
- (TCL_LEAVE_ERR_MSG));
+ newValuePtr = Tcl_ObjGetVar2(interp, objv[1], (Tcl_Obj *) NULL, 0);
if (newValuePtr == NULL) {
/*
* The variable doesn't exist yet. Just create it with an empty
* initial value.
*/
- Tcl_Obj *nullObjPtr = Tcl_NewObj();
- newValuePtr = Tcl_ObjSetVar2(interp, objv[1], NULL,
- nullObjPtr, TCL_LEAVE_ERR_MSG);
+ varValuePtr = Tcl_NewObj();
+ newValuePtr = Tcl_ObjSetVar2(interp, objv[1], NULL, varValuePtr,
+ TCL_LEAVE_ERR_MSG);
if (newValuePtr == NULL) {
- Tcl_DecrRefCount(nullObjPtr); /* free unneeded object */
+ Tcl_DecrRefCount(varValuePtr); /* free unneeded object */
return TCL_ERROR;
}
}
@@ -2723,27 +2681,41 @@ Tcl_LappendObjCmd(dummy, interp, objc, objv)
createdNewObj = 0;
createVar = 1;
- varValuePtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
+
+ /*
+ * 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 to insure that they remain valid
+ * even if the variable was undefined and unused.
+ */
+
+ varPtr = TclObjLookupVar(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++;
+ }
+ 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 (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.
*/
- char *p, *varName;
- int nameBytes, i;
-
- varName = Tcl_GetStringFromObj(objv[1], &nameBytes);
- for (i = 0, p = varName; i < nameBytes; i++, p++) {
- if (*p == '(') {
- p = (varName + nameBytes-1);
- if (*p == ')') { /* last char is ')' => array ref */
- createVar = 0;
- }
- break;
- }
- }
+ createVar = (TclIsVarUndefined(varPtr));
varValuePtr = Tcl_NewObj();
createdNewObj = 1;
} else if (Tcl_IsShared(varValuePtr)) {
@@ -2764,7 +2736,7 @@ Tcl_LappendObjCmd(dummy, interp, objc, objv)
return result;
}
}
- listRepPtr = (List *) varValuePtr->internalRep.otherValuePtr;
+ listRepPtr = (List *) varValuePtr->internalRep.twoPtrValue.ptr1;
elemPtrs = listRepPtr->elements;
numElems = listRepPtr->elemCount;
@@ -2810,8 +2782,8 @@ Tcl_LappendObjCmd(dummy, interp, objc, objv)
* was new and we didn't create the variable.
*/
- newValuePtr = Tcl_ObjSetVar2(interp, objv[1], NULL, varValuePtr,
- TCL_LEAVE_ERR_MSG);
+ newValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1, NULL,
+ varValuePtr, TCL_LEAVE_ERR_MSG);
if (newValuePtr == NULL) {
if (createdNewObj && !createVar) {
Tcl_DecrRefCount(varValuePtr); /* free unneeded obj */
@@ -2861,18 +2833,18 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
enum {ARRAY_ANYMORE, ARRAY_DONESEARCH, ARRAY_EXISTS, ARRAY_GET,
ARRAY_NAMES, ARRAY_NEXTELEMENT, ARRAY_SET, ARRAY_SIZE,
- ARRAY_STARTSEARCH, ARRAY_UNSET};
- static char *arrayOptions[] = {
+ ARRAY_STARTSEARCH, ARRAY_STATISTICS, ARRAY_UNSET};
+ static CONST char *arrayOptions[] = {
"anymore", "donesearch", "exists", "get", "names", "nextelement",
- "set", "size", "startsearch", "unset", (char *) NULL
+ "set", "size", "startsearch", "statistics", "unset", (char *) NULL
};
Interp *iPtr = (Interp *) interp;
Var *varPtr, *arrayPtr;
Tcl_HashEntry *hPtr;
- Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
+ Tcl_Obj *resultPtr, *varNamePtr;
int notArray;
- char *varName, *msg;
+ char *varName;
int index, result;
@@ -2887,38 +2859,50 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
}
/*
- * Locate the array variable (and it better be an array).
+ * Locate the array variable
*/
- varName = TclGetString(objv[2]);
- varPtr = TclLookupVar(interp, varName, (char *) NULL, /*flags*/ 0,
+ varNamePtr = objv[2];
+ varName = TclGetString(varNamePtr);
+ varPtr = TclObjLookupVar(interp, varNamePtr, NULL, /*flags*/ 0,
/*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
- notArray = 0;
- if ((varPtr == NULL) || !TclIsVarArray(varPtr)
- || TclIsVarUndefined(varPtr)) {
- notArray = 1;
- }
-
/*
* Special array trace used to keep the env array in sync for
* array names, array get, etc.
*/
- if (varPtr != NULL && varPtr->tracePtr != NULL) {
- msg = CallTraces(iPtr, arrayPtr, varPtr, varName, NULL,
+ if (varPtr != NULL && varPtr->tracePtr != NULL
+ && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
+ if (TCL_ERROR == CallVarTraces(iPtr, arrayPtr, varPtr, varName, NULL,
(TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
- TCL_TRACE_ARRAY));
- if (msg != NULL) {
- VarErrMsg(interp, varName, NULL, "trace array", msg);
+ TCL_TRACE_ARRAY), /* leaveErrMsg */ 1)) {
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.
+ */
+
+ notArray = 0;
+ if ((varPtr == NULL) || !TclIsVarArray(varPtr)
+ || TclIsVarUndefined(varPtr)) {
+ notArray = 1;
+ }
+
+ /*
+ * We have to wait to get the resultPtr until here because
+ * CallVarTraces can affect the result.
+ */
+
+ resultPtr = Tcl_GetObjResult(interp);
+
switch (index) {
case ARRAY_ANYMORE: {
ArraySearch *searchPtr;
- char *searchId;
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv,
@@ -2928,8 +2912,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
if (notArray) {
goto error;
}
- searchId = Tcl_GetString(objv[3]);
- searchPtr = ParseSearchId(interp, varPtr, varName, searchId);
+ searchPtr = ParseSearchId(interp, varPtr, varName, objv[3]);
if (searchPtr == NULL) {
return TCL_ERROR;
}
@@ -2953,7 +2936,6 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
}
case ARRAY_DONESEARCH: {
ArraySearch *searchPtr, *prevPtr;
- char *searchId;
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv,
@@ -2963,8 +2945,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
if (notArray) {
goto error;
}
- searchId = Tcl_GetString(objv[3]);
- searchPtr = ParseSearchId(interp, varPtr, varName, searchId);
+ searchPtr = ParseSearchId(interp, varPtr, varName, objv[3]);
if (searchPtr == NULL) {
return TCL_ERROR;
}
@@ -2995,7 +2976,8 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
Var *varPtr2;
char *pattern = NULL;
char *name;
- Tcl_Obj *namePtr, *valuePtr;
+ Tcl_Obj *namePtr, *valuePtr, *nameLstPtr, *tmpResPtr, **namePtrPtr;
+ int i, count;
if ((objc != 3) && (objc != 4)) {
Tcl_WrongNumArgs(interp, 2, objv, "arrayName ?pattern?");
@@ -3007,6 +2989,14 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
if (objc == 4) {
pattern = TclGetString(objv[3]);
}
+
+ /*
+ * Store the array names in a new object.
+ */
+
+ nameLstPtr = Tcl_NewObj();
+ Tcl_IncrRefCount(nameLstPtr);
+
for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, &search);
hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
@@ -3019,27 +3009,75 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
}
namePtr = Tcl_NewStringObj(name, -1);
- result = Tcl_ListObjAppendElement(interp, resultPtr,
+ result = Tcl_ListObjAppendElement(interp, nameLstPtr,
namePtr);
if (result != TCL_OK) {
Tcl_DecrRefCount(namePtr); /* free unneeded name obj */
+ Tcl_DecrRefCount(nameLstPtr);
return result;
}
+ }
+
+ /*
+ * Make sure the Var structure of the array is not removed by
+ * a trace while we're working.
+ */
+
+ varPtr->refCount++;
+
+ /*
+ * Get the array values corresponding to each element name
+ */
+ tmpResPtr = Tcl_NewObj();
+ result = Tcl_ListObjGetElements(interp, nameLstPtr,
+ &count, &namePtrPtr);
+ 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) {
- Tcl_DecrRefCount(namePtr); /* free unneeded name obj */
- return result;
+ /*
+ * 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) && !TclIsVarUndefined(varPtr)) {
+ /*
+ * The array itself looks OK, the variable was
+ * undefined: forget it.
+ */
+
+ continue;
+ } else {
+ result = TCL_ERROR;
+ goto errorInArrayGet;
+ }
}
- result = Tcl_ListObjAppendElement(interp, resultPtr,
- valuePtr);
+ result = Tcl_ListObjAppendElement(interp, tmpResPtr, namePtr);
if (result != TCL_OK) {
- Tcl_DecrRefCount(namePtr); /* free unneeded name obj */
- return result;
+ goto errorInArrayGet;
+ }
+ result = Tcl_ListObjAppendElement(interp, tmpResPtr, valuePtr);
+ if (result != TCL_OK) {
+ goto errorInArrayGet;
}
}
+ varPtr->refCount--;
+ Tcl_SetObjResult(interp, tmpResPtr);
+ Tcl_DecrRefCount(nameLstPtr);
break;
+
+ errorInArrayGet:
+ varPtr->refCount--;
+ Tcl_DecrRefCount(nameLstPtr);
+ Tcl_DecrRefCount(tmpResPtr); /* free unneeded temp result obj */
+ return result;
}
case ARRAY_NAMES: {
Tcl_HashSearch search;
@@ -3047,9 +3085,17 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
char *pattern = NULL;
char *name;
Tcl_Obj *namePtr;
+ 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 != 4)) {
- Tcl_WrongNumArgs(interp, 2, objv, "arrayName ?pattern?");
+ if ((objc < 3) && (objc > 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "arrayName ?mode? ?pattern?");
return TCL_ERROR;
}
if (notArray) {
@@ -3057,7 +3103,13 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
}
if (objc == 4) {
pattern = Tcl_GetString(objv[3]);
- }
+ } else if (objc == 5) {
+ pattern = Tcl_GetString(objv[4]);
+ if (Tcl_GetIndexFromObj(interp, objv[3], options, "option",
+ 0, &mode) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, &search);
hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
@@ -3065,8 +3117,25 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
continue;
}
name = Tcl_GetHashKey(varPtr->value.tablePtr, hPtr);
- if ((objc == 4) && !Tcl_StringMatch(name, pattern)) {
- continue; /* element name doesn't match pattern */
+ 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) {
+ return TCL_ERROR;
+ }
+ break;
+ }
+ if (matched == 0) {
+ continue;
+ }
}
namePtr = Tcl_NewStringObj(name, -1);
@@ -3080,7 +3149,6 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
}
case ARRAY_NEXTELEMENT: {
ArraySearch *searchPtr;
- char *searchId;
Tcl_HashEntry *hPtr;
if (objc != 4) {
@@ -3091,8 +3159,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
if (notArray) {
goto error;
}
- searchId = Tcl_GetString(objv[3]);
- searchPtr = ParseSearchId(interp, varPtr, varName, searchId);
+ searchPtr = ParseSearchId(interp, varPtr, varName, objv[3]);
if (searchPtr == NULL) {
return TCL_ERROR;
}
@@ -3178,7 +3245,27 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
varPtr->searchPtr = searchPtr;
break;
}
- case ARRAY_UNSET: {
+
+ case ARRAY_STATISTICS: {
+ CONST char *stats;
+
+ if (notArray) {
+ goto error;
+ }
+
+ stats = Tcl_HashStats(varPtr->value.tablePtr);
+ if (stats != NULL) {
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), stats, -1);
+ ckfree((void *)stats);
+ } else {
+ Tcl_SetResult(interp, "error reading array statistics",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+ break;
+ }
+
+ case ARRAY_UNSET: {
Tcl_HashSearch search;
Var *varPtr2;
char *pattern = NULL;
@@ -3195,7 +3282,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
/*
* When no pattern is given, just unset the whole array
*/
- if (Tcl_UnsetVar2(interp, varName, (char *) NULL, 0)
+ if (TclObjUnsetVar2(interp, varNamePtr, NULL, 0)
!= TCL_OK) {
return TCL_ERROR;
}
@@ -3210,7 +3297,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
}
name = Tcl_GetHashKey(varPtr->value.tablePtr, hPtr);
if (Tcl_StringMatch(name, pattern) &&
- (Tcl_UnsetVar2(interp, varName, name, 0)
+ (TclObjUnsetVar2(interp, varNamePtr, name, 0)
!= TCL_OK)) {
return TCL_ERROR;
}
@@ -3254,26 +3341,26 @@ TclArraySet(interp, arrayNameObj, arrayElemObj)
{
Var *varPtr, *arrayPtr;
Tcl_Obj **elemPtrs;
- int result, elemLen, i;
+ int result, elemLen, i, nameLen;
char *varName, *p;
- varName = TclGetString(arrayNameObj);
- for (p = varName; *p ; p++) {
- if (*p == '(') {
- do {
- p++;
- } while (*p != '\0');
- p--;
- if (*p == ')') {
+ varName = Tcl_GetStringFromObj(arrayNameObj, &nameLen);
+ p = varName + nameLen - 1;
+ if (*p == ')') {
+ while (--p >= varName) {
+ if (*p == '(') {
VarErrMsg(interp, varName, NULL, "set", needArray);
return TCL_ERROR;
}
- break;
}
}
- varPtr = TclLookupVar(interp, varName, (char *) NULL, /*flags*/ 0,
- /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+ varPtr = TclObjLookupVar(interp, arrayNameObj, NULL,
+ /*flags*/ TCL_LEAVE_ERR_MSG, /*msg*/ "set", /*createPart1*/ 1,
+ /*createPart2*/ 0, &arrayPtr);
+ if (varPtr == NULL) {
+ return TCL_ERROR;
+ }
if (arrayElemObj != NULL) {
result = Tcl_ListObjGetElements(interp, arrayElemObj,
@@ -3288,9 +3375,19 @@ TclArraySet(interp, arrayNameObj, arrayElemObj)
return TCL_ERROR;
}
if (elemLen > 0) {
+ /*
+ * 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.
+ */
+
for (i = 0; i < elemLen; i += 2) {
- if (Tcl_ObjSetVar2(interp, arrayNameObj, elemPtrs[i],
- elemPtrs[i+1], TCL_LEAVE_ERR_MSG) == NULL) {
+ 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;
}
@@ -3320,22 +3417,6 @@ TclArraySet(interp, arrayNameObj, arrayElemObj)
VarErrMsg(interp, varName, (char *)NULL, "array set", needArray);
return TCL_ERROR;
}
- } else {
- /*
- * Create variable for new array.
- */
-
- varPtr = TclLookupVar(interp, varName, (char *) NULL,
- TCL_LEAVE_ERR_MSG, "set",
- /*createPart1*/ 1, /*createPart2*/ 0, &arrayPtr);
-
- /*
- * Still couldn't do it - this can occur if a non-existent
- * namespace was specified
- */
- if (varPtr == NULL) {
- return TCL_ERROR;
- }
}
TclSetVarArray(varPtr);
TclClearVarUndefined(varPtr);
@@ -3348,7 +3429,7 @@ TclArraySet(interp, arrayNameObj, arrayElemObj)
/*
*----------------------------------------------------------------------
*
- * MakeUpvar --
+ * ObjMakeUpvar --
*
* This procedure does all of the work of the "global" and "upvar"
* commands.
@@ -3366,158 +3447,101 @@ TclArraySet(interp, arrayNameObj, arrayElemObj)
*/
static int
-MakeUpvar(iPtr, framePtr, otherP1, otherP2, otherFlags, myName, myFlags)
- Interp *iPtr; /* Interpreter containing variables. Used
- * for error messages, too. */
+ObjMakeUpvar(interp, framePtr, otherP1Ptr, otherP2, otherFlags, myName, myFlags, index)
+ Tcl_Interp *interp; /* Interpreter containing variables. Used
+ * for error messages, too. */
CallFrame *framePtr; /* Call frame containing "other" variable.
* NULL means use global :: context. */
- char *otherP1, *otherP2; /* Two-part name of variable in framePtr. */
- 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. */
- char *myName; /* Name of variable which will refer 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:
+ CONST 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_HashEntry *hPtr;
+ Interp *iPtr = (Interp *) interp;
Var *otherPtr, *varPtr, *arrayPtr;
CallFrame *varFramePtr;
- CallFrame *savedFramePtr = NULL; /* Init. to avoid compiler warning. */
- Tcl_HashTable *tablePtr;
- Namespace *nsPtr, *altNsPtr, *dummyNsPtr;
- char *tail;
- int new;
+ CONST char *errMsg;
/*
* Find "other" in "framePtr". If not looking up other in just the
* current namespace, temporarily replace the current var frame
- * pointer in the interpreter in order to use TclLookupVar.
+ * pointer in the interpreter in order to use TclObjLookupVar.
*/
+ varFramePtr = iPtr->varFramePtr;
if (!(otherFlags & TCL_NAMESPACE_ONLY)) {
- savedFramePtr = iPtr->varFramePtr;
iPtr->varFramePtr = framePtr;
}
- otherPtr = TclLookupVar((Tcl_Interp *) iPtr, otherP1, otherP2,
+ otherPtr = TclObjLookupVar(interp, otherP1Ptr, otherP2,
(otherFlags | TCL_LEAVE_ERR_MSG), "access",
/*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
if (!(otherFlags & TCL_NAMESPACE_ONLY)) {
- iPtr->varFramePtr = savedFramePtr;
+ iPtr->varFramePtr = varFramePtr;
}
if (otherPtr == NULL) {
return TCL_ERROR;
}
- /*
- * Now create a hashtable entry for "myName". Create it as either a
- * namespace variable or as a local variable in a procedure call
- * frame. Interpret myName 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),
- * 3) the active frame was pushed to define the namespace context
- * for a "namespace eval" or "namespace inscope" command,
- * 4) the name has namespace qualifiers ("::"s).
- * If creating myName in the active procedure, look first in the
- * frame's array of compiler-allocated local variables, then in its
- * hashtable for runtime-created local variables. Create that
- * procedure's local variable hashtable if necessary.
- */
-
- varFramePtr = iPtr->varFramePtr;
- if ((myFlags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
- || (varFramePtr == NULL)
- || !varFramePtr->isProcCallFrame
- || (strstr(myName, "::") != NULL)) {
- TclGetNamespaceForQualName((Tcl_Interp *) iPtr, myName,
- (Namespace *) NULL, myFlags, &nsPtr, &altNsPtr, &dummyNsPtr, &tail);
-
- if (nsPtr == NULL) {
- nsPtr = altNsPtr;
- }
- if (nsPtr == NULL) {
- Tcl_AppendResult((Tcl_Interp *) iPtr, "bad variable name \"",
- myName, "\": unknown namespace", (char *) NULL);
- return TCL_ERROR;
- }
-
+ if (index >= 0) {
+ if (!varFramePtr->isProcCallFrame) {
+ 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.
*/
-
- if ((otherP2 ? arrayPtr->nsPtr : otherPtr->nsPtr) == NULL) {
+
+ if (((otherP2 ? arrayPtr->nsPtr : otherPtr->nsPtr) == NULL)
+ && ((myFlags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
+ || (varFramePtr == NULL)
+ || !varFramePtr->isProcCallFrame
+ || (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);
- return TCL_ERROR;
- }
+ myName, "\": upvar won't create namespace variable that ",
+ "refers to procedure variable", (char *) NULL);
+ return TCL_ERROR;
+ }
- hPtr = Tcl_CreateHashEntry(&nsPtr->varTable, tail, &new);
- if (new) {
- varPtr = NewVar();
- Tcl_SetHashValue(hPtr, varPtr);
- varPtr->hPtr = hPtr;
- varPtr->nsPtr = nsPtr;
- } else {
- varPtr = (Var *) Tcl_GetHashValue(hPtr);
+ /*
+ * Lookup and eventually create the new variable.
+ */
+
+ varPtr = TclLookupSimpleVar(interp, myName, myFlags, /*create*/ 1,
+ &errMsg, &index);
+ if (varPtr == NULL) {
+ VarErrMsg(interp, myName, NULL, "create", errMsg);
+ return TCL_ERROR;
}
- } else { /* look in the call frame */
- Proc *procPtr = varFramePtr->procPtr;
- int localCt = procPtr->numCompiledLocals;
- CompiledLocal *localPtr = procPtr->firstLocalPtr;
- Var *localVarPtr = varFramePtr->compiledLocals;
- int nameLen = strlen(myName);
- int i;
+ }
- varPtr = NULL;
- for (i = 0; i < localCt; i++) {
- if (!TclIsVarTemporary(localPtr)) {
- char *localName = localVarPtr->name;
- if ((myName[0] == localName[0])
- && (nameLen == localPtr->nameLength)
- && (strcmp(myName, localName) == 0)) {
- varPtr = localVarPtr;
- new = 0;
- break;
- }
- }
- localVarPtr++;
- localPtr = localPtr->nextPtr;
- }
- if (varPtr == NULL) { /* look in frame's local var hashtable */
- tablePtr = varFramePtr->varTablePtr;
- if (tablePtr == NULL) {
- tablePtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
- Tcl_InitHashTable(tablePtr, TCL_STRING_KEYS);
- varFramePtr->varTablePtr = tablePtr;
- }
- hPtr = Tcl_CreateHashEntry(tablePtr, myName, &new);
- if (new) {
- varPtr = NewVar();
- Tcl_SetHashValue(hPtr, varPtr);
- varPtr->hPtr = hPtr;
- varPtr->nsPtr = varFramePtr->nsPtr;
- } else {
- varPtr = (Var *) Tcl_GetHashValue(hPtr);
- }
- }
+ if (varPtr == otherPtr) {
+ Tcl_SetResult((Tcl_Interp *) iPtr,
+ "can't upvar from variable to itself", TCL_STATIC);
+ return TCL_ERROR;
}
- if (!new) {
+ if (varPtr->tracePtr != NULL) {
+ Tcl_AppendResult((Tcl_Interp *) iPtr, "variable \"", myName,
+ "\" has traces: can't use for upvar", (char *) NULL);
+ return TCL_ERROR;
+ } else if (!TclIsVarUndefined(varPtr)) {
/*
- * The variable already exists. Make sure this variable "varPtr"
+ * The variable already existed. Make sure this variable "varPtr"
* isn't the same as "otherPtr" (avoid circular links). Also, if
* it's not an upvar then it's an error. If it is an upvar, then
* just disconnect it from the thing it currently refers to.
*/
- if (varPtr == otherPtr) {
- Tcl_SetResult((Tcl_Interp *) iPtr,
- "can't upvar from variable to itself", TCL_STATIC);
- return TCL_ERROR;
- }
if (TclIsVarLink(varPtr)) {
Var *linkPtr = varPtr->value.linkPtr;
if (linkPtr == otherPtr) {
@@ -3527,14 +3551,10 @@ MakeUpvar(iPtr, framePtr, otherP1, otherP2, otherFlags, myName, myFlags)
if (TclIsVarUndefined(linkPtr)) {
CleanupVar(linkPtr, (Var *) NULL);
}
- } else if (!TclIsVarUndefined(varPtr)) {
+ } else {
Tcl_AppendResult((Tcl_Interp *) iPtr, "variable \"", myName,
"\" already exists", (char *) NULL);
return TCL_ERROR;
- } else if (varPtr->tracePtr != NULL) {
- Tcl_AppendResult((Tcl_Interp *) iPtr, "variable \"", myName,
- "\" has traces: can't use for upvar", (char *) NULL);
- return TCL_ERROR;
}
}
TclSetVarLink(varPtr);
@@ -3569,52 +3589,16 @@ int
Tcl_UpVar(interp, frameName, varName, localName, flags)
Tcl_Interp *interp; /* Command interpreter in which varName is
* to be looked up. */
- 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". */
- 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. */
- char *localName; /* Name of link variable. */
+ CONST char *localName; /* Name of link variable. */
int flags; /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
* indicates scope of localName. */
{
- int result;
- CallFrame *framePtr;
- register char *p;
-
- result = TclGetFrame(interp, frameName, &framePtr);
- if (result == -1) {
- return TCL_ERROR;
- }
-
- /*
- * Figure out whether varName is an array reference, then call
- * MakeUpvar to do all the real work.
- */
-
- for (p = varName; *p != '\0'; p++) {
- if (*p == '(') {
- char *openParen = p;
- do {
- p++;
- } while (*p != '\0');
- p--;
- if (*p != ')') {
- goto scalar;
- }
- *openParen = '\0';
- *p = '\0';
- result = MakeUpvar((Interp *) interp, framePtr, varName,
- openParen+1, 0, localName, flags);
- *openParen = '(';
- *p = ')';
- return result;
- }
- }
-
- scalar:
- return MakeUpvar((Interp *) interp, framePtr, varName, (char *) NULL,
- 0, localName, flags);
+ return Tcl_UpVar2(interp, frameName, varName, NULL, localName, flags);
}
/*
@@ -3642,23 +3626,30 @@ int
Tcl_UpVar2(interp, frameName, part1, part2, localName, flags)
Tcl_Interp *interp; /* Interpreter containing variables. Used
* for error messages too. */
- 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". */
- char *part1, *part2; /* Two parts of source variable name to
+ CONST char *part1;
+ CONST char *part2; /* Two parts of source variable name to
* link to. */
- char *localName; /* Name of link variable. */
+ CONST char *localName; /* Name of link variable. */
int flags; /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
* indicates scope of localName. */
{
int result;
CallFrame *framePtr;
+ Tcl_Obj *part1Ptr;
- result = TclGetFrame(interp, frameName, &framePtr);
- if (result == -1) {
+ if (TclGetFrame(interp, frameName, &framePtr) == -1) {
return TCL_ERROR;
}
- return MakeUpvar((Interp *) interp, framePtr, part1, part2, 0,
- localName, flags);
+
+ part1Ptr = Tcl_NewStringObj(part1, -1);
+ Tcl_IncrRefCount(part1Ptr);
+ result = ObjMakeUpvar(interp, framePtr, part1Ptr, part2, 0,
+ localName, flags, -1);
+ TclDecrRefCount(part1Ptr);
+
+ return result;
}
/*
@@ -3779,7 +3770,7 @@ Tcl_GlobalObjCmd(dummy, interp, objc, objv)
while ((tail > varName) && ((*tail != ':') || (*(tail-1) != ':'))) {
tail--;
}
- if (*tail == ':') {
+ if ((*tail == ':') && (tail > varName)) {
tail++;
}
@@ -3787,9 +3778,9 @@ Tcl_GlobalObjCmd(dummy, interp, objc, objv)
* Link to the variable "varName" in the global :: namespace.
*/
- result = MakeUpvar(iPtr, (CallFrame *) NULL,
- varName, (char *) NULL, /*otherFlags*/ TCL_GLOBAL_ONLY,
- /*myName*/ tail, /*myFlags*/ 0);
+ result = ObjMakeUpvar(interp, (CallFrame *) NULL,
+ objPtr, NULL, /*otherFlags*/ TCL_GLOBAL_ONLY,
+ /*myName*/ tail, /*myFlags*/ 0, -1);
if (result != TCL_OK) {
return result;
}
@@ -3844,6 +3835,12 @@ Tcl_VariableObjCmd(dummy, interp, objc, objv)
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;
+ }
for (i = 1; i < objc; i = i+2) {
/*
@@ -3851,8 +3848,9 @@ Tcl_VariableObjCmd(dummy, interp, objc, objv)
* it if necessary.
*/
- varName = TclGetString(objv[i]);
- varPtr = TclLookupVar(interp, varName, (char *) NULL,
+ varNamePtr = objv[i];
+ varName = TclGetString(varNamePtr);
+ varPtr = TclObjLookupVar(interp, varNamePtr, NULL,
(TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "define",
/*createPart1*/ 1, /*createPart2*/ 0, &arrayPtr);
@@ -3889,8 +3887,8 @@ Tcl_VariableObjCmd(dummy, interp, objc, objv)
*/
if (i+1 < objc) { /* a value was specified */
- varValuePtr = Tcl_ObjSetVar2(interp, objv[i], NULL, objv[i+1],
- (TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG));
+ varValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, varName, NULL,
+ objv[i+1], (TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG));
if (varValuePtr == NULL) {
return TCL_ERROR;
}
@@ -3924,10 +3922,10 @@ Tcl_VariableObjCmd(dummy, interp, objc, objv)
* current namespace.
*/
- result = MakeUpvar(iPtr, (CallFrame *) NULL,
- /*otherP1*/ varName, /*otherP2*/ (char *) NULL,
+ result = ObjMakeUpvar(interp, (CallFrame *) NULL,
+ /*otherP1*/ varNamePtr, /*otherP2*/ NULL,
/*otherFlags*/ TCL_NAMESPACE_ONLY,
- /*myName*/ tail, /*myFlags*/ 0);
+ /*myName*/ tail, /*myFlags*/ 0, -1);
if (result != TCL_OK) {
return result;
}
@@ -3961,10 +3959,8 @@ Tcl_UpvarObjCmd(dummy, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- register Interp *iPtr = (Interp *) interp;
CallFrame *framePtr;
- char *frameSpec, *otherVarName, *myVarName;
- register char *p;
+ char *frameSpec, *localName;
int result;
if (objc < 3) {
@@ -3997,34 +3993,9 @@ Tcl_UpvarObjCmd(dummy, interp, objc, objv)
*/
for ( ; objc > 0; objc -= 2, objv += 2) {
- myVarName = TclGetString(objv[1]);
- otherVarName = TclGetString(objv[0]);
- for (p = otherVarName; *p != 0; p++) {
- if (*p == '(') {
- char *openParen = p;
-
- do {
- p++;
- } while (*p != '\0');
- p--;
- if (*p != ')') {
- goto scalar;
- }
- *openParen = '\0';
- *p = '\0';
- result = MakeUpvar(iPtr, framePtr,
- otherVarName, openParen+1, /*otherFlags*/ 0,
- myVarName, /*flags*/ 0);
- *openParen = '(';
- *p = ')';
- goto checkResult;
- }
- }
- scalar:
- result = MakeUpvar(iPtr, framePtr, otherVarName, (char *) NULL, 0,
- myVarName, /*flags*/ 0);
-
- checkResult:
+ localName = TclGetString(objv[1]);
+ result = ObjMakeUpvar(interp, framePtr, /* othervarName */ objv[0],
+ NULL, 0, /* myVarName */ localName, /*flags*/ 0, -1);
if (result != TCL_OK) {
return TCL_ERROR;
}
@@ -4035,7 +4006,39 @@ Tcl_UpvarObjCmd(dummy, interp, objc, objv)
/*
*----------------------------------------------------------------------
*
- * CallTraces --
+ * DisposeTraceResult--
+ *
+ * This procedure is called to dispose of the result returned from
+ * a trace procedure. The disposal method appropriate to the type
+ * of result is determined by flags.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The memory allocated for the trace result may be freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+DisposeTraceResult(flags, result)
+ int flags; /* Indicates type of result to determine
+ * proper disposal method */
+ char *result; /* The result returned from a trace
+ * procedure to be disposed */
+{
+ if (flags & TCL_TRACE_RESULT_DYNAMIC) {
+ ckfree(result);
+ } else if (flags & TCL_TRACE_RESULT_OBJECT) {
+ Tcl_DecrRefCount((Tcl_Obj *) result);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CallVarTraces --
*
* This procedure is invoked to find and invoke relevant
* trace procedures associated with a particular operation on
@@ -4043,12 +4046,11 @@ Tcl_UpvarObjCmd(dummy, interp, objc, objv)
* variable and on its containing array (where relevant).
*
* Results:
- * The return value is NULL if no trace procedures were invoked, or
- * if all the invoked trace procedures returned successfully.
- * The return value is non-NULL if a trace procedure returned an
- * error (in this case no more trace procedures were invoked after
- * the error was returned). In this case the return value is a
- * pointer to a static string describing the error.
+ * Returns TCL_OK to indicate normal operation. Returns TCL_ERROR
+ * if invocation of a trace procedure indicated an error. When
+ * TCL_ERROR is returned and leaveErrMsg is true, then the
+ * ::errorInfo variable of iPtr has information about the error
+ * appended to it.
*
* Side effects:
* Almost anything can happen, depending on trace; this procedure
@@ -4057,26 +4059,33 @@ Tcl_UpvarObjCmd(dummy, interp, objc, objv)
*----------------------------------------------------------------------
*/
-static char *
-CallTraces(iPtr, arrayPtr, varPtr, part1, part2, flags)
+int
+CallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg)
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. */
- char *part1, *part2; /* Variable's two-part name. */
+ CONST char *part1;
+ CONST char *part2; /* Variable's two-part name. */
int flags; /* Flags passed to trace procedures:
* indicates what's happening to variable,
* plus other stuff like TCL_GLOBAL_ONLY,
* TCL_NAMESPACE_ONLY, and
* TCL_INTERP_DESTROYED. */
+ CONST 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, *openParen, *p;
+ char *result;
+ CONST char *openParen, *p;
Tcl_DString nameCopy;
int copiedName;
+ int code = TCL_OK;
+ int disposeFlags = 0;
/*
* If there are already similar trace procedures active for the
@@ -4084,10 +4093,13 @@ CallTraces(iPtr, arrayPtr, varPtr, part1, part2, flags)
*/
if (varPtr->flags & VAR_TRACE_ACTIVE) {
- return NULL;
+ return code;
}
varPtr->flags |= VAR_TRACE_ACTIVE;
varPtr->refCount++;
+ if (arrayPtr != NULL) {
+ arrayPtr->refCount++;
+ }
/*
* If the variable name hasn't been parsed into array name and
@@ -4108,12 +4120,14 @@ CallTraces(iPtr, arrayPtr, varPtr, part1, part2, flags)
} while (*p != '\0');
p--;
if (*p == ')') {
+ int offset = (openParen - part1);
+ char *newPart1;
Tcl_DStringInit(&nameCopy);
Tcl_DStringAppend(&nameCopy, part1, (p-part1));
- part2 = Tcl_DStringValue(&nameCopy)
- + (openParen + 1 - part1);
- part2[-1] = 0;
- part1 = Tcl_DStringValue(&nameCopy);
+ newPart1 = Tcl_DStringValue(&nameCopy);
+ newPart1[offset] = 0;
+ part1 = newPart1;
+ part2 = newPart1 + offset + 1;
copiedName = 1;
}
break;
@@ -4126,10 +4140,10 @@ CallTraces(iPtr, arrayPtr, varPtr, part1, part2, flags)
*/
result = NULL;
- active.nextPtr = iPtr->activeTracePtr;
- iPtr->activeTracePtr = &active;
- if (arrayPtr != NULL) {
- arrayPtr->refCount++;
+ active.nextPtr = iPtr->activeVarTracePtr;
+ iPtr->activeVarTracePtr = &active;
+ Tcl_Preserve((ClientData) iPtr);
+ if (arrayPtr != NULL && !(arrayPtr->flags & VAR_TRACE_ACTIVE)) {
active.varPtr = arrayPtr;
for (tracePtr = arrayPtr->tracePtr; tracePtr != NULL;
tracePtr = active.nextTracePtr) {
@@ -4137,15 +4151,22 @@ CallTraces(iPtr, arrayPtr, varPtr, part1, part2, flags)
if (!(tracePtr->flags & flags)) {
continue;
}
+ Tcl_Preserve((ClientData) tracePtr);
result = (*tracePtr->traceProc)(tracePtr->clientData,
(Tcl_Interp *) iPtr, part1, part2, flags);
if (result != NULL) {
if (flags & TCL_TRACE_UNSETS) {
- result = NULL;
+ /* Ignore errors in unset traces */
+ DisposeTraceResult(tracePtr->flags, result);
} else {
- goto done;
+ disposeFlags = tracePtr->flags;
+ code = TCL_ERROR;
}
}
+ Tcl_Release((ClientData) tracePtr);
+ if (code == TCL_ERROR) {
+ goto done;
+ }
}
}
@@ -4163,15 +4184,22 @@ CallTraces(iPtr, arrayPtr, varPtr, part1, part2, flags)
if (!(tracePtr->flags & flags)) {
continue;
}
+ Tcl_Preserve((ClientData) tracePtr);
result = (*tracePtr->traceProc)(tracePtr->clientData,
(Tcl_Interp *) iPtr, part1, part2, flags);
if (result != NULL) {
if (flags & TCL_TRACE_UNSETS) {
- result = NULL;
+ /* Ignore errors in unset traces */
+ DisposeTraceResult(tracePtr->flags, result);
} else {
- goto done;
+ disposeFlags = tracePtr->flags;
+ code = TCL_ERROR;
}
}
+ Tcl_Release((ClientData) tracePtr);
+ if (code == TCL_ERROR) {
+ goto done;
+ }
}
/*
@@ -4180,6 +4208,33 @@ CallTraces(iPtr, arrayPtr, varPtr, part1, part2, flags)
*/
done:
+ if (code == TCL_ERROR) {
+ if (leaveErrMsg) {
+ CONST char *type = "";
+ switch (flags&(TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_ARRAY)) {
+ case TCL_TRACE_READS: {
+ type = "read";
+ break;
+ }
+ case TCL_TRACE_WRITES: {
+ type = "set";
+ break;
+ }
+ case TCL_TRACE_ARRAY: {
+ type = "trace array";
+ break;
+ }
+ }
+ if (disposeFlags & TCL_TRACE_RESULT_OBJECT) {
+ VarErrMsg((Tcl_Interp *) iPtr, part1, part2, type,
+ Tcl_GetString((Tcl_Obj *) result));
+ } else {
+ VarErrMsg((Tcl_Interp *) iPtr, part1, part2, type, result);
+ }
+ }
+ DisposeTraceResult(disposeFlags,result);
+ }
+
if (arrayPtr != NULL) {
arrayPtr->refCount--;
}
@@ -4188,8 +4243,9 @@ CallTraces(iPtr, arrayPtr, varPtr, part1, part2, flags)
}
varPtr->flags &= ~VAR_TRACE_ACTIVE;
varPtr->refCount--;
- iPtr->activeTracePtr = active.nextPtr;
- return result;
+ iPtr->activeVarTracePtr = active.nextPtr;
+ Tcl_Release((ClientData) iPtr);
+ return code;
}
/*
@@ -4233,9 +4289,75 @@ NewVar()
/*
*----------------------------------------------------------------------
*
+ * SetArraySearchObj --
+ *
+ * This function converts the given tcl object into one that
+ * has the "array search" internal type.
+ *
+ * Results:
+ * TCL_OK if the conversion succeeded, and TCL_ERROR if it failed
+ * (when an error message will be placed in the interpreter's
+ * result.)
+ *
+ * Side effects:
+ * Updates the internal type and representation of the object to
+ * make 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;
+{
+ char *string;
+ char *end;
+ int id;
+ size_t offset;
+
+ /*
+ * Get the string representation. Make it up-to-date if necessary.
+ */
+
+ string = Tcl_GetString(objPtr);
+
+ /*
+ * Parse the id into the three parts separated by dashes.
+ */
+ if ((string[0] != 's') || (string[1] != '-')) {
+ syntax:
+ Tcl_AppendResult(interp, "illegal search identifier \"", string,
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ id = strtoul(string+2, &end, 10);
+ if ((end == (string+2)) || (*end != '-')) {
+ goto syntax;
+ }
+ /*
+ * Can't perform value check in this context, so place reference
+ * to place in string to use for the check in the object instead.
+ */
+ end++;
+ offset = end - string;
+
+ if (objPtr->typePtr != NULL && objPtr->typePtr->freeIntRepProc != NULL) {
+ objPtr->typePtr->freeIntRepProc(objPtr);
+ }
+ objPtr->typePtr = &tclArraySearchType;
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *)(((char *)NULL)+id);
+ objPtr->internalRep.twoPtrValue.ptr2 = (VOID *)(((char *)NULL)+offset);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* ParseSearchId --
*
- * This procedure translates from a string to a pointer to an
+ * This procedure translates from a tcl object to a pointer to an
* active array search (if there is one that matches the string).
*
* Results:
@@ -4244,41 +4366,47 @@ NewVar()
* the interp's result contains an error message.
*
* Side effects:
- * None.
+ * The tcl object might have its internal type and representation
+ * modified.
*
*----------------------------------------------------------------------
*/
static ArraySearch *
-ParseSearchId(interp, varPtr, varName, string)
+ParseSearchId(interp, varPtr, varName, handleObj)
Tcl_Interp *interp; /* Interpreter containing variable. */
- Var *varPtr; /* Array variable search is for. */
- char *varName; /* Name of array variable that search is
+ CONST Var *varPtr; /* Array variable search is for. */
+ CONST char *varName; /* Name of array variable that search is
* supposed to be for. */
- char *string; /* String 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. */
{
- char *end;
+ register char *string;
+ register size_t offset;
int id;
ArraySearch *searchPtr;
/*
- * Parse the id into the three parts separated by dashes.
+ * Parse the id.
*/
-
- if ((string[0] != 's') || (string[1] != '-')) {
- syntax:
- Tcl_AppendResult(interp, "illegal search identifier \"", string,
- "\"", (char *) NULL);
+ if (Tcl_ConvertToType(interp, handleObj, &tclArraySearchType) != TCL_OK) {
return NULL;
}
- id = strtoul(string+2, &end, 10);
- if ((end == (string+2)) || (*end != '-')) {
- goto syntax;
- }
- if (strcmp(end+1, varName) != 0) {
+ /*
+ * Cast is safe, since always came from an int in the first place.
+ */
+ id = (int)(((char*)handleObj->internalRep.twoPtrValue.ptr1) -
+ ((char*)NULL));
+ string = Tcl_GetString(handleObj);
+ offset = (((char*)handleObj->internalRep.twoPtrValue.ptr2) -
+ ((char*)NULL));
+ /*
+ * This test cannot be placed inside the Tcl_Obj machinery, since
+ * it is dependent on the variable context.
+ */
+ if (strcmp(string+offset, varName) != 0) {
Tcl_AppendResult(interp, "search identifier \"", string,
"\" isn't for variable \"", varName, "\"", (char *) NULL);
return NULL;
@@ -4287,6 +4415,10 @@ ParseSearchId(interp, varPtr, varName, string)
/*
* Search through the list of active searches on the interpreter
* to see if the desired one exists.
+ *
+ * Note that we cannot store the searchPtr directly in the Tcl_Obj
+ * as that would run into trouble when DeleteSearches() was called
+ * so we must scan this list every time.
*/
for (searchPtr = varPtr->searchPtr; searchPtr != NULL;
@@ -4374,10 +4506,13 @@ TclDeleteVars(iPtr, tablePtr)
flags = TCL_TRACE_UNSETS;
if (tablePtr == &iPtr->globalNsPtr->varTable) {
- flags |= (TCL_INTERP_DESTROYED | TCL_GLOBAL_ONLY);
+ flags |= TCL_GLOBAL_ONLY;
} else if (tablePtr == &currNsPtr->varTable) {
flags |= TCL_NAMESPACE_ONLY;
}
+ if (Tcl_InterpDeleted(interp)) {
+ flags |= TCL_INTERP_DESTROYED;
+ }
for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL;
hPtr = Tcl_NextHashEntry(&search)) {
@@ -4411,7 +4546,7 @@ TclDeleteVars(iPtr, tablePtr)
* 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 CallTraces the variable's
+ * table is deleted). Note that we give CallVarTraces the variable's
* fully-qualified name so that any called trace procedures can
* refer to these variables being deleted.
*/
@@ -4420,16 +4555,16 @@ TclDeleteVars(iPtr, tablePtr)
objPtr = Tcl_NewObj();
Tcl_IncrRefCount(objPtr); /* until done with traces */
Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, objPtr);
- (void) CallTraces(iPtr, (Var *) NULL, varPtr,
- Tcl_GetString(objPtr), (char *) NULL, flags);
+ CallVarTraces(iPtr, (Var *) NULL, varPtr, Tcl_GetString(objPtr),
+ NULL, flags, /* leaveErrMsg */ 0);
Tcl_DecrRefCount(objPtr); /* free no longer needed obj */
while (varPtr->tracePtr != NULL) {
VarTrace *tracePtr = varPtr->tracePtr;
varPtr->tracePtr = tracePtr->nextPtr;
- ckfree((char *) tracePtr);
+ Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC);
}
- for (activePtr = iPtr->activeTracePtr; activePtr != NULL;
+ for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL;
activePtr = activePtr->nextPtr) {
if (activePtr->varPtr == varPtr) {
activePtr->nextTracePtr = NULL;
@@ -4546,14 +4681,14 @@ TclDeleteCompiledLocalVars(iPtr, framePtr)
*/
if (varPtr->tracePtr != NULL) {
- (void) CallTraces(iPtr, (Var *) NULL, varPtr,
- varPtr->name, (char *) NULL, flags);
+ CallVarTraces(iPtr, (Var *) NULL, varPtr, varPtr->name, NULL,
+ flags, /* leaveErrMsg */ 0);
while (varPtr->tracePtr != NULL) {
VarTrace *tracePtr = varPtr->tracePtr;
varPtr->tracePtr = tracePtr->nextPtr;
- ckfree((char *) tracePtr);
+ Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC);
}
- for (activePtr = iPtr->activeTracePtr; activePtr != NULL;
+ for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL;
activePtr = activePtr->nextPtr) {
if (activePtr->varPtr == varPtr) {
activePtr->nextTracePtr = NULL;
@@ -4607,10 +4742,10 @@ TclDeleteCompiledLocalVars(iPtr, framePtr)
static void
DeleteArray(iPtr, arrayName, varPtr, flags)
Interp *iPtr; /* Interpreter containing array. */
- char *arrayName; /* Name of array (used for trace
+ CONST char *arrayName; /* Name of array (used for trace
* callbacks). */
Var *varPtr; /* Pointer to variable structure. */
- int flags; /* Flags to pass to CallTraces:
+ int flags; /* Flags to pass to CallVarTraces:
* TCL_TRACE_UNSETS and sometimes
* TCL_INTERP_DESTROYED,
* TCL_NAMESPACE_ONLY, or
@@ -4634,14 +4769,15 @@ DeleteArray(iPtr, arrayName, varPtr, flags)
elPtr->hPtr = NULL;
if (elPtr->tracePtr != NULL) {
elPtr->flags &= ~VAR_TRACE_ACTIVE;
- (void) CallTraces(iPtr, (Var *) NULL, elPtr, arrayName,
- Tcl_GetHashKey(varPtr->value.tablePtr, hPtr), flags);
+ CallVarTraces(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;
- ckfree((char *) tracePtr);
+ Tcl_EventuallyFree((ClientData) tracePtr,TCL_DYNAMIC);
}
- for (activePtr = iPtr->activeTracePtr; activePtr != NULL;
+ for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL;
activePtr = activePtr->nextPtr) {
if (activePtr->varPtr == elPtr) {
activePtr->nextTracePtr = NULL;
@@ -4650,6 +4786,19 @@ DeleteArray(iPtr, arrayName, varPtr, flags)
}
TclSetVarUndefined(elPtr);
TclSetVarScalar(elPtr);
+
+ /*
+ * Even though array elements are not supposed to be namespace
+ * variables, some combinations of [upvar] and [variable] may
+ * create such beasts - see [Bug 604239]. This is necessary to
+ * avoid leaking the corresponding Var struct, and is otherwise
+ * harmless.
+ */
+
+ if (elPtr->flags & VAR_NAMESPACE_VAR) {
+ elPtr->flags &= ~VAR_NAMESPACE_VAR;
+ elPtr->refCount--;
+ }
if (elPtr->refCount == 0) {
ckfree((char *) elPtr); /* element Vars are VAR_IN_HASHTABLE */
}
@@ -4729,10 +4878,11 @@ CleanupVar(varPtr, arrayPtr)
static void
VarErrMsg(interp, part1, part2, operation, reason)
Tcl_Interp *interp; /* Interpreter in which to record message. */
- char *part1, *part2; /* Variable's two-part name. */
- char *operation; /* String describing operation that failed,
+ 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". */
- char *reason; /* String describing why operation failed. */
+ CONST char *reason; /* String describing why operation failed. */
{
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "can't ", operation, " \"", part1,
@@ -4742,7 +4892,6 @@ VarErrMsg(interp, part1, part2, operation, reason)
}
Tcl_AppendResult(interp, "\": ", reason, (char *) NULL);
}
-
/*
*----------------------------------------------------------------------
@@ -4765,11 +4914,10 @@ VarErrMsg(interp, part1, part2, operation, reason)
Var *
TclVarTraceExists(interp, varName)
Tcl_Interp *interp; /* The interpreter */
- char *varName; /* The variable name */
+ CONST char *varName; /* The variable name */
{
Var *varPtr;
Var *arrayPtr;
- char *msg;
/*
* The choice of "create" flag values is delicate here, and
@@ -4782,27 +4930,223 @@ TclVarTraceExists(interp, varName)
*/
varPtr = TclLookupVar(interp, varName, (char *) NULL,
- 0, "access",
- /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr);
+ 0, "access", /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr);
+
if (varPtr == NULL) {
return NULL;
}
- if ((varPtr != NULL) &&
- ((varPtr->tracePtr != NULL)
- || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL)))) {
- msg = CallTraces((Interp *)interp, arrayPtr, varPtr, varName,
- (char *) NULL, TCL_TRACE_READS);
- if (msg != NULL) {
- /*
- * If the variable doesn't exist anymore and no-one's using
- * it, then free up the relevant structures and hash table entries.
- */
- if (TclIsVarUndefined(varPtr)) {
- CleanupVar(varPtr, arrayPtr);
+ if ((varPtr->tracePtr != NULL)
+ || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
+ CallVarTraces((Interp *)interp, arrayPtr, varPtr, varName, NULL,
+ TCL_TRACE_READS, /* leaveErrMsg */ 0);
+ }
+
+ /*
+ * If the variable doesn't exist anymore and no-one's using
+ * it, then free up the relevant structures and hash table entries.
+ */
+
+ if (TclIsVarUndefined(varPtr)) {
+ CleanupVar(varPtr, arrayPtr);
+ return NULL;
+ }
+
+ return varPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Internal functions for variable name object types --
+ *
+ *----------------------------------------------------------------------
+ */
+
+/*
+ * localVarName -
+ *
+ * INTERNALREP DEFINITION:
+ * twoPtrValue.ptr1 = pointer to the corresponding Proc
+ * twoPtrValue.ptr2 = index into locals table
+*/
+
+static void
+FreeLocalVarName(objPtr)
+ Tcl_Obj *objPtr;
+{
+ register Proc *procPtr = (Proc *) objPtr->internalRep.twoPtrValue.ptr1;
+ procPtr->refCount--;
+ if (procPtr->refCount <= 0) {
+ TclProcCleanupProc(procPtr);
+ }
+}
+
+static void
+DupLocalVarName(srcPtr, dupPtr)
+ Tcl_Obj *srcPtr;
+ Tcl_Obj *dupPtr;
+{
+ register Proc *procPtr = (Proc *) srcPtr->internalRep.twoPtrValue.ptr1;
+
+ dupPtr->internalRep.twoPtrValue.ptr1 = (VOID *) procPtr;
+ dupPtr->internalRep.twoPtrValue.ptr2 = srcPtr->internalRep.twoPtrValue.ptr2;
+ procPtr->refCount++;
+ dupPtr->typePtr = &tclLocalVarNameType;
+}
+
+static void
+UpdateLocalVarName(objPtr)
+ Tcl_Obj *objPtr;
+{
+ Proc *procPtr = (Proc *) objPtr->internalRep.twoPtrValue.ptr1;
+ unsigned int index = (unsigned int) objPtr->internalRep.twoPtrValue.ptr2;
+ CompiledLocal *localPtr = procPtr->firstLocalPtr;
+ unsigned int nameLen;
+
+ if (localPtr == NULL) {
+ goto emptyName;
+ }
+ while (index--) {
+ localPtr = localPtr->nextPtr;
+ if (localPtr == NULL) {
+ goto emptyName;
+ }
+ }
+
+ nameLen = (unsigned int) localPtr->nameLength;
+ objPtr->bytes = ckalloc(nameLen + 1);
+ memcpy(objPtr->bytes, localPtr->name, nameLen + 1);
+ objPtr->length = nameLen;
+ return;
+
+ emptyName:
+ objPtr->bytes = ckalloc(1);
+ *(objPtr->bytes) = '\0';
+ objPtr->length = 0;
+}
+
+/*
+ * nsVarName -
+ *
+ * INTERNALREP DEFINITION:
+ * twoPtrValue.ptr1: pointer to the namespace containing the
+ * reference.
+ * twoPtrValue.ptr2: pointer to the corresponding Var
+*/
+
+static void
+FreeNsVarName(objPtr)
+ Tcl_Obj *objPtr;
+{
+ register Var *varPtr = (Var *) objPtr->internalRep.twoPtrValue.ptr2;
+
+ varPtr->refCount--;
+ if (TclIsVarUndefined(varPtr) && (varPtr->refCount <= 0)) {
+ if (TclIsVarLink(varPtr)) {
+ Var *linkPtr = varPtr->value.linkPtr;
+ linkPtr->refCount--;
+ if (TclIsVarUndefined(linkPtr) && (linkPtr->refCount <= 0)) {
+ CleanupVar(linkPtr, (Var *) NULL);
}
- return NULL;
}
+ CleanupVar(varPtr, NULL);
}
- return varPtr;
+}
+
+static void
+DupNsVarName(srcPtr, dupPtr)
+ Tcl_Obj *srcPtr;
+ Tcl_Obj *dupPtr;
+{
+ Namespace *nsPtr = (Namespace *) srcPtr->internalRep.twoPtrValue.ptr1;
+ register Var *varPtr = (Var *) srcPtr->internalRep.twoPtrValue.ptr2;
+
+ dupPtr->internalRep.twoPtrValue.ptr1 = (VOID *) nsPtr;
+ dupPtr->internalRep.twoPtrValue.ptr2 = (VOID *) varPtr;
+ varPtr->refCount++;
+ dupPtr->typePtr = &tclNsVarNameType;
+}
+
+/*
+ * parsedVarName -
+ *
+ * INTERNALREP DEFINITION:
+ * twoPtrValue.ptr1 = pointer to the array name Tcl_Obj
+ * (NULL if scalar)
+ * twoPtrValue.ptr2 = pointer to the element name string
+ * (owned by this Tcl_Obj), or NULL if
+ * it is a scalar variable
+ */
+
+static void
+FreeParsedVarName(objPtr)
+ Tcl_Obj *objPtr;
+{
+ register Tcl_Obj *arrayPtr =
+ (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr1;
+ register char *elem = (char *) objPtr->internalRep.twoPtrValue.ptr2;
+
+ if (arrayPtr != NULL) {
+ TclDecrRefCount(arrayPtr);
+ ckfree(elem);
+ }
+}
+
+static void
+DupParsedVarName(srcPtr, dupPtr)
+ Tcl_Obj *srcPtr;
+ Tcl_Obj *dupPtr;
+{
+ register Tcl_Obj *arrayPtr =
+ (Tcl_Obj *) srcPtr->internalRep.twoPtrValue.ptr1;
+ register char *elem = (char *) srcPtr->internalRep.twoPtrValue.ptr2;
+ char *elemCopy;
+ unsigned int elemLen;
+
+ if (arrayPtr != NULL) {
+ Tcl_IncrRefCount(arrayPtr);
+ elemLen = strlen(elem);
+ 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->typePtr = &tclParsedVarNameType;
+}
+
+static void
+UpdateParsedVarName(objPtr)
+ Tcl_Obj *objPtr;
+{
+ Tcl_Obj *arrayPtr = (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr1;
+ char *part2 = (char *) objPtr->internalRep.twoPtrValue.ptr2;
+ char *part1, *p;
+ int len1, len2, totalLen;
+
+ if (arrayPtr == NULL) {
+ /*
+ * This is a parsed scalar name: what is it
+ * doing here?
+ */
+ panic("ERROR: scalar parsedVarName without a string rep.\n");
+ }
+ part1 = Tcl_GetStringFromObj(arrayPtr, &len1);
+ len2 = strlen(part2);
+
+ totalLen = len1 + len2 + 2;
+ p = ckalloc((unsigned int) totalLen + 1);
+ objPtr->bytes = p;
+ objPtr->length = totalLen;
+
+ memcpy(p, part1, (unsigned int) len1);
+ p += len1;
+ *p++ = '(';
+ memcpy(p, part2, (unsigned int) len2);
+ p += len2;
+ *p++ = ')';
+ *p = '\0';
}
diff --git a/tcl/library/auto.tcl b/tcl/library/auto.tcl
index 37a47a201cb..044d24c7dd1 100644
--- a/tcl/library/auto.tcl
+++ b/tcl/library/auto.tcl
@@ -50,27 +50,18 @@ proc auto_reset {} {
# initScript Initialization script to source (e.g., tk.tcl)
# enVarName environment variable to honor (e.g., TK_LIBRARY)
# varName Global variable to set when done (e.g., tk_library)
-# CYGNUS LOCAL: We have funny things like gdb having different library
-# names before & after install (and neither of them is gdb
-# or gdb$version...
-# srcLibName The name of the library directory in the build tree (assumed to be
-# under the basename directory.
-# instLibName The name of the installed library directory
-# pkgName The package name (for cases like Itcl where you have
-# several subpackages under one package...
-# debug_startup Run the startup proc through debugger_eval?
-
-proc tcl_findLibrary {basename version patch initScript
- enVarName varName {srcLibName {}} {instLibName {}}
- {pkgName {}} {debug_startup 0}} {
+
+proc tcl_findLibrary {basename version patch initScript enVarName varName} {
upvar #0 $varName the_library
global env errorInfo
set dirs {}
set errors {}
+
# The C application may have hardwired a path, which we honor
- if {[info exist the_library] && [string compare $the_library {}]} {
+ set variableSet [info exists the_library]
+ if {$variableSet && [string compare $the_library {}]} {
lappend dirs $the_library
} else {
@@ -83,30 +74,38 @@ proc tcl_findLibrary {basename version patch initScript
}
# 2. Relative to the Tcl library
-
- if {$srcLibName == ""} {
- set srcLibName library
- }
- if {$instLibName == ""} {
- set instLibName $basename$version
- }
lappend dirs [file join [file dirname [info library]] \
$basename$version]
+ # 3. Various locations relative to the executable
+ # ../lib/foo1.0 (From bin directory in install hierarchy)
+ # ../../lib/foo1.0 (From bin/arch directory in install hierarchy)
+ # ../library (From unix directory in build hierarchy)
+ # ../../library (From unix/arch directory in build hierarchy)
+ # ../../foo1.0.1/library
+ # (From unix directory in parallel build hierarchy)
+ # ../../../foo1.0.1/library
+ # (From unix/arch directory in parallel build hierarchy)
+
set parentDir [file dirname [file dirname [info nameofexecutable]]]
set grandParentDir [file dirname $parentDir]
lappend dirs [file join $parentDir lib $basename$version]
lappend dirs [file join $grandParentDir lib $basename$version]
lappend dirs [file join $parentDir library]
lappend dirs [file join $grandParentDir library]
- if {![regexp {.*[ab][0-9]*} $patch ver]} {
- set ver $version
- }
- lappend dirs [file join $grandParentDir $basename$ver library]
- lappend dirs [file join [file dirname $grandParentDir] $basename$ver library]
+ lappend dirs [file join $grandParentDir $basename$patch library]
+ lappend dirs [file join [file dirname $grandParentDir] \
+ $basename$patch library]
+
+ # 4. On MacOSX, check the directories in the tcl_pkgPath
+ if {[string equal $::tcl_platform(platform) "unix"] && \
+ [string equal $::tcl_platform(os) "Darwin"]} {
+ foreach d $::tcl_pkgPath {
+ lappend dirs [file join $d $basename$version]
+ }
+ }
}
-
foreach i $dirs {
set the_library $i
set file [file join $i $initScript]
@@ -115,21 +114,15 @@ proc tcl_findLibrary {basename version patch initScript
# we have a source command, but no file exists command
if {[interp issafe] || [file exists $file]} {
- if {$debug_startup} {
-
- if {![catch {uplevel \#0 debugger_eval [list [list source $file]]} msg]} {
- return
- } else {
- append errors "$file: $msg\n$errorInfo\n"
- }
- } else {
- if {![catch {uplevel \#0 [list source $file]} msg]} {
- return
- } else {
- append errors "$file: $msg\n$errorInfo\n"
- }
- }
- }
+ if {![catch {uplevel #0 [list source $file]} msg]} {
+ return
+ } else {
+ append errors "$file: $msg\n$errorInfo\n"
+ }
+ }
+ }
+ if {!$variableSet} {
+ unset the_library
}
set msg "Can't find a usable $initScript in the following directories: \n"
append msg " $dirs\n\n"
@@ -138,6 +131,7 @@ proc tcl_findLibrary {basename version patch initScript
error $msg
}
+
# ----------------------------------------------------------------------
# auto_mkindex
# ----------------------------------------------------------------------
diff --git a/tcl/library/dde/pkgIndex.tcl b/tcl/library/dde/pkgIndex.tcl
new file mode 100644
index 00000000000..f045ad89e50
--- /dev/null
+++ b/tcl/library/dde/pkgIndex.tcl
@@ -0,0 +1,6 @@
+if {![package vsatisfies [package provide Tcl] 8]} {return}
+if {[info exists tcl_platform(debug)]} {
+ package ifneeded dde 1.2 [list load [file join $dir tcldde12d.dll] dde]
+} else {
+ package ifneeded dde 1.2 [list load [file join $dir tcldde12.dll] dde]
+}
diff --git a/tcl/library/encoding/cp1250.enc b/tcl/library/encoding/cp1250.enc
index 934539a56b2..070ad901bd6 100644
--- a/tcl/library/encoding/cp1250.enc
+++ b/tcl/library/encoding/cp1250.enc
@@ -10,9 +10,9 @@ S
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
-00800081201A0083201E2026202020210088203001602039015A0164017D0179
+20AC0081201A0083201E2026202020210088203001602039015A0164017D0179
009020182019201C201D202220132014009821220161203A015B0165017E017A
-00A002C702D8014100A4010400A600A700A800A9015E00AB000000AD00AE017B
+00A002C702D8014100A4010400A600A700A800A9015E00AB00AC00AD00AE017B
00B000B102DB014200B400B500B600B700B80105015F00BB013D02DD013E017C
015400C100C2010200C40139010600C7010C00C9011800CB011A00CD00CE010E
01100143014700D300D4015000D600D70158016E00DA017000DC00DD016200DF
diff --git a/tcl/library/encoding/cp1251.enc b/tcl/library/encoding/cp1251.enc
index 7daed16e5fc..376b1b40d89 100644
--- a/tcl/library/encoding/cp1251.enc
+++ b/tcl/library/encoding/cp1251.enc
@@ -10,7 +10,7 @@ S
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
-04020403201A0453201E2026202020210088203004092039040A040C040B040F
+04020403201A0453201E20262020202120AC203004092039040A040C040B040F
045220182019201C201D202220132014009821220459203A045A045C045B045F
00A0040E045E040800A4049000A600A7040100A9040400AB00AC00AD00AE0407
00B000B104060456049100B500B600B704512116045400BB0458040504550457
diff --git a/tcl/library/encoding/cp1252.enc b/tcl/library/encoding/cp1252.enc
index fe55a4694bf..dd525ea4c58 100644
--- a/tcl/library/encoding/cp1252.enc
+++ b/tcl/library/encoding/cp1252.enc
@@ -10,8 +10,8 @@ S
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
-00800081201A0192201E20262020202102C62030016020390152008D008E008F
-009020182019201C201D20222013201402DC21220161203A0153009D009E0178
+20AC0081201A0192201E20262020202102C62030016020390152008D017D008F
+009020182019201C201D20222013201402DC21220161203A0153009D017E0178
00A000A100A200A300A400A500A600A700A800A900AA00AB00AC00AD00AE00AF
00B000B100B200B300B400B500B600B700B800B900BA00BB00BC00BD00BE00BF
00C000C100C200C300C400C500C600C700C800C900CA00CB00CC00CD00CE00CF
diff --git a/tcl/library/encoding/cp1253.enc b/tcl/library/encoding/cp1253.enc
index a934bc9a48f..a8754c37a2e 100644
--- a/tcl/library/encoding/cp1253.enc
+++ b/tcl/library/encoding/cp1253.enc
@@ -10,7 +10,7 @@ S
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
-00800081201A0192201E20262020202100882030008A2039008C008D008E008F
+20AC0081201A0192201E20262020202100882030008A2039008C008D008E008F
009020182019201C201D20222013201400982122009A203A009C009D009E009F
00A00385038600A300A400A500A600A700A800A9000000AB00AC00AD00AE2015
00B000B100B200B3038400B500B600B703880389038A00BB038C00BD038E038F
diff --git a/tcl/library/encoding/cp1254.enc b/tcl/library/encoding/cp1254.enc
index d8553a2a73b..b9e3b3c518d 100644
--- a/tcl/library/encoding/cp1254.enc
+++ b/tcl/library/encoding/cp1254.enc
@@ -10,7 +10,7 @@ S
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
-00800081201A0192201E20262020202102C62030016020390152008D008E008F
+20AC0081201A0192201E20262020202102C62030016020390152008D008E008F
009020182019201C201D20222013201402DC21220161203A0153009D009E0178
00A000A100A200A300A400A500A600A700A800A900AA00AB00AC00AD00AE00AF
00B000B100B200B300B400B500B600B700B800B900BA00BB00BC00BD00BE00BF
diff --git a/tcl/library/encoding/cp1255.enc b/tcl/library/encoding/cp1255.enc
index 275c0169636..6e78b954b7e 100644
--- a/tcl/library/encoding/cp1255.enc
+++ b/tcl/library/encoding/cp1255.enc
@@ -10,11 +10,11 @@ S
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
-00800081201A0192201E20262020202102C62030008A2039008C008D008E008F
+20AC0081201A0192201E20262020202102C62030008A2039008C008D008E008F
009020182019201C201D20222013201402DC2122009A203A009C009D009E009F
-00A0000000A200A320AA00A500A600A700A800A9000000AB00AC00AD00AE00AF
-00B000B100B200B300B400B500B600B7000000B9000000BB00BC00BD00BE0000
-05B005B105B205B305B405B505B605B705B805B905BA05BB05BC05BD05BE05BF
-05C005C105C205C305F005F105F2000000000000000000000000000000000000
+00A000A100A200A320AA00A500A600A700A800A900D700AB00AC00AD00AE00AF
+00B000B100B200B300B400B500B600B700B800B900F700BB00BC00BD00BE00BF
+05B005B105B205B305B405B505B605B705B805B9000005BB05BC05BD05BE05BF
+05C005C105C205C305F005F105F205F305F40000000000000000000000000000
05D005D105D205D305D405D505D605D705D805D905DA05DB05DC05DD05DE05DF
05E005E105E205E305E405E505E605E705E805E905EA00000000200E200F0000
diff --git a/tcl/library/encoding/cp1256.enc b/tcl/library/encoding/cp1256.enc
index 1a9d8a6c652..a98762a0868 100644
--- a/tcl/library/encoding/cp1256.enc
+++ b/tcl/library/encoding/cp1256.enc
@@ -10,11 +10,11 @@ S
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
-0080067E201A0192201E20262020202102C62030008A2039015206860698008F
-06AF20182019201C201D20222013201400982122009A203A0153200C200D009F
-00A0060C00A200A300A400A500A600A700A800A9000000AB00AC00AD00AE00AF
+20AC067E201A0192201E20262020202102C62030067920390152068606980688
+06AF20182019201C201D20222013201406A921220691203A0153200C200D06BA
+00A0060C00A200A300A400A500A600A700A800A906BE00AB00AC00AD00AE00AF
00B000B100B200B300B400B500B600B700B800B9061B00BB00BC00BD00BE061F
-0000062106220623062406250626062706280629062A062B062C062D062E062F
+06C1062106220623062406250626062706280629062A062B062C062D062E062F
063006310632063306340635063600D7063706380639063A0640064106420643
00E0064400E2064506460647064800E700E800E900EA00EB0649064A00EE00EF
-064B064C064D064E00F4064F065000F7065100F9065200FB00FC200E200F0000
+064B064C064D064E00F4064F065000F7065100F9065200FB00FC200E200F06D2
diff --git a/tcl/library/encoding/cp1257.enc b/tcl/library/encoding/cp1257.enc
index 4aab0c663b0..4aa135dfc0c 100644
--- a/tcl/library/encoding/cp1257.enc
+++ b/tcl/library/encoding/cp1257.enc
@@ -10,7 +10,7 @@ S
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
-00800081201A0083201E20262020202100882030008A2039008C00A802C700B8
+20AC0081201A0083201E20262020202100882030008A2039008C00A802C700B8
009020182019201C201D20222013201400982122009A203A009C00AF02DB009F
00A0000000A200A300A4000000A600A700D800A9015600AB00AC00AD00AE00C6
00B000B100B200B300B400B500B600B700F800B9015700BB00BC00BD00BE00E6
diff --git a/tcl/library/encoding/cp1258.enc b/tcl/library/encoding/cp1258.enc
index 8c1fce89954..95fdef88295 100644
--- a/tcl/library/encoding/cp1258.enc
+++ b/tcl/library/encoding/cp1258.enc
@@ -10,11 +10,11 @@ S
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
-00800081201A0192201E20262020202102C62030008A20390152008D008E008F
+20AC0081201A0192201E20262020202102C62030008A20390152008D008E008F
009020182019201C201D20222013201402DC2122009A203A0153009D009E0178
00A000A100A200A300A400A500A600A700A800A900AA00AB00AC00AD00AE00AF
00B000B100B200B300B400B500B600B700B800B900BA00BB00BC00BD00BE00BF
-00C000C100C2010200C400C500C600C700C800C900CA00CB034000CD00CE00CF
+00C000C100C2010200C400C500C600C700C800C900CA00CB030000CD00CE00CF
011000D1030900D300D401A000D600D700D800D900DA00DB00DC01AF030300DF
-00E000E100E2010300E400E500E600E700E800E900EA00EB034100ED00EE00EF
+00E000E100E2010300E400E500E600E700E800E900EA00EB030100ED00EE00EF
011100F1032300F300F401A100F600F700F800F900FA00FB00FC01B020AB00FF
diff --git a/tcl/library/encoding/cp874.enc b/tcl/library/encoding/cp874.enc
index cdcca32af14..0487b97d98a 100644
--- a/tcl/library/encoding/cp874.enc
+++ b/tcl/library/encoding/cp874.enc
@@ -10,7 +10,7 @@ S
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
-0080008100820083008420260086008700880089008A008B008C008D008E008F
+20AC008100820083008420260086008700880089008A008B008C008D008E008F
009020182019201C201D20222013201400980099009A009B009C009D009E009F
00A00E010E020E030E040E050E060E070E080E090E0A0E0B0E0C0E0D0E0E0E0F
0E100E110E120E130E140E150E160E170E180E190E1A0E1B0E1C0E1D0E1E0E1F
diff --git a/tcl/library/encoding/cp936.enc b/tcl/library/encoding/cp936.enc
index 53d975c48f4..37bcc80db0f 100644
--- a/tcl/library/encoding/cp936.enc
+++ b/tcl/library/encoding/cp936.enc
@@ -10,7 +10,7 @@ M
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
-0080000000000000000000000000000000000000000000000000000000000000
+20AC000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
diff --git a/tcl/library/encoding/cp949.enc b/tcl/library/encoding/cp949.enc
index 697fc6f94e0..2f3ec39f949 100644
--- a/tcl/library/encoding/cp949.enc
+++ b/tcl/library/encoding/cp949.enc
@@ -594,7 +594,7 @@ C96F21D221D42200220300B4FF5E02C702D802DD02DA02D900B802DB00A100BF
02D0222E2211220F00A42109203025C125C025B725B626642660266126652667
2663229925C825A325D025D1259225A425A525A825A725A625A92668260F260E
261C261E00B62020202121952197219921962198266D2669266A266C327F321C
-211633C7212233C233D821210000000000000000000000000000000000000000
+211633C7212233C233D8212120AC00AE00000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
A3
0000000000000000000000000000000000000000000000000000000000000000
diff --git a/tcl/library/encoding/cp950.enc b/tcl/library/encoding/cp950.enc
index 881628443c8..f33d7854a6a 100644
--- a/tcl/library/encoding/cp950.enc
+++ b/tcl/library/encoding/cp950.enc
@@ -67,7 +67,7 @@ FF57FF58FF59FF5A039103920393039403950396039703980399039A039B039C
311F312031213122312331243125312631273128312902D902C902CA02C702CB
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
-0000000000000000000000000000000000000000000000000000000000000000
+000020AC00000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
A4
0000000000000000000000000000000000000000000000000000000000000000
diff --git a/tcl/library/encoding/ebcdic.enc b/tcl/library/encoding/ebcdic.enc
new file mode 100644
index 00000000000..f451de59a59
--- /dev/null
+++ b/tcl/library/encoding/ebcdic.enc
@@ -0,0 +1,19 @@
+S
+006F 0 1
+00
+0000000100020003008500090086007F0087008D008E000B000C000D000E000F
+0010001100120013008F000A0008009700180019009C009D001C001D001E001F
+0080008100820083008400920017001B00880089008A008B008C000500060007
+0090009100160093009400950096000400980099009A009B00140015009E001A
+002000A000E200E400E000E100E300E500E700F10060002E003C0028002B007C
+002600E900EA00EB00E800ED00EE00EF00EC00DF00210024002A0029003B009F
+002D002F00C200C400C000C100C300C500C700D1005E002C0025005F003E003F
+00F800C900CA00CB00C800CD00CE00CF00CC00A8003A002300400027003D0022
+00D800610062006300640065006600670068006900AB00BB00F000FD00FE00B1
+00B0006A006B006C006D006E006F00700071007200AA00BA00E600B800C600A4
+00B500AF0073007400750076007700780079007A00A100BF00D000DD00DE00AE
+00A200A300A500B700A900A700B600BC00BD00BE00AC005B005C005D00B400D7
+00F900410042004300440045004600470048004900AD00F400F600F200F300F5
+00A6004A004B004C004D004E004F00500051005200B900FB00FC00DB00FA00FF
+00D900F70053005400550056005700580059005A00B200D400D600D200D300D5
+003000310032003300340035003600370038003900B3007B00DC007D00DA007E
diff --git a/tcl/library/encoding/iso2022-jp.enc b/tcl/library/encoding/iso2022-jp.enc
index a4e455f3ba9..6f43d7c9454 100644
--- a/tcl/library/encoding/iso2022-jp.enc
+++ b/tcl/library/encoding/iso2022-jp.enc
@@ -5,8 +5,8 @@ init {}
final {}
iso8859-1 \x1b(B
jis0201 \x1b(J
-jis0208 \x1b$@
jis0208 \x1b$B
+jis0208 \x1b$@
jis0212 \x1b$(D
gb2312 \x1b$A
ksc5601 \x1b$(C
diff --git a/tcl/library/encoding/iso2022.enc b/tcl/library/encoding/iso2022.enc
index ae7cde15fee..a58f8e3e297 100644
--- a/tcl/library/encoding/iso2022.enc
+++ b/tcl/library/encoding/iso2022.enc
@@ -6,11 +6,9 @@ final {}
iso8859-1 \x1b(B
jis0201 \x1b(J
gb1988 \x1b(T
-jis0208 \x1b$@
jis0208 \x1b$B
+jis0208 \x1b$@
jis0212 \x1b$(D
gb2312 \x1b$A
ksc5601 \x1b$(C
jis0208 \x1b&@\x1b$B
-
-
diff --git a/tcl/library/encoding/iso8859-10.enc b/tcl/library/encoding/iso8859-10.enc
new file mode 100644
index 00000000000..934b3b920ba
--- /dev/null
+++ b/tcl/library/encoding/iso8859-10.enc
@@ -0,0 +1,20 @@
+# Encoding file: iso8859-10, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+0080008100820083008400850086008700880089008A008B008C008D008E008F
+0090009100920093009400950096009700980099009A009B009C009D009E009F
+00A0010401120122012A0128013600A7013B011001600166017D00AD016A014A
+00B0010501130123012B0129013700B7013C011101610167017E2015016B014B
+010000C100C200C300C400C500C6012E010C00C9011800CB011600CD00CE00CF
+00D00145014C00D300D400D500D6016800D8017200DA00DB00DC00DD00DE00DF
+010100E100E200E300E400E500E6012F010D00E9011900EB011700ED00EE00EF
+00F00146014D00F300F400F500F6016900F8017300FA00FB00FC00FD00FE0138
diff --git a/tcl/library/encoding/iso8859-13.enc b/tcl/library/encoding/iso8859-13.enc
new file mode 100644
index 00000000000..b7edcaf38f4
--- /dev/null
+++ b/tcl/library/encoding/iso8859-13.enc
@@ -0,0 +1,20 @@
+# Encoding file: iso8859-13, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+0080008100820083008400850086008700880089008A008B008C008D008E008F
+0090009100920093009400950096009700980099009A009B009C009D009E009F
+00A0201D00A200A300A4201E00A600A700D800A9015600AB00AC00AD00AE00C6
+00B000B100B200B3201C00B500B600B700F800B9015700BB00BC00BD00BE00E6
+0104012E0100010600C400C501180112010C00C90179011601220136012A013B
+01600143014500D3014C00D500D600D701720141015A016A00DC017B017D00DF
+0105012F0101010700E400E501190113010D00E9017A011701230137012B013C
+01610144014600F3014D00F500F600F701730142015B016B00FC017C017E2019
diff --git a/tcl/library/encoding/iso8859-14.enc b/tcl/library/encoding/iso8859-14.enc
new file mode 100644
index 00000000000..a65ba05b9af
--- /dev/null
+++ b/tcl/library/encoding/iso8859-14.enc
@@ -0,0 +1,20 @@
+# Encoding file: iso8859-14, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+0080008100820083008400850086008700880089008A008B008C008D008E008F
+0090009100920093009400950096009700980099009A009B009C009D009E009F
+00A01E021E0300A3010A010B1E0A00A71E8000A91E821E0B1EF200AD00AE0178
+1E1E1E1F012001211E401E4100B61E561E811E571E831E601EF31E841E851E61
+00C000C100C200C300C400C500C600C700C800C900CA00CB00CC00CD00CE00CF
+017400D100D200D300D400D500D61E6A00D800D900DA00DB00DC00DD017600DF
+00E000E100E200E300E400E500E600E700E800E900EA00EB00EC00ED00EE00EF
+017500F100F200F300F400F500F61E6B00F800F900FA00FB00FC00FD017700FF
diff --git a/tcl/library/encoding/iso8859-15.enc b/tcl/library/encoding/iso8859-15.enc
new file mode 100644
index 00000000000..823af466e5b
--- /dev/null
+++ b/tcl/library/encoding/iso8859-15.enc
@@ -0,0 +1,20 @@
+# Encoding file: iso8859-15, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+0080008100820083008400850086008700880089008A008B008C008D008E008F
+0090009100920093009400950096009700980099009A009B009C009D009E009F
+00A000A100A200A320AC00A5016000A7016100A900AA00AB00AC00AD00AE00AF
+00B000B100B200B3017D00B500B600B7017E00B900BA00BB01520153017800BF
+00C000C100C200C300C400C500C600C700C800C900CA00CB00CC00CD00CE00CF
+00D000D100D200D300D400D500D600D700D800D900DA00DB00DC00DD00DE00DF
+00E000E100E200E300E400E500E600E700E800E900EA00EB00EC00ED00EE00EF
+00F000F100F200F300F400F500F600F700F800F900FA00FB00FC00FD00FE00FF
diff --git a/tcl/library/encoding/iso8859-16.enc b/tcl/library/encoding/iso8859-16.enc
new file mode 100644
index 00000000000..da3370932f4
--- /dev/null
+++ b/tcl/library/encoding/iso8859-16.enc
@@ -0,0 +1,20 @@
+# Encoding file: iso8859-16, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+0080008100820083008400850086008700880089008A008B008C008D008E008F
+0090009100920093009400950096009700980099009A009B009C009D009E009F
+00A001040105014120AC201E016000A7016100A9021800AB017900AD017A017B
+00B000B1010C0142017D201D00B600B7017E010D021900BB015201530178017C
+00C000C100C2010200C4010600C600C700C800C900CA00CB00CC00CD00CE00CF
+0110014300D200D300D4015000D6015A017000D900DA00DB00DC0118021A00DF
+00E000E100E2010300E4010700E600E700E800E900EA00EB00EC00ED00EE00EF
+0111014400F200F300F4015100F6015B017100F900FA00FB00FC0119021B00FF
diff --git a/tcl/library/encoding/iso8859-6.enc b/tcl/library/encoding/iso8859-6.enc
index 6510af74070..19ddefbc7bf 100644
--- a/tcl/library/encoding/iso8859-6.enc
+++ b/tcl/library/encoding/iso8859-6.enc
@@ -5,7 +5,7 @@ S
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
-0660066106620663066406650666066706680669003A003B003C003D003E003F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
diff --git a/tcl/library/encoding/iso8859-7.enc b/tcl/library/encoding/iso8859-7.enc
index 2cb69a25c99..0f93ac88c6d 100644
--- a/tcl/library/encoding/iso8859-7.enc
+++ b/tcl/library/encoding/iso8859-7.enc
@@ -12,7 +12,7 @@ S
0070007100720073007400750076007700780079007A007B007C007D007E007F
0080008100820083008400850086008700880089008A008B008C008D008E008F
0090009100920093009400950096009700980099009A009B009C009D009E009F
-00A002BD02BC00A30000000000A600A700A800A9000000AB00AC00AD00002015
+00A02018201900A30000000000A600A700A800A9000000AB00AC00AD00002015
00B000B100B200B303840385038600B703880389038A00BB038C00BD038E038F
0390039103920393039403950396039703980399039A039B039C039D039E039F
03A003A1000003A303A403A503A603A703A803A903AA03AB03AC03AD03AE03AF
diff --git a/tcl/library/encoding/iso8859-8.enc b/tcl/library/encoding/iso8859-8.enc
index 6b424d57d9f..579fa5b47ea 100644
--- a/tcl/library/encoding/iso8859-8.enc
+++ b/tcl/library/encoding/iso8859-8.enc
@@ -12,9 +12,9 @@ S
0070007100720073007400750076007700780079007A007B007C007D007E007F
0080008100820083008400850086008700880089008A008B008C008D008E008F
0090009100920093009400950096009700980099009A009B009C009D009E009F
-00A0000000A200A300A400A500A600A700A800A900D700AB00AC00AD00AE203E
+00A0000000A200A300A400A500A600A700A800A900D700AB00AC00AD00AE00AF
00B000B100B200B300B400B500B600B700B800B900F700BB00BC00BD00BE0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000002017
05D005D105D205D305D405D505D605D705D805D905DA05DB05DC05DD05DE05DF
-05E005E105E205E305E405E505E605E705E805E905EA00000000000000000000
+05E005E105E205E305E405E505E605E705E805E905EA00000000200E200F0000
diff --git a/tcl/library/encoding/koi8-u.enc b/tcl/library/encoding/koi8-u.enc
new file mode 100644
index 00000000000..34ed2fff127
--- /dev/null
+++ b/tcl/library/encoding/koi8-u.enc
@@ -0,0 +1,20 @@
+# Encoding file: koi8-u, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+25002502250C251025142518251C2524252C2534253C258025842588258C2590
+259125922593232025A02219221A22482264226500A0232100B000B200B700F7
+25502551255204510454255404560457255725582559255A255B0491255D255E
+255F25602561040104032563040604072566256725682569256A0490256C00A9
+044E0430043104460434043504440433044504380439043A043B043C043D043E
+043F044F044004410442044304360432044C044B04370448044D04490447044A
+042E0410041104260414041504240413042504180419041A041B041C041D041E
+041F042F042004210422042304160412042C042B04170428042D04290427042A
diff --git a/tcl/library/encoding/macCroatian.enc b/tcl/library/encoding/macCroatian.enc
index 132a74c789c..c23d0f0b772 100644
--- a/tcl/library/encoding/macCroatian.enc
+++ b/tcl/library/encoding/macCroatian.enc
@@ -13,8 +13,8 @@ S
00C400C500C700C900D100D600DC00E100E000E200E400E300E500E700E900E8
00EA00EB00ED00EC00EE00EF00F100F300F200F400F600F500FA00F900FB00FC
202000B000A200A300A7202200B600DF00AE0160212200B400A82260017D00D8
-221E00B122642265220600B522022211220F0161222B00AA00BA2126017E00F8
+221E00B122642265220600B522022211220F0161222B00AA00BA03A9017E00F8
00BF00A100AC221A01922248010600AB010C202600A000C000C300D501520153
-01102014201C201D2018201900F725CAF8FF00A9204400A42039203A00C600BB
+01102014201C201D2018201900F725CAF8FF00A9204420AC2039203A00C600BB
201300B7201A201E203000C2010700C1010D00C800CD00CE00CF00CC00D300D4
011100D200DA00DB00D9013102C602DC00AF03C000CB02DA00B800CA00E602C7
diff --git a/tcl/library/encoding/macCyrillic.enc b/tcl/library/encoding/macCyrillic.enc
index 559083373cb..e657739bdaf 100644
--- a/tcl/library/encoding/macCyrillic.enc
+++ b/tcl/library/encoding/macCyrillic.enc
@@ -12,9 +12,9 @@ S
0070007100720073007400750076007700780079007A007B007C007D007E007F
0410041104120413041404150416041704180419041A041B041C041D041E041F
0420042104220423042404250426042704280429042A042B042C042D042E042F
-202000B000A200A300A7202200B6040600AE00A9212204020452226004030453
-221E00B122642265045600B522020408040404540407045704090459040A045A
+202000B0049000A300A7202200B6040600AE00A9212204020452226004030453
+221E00B122642265045600B504910408040404540407045704090459040A045A
0458040500AC221A01922248220600AB00BB202600A0040B045B040C045C0455
20132014201C201D2018201900F7201E040E045E040F045F211604010451044F
0430043104320433043404350436043704380439043A043B043C043D043E043F
-0440044104420443044404450446044704480449044A044B044C044D044E00A4
+0440044104420443044404450446044704480449044A044B044C044D044E20AC
diff --git a/tcl/library/encoding/macGreek.enc b/tcl/library/encoding/macGreek.enc
index fbfa51fe8f0..67b9953dd25 100644
--- a/tcl/library/encoding/macGreek.enc
+++ b/tcl/library/encoding/macGreek.enc
@@ -12,7 +12,7 @@ S
0070007100720073007400750076007700780079007A007B007C007D007E007F
00C400B900B200C900B300D600DC038500E000E200E4038400A800E700E900E8
00EA00EB00A3212200EE00EF202200BD203000F400F600A600AD00F900FB00FC
-2020039303940398039B039E03A000DF00AE00A903A303AA00A7226000B00387
+2020039303940398039B039E03A000DF00AE00A903A303AA00A7226000B000B7
039100B12264226500A503920395039603970399039A039C03A603AB03A803A9
03AC039D00AC039F03A1224803A400AB00BB202600A003A503A7038603880153
20132015201C201D2018201900F70389038A038C038E03AD03AE03AF03CC038F
diff --git a/tcl/library/encoding/macIceland.enc b/tcl/library/encoding/macIceland.enc
index e3fe9a959ac..c6360698ae5 100644
--- a/tcl/library/encoding/macIceland.enc
+++ b/tcl/library/encoding/macIceland.enc
@@ -13,8 +13,8 @@ S
00C400C500C700C900D100D600DC00E100E000E200E400E300E500E700E900E8
00EA00EB00ED00EC00EE00EF00F100F300F200F400F600F500FA00F900FB00FC
00DD00B000A200A300A7202200B600DF00AE00A9212200B400A8226000C600D8
-221E00B12264226500A500B522022211220F03C0222B00AA00BA212600E600F8
+221E00B12264226500A500B522022211220F03C0222B00AA00BA03A900E600F8
00BF00A100AC221A01922248220600AB00BB202600A000C000C300D501520153
-20132014201C201D2018201900F725CA00FF0178204400A400D000F000DE00FE
+20132014201C201D2018201900F725CA00FF0178204420AC00D000F000DE00FE
00FD00B7201A201E203000C200CA00C100CB00C800CD00CE00CF00CC00D300D4
F8FF00D200DA00DB00D9013102C602DC00AF02D802D902DA00B802DD02DB02C7
diff --git a/tcl/library/encoding/macRoman.enc b/tcl/library/encoding/macRoman.enc
index 6cfd7494884..15de26623f3 100644
--- a/tcl/library/encoding/macRoman.enc
+++ b/tcl/library/encoding/macRoman.enc
@@ -13,8 +13,8 @@ S
00C400C500C700C900D100D600DC00E100E000E200E400E300E500E700E900E8
00EA00EB00ED00EC00EE00EF00F100F300F200F400F600F500FA00F900FB00FC
202000B000A200A300A7202200B600DF00AE00A9212200B400A8226000C600D8
-221E00B12264226500A500B522022211220F03C0222B00AA00BA212600E600F8
+221E00B12264226500A500B522022211220F03C0222B00AA00BA03A900E600F8
00BF00A100AC221A01922248220600AB00BB202600A000C000C300D501520153
-20132014201C201D2018201900F725CA00FF0178204400A42039203AFB01FB02
+20132014201C201D2018201900F725CA00FF0178204420AC2039203AFB01FB02
202100B7201A201E203000C200CA00C100CB00C800CD00CE00CF00CC00D300D4
F8FF00D200DA00DB00D9013102C602DC00AF02D802D902DA00B802DD02DB02C7
diff --git a/tcl/library/encoding/macTurkish.enc b/tcl/library/encoding/macTurkish.enc
index 73e86876bfb..f9542ae5c85 100644
--- a/tcl/library/encoding/macTurkish.enc
+++ b/tcl/library/encoding/macTurkish.enc
@@ -13,7 +13,7 @@ S
00C400C500C700C900D100D600DC00E100E000E200E400E300E500E700E900E8
00EA00EB00ED00EC00EE00EF00F100F300F200F400F600F500FA00F900FB00FC
202000B000A200A300A7202200B600DF00AE00A9212200B400A8226000C600D8
-221E00B12264226500A500B522022211220F03C0222B00AA00BA212600E600F8
+221E00B12264226500A500B522022211220F03C0222B00AA00BA03A900E600F8
00BF00A100AC221A01922248220600AB00BB202600A000C000C300D501520153
20132014201C201D2018201900F725CA00FF0178011E011F01300131015E015F
202100B7201A201E203000C200CA00C100CB00C800CD00CE00CF00CC00D300D4
diff --git a/tcl/library/encoding/tis-620.enc b/tcl/library/encoding/tis-620.enc
new file mode 100644
index 00000000000..c233be5dada
--- /dev/null
+++ b/tcl/library/encoding/tis-620.enc
@@ -0,0 +1,20 @@
+# Encoding file: tis-620, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E0000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00000E010E020E030E040E050E060E070E080E090E0A0E0B0E0C0E0D0E0E0E0F
+0E100E110E120E130E140E150E160E170E180E190E1A0E1B0E1C0E1D0E1E0E1F
+0E200E210E220E230E240E250E260E270E280E290E2A0E2B0E2C0E2D0E2E0E2F
+0E300E310E320E330E340E350E360E370E380E390E3A00000000000000000E3F
+0E400E410E420E430E440E450E460E470E480E490E4A0E4B0E4C0E4D0E4E0E4F
+0E500E510E520E530E540E550E560E570E580E590E5A0E5B0000000000000000 \ No newline at end of file
diff --git a/tcl/library/history.tcl b/tcl/library/history.tcl
index 1b4849e569f..cb2bba29f05 100644
--- a/tcl/library/history.tcl
+++ b/tcl/library/history.tcl
@@ -166,6 +166,12 @@ proc history {args} {
proc tcl::HistAdd {command {exec {}}} {
variable history
+
+ # Do not add empty commands to the history
+ if {[string trim $command] == ""} {
+ return ""
+ }
+
set i [incr history(nextid)]
set history($i) $command
set j [incr history(oldest)]
@@ -368,4 +374,3 @@ proc history {args} {
set i [HistIndex $event]
set history($i) $cmd
}
-
diff --git a/tcl/library/http/http.tcl b/tcl/library/http/http.tcl
new file mode 100644
index 00000000000..a7b3b5e5790
--- /dev/null
+++ b/tcl/library/http/http.tcl
@@ -0,0 +1,914 @@
+# 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$
+
+# 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.2
+# keep this in sync with pkgIndex.tcl
+# and with the install directories in Makefiles
+package provide http 2.4.2
+
+namespace eval http {
+ variable http
+ array set http {
+ -accept */*
+ -proxyhost {}
+ -proxyport {}
+ -proxyfilter http::ProxyRequired
+ }
+ set http(-useragent) "Tcl http client package [package provide http]"
+
+ proc init {} {
+ variable formMap
+ variable alphanumeric a-zA-Z0-9
+ for {set i 0} {$i <= 256} {incr i} {
+ set c [format %c $i]
+ if {![string match \[$alphanumeric\] $c]} {
+ set formMap($c) %[format %.2x $i]
+ }
+ }
+ # These are handled specially
+ array set formMap { " " + \n %0d%0a }
+ }
+ init
+
+ variable urlTypes
+ array set urlTypes {
+ http {80 ::socket}
+ }
+
+ variable encodings [string tolower [encoding names]]
+ # This can be changed, but iso8859-1 is the RFC standard.
+ variable defaultCharset "iso8859-1"
+
+ namespace export geturl config reset wait formatQuery register unregister
+ # Useful, but not exported: data size status code
+}
+
+# http::register --
+#
+# See documentaion for details.
+#
+# Arguments:
+# 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]
+}
+
+# http::unregister --
+#
+# Unregisters URL protocol handler
+#
+# Arguments:
+# 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)]} {
+ return -code error "unsupported url type \"$proto\""
+ }
+ set old $urlTypes($proto)
+ unset urlTypes($proto)
+ return $old
+}
+
+# http::config --
+#
+# See documentaion for details.
+#
+# Arguments:
+# args Options parsed by the procedure.
+# Results:
+# TODO
+
+proc http::config {args} {
+ variable http
+ set options [lsort [array names http -*]]
+ set usage [join $options ", "]
+ if {[llength $args] == 0} {
+ set result {}
+ foreach name $options {
+ lappend result $name $http($name)
+ }
+ return $result
+ }
+ regsub -all -- - $options {} options
+ set pat ^-([join $options |])$
+ if {[llength $args] == 1} {
+ set flag [lindex $args 0]
+ if {[regexp -- $pat $flag]} {
+ return $http($flag)
+ } else {
+ return -code error "Unknown option $flag, must be: $usage"
+ }
+ } else {
+ foreach {flag value} $args {
+ if {[regexp -- $pat $flag]} {
+ set http($flag) $value
+ } else {
+ return -code error "Unknown option $flag, must be: $usage"
+ }
+ }
+ }
+}
+
+# http::Finish --
+#
+# Clean up the socket and eval close time callbacks
+#
+# 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.
+#
+# Side Effects:
+# Closes the socket
+
+proc http::Finish { token {errormsg ""} {skipCB 0}} {
+ variable $token
+ upvar 0 $token state
+ global errorInfo errorCode
+ if {[string length $errormsg] != 0} {
+ set state(error) [list $errormsg $errorInfo $errorCode]
+ 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 {[info exist state(-command)]} {
+ # Command callback may already have unset our state
+ unset state(-command)
+ }
+ }
+}
+
+# http::reset --
+#
+# See documentaion for details.
+#
+# Arguments:
+# token Connection token.
+# why Status info.
+#
+# Side Effects:
+# See Finish
+
+proc http::reset { token {why reset} } {
+ variable $token
+ upvar 0 $token state
+ set state(status) $why
+ catch {fileevent $state(sock) readable {}}
+ catch {fileevent $state(sock) writable {}}
+ Finish $token
+ if {[info exists state(error)]} {
+ set errorlist $state(error)
+ unset state
+ eval ::error $errorlist
+ }
+}
+
+# http::geturl --
+#
+# Establishes a connection to a remote url via http.
+#
+# Arguments:
+# url The http URL to goget.
+# 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.
+
+proc http::geturl { url args } {
+ variable http
+ variable urlTypes
+ variable defaultCharset
+
+ # 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
+ }
+ set token [namespace current]::[incr http(uid)]
+ variable $token
+ upvar 0 $token state
+ reset $token
+
+ # Process command options.
+
+ array set state {
+ -binary false
+ -blocksize 8192
+ -queryblocksize 8192
+ -validate 0
+ -headers {}
+ -timeout 0
+ -type application/x-www-form-urlencoded
+ -queryprogress {}
+ state header
+ meta {}
+ coding {}
+ currentsize 0
+ totalsize 0
+ querylength 0
+ queryoffset 0
+ type text/html
+ body {}
+ status ""
+ http ""
+ }
+ set state(charset) $defaultCharset
+ set options {-binary -blocksize -channel -command -handler -headers \
+ -progress -query -queryblocksize -querychannel -queryprogress\
+ -validate -timeout -type}
+ set usage [join $options ", "]
+ regsub -all -- - $options {} options
+ set pat ^-([join $options |])$
+ foreach {flag value} $args {
+ if {[regexp $pat $flag]} {
+ # Validate numbers
+ if {[info exists state($flag)] && \
+ [string is integer -strict $state($flag)] && \
+ ![string is integer -strict $value]} {
+ unset $token
+ return -code error "Bad value for $flag ($value), must be integer"
+ }
+ set state($flag) $value
+ } else {
+ unset $token
+ return -code error "Unknown option $flag, can be: $usage"
+ }
+ }
+
+ # Make sure -query and -querychannel aren't both specified
+
+ set isQueryChannel [info exists state(-querychannel)]
+ set isQuery [info exists state(-query)]
+ if {$isQuery && $isQueryChannel} {
+ unset $token
+ return -code error "Can't combine -query and -querychannel options!"
+ }
+
+ # Validate URL, determine the server host and port, and check proxy case
+
+ if {![regexp -nocase {^(([^:]*)://)?([^/:]+)(:([0-9]+))?(/.*)?$} $url \
+ x prefix proto host y port srvurl]} {
+ unset $token
+ return -code error "Unsupported URL: $url"
+ }
+ if {[string length $proto] == 0} {
+ set proto http
+ set url ${proto}://$url
+ }
+ if {![info exists urlTypes($proto)]} {
+ unset $token
+ return -code error "Unsupported URL type \"$proto\""
+ }
+ set defport [lindex $urlTypes($proto) 0]
+ set defcmd [lindex $urlTypes($proto) 1]
+
+ if {[string length $port] == 0} {
+ 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.
+
+ 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 {[info exists phost] && [string length $phost]} {
+ set srvurl $url
+ set conStat [catch {eval $defcmd $async {$phost $pport}} s]
+ } else {
+ set conStat [catch {eval $defcmd $async {$host $port}} s]
+ }
+ if {$conStat} {
+
+ # 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) $s
+
+ # Wait for the connection to complete
+
+ if {$state(-timeout) > 0} {
+ fileevent $s writable [list http::Connect $token]
+ http::wait $token
+
+ if {[string equal $state(status) "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
+ # exception from here instead.
+ set err [lindex $state(error) 0]
+ cleanup $token
+ return -code error $err
+ } elseif {![string equal $state(status) "connect"]} {
+ # Likely to be connection timeout
+ return $token
+ }
+ set state(status) ""
+ }
+
+ # Send data in cr-lf format, but accept any line terminators
+
+ fconfigure $s -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.
+
+ catch {fconfigure $s -blocking off}
+ set how GET
+ if {$isQuery} {
+ set state(querylength) [string length $state(-query)]
+ if {$state(querylength) > 0} {
+ set how POST
+ set contDone 0
+ } else {
+ # there's no query data
+ unset state(-query)
+ set isQuery 0
+ }
+ } elseif {$state(-validate)} {
+ set how HEAD
+ } elseif {$isQueryChannel} {
+ set how POST
+ # The query channel must be blocking for the async Write to
+ # work properly.
+ fconfigure $state(-querychannel) -blocking 1 -translation binary
+ set contDone 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"
+ } else {
+ puts $s "Host: $host:$port"
+ }
+ puts $s "User-Agent: $http(-useragent)"
+ foreach {key value} $state(-headers) {
+ regsub -all \[\n\r\] $value {} value
+ set key [string trim $key]
+ if {[string equal $key "Content-Length"]} {
+ set contDone 1
+ set state(querylength) $value
+ }
+ if {[string length $key]} {
+ puts $s "$key: $value"
+ }
+ }
+ if {$isQueryChannel && $state(querylength) == 0} {
+ # 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
+ set state(querylength) \
+ [expr {[tell $state(-querychannel)] - $start}]
+ seek $state(-querychannel) $start
+ }
+
+ # 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.
+
+ if {$isQuery || $isQueryChannel} {
+ puts $s "Content-Type: $state(-type)"
+ if {!$contDone} {
+ puts $s "Content-Length: $state(querylength)"
+ }
+ puts $s ""
+ fconfigure $s -translation {auto binary}
+ fileevent $s writable [list http::Write $token]
+ } else {
+ puts $s ""
+ flush $s
+ fileevent $s readable [list http::Event $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 {[string equal $state(status) "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.
+
+ # if state(status) is error, it means someone's already called Finish
+ # to do the above-described clean up.
+ if {[string equal $state(status) "error"]} {
+ Finish $token $err 1
+ }
+ cleanup $token
+ return -code error $err
+ }
+
+ return $token
+}
+
+# Data access functions:
+# Data - the URL data
+# Status - the transaction status: ok, reset, eof, timeout
+# Code - the HTTP transaction code, e.g., 200
+# Size - the size of the URL data
+
+proc http::data {token} {
+ variable $token
+ upvar 0 $token state
+ return $state(body)
+}
+proc http::status {token} {
+ variable $token
+ upvar 0 $token state
+ return $state(status)
+}
+proc http::code {token} {
+ variable $token
+ upvar 0 $token state
+ return $state(http)
+}
+proc http::ncode {token} {
+ variable $token
+ upvar 0 $token state
+ if {[regexp {[0-9]{3}} $state(http) numeric_code]} {
+ return $numeric_code
+ } else {
+ return $state(http)
+ }
+}
+proc http::size {token} {
+ variable $token
+ upvar 0 $token state
+ return $state(currentsize)
+}
+
+proc http::error {token} {
+ variable $token
+ upvar 0 $token state
+ if {[info exists state(error)]} {
+ return $state(error)
+ }
+ return ""
+}
+
+# http::cleanup
+#
+# Garbage collect the state associated with a transaction
+#
+# Arguments
+# token The token returned from http::geturl
+#
+# Side Effects
+# unsets the state array
+
+proc http::cleanup {token} {
+ variable $token
+ upvar 0 $token state
+ if {[info exist state]} {
+ unset state
+ }
+}
+
+# http::Connect
+#
+# This callback is made when an asyncronous connection completes.
+#
+# Arguments
+# token The token returned from http::geturl
+#
+# Side Effects
+# Sets the status of the connection, which unblocks
+# the waiting geturl call
+
+proc http::Connect {token} {
+ 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
+ } else {
+ set state(status) connect
+ fileevent $state(sock) writable {}
+ }
+ return
+}
+
+# http::Write
+#
+# Write POST query data to the socket
+#
+# Arguments
+# token The token for the connection
+#
+# Side Effects
+# Write the socket and handle callbacks.
+
+proc http::Write {token} {
+ variable $token
+ upvar 0 $token state
+ set s $state(sock)
+
+ # Output a block. Tcl will buffer this if the socket blocks
+
+ set done 0
+ if {[catch {
+
+ # Catch I/O errors on dead sockets
+
+ if {[info exists state(-query)]} {
+
+ # 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}]]
+ incr state(queryoffset) $state(-queryblocksize)
+ if {$state(queryoffset) >= $state(querylength)} {
+ set state(queryoffset) $state(querylength)
+ set done 1
+ }
+ } else {
+
+ # Copy blocks from the query channel
+
+ set outStr [read $state(-querychannel) $state(-queryblocksize)]
+ puts -nonewline $s $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.
+
+ set state(posterror) $err
+ set done 1
+ }
+ if {$done} {
+ catch {flush $s}
+ fileevent $s writable {}
+ fileevent $s readable [list http::Event $token]
+ }
+
+ # Callback to the client after we've completely handled everything
+
+ if {[string length $state(-queryprogress)]} {
+ eval $state(-queryprogress) [list $token $state(querylength)\
+ $state(queryoffset)]
+ }
+}
+
+# http::Event
+#
+# Handle input on the socket
+#
+# Arguments
+# token The token returned from http::geturl
+#
+# Side Effects
+# Read the socket and handle callbacks.
+
+proc http::Event {token} {
+ variable $token
+ upvar 0 $token state
+ set s $state(sock)
+
+ if {[eof $s]} {
+ Eof $token
+ return
+ }
+ if {[string equal $state(state) "header"]} {
+ if {[catch {gets $s line} n]} {
+ Finish $token $n
+ } elseif {$n == 0} {
+ variable encodings
+ set state(state) body
+ if {$state(-binary) || ![regexp -nocase ^text $state(type)] || \
+ [regexp gzip|compress $state(coding)]} {
+ # Turn off conversions for non-text data
+ fconfigure $s -translation binary
+ if {[info exists state(-channel)]} {
+ 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(-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]
+ }
+ if {[regexp -nocase {^([^:]+):(.+)$} $line x key value]} {
+ lappend state(meta) $key [string trim $value]
+ } elseif {[regexp ^HTTP $line]} {
+ set state(http) $line
+ }
+ }
+ } else {
+ if {[catch {
+ if {[info exists state(-handler)]} {
+ set n [eval $state(-handler) {$s $token}]
+ } else {
+ set block [read $s $state(-blocksize)]
+ set n [string length $block]
+ if {$n >= 0} {
+ append state(body) $block
+ }
+ }
+ if {$n >= 0} {
+ incr state(currentsize) $n
+ }
+ } err]} {
+ Finish $token $err
+ } else {
+ if {[info exists state(-progress)]} {
+ eval $state(-progress) \
+ {$token $state(totalsize) $state(currentsize)}
+ }
+ }
+ }
+}
+
+# http::CopyStart
+#
+# Error handling wrapper around fcopy
+#
+# Arguments
+# s 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
+ upvar 0 $token state
+ if {[catch {
+ fcopy $s $state(-channel) -size $state(-blocksize) -command \
+ [list http::CopyDone $token]
+ } err]} {
+ Finish $token $err
+ }
+}
+
+# http::CopyDone
+#
+# fcopy completion callback
+#
+# Arguments
+# token The token returned from http::geturl
+# count The amount transfered
+#
+# Side Effects
+# Invokes callbacks
+
+proc http::CopyDone {token count {error {}}} {
+ variable $token
+ upvar 0 $token state
+ set s $state(sock)
+ incr state(currentsize) $count
+ if {[info exists state(-progress)]} {
+ eval $state(-progress) {$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} {
+ Eof $token
+ } else {
+ CopyStart $s $token
+ }
+}
+
+# http::Eof
+#
+# Handle eof on the socket
+#
+# Arguments
+# token The token returned from http::geturl
+#
+# Side Effects
+# Clean up the socket
+
+proc http::Eof {token} {
+ variable $token
+ upvar 0 $token state
+ if {[string equal $state(state) "header"]} {
+ # Premature eof
+ set state(status) eof
+ } else {
+ set state(status) ok
+ }
+ set state(state) eof
+ Finish $token
+}
+
+# http::wait --
+#
+# See documentaion for details.
+#
+# Arguments:
+# token Connection token.
+#
+# Results:
+# The status after the wait.
+
+proc http::wait {token} {
+ variable $token
+ upvar 0 $token state
+
+ if {![info exists state(status)] || [string length $state(status)] == 0} {
+ # We must wait on the original variable name, not the upvar alias
+ vwait $token\(status)
+ }
+
+ return $state(status)
+}
+
+# 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.
+#
+# Arguments:
+# args A list of name-value pairs.
+#
+# Results:
+# TODO
+
+proc http::formatQuery {args} {
+ set result ""
+ set sep ""
+ foreach i $args {
+ append result $sep [mapReply $i]
+ if {[string equal $sep "="]} {
+ set sep &
+ } else {
+ set sep =
+ }
+ }
+ return $result
+}
+
+# http::mapReply --
+#
+# Do x-www-urlencoded character mapping
+#
+# Arguments:
+# string The string the needs to be encoded
+#
+# Results:
+# The encoded string
+
+proc http::mapReply {string} {
+ variable formMap
+ variable alphanumeric
+
+ # The spec says: "non-alphanumeric characters are replaced by '%HH'"
+ # 1 leave alphanumerics characters alone
+ # 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
+
+ regsub -all \[^$alphanumeric\] $string {$formMap(&)} string
+ regsub -all {[][{})\\]\)} $string {\\&} string
+ return [subst -nocommand $string]
+}
+
+# http::ProxyRequired --
+# Default proxy filter.
+#
+# Arguments:
+# host The destination host
+#
+# Results:
+# The current proxy settings
+
+proc http::ProxyRequired {host} {
+ variable http
+ if {[info exists http(-proxyhost)] && [string length $http(-proxyhost)]} {
+ if {![info exists http(-proxyport)] || \
+ ![string length $http(-proxyport)]} {
+ set http(-proxyport) 8080
+ }
+ return [list $http(-proxyhost) $http(-proxyport)]
+ }
+}
diff --git a/tcl/library/http/pkgIndex.tcl b/tcl/library/http/pkgIndex.tcl
new file mode 100644
index 00000000000..8461a6799b3
--- /dev/null
+++ b/tcl/library/http/pkgIndex.tcl
@@ -0,0 +1,12 @@
+# 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.2]} {return}
+package ifneeded http 2.4.2 [list tclPkgSetup $dir http 2.4.2 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister}}}]
diff --git a/tcl/library/init.tcl b/tcl/library/init.tcl
index 8a1ff67467b..e290e8b1787 100644
--- a/tcl/library/init.tcl
+++ b/tcl/library/init.tcl
@@ -16,7 +16,7 @@
if {[info commands package] == ""} {
error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]"
}
-package require -exact Tcl 8.3
+package require -exact Tcl 8.4
# Compute the auto path to use in this interpreter.
# The values on the path come from several locations:
@@ -30,8 +30,9 @@ package require -exact Tcl 8.3
# The parent directory of tcl_library. Adding the parent
# means that packages in peer directories will be found automatically.
#
-# Also add the directory where the executable is located, plus ../lib
-# relative to that path.
+# Also add the directory ../lib relative to the directory where the
+# executable is located. This is meant to find binary packages for the
+# same architecture as the current executable.
#
# tcl_pkgPath, which is set by the platform-specific initialization routines
# On UNIX it is compiled in
@@ -45,66 +46,66 @@ if {![info exists auto_path]} {
set auto_path ""
}
}
-if {[string compare [info library] {}]} {
- foreach __dir [list [info library] [file dirname [info library]]] {
- if {[lsearch -exact $auto_path $__dir] < 0} {
- lappend auto_path $__dir
+namespace eval tcl {
+ variable Dir
+ if {[string compare [info library] {}]} {
+ foreach Dir [list [info library] [file dirname [info library]]] {
+ if {[lsearch -exact $::auto_path $Dir] < 0} {
+ lappend ::auto_path $Dir
+ }
}
}
-}
-set __dir [file join [file dirname [file dirname \
- [info nameofexecutable]]] lib]
-if {[lsearch -exact $auto_path $__dir] < 0} {
- lappend auto_path $__dir
-}
-if {[info exist tcl_pkgPath]} {
- foreach __dir $tcl_pkgPath {
- if {[lsearch -exact $auto_path $__dir] < 0} {
- lappend auto_path $__dir
+ set Dir [file join [file dirname [file dirname \
+ [info nameofexecutable]]] lib]
+ if {[lsearch -exact $::auto_path $Dir] < 0} {
+ lappend ::auto_path $Dir
+ }
+ if {[info exist ::tcl_pkgPath]} {
+ foreach Dir $::tcl_pkgPath {
+ if {[lsearch -exact $::auto_path $Dir] < 0} {
+ lappend ::auto_path $Dir
+ }
}
}
}
-if {[info exists __dir]} {
- unset __dir
-}
# Windows specific end of initialization
if {(![interp issafe]) && [string equal $tcl_platform(platform) "windows"]} {
namespace eval tcl {
- proc envTraceProc {lo n1 n2 op} {
+ proc EnvTraceProc {lo n1 n2 op} {
set x $::env($n2)
set ::env($lo) $x
set ::env([string toupper $lo]) $x
}
- }
- foreach p [array names env] {
- set u [string toupper $p]
- if {[string compare $u $p]} {
- switch -- $u {
- COMSPEC -
- PATH {
- if {![info exists env($u)]} {
- set env($u) $env($p)
+ proc InitWinEnv {} {
+ global env tcl_platform
+ foreach p [array names env] {
+ set u [string toupper $p]
+ if {[string compare $u $p]} {
+ switch -- $u {
+ COMSPEC -
+ PATH {
+ if {![info exists env($u)]} {
+ set env($u) $env($p)
+ }
+ trace variable env($p) w \
+ [namespace code [list EnvTraceProc $p]]
+ trace variable env($u) w \
+ [namespace code [list EnvTraceProc $p]]
+ }
}
- trace variable env($p) w [list tcl::envTraceProc $p]
- trace variable env($u) w [list tcl::envTraceProc $p]
+ }
+ }
+ if {![info exists env(COMSPEC)]} {
+ if {[string equal $tcl_platform(os) "Windows NT"]} {
+ set env(COMSPEC) cmd.exe
+ } else {
+ set env(COMSPEC) command.com
}
}
}
- }
- if {[info exists p]} {
- unset p
- }
- if {[info exists u]} {
- unset u
- }
- if {![info exists env(COMSPEC)]} {
- if {[string equal $tcl_platform(os) "Windows NT"]} {
- set env(COMSPEC) cmd.exe
- } else {
- set env(COMSPEC) command.com
- }
+ InitWinEnv
}
}
@@ -163,9 +164,9 @@ proc unknown args {
# then concatenate its arguments onto the end and evaluate it.
set cmd [lindex $args 0]
- if {[regexp "^namespace\[ \t\n\]+inscope" $cmd] && [llength $cmd] == 4} {
+ if {[regexp "^:*namespace\[ \t\n\]+inscope" $cmd] && [llength $cmd] == 4} {
set arglist [lrange $args 1 end]
- set ret [catch {uplevel $cmd $arglist} result]
+ set ret [catch {uplevel 1 ::$cmd $arglist} result]
if {$ret == 0} {
return $result
} else {
@@ -188,7 +189,7 @@ proc unknown args {
return -code error "self-referential recursion in \"unknown\" for command \"$name\"";
}
set unknown_pending($name) pending;
- set ret [catch {auto_load $name [uplevel 1 {namespace current}]} msg]
+ set ret [catch {auto_load $name [uplevel 1 {::namespace current}]} msg]
unset unknown_pending($name);
if {$ret != 0} {
append errorInfo "\n (autoloading \"$name\")"
@@ -203,14 +204,48 @@ proc unknown args {
set code [catch {uplevel 1 $args} msg]
if {$code == 1} {
#
- # Strip the last five lines off the error stack (they're
- # from the "uplevel" command).
+ # Compute stack trace contribution from the [uplevel].
+ # Note the dependence on how Tcl_AddErrorInfo, etc.
+ # construct the stack trace.
#
-
- set new [split $errorInfo \n]
- set new [join [lrange $new 0 [expr {[llength $new] - 6}]] \n]
+ set cinfo $args
+ if {[string length $cinfo] > 150} {
+ set cinfo "[string range $cinfo 0 149]..."
+ }
+ append cinfo "\"\n (\"uplevel\" body line 1)"
+ append cinfo "\n invoked from within"
+ append cinfo "\n\"uplevel 1 \$args\""
+ #
+ # Try each possible form of the stack trace
+ # and trim the extra contribution from the matching case
+ #
+ set expect "$msg\n while executing\n\"$cinfo"
+ if {$errorInfo eq $expect} {
+ #
+ # The stack has only the eval from the expanded command
+ # Do not generate any stack trace here.
+ #
+ return -code error -errorcode $errorCode $msg
+ }
+ #
+ # Stack trace is nested, trim off just the contribution
+ # from the extra "eval" of $args due to the "catch" above.
+ #
+ set expect "\n invoked from within\n\"$cinfo"
+ set exlen [string length $expect]
+ set eilen [string length $errorInfo]
+ set i [expr {$eilen - $exlen - 1}]
+ set einfo [string range $errorInfo 0 $i]
+ #
+ # For now verify that $errorInfo consists of what we are about
+ # to return plus what we expected to trim off.
+ #
+ if {$errorInfo ne "$einfo$expect"} {
+ error "Tcl bug: unexpected stack trace in \"unknown\"" {} \
+ [list CORE UNKNOWN BADTRACE $expect $errorInfo]
+ }
return -code error -errorcode $errorCode \
- -errorinfo $new $msg
+ -errorinfo $einfo $msg
} else {
return -code $code $msg
}
@@ -228,7 +263,7 @@ proc unknown args {
if {[string equal [info commands console] ""]} {
set redir ">&@stdout <@stdin"
}
- return [uplevel exec $redir $new [lrange $args 1 end]]
+ return [uplevel 1 exec $redir $new [lrange $args 1 end]]
}
}
set errorCode $savedErrorCode
@@ -244,7 +279,7 @@ proc unknown args {
if {[info exists newcmd]} {
tclLog $newcmd
history change $newcmd 0
- return [uplevel $newcmd]
+ return [uplevel 1 $newcmd]
}
set ret [catch {set cmds [info commands $name*]} msg]
@@ -256,7 +291,7 @@ proc unknown args {
"error in unknown while checking if \"$name\" is a unique command abbreviation: $msg"
}
if {[llength $cmds] == 1} {
- return [uplevel [lreplace $args 0 0 $cmds]]
+ return [uplevel 1 [lreplace $args 0 0 $cmds]]
}
if {[llength $cmds]} {
if {[string equal $name ""]} {
@@ -286,7 +321,7 @@ proc auto_load {cmd {namespace {}}} {
global auto_index auto_oldpath auto_path
if {[string length $namespace] == 0} {
- set namespace [uplevel {namespace current}]
+ set namespace [uplevel 1 [list ::namespace current]]
}
set nameList [auto_qualify $cmd $namespace]
# workaround non canonical auto_index entries that might be around
@@ -461,15 +496,16 @@ proc auto_import {pattern} {
return
}
- set ns [uplevel namespace current]
+ set ns [uplevel 1 [list ::namespace current]]
set patternList [auto_qualify $pattern $ns]
auto_load_index
foreach pattern $patternList {
- foreach name [array names auto_index] {
- if {[string match $pattern $name] && \
- [string equal "" [info commands $name]]} {
+ foreach name [array names auto_index $pattern] {
+ if {[string equal "" [info commands $name]]
+ && [string equal [namespace qualifiers $pattern] \
+ [namespace qualifiers $name]]} {
uplevel #0 $auto_index($name)
}
}
@@ -509,13 +545,26 @@ proc auto_execok name {
# NT includes the 'start' built-in
lappend shellBuiltins "start"
}
+ if {[info exists env(PATHEXT)]} {
+ # Add an initial ; to have the {} extension check first.
+ set execExtensions [split ";$env(PATHEXT)" ";"]
+ } else {
+ set execExtensions [list {} .com .exe .bat]
+ }
if {[lsearch -exact $shellBuiltins $name] != -1} {
- return [set auto_execs($name) [list $env(COMSPEC) /c $name]]
+ # 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.
+ set cmd $env(COMSPEC)
+ if {[file exists $cmd]} {
+ set cmd [file attributes $cmd -shortname]
+ }
+ return [set auto_execs($name) [list $cmd /c $name]]
}
if {[llength [file split $name]] != 1} {
- foreach ext {{} .com .exe .bat} {
+ foreach ext $execExtensions {
set file ${name}${ext}
if {[file exists $file] && ![file isdirectory $file]} {
return [set auto_execs($name) [list $file]]
@@ -545,7 +594,7 @@ proc auto_execok name {
# Skip already checked directories
if {[info exists checked($dir)] || [string equal {} $dir]} { continue }
set checked($dir) {}
- foreach ext {{} .com .exe .bat} {
+ foreach ext $execExtensions {
set file [file join $dir ${name}${ext}]
if {[file exists $file] && ![file isdirectory $file]} {
return [set auto_execs($name) [list $file]]
@@ -586,3 +635,81 @@ proc auto_execok name {
}
+# ::tcl::CopyDirectory --
+#
+# 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.
+#
+# Note that making changes to this procedure can change the results
+# of running Tcl's tests.
+#
+# Arguments:
+# action - "renaming" or "copying"
+# src - source directory
+# dest - destination directory
+proc tcl::CopyDirectory {action src dest} {
+ set nsrc [file normalize $src]
+ set ndest [file normalize $dest]
+ if {[string equal $action "renaming"]} {
+ # Can't rename volumes. We could give a more precise
+ # error message here, but that would break the test suite.
+ if {[lsearch -exact [file volumes] $nsrc] != -1} {
+ return -code error "error $action \"$src\" to\
+ \"$dest\": trying to rename a volume or move a directory\
+ into itself"
+ }
+ }
+ if {[file exists $dest]} {
+ if {$nsrc == $ndest} {
+ return -code error "error $action \"$src\" to\
+ \"$dest\": trying to rename a volume or move a directory\
+ into itself"
+ }
+ if {[string equal $action "copying"]} {
+ return -code error "error $action \"$src\" to\
+ \"$dest\": file already exists"
+ } else {
+ # Depending on the platform, and on the current
+ # working directory, the directories '.', '..'
+ # can be returned in various combinations. Anyway,
+ # if any other file is returned, we must signal an error.
+ set existing [glob -nocomplain -directory $dest * .*]
+ eval [list lappend existing] \
+ [glob -nocomplain -directory $dest -type hidden * .*]
+ foreach s $existing {
+ if {([file tail $s] != ".") && ([file tail $s] != "..")} {
+ return -code error "error $action \"$src\" to\
+ \"$dest\": file already exists"
+ }
+ }
+ }
+ } else {
+ if {[string first $nsrc $ndest] != -1} {
+ set srclen [expr {[llength [file split $nsrc]] -1}]
+ set ndest [lindex [file split $ndest] $srclen]
+ if {$ndest == [file tail $nsrc]} {
+ return -code error "error $action \"$src\" to\
+ \"$dest\": trying to rename a volume or move a directory\
+ into itself"
+ }
+ }
+ file mkdir $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] != ".") && ([file tail $s] != "..")} {
+ file copy $s [file join $dest [file tail $s]]
+ }
+ }
+ return
+}
diff --git a/tcl/library/ldAout.tcl b/tcl/library/ldAout.tcl
index 2b369558f4e..8dd8cbe0df6 100644
--- a/tcl/library/ldAout.tcl
+++ b/tcl/library/ldAout.tcl
@@ -182,7 +182,7 @@ proc tclLdAout {{cc {}} {shlib_suffix {}} {shlib_cflags none}} {
append C {typedef int Tcl_PackageInitProc (Tcl_Interp *);} \n
append C {Tcl_PackageInitProc *} \n
append C TclLoadDictionary_ $modName { (symbol)} \n
- append C { char * symbol;} \n
+ append C { CONST char * symbol;} \n
append C {
{
int i;
diff --git a/tcl/library/license.terms b/tcl/library/license.terms
index 9df3e600352..f1dcaa5245c 100644
--- a/tcl/library/license.terms
+++ b/tcl/library/license.terms
@@ -1,7 +1,8 @@
This software is copyrighted by the Regents of the University of
-California, Sun Microsystems, Inc., Scriptics Corporation,
-and other parties. The following terms apply to all files associated
-with the software unless explicitly disclaimed in individual files.
+California, Sun Microsystems, Inc., Scriptics Corporation, ActiveState
+Corporation and other parties. The following terms apply to all files
+associated with the software unless explicitly disclaimed in
+individual files.
The authors hereby grant permission to use, copy, modify, distribute,
and license this software and its documentation for any purpose, provided
diff --git a/tcl/library/msgcat/msgcat.tcl b/tcl/library/msgcat/msgcat.tcl
new file mode 100644
index 00000000000..eb3b521976e
--- /dev/null
+++ b/tcl/library/msgcat/msgcat.tcl
@@ -0,0 +1,457 @@
+# msgcat.tcl --
+#
+# This file defines various procedures which implement a
+# message catalog facility for Tcl programs. It should be
+# loaded with the command "package require msgcat".
+#
+# Copyright (c) 1998-2000 by Ajuba Solutions.
+# Copyright (c) 1998 by Mark Harrison.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+package require Tcl 8.2
+# When the version number changes, be sure to update the pkgIndex.tcl file,
+# and the installation directory in the Makefiles.
+package provide msgcat 1.3
+
+namespace eval msgcat {
+ namespace export mc mcload mclocale mcmax mcmset mcpreferences mcset \
+ mcunknown
+
+ # Records the current locale as passed to mclocale
+ variable Locale ""
+
+ # Records the list of locales to search
+ variable Loclist {}
+
+ # Records the mapping between source strings and translated strings. The
+ # array key is of the form "<locale>,<namespace>,<src>" and the value is
+ # the translated string.
+ array set Msgs {}
+
+ # Map of language codes used in Windows registry to those of ISO-639
+ array set WinRegToISO639 {
+ 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
+ }
+}
+
+# msgcat::mc --
+#
+# Find the translation for the given string based on the current
+# locale setting. Check the local namespace first, then look in each
+# parent namespace until the source is found. If additional args are
+# specified, use the format command to work them into the traslated
+# string.
+#
+# Arguments:
+# src The string to translate.
+# args Args to pass to the format command
+#
+# Results:
+# Returns the translatd string. Propagates errors thrown by the
+# format command.
+
+proc msgcat::mc {src args} {
+ # Check for the src in each namespace starting from the local and
+ # ending in the global.
+
+ variable Msgs
+ variable Loclist
+ variable Locale
+
+ set ns [uplevel 1 [list ::namespace current]]
+
+ while {$ns != ""} {
+ foreach loc $Loclist {
+ if {[info exists Msgs($loc,$ns,$src)]} {
+ if {[llength $args] == 0} {
+ return $Msgs($loc,$ns,$src)
+ } else {
+ return [uplevel 1 \
+ [linsert $args 0 ::format $Msgs($loc,$ns,$src)]]
+ }
+ }
+ }
+ set ns [namespace parent $ns]
+ }
+ # we have not found the translation
+ return [uplevel 1 \
+ [linsert $args 0 [::namespace origin mcunknown] $Locale $src]]
+}
+
+# msgcat::mclocale --
+#
+# Query or set the current locale.
+#
+# Arguments:
+# newLocale (Optional) The new locale string. Locale strings
+# should be composed of one or more sublocale parts
+# separated by underscores (e.g. en_US).
+#
+# Results:
+# Returns the current locale.
+
+proc msgcat::mclocale {args} {
+ variable Loclist
+ variable Locale
+ set len [llength $args]
+
+ if {$len > 1} {
+ error {wrong # args: should be "mclocale ?newLocale?"}
+ }
+
+ if {$len == 1} {
+ set Locale [string tolower [lindex $args 0]]
+ set Loclist {}
+ set word ""
+ foreach part [split $Locale _] {
+ set word [string trimleft "${word}_${part}" _]
+ set Loclist [linsert $Loclist 0 $word]
+ }
+ }
+ return $Locale
+}
+
+# msgcat::mcpreferences --
+#
+# Fetch the list of locales used to look up strings, ordered from
+# most preferred to least preferred.
+#
+# Arguments:
+# None.
+#
+# Results:
+# Returns an ordered list of the locales preferred by the user.
+
+proc msgcat::mcpreferences {} {
+ variable Loclist
+ return $Loclist
+}
+
+# msgcat::mcload --
+#
+# Attempt to load message catalogs for each locale in the
+# preference list from the specified directory.
+#
+# Arguments:
+# langdir The directory to search.
+#
+# Results:
+# Returns the number of message catalogs that were loaded.
+
+proc msgcat::mcload {langdir} {
+ set x 0
+ foreach p [mcpreferences] {
+ set langfile [file join $langdir $p.msg]
+ if {[file exists $langfile]} {
+ incr x
+ set fid [open $langfile "r"]
+ fconfigure $fid -encoding utf-8
+ uplevel 1 [read $fid]
+ close $fid
+ }
+ }
+ return $x
+}
+
+# msgcat::mcset --
+#
+# Set the translation for a given string in a specified locale.
+#
+# Arguments:
+# locale The locale to use.
+# src The source string.
+# dest (Optional) The translated string. If omitted,
+# the source string is used.
+#
+# Results:
+# Returns the new locale.
+
+proc msgcat::mcset {locale src {dest ""}} {
+ variable Msgs
+ if {[string equal $dest ""]} {
+ set dest $src
+ }
+
+ set ns [uplevel 1 [list ::namespace current]]
+
+ set Msgs([string tolower $locale],$ns,$src) $dest
+ return $dest
+}
+
+# msgcat::mcmset --
+#
+# Set the translation for multiple strings in a specified locale.
+#
+# Arguments:
+# locale The locale to use.
+# pairs One or more src/dest pairs (must be even length)
+#
+# Results:
+# Returns the number of pairs processed
+
+proc msgcat::mcmset {locale pairs } {
+ variable Msgs
+
+ set length [llength $pairs]
+ if {$length % 2} {
+ error {bad translation list: should be "mcmset locale {src dest ...}"}
+ }
+
+ set locale [string tolower $locale]
+ set ns [uplevel 1 [list ::namespace current]]
+
+ foreach {src dest} $pairs {
+ set Msgs($locale,$ns,$src) $dest
+ }
+
+ return $length
+}
+
+# msgcat::mcunknown --
+#
+# 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.
+# If additional args are specified, the format command will be used
+# to work them into the traslated string.
+#
+# Arguments:
+# locale The current locale.
+# src The string to be translated.
+# args Args to pass to the format command
+#
+# Results:
+# Returns the translated value.
+
+proc msgcat::mcunknown {locale src args} {
+ if {[llength $args]} {
+ return [uplevel 1 [linsert $args 0 ::format $src]]
+ } else {
+ return $src
+ }
+}
+
+# msgcat::mcmax --
+#
+# Calculates the maximun length of the translated strings of the given
+# list.
+#
+# Arguments:
+# args strings to translate.
+#
+# Results:
+# Returns the length of the longest translated string.
+
+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 max $len
+ }
+ }
+ return $max
+}
+
+# Convert the locale values stored in environment variables to a form
+# suitable for passing to [mclocale]
+proc msgcat::ConvertLocale {value} {
+ # Assume $value is of form: $language[_$territory][.$codeset][@modifier]
+ # Convert to form: $language[_$territory][_$modifier]
+ #
+ # Comment out expanded RE version -- bugs alleged
+ # regexp -expanded {
+ # ^ # Match all the way to the beginning
+ # ([^_.@]*) # Match "lanugage"; ends with _, ., or @
+ # (_([^.@]*))? # Match (optional) "territory"; starts with _
+ # ([.]([^@]*))? # Match (optional) "codeset"; starts with .
+ # (@(.*))? # Match (optional) "modifier"; starts with @
+ # $ # Match all the way to the end
+ # } $value -> language _ territory _ codeset _ modifier
+ regexp {^([^_.@]*)(_([^.@]*))?([.]([^@]*))?(@(.*))?$} $value \
+ -> language _ territory _ codeset _ modifier
+ set ret $language
+ if {[string length $territory]} {
+ append ret _$territory
+ }
+ if {[string length $modifier]} {
+ append ret _$modifier
+ }
+ return $ret
+}
+
+# Initialize the default locale
+proc msgcat::Init {} {
+ #
+ # set default locale, try to get from environment
+ #
+ foreach varName {LC_ALL LC_MESSAGES LANG} {
+ if {[info exists ::env($varName)]
+ && ![string equal "" $::env($varName)]} {
+ mclocale [ConvertLocale $::env($varName)]
+ return
+ }
+ }
+ #
+ # On Windows, try to set locale depending on registry settings,
+ # or fall back on locale of "C". Other platforms will return
+ # when they fail to load the registry package.
+ #
+ set key {HKEY_CURRENT_USER\Control Panel\International}
+ if {[catch {package require registry}] \
+ || [catch {registry get $key "locale"} locale]} {
+ mclocale C
+ return
+ }
+ #
+ # Keep trying to match against smaller and smaller suffixes
+ # of the registry value, since the latter hexadigits appear
+ # to determine general language and earlier hexadigits determine
+ # more precise information, such as territory. For example,
+ # 0409 - English - United States
+ # 0809 - English - United Kingdom
+ # Add more translations to the WinRegToISO639 array above.
+ #
+ variable WinRegToISO639
+ set locale [string tolower $locale]
+ while {[string length $locale]} {
+ if {![catch {mclocale [ConvertLocale $WinRegToISO639($locale)]}]} {
+ return
+ }
+ set locale [string range $locale 1 end]
+ }
+ #
+ # No translation known. Fall back on "C" locale
+ #
+ mclocale C
+}
+msgcat::Init
diff --git a/tcl/library/msgcat/pkgIndex.tcl b/tcl/library/msgcat/pkgIndex.tcl
new file mode 100644
index 00000000000..9d16a190510
--- /dev/null
+++ b/tcl/library/msgcat/pkgIndex.tcl
@@ -0,0 +1,2 @@
+if {![package vsatisfies [package provide Tcl] 8.2]} {return}
+package ifneeded msgcat 1.3 [list source [file join $dir msgcat.tcl]]
diff --git a/tcl/library/opt/optparse.tcl b/tcl/library/opt/optparse.tcl
new file mode 100644
index 00000000000..828dba5d2db
--- /dev/null
+++ b/tcl/library/opt/optparse.tcl
@@ -0,0 +1,1092 @@
+# optparse.tcl --
+#
+# (private) Option parsing package
+# Primarily used internally by the safe:: code.
+#
+# WARNING: This code will go away in a future release
+# 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$
+
+package require Tcl 8
+# When this version number changes, update the pkgIndex.tcl file
+# and the install directory in the Makefiles.
+package provide opt 0.4.3
+
+namespace eval ::tcl {
+
+ # Exported APIs
+ namespace export OptKeyRegister OptKeyDelete OptKeyError OptKeyParse \
+ OptProc OptProcArgGiven OptParse \
+ Lempty Lget \
+ Lassign Lvarpop Lvarpop1 Lvarset Lvarincr \
+ SetMax SetMin
+
+
+################# Example of use / 'user documentation' ###################
+
+ proc OptCreateTestProc {} {
+
+ # Defines ::tcl::OptParseTest as a test proc with parsed arguments
+ # (can't be defined before the code below is loaded (before "OptProc"))
+
+ # 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
+ OptProc OptParseTest {
+ {subcommand -choice {save print} "sub command"}
+ {arg1 3 "some number"}
+ {-aflag}
+ {-intflag 7}
+ {-weirdflag "help string"}
+ {-noStatics "Not ok to load static packages"}
+ {-nestedloading1 true "OK to load into nested slaves"}
+ {-nestedloading2 -boolean true "OK to load into nested slaves"}
+ {-libsOK -choice {Tk SybTcl}
+ "List of packages that can be loaded"}
+ {-precision -int 12 "Number of digits of precision"}
+ {-intval 7 "An integer"}
+ {-scale -float 1.0 "Scale factor"}
+ {-zoom 1.0 "Zoom factor"}
+ {-arbitrary foobar "Arbitrary string"}
+ {-random -string 12 "Random string"}
+ {-listval -list {} "List value"}
+ {-blahflag -blah abc "Funny type"}
+ {arg2 -boolean "a boolean"}
+ {arg3 -choice "ch1 ch2"}
+ {?optarg? -list {} "optional argument"}
+ } {
+ foreach v [info locals] {
+ puts stderr [format "%14s : %s" $v [set $v]]
+ }
+ }
+ }
+
+################### No User serviceable part below ! ###############
+# You should really not look any further :
+# The following is private unexported undocumented unblessed... code
+# time to hit "q" ;-) !
+
+# Hmmm... ok, you really want to know ?
+
+# You've been warned... Here it is...
+
+ # Array storing the parsed descriptions
+ variable OptDesc;
+ array set OptDesc {};
+ # Next potentially free key id (numeric)
+ variable OptDescN 0;
+
+# Inside algorithm/mechanism description:
+# (not for the faint hearted ;-)
+#
+# The argument description is parsed into a "program tree"
+# It is called a "program" because it is the program used by
+# the state machine interpreter that use that program to
+# actually parse the arguments at run time.
+#
+# 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
+# x* means x repeated 0 or more time
+# x+ means "x x*"
+# x? means optionally x
+# x | y means x or y
+# "cccc" means the literal string
+#
+# program :== { programCounter programStep* }
+#
+# programStep :== program | singleStep
+#
+# programCounter :== {"P" integer+ }
+#
+# singleStep :== { instruction parameters* }
+#
+# instruction :== single element list
+#
+# (the difference between singleStep and program is that \
+# llength [lindex $program 0] >= 2
+# while
+# llength [lindex $singleStep 0] == 1
+# )
+#
+# And for this application:
+#
+# singleStep :== { instruction varname {hasBeenSet currentValue} type
+# typeArgs help }
+# instruction :== "flags" | "value"
+# type :== knowType | anyword
+# knowType :== "string" | "int" | "boolean" | "boolflag" | "float"
+# | "choice"
+#
+# for type "choice" typeArgs is a list of possible choices, the first one
+# is the default value. for all other types the typeArgs is the default value
+#
+# a "boolflag" is the type for a flag whose presence or absence, without
+# additional arguments means respectively true or false (default flag type).
+#
+# programCounter is the index in the list of the currently processed
+# programStep (thus starting at 1 (0 is {"P" prgCounterValue}).
+# If it is a list it points toward each currently selected programStep.
+# (like for "flags", as they are optional, form a set and programStep).
+
+# Performance/Implementation issues
+# ---------------------------------
+# We use tcl lists instead of arrays because with tcl8.0
+# they should start to be much faster.
+# But this code use a lot of helper procs (like Lvarset)
+# which are quite slow and would be helpfully optimized
+# for instance by being written in C. Also our struture
+# is complex and there is maybe some places where the
+# string rep might be calculated at great exense. to be checked.
+
+#
+# Parse a given description and saves it here under the given key
+# generate a unused keyid if not given
+#
+proc ::tcl::OptKeyRegister {desc {key ""}} {
+ variable OptDesc;
+ variable OptDescN;
+ if {[string compare $key ""] == 0} {
+ # 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;
+ }
+ # program counter
+ set program [list [list "P" 1]];
+
+ # are we processing flags (which makes a single program step)
+ set inflags 0;
+
+ set state {};
+
+ # flag used to detect that we just have a single (flags set) subprogram.
+ set empty 1;
+
+ foreach item $desc {
+ if {$state == "args"} {
+ # more items after 'args'...
+ return -code error "'args' special argument must be the last one";
+ }
+ set res [OptNormalizeOne $item];
+ set state [lindex $res 0];
+ if {$inflags} {
+ if {$state == "flags"} {
+ # add to 'subprogram'
+ 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;
+ # put the other regular stuff
+ lappend program $res;
+ set inflags 0;
+ set empty 0;
+ }
+ } else {
+ if {$state == "flags"} {
+ set inflags 1;
+ # sub program counter + first sub program
+ set flagsprg [list [list "P" 1] $res];
+ } else {
+ lappend program $res;
+ set empty 0;
+ }
+ }
+ }
+ if {$inflags} {
+ if {$empty} {
+ # We just have the subprogram, optimize and remove
+ # unneeded level:
+ set program $flagsprg;
+ } else {
+ lappend program $flagsprg;
+ }
+ }
+
+ set OptDesc($key) $program;
+
+ return $key;
+}
+
+#
+# Free the storage for that given key
+#
+proc ::tcl::OptKeyDelete {key} {
+ variable OptDesc;
+ unset OptDesc($key);
+}
+
+ # Get the parsed description stored under the given key.
+ proc OptKeyGetDesc {descKey} {
+ variable OptDesc;
+ if {![info exists OptDesc($descKey)]} {
+ return -code error "Unknown option description key \"$descKey\"";
+ }
+ set OptDesc($descKey);
+ }
+
+# Parse entry point for ppl who don't want to register with a key,
+# for instance because the description changes dynamically.
+# (otherwise one should really use OptKeyRegister once + OptKeyParse
+# 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;
+}
+
+# Helper function, replacement for proc that both
+# register the description under a key which is the name of the proc
+# (and thus unique to that code)
+# and add a first line to the code to call the OptKeyParse proc
+# Stores the list of variables that have been actually given by the user
+# (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]];
+ if { ([string match "::*" $name])
+ || ([string compare $namespace "::"]==0)} {
+ # absolute name or global namespace, name is the key
+ set key $name;
+ } else {
+ # we are relative to some non top level namespace:
+ set key "${namespace}::${name}";
+ }
+ 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;
+ expr {[lsearch $alist $argname] >=0}
+}
+
+ #######
+ # Programs/Descriptions manipulation
+
+ # Return the instruction word/list of a given step/(sub)program
+ proc OptInstr {lst} {
+ lindex $lst 0;
+ }
+ # Is a (sub) program or a plain instruction ?
+ proc OptIsPrg {lst} {
+ expr {[llength [OptInstr $lst]]>=2}
+ }
+ # Is this instruction a program counter or a real instr
+ proc OptIsCounter {item} {
+ expr {[lindex $item 0]=="P"}
+ }
+ # Current program counter (2nd word of first word)
+ proc OptGetPrgCounter {lst} {
+ Lget $lst {0 1}
+ }
+ # Current program counter (2nd word of first word)
+ proc OptSetPrgCounter {lstName 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 {};
+ foreach idx [lrange [lindex $lst 0] 1 end] {
+ lappend res [Lget $lst $idx];
+ }
+ return $res;
+ }
+
+ # Advance to next description
+ proc OptNextDesc {descName} {
+ uplevel 1 [list Lvarincr $descName {0 1}];
+ }
+
+ # Get the current description, eventually descend
+ proc OptCurDesc {descriptions} {
+ lindex $descriptions [OptGetPrgCounter $descriptions];
+ }
+ # get the current description, eventually descend
+ # through sub programs as needed.
+ proc OptCurDescFinal {descriptions} {
+ set item [OptCurDesc $descriptions];
+ # Descend untill we get the actual item and not a sub program
+ while {[OptIsPrg $item]} {
+ set item [OptCurDesc $item];
+ }
+ return $item;
+ }
+ # Current final instruction adress
+ proc OptCurAddr {descriptions {start {}}} {
+ set adress [OptGetPrgCounter $descriptions];
+ lappend start $adress;
+ set item [lindex $descriptions $adress];
+ if {[OptIsPrg $item]} {
+ return [OptCurAddr $item $start];
+ } else {
+ 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];
+ # use the 3th field of the item (see OptValue / OptNewInst)
+ lappend adress 2
+ Lvarset descriptions $adress [list 1 $value];
+ # ^hasBeenSet flag
+ }
+
+ # empty state means done/paste the end of the program
+ proc OptState {item} {
+ lindex $item 0
+ }
+
+ # current state
+ proc OptCurState {descriptions} {
+ OptState [OptCurDesc $descriptions];
+ }
+
+ #######
+ # Arguments manipulation
+
+ # Returns the argument that has to be processed now
+ proc OptCurrentArg {lst} {
+ lindex $lst 0;
+ }
+ # Advance to next argument
+ proc OptNextArg {argsName} {
+ uplevel 1 [list Lvarpop1 $argsName];
+ }
+ #######
+
+
+
+
+
+ # Loop over all descriptions, calling OptDoOne which will
+ # eventually eat all the arguments.
+ proc OptDoAll {descriptionsName argumentsName} {
+ upvar $descriptionsName descriptions
+ 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];
+ # We'll exit the loop in "OptDoOne" or when state is empty.
+ while 1 {
+ 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;
+ Lvarset1nc descriptions [OptGetPrgCounter $descriptions]\
+ $curitem;
+ OptNextDesc descriptions;
+ set curitem [OptCurDesc $descriptions];
+ set state [OptCurState $descriptions];
+ }
+# puts "state = \"$state\" - arguments=($arguments)";
+ if {[Lempty $state]} {
+ # Nothing left to do, we are done in this branch:
+ break;
+ }
+ # The following statement can make us terminate/continue
+ # as it use return -code {break, continue, return and error}
+ # codes
+ 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];
+ }
+ }
+
+ # 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;
+
+ # the special state/instruction "args" eats all
+ # the remaining args (if any)
+ if {($state == "args")} {
+ if {![Lempty $arguments]} {
+ # If there is no additional arguments, leave the default value
+ # in.
+ OptCurSetValue descriptions $arguments;
+ set arguments {};
+ }
+# puts "breaking out ('args' state: consuming every reminding args)"
+ 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;
+ } elseif {$state == "optValue"} {
+ set state next; # not used, for debug only
+ # go to next state
+ return ;
+ } else {
+ return -code error [OptMissingValue $descriptions];
+ }
+ } else {
+ set arg [OptCurrentArg $arguments];
+ }
+
+ switch $state {
+ flags {
+ # A non-dash argument terminates the options, as does --
+
+ # Still a flag ?
+ if {![OptIsFlag $arg]} {
+ # don't consume the argument, return to previous prg
+ return -code return;
+ }
+ # consume the flag
+ OptNextArg arguments;
+ if {[string compare "--" $arg] == 0} {
+ # return from 'flags' state
+ return -code return;
+ }
+
+ 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];
+ if {[OptNeedValue $item]} {
+ # we need a value, next state is
+ set state flagValue;
+ } else {
+ OptCurSetValue descriptions 1;
+ }
+ # continue
+ return -code continue;
+ }
+ flagValue -
+ value {
+ 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;
+ # set the value
+ OptCurSetValue descriptions $val;
+ # go to next state
+ if {$state == "flagValue"} {
+ set state flags
+ return -code continue;
+ } else {
+ set state next; # not used, for debug only
+ return ; # will go on next step
+ }
+ }
+ optValue {
+ 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;
+ # set the value
+ OptCurSetValue descriptions $val;
+ }
+ # go to next state
+ set state next; # not used, for debug only
+ return ; # will go on next step
+ }
+ }
+ # If we reach this point: an unknown
+ # state as been entered !
+ return -code error "Bug! unknown state in DoOne \"$state\"\
+ (prg counter [OptGetPrgCounter $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];
+
+ # make sure -help always give usage
+ if {[string compare "-help" [string tolower $arglist]] == 0} {
+ return -code error [OptError "Usage information:" $desc 1];
+ }
+
+ OptDoAll desc arglist;
+
+ if {![Lempty $arglist]} {
+ return -code error [OptTooManyArgs $desc $arglist];
+ }
+
+ # Analyse the result
+ # Walk through the tree:
+ 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 {[OptIsPrg $item]} {
+ set vnamesLst [OptTreeVars $item $level $vnamesLst];
+ } else {
+ set vname [OptVarName $item];
+ upvar $level $vname var
+ if {[OptHasBeenSet $item]} {
+# puts "adding $vname"
+ # lets use the input name for the returned list
+ # 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];
+ } else {
+ set var [OptDefaultValue $item];
+ }
+ }
+ }
+ return $vnamesLst
+ }
+
+
+# Check the type of a value
+# 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)";
+
+ # only types "any", "choice", and numbers can have leading "-"
+
+ switch -exact -- $type {
+ int {
+ if {![regexp {^(-+)?[0-9]+$} $arg]} {
+ error "not an integer"
+ }
+ return $arg;
+ }
+ float {
+ return [expr {double($arg)}]
+ }
+ script -
+ list {
+ # if llength fail : malformed list
+ if {[llength $arg]==0} {
+ if {[OptIsFlag $arg]} {
+ error "no values with leading -"
+ }
+ }
+ return $arg;
+ }
+ boolean {
+ if {![regexp -nocase {^(true|false|0|1)$} $arg]} {
+ error "non canonic boolean"
+ }
+ # convert true/false because expr/if is broken with "!,...
+ if {$arg} {
+ return 1
+ } else {
+ return 0
+ }
+ }
+ choice {
+ if {[lsearch -exact $typeArgs $arg] < 0} {
+ error "invalid choice"
+ }
+ return $arg;
+ }
+ any {
+ return $arg;
+ }
+ string -
+ default {
+ if {[OptIsFlag $arg]} {
+ error "no values with leading -"
+ }
+ return $arg
+ }
+ }
+ return neverReached;
+}
+
+ # internal utilities
+
+ # 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;
+ set hits 0
+ set hitems {}
+ set i 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];
+ if {$len == [string length $lflag]} {
+ if {[string compare $larg $lflag]==0} {
+ # Exact match case
+ OptSetPrgCounter desc $i;
+ return 1;
+ }
+ } else {
+ if {[string compare $larg [string range $lflag 0 $last]]==0} {
+ lappend hitems $i;
+ incr hits;
+ }
+ }
+ incr i;
+ }
+ if {$hits} {
+ OptSetPrgCounter desc $hitems;
+ }
+ return $hits
+ }
+
+ # Extract fields from the list structure:
+
+ proc OptName {item} {
+ lindex $item 1;
+ }
+ #
+ proc OptHasBeenSet {item} {
+ Lget $item {2 0};
+ }
+ #
+ proc OptValue {item} {
+ Lget $item {2 1};
+ }
+
+ proc OptIsFlag {name} {
+ string match "-*" $name;
+ }
+ proc OptIsOpt {name} {
+ string match {\?*} $name;
+ }
+ proc OptVarName {item} {
+ set name [OptName $item];
+ if {[OptIsFlag $name]} {
+ return [string range $name 1 end];
+ } elseif {[OptIsOpt $name]} {
+ return [string trim $name "?"];
+ } else {
+ return $name;
+ }
+ }
+ proc OptType {item} {
+ lindex $item 3
+ }
+ proc OptTypeArgs {item} {
+ lindex $item 4
+ }
+ proc OptHelp {item} {
+ lindex $item 5
+ }
+ proc OptNeedValue {item} {
+ string compare [OptType $item] boolflag
+ }
+ proc OptDefaultValue {item} {
+ set val [OptTypeArgs $item]
+ switch -exact -- [OptType $item] {
+ choice {return [lindex $val 0]}
+ boolean -
+ boolflag {
+ # convert back false/true to 0/1 because expr !$bool
+ # is broken..
+ if {$val} {
+ return 1
+ } else {
+ return 0
+ }
+ }
+ }
+ return $val
+ }
+
+ # Description format error helper
+ proc OptOptUsage {item {what ""}} {
+ return -code error "invalid description format$what: $item\n\
+ should be a list of {varname|-flagname ?-type? ?defaultvalue?\
+ ?helpstring?}";
+ }
+
+
+ # Generate a canonical form single instruction
+ proc OptNewInst {state varname type typeArgs help} {
+ list $state $varname [list 0 {}] $type $typeArgs $help;
+ # ^ ^
+ # | |
+ # hasBeenSet=+ +=currentValue
+ }
+
+ # 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];
+ if {$isflag} {
+ set state "flags";
+ } elseif {$isopt} {
+ set state "optValue";
+ } elseif {[string compare $varname "args"]} {
+ set state "value";
+ } else {
+ set state "args";
+ }
+
+ # apply 'smart' 'fuzzy' logic to try to make
+ # description writer's life easy, and our's difficult :
+ # let's guess the missing arguments :-)
+
+ switch $lg {
+ 1 {
+ if {$isflag} {
+ return [OptNewInst $state $varname boolflag false ""];
+ } else {
+ return [OptNewInst $state $varname any "" ""];
+ }
+ }
+ 2 {
+ # varname default
+ # varname help
+ set type [OptGuessType $arg1]
+ if {[string compare $type "string"] == 0} {
+ if {$isflag} {
+ set type boolflag
+ set def false
+ } else {
+ set type any
+ set def ""
+ }
+ set help $arg1
+ } else {
+ set help ""
+ set def $arg1
+ }
+ 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 ""];
+ } else {
+ return [OptNewInst $state $varname $type "" $arg2];
+ }
+ } else {
+ return [OptNewInst $state $varname\
+ [OptGuessType $arg1] $arg1 $arg2]
+ }
+ }
+ 4 {
+ if {[regexp {^-(.+)$} $arg1 x type]} {
+ return [OptNewInst $state $varname $type $arg2 $arg3];
+ } else {
+ return -code error [OptOptUsage $item];
+ }
+ }
+ default {
+ return -code error [OptOptUsage $item];
+ }
+ }
+ }
+
+ # Auto magic lasy type determination
+ proc OptGuessType {arg} {
+ if {[regexp -nocase {^(true|false)$} $arg]} {
+ return boolean
+ }
+ if {[regexp {^(-+)?[0-9]+$} $arg]} {
+ return int
+ }
+ if {![catch {expr {double($arg)}}]} {
+ return float
+ }
+ return string
+ }
+
+ # Error messages front ends
+
+ proc OptAmbigous {desc arg} {
+ OptError "ambigous option \"$arg\", choose from:" [OptSelection $desc]
+ }
+ proc OptFlagUsage {desc arg} {
+ OptError "bad flag \"$arg\", must be one of" $desc;
+ }
+ proc OptTooManyArgs {desc arguments} {
+ OptError "too many arguments (unexpected argument(s): $arguments),\
+ usage:"\
+ $desc 1
+ }
+ proc OptParamType {item} {
+ if {[OptIsFlag $item]} {
+ return "flag";
+ } else {
+ return "parameter";
+ }
+ }
+ proc OptBadValue {item arg {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];
+ 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;
+}
+
+ # determine string length for nice tabulated output
+ proc OptLengths {desc nlName tlName dlName} {
+ upvar $nlName nl;
+ upvar $tlName tl;
+ upvar $dlName dl;
+ foreach item $desc {
+ 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];
+ if {[OptState $item] != "header"} {
+ set dv "($dv)";
+ }
+ set l [string length $dv];
+ # limit the space allocated to potentially big "choices"
+ if {([OptType $item] != "choice") || ($l<=12)} {
+ SetMax dl $l
+ } else {
+ if {![info exists dl]} {
+ set dl 0
+ }
+ }
+ }
+ }
+ }
+ # output the tree
+ proc OptTree {desc nl tl dl} {
+ set res "";
+ foreach item $desc {
+ if {[OptIsCounter $item]} continue;
+ if {[OptIsPrg $item]} {
+ append res [OptTree $item $nl $tl $dl];
+ } else {
+ set dv [OptTypeArgs $item];
+ if {[OptState $item] != "header"} {
+ set dv "($dv)";
+ }
+ append res [format "\n %-*s %-*s %-*s %s" \
+ $nl [OptName $item] $tl [OptType $item] \
+ $dl $dv [OptHelp $item]]
+ }
+ }
+ return $res;
+ }
+
+# Give nice usage string
+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 desc [concat $h $desc]
+ }
+ OptLengths $desc nl tl dl
+ # actually output
+ return "$prefix[OptTree $desc $nl $tl $dl]"
+}
+
+
+################ General Utility functions #######################
+
+#
+# List utility functions
+# Naming convention:
+# "Lvarxxx" take the list VARiable name as argument
+# "Lxxxx" take the list value as argument
+# (which is not costly with Tcl8 objects system
+# as it's still a reference and not a copy of the values)
+#
+
+# Is that list empty ?
+proc ::tcl::Lempty {list} {
+ expr {[llength $list]==0}
+}
+
+# Gets the value of one leaf of a lists tree
+proc ::tcl::Lget {list indexLst} {
+ if {[llength $indexLst] <= 1} {
+ return [lindex $list $indexLst];
+ }
+ 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
+# 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;
+ if {[llength $indexLst] <= 1} {
+ Lvarset1nc list $indexLst $newValue;
+ } else {
+ 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 {};
+ # recursively replace in targetList
+ Lvarset targetList [lrange $indexLst 1 end] $newValue;
+ # put updated sub list back in the tree
+ 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;
+ if {$index < 0} {return -code error "invalid negative index"}
+ set lg [llength $list];
+ if {$index >= $lg} {
+ variable emptyList;
+ for {set i $lg} {$i<$index} {incr i} {
+ lappend list $emptyList;
+ }
+ lappend list $newValue;
+ } else {
+ 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];
+}
+# Increments the value of one leaf of a lists tree
+# (which must exists)
+proc ::tcl::Lvarincr {listName indexLst {howMuch 1}} {
+ upvar $listName list;
+ if {[llength $indexLst] <= 1} {
+ Lvarincr1 list $indexLst $howMuch;
+ } else {
+ set idx [lindex $indexLst 0];
+ set targetList [lindex $list $idx];
+ # reduce refcount on targetList
+ Lvarset1nc list $idx {};
+ # recursively replace in targetList
+ Lvarincr targetList [lrange $indexLst 1 end] $howMuch;
+ # put updated sub list back in the tree
+ 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;
+}
+# 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];
+}
+# 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;
+}
+# 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];
+ foreach vname $args {
+ if {$i>=$lg} break
+ uplevel 1 [list ::set $vname [lindex $list $i]];
+ incr i;
+ }
+ return $lg;
+}
+
+# Misc utilities
+
+# Set the varname to value if value is greater than varname's current value
+# or if varname is undefined
+proc ::tcl::SetMax {varname value} {
+ upvar 1 $varname var
+ if {![info exists var] || $value > $var} {
+ set var $value
+ }
+}
+
+# Set the varname to value if value is smaller than varname's current value
+# or if varname is undefined
+proc ::tcl::SetMin {varname value} {
+ upvar 1 $varname var
+ if {![info exists var] || $value < $var} {
+ set var $value
+ }
+}
+
+
+ # everything loaded fine, lets create the test proc:
+ # OptCreateTestProc
+ # Don't need the create temp proc anymore:
+ # rename OptCreateTestProc {}
+}
diff --git a/tcl/library/opt/pkgIndex.tcl b/tcl/library/opt/pkgIndex.tcl
new file mode 100644
index 00000000000..02c289c9a4e
--- /dev/null
+++ b/tcl/library/opt/pkgIndex.tcl
@@ -0,0 +1,12 @@
+# Tcl package index file, version 1.1
+# This file is generated by the "pkg_mkIndex -direct" 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]} {return}
+package ifneeded opt 0.4.3 [list source [file join $dir optparse.tcl]]
diff --git a/tcl/library/package.tcl b/tcl/library/package.tcl
index ab6b790b861..02c33e6a1f7 100644
--- a/tcl/library/package.tcl
+++ b/tcl/library/package.tcl
@@ -33,13 +33,30 @@ namespace eval ::pkg {
proc pkg_compareExtension { fileName {ext {}} } {
global tcl_platform
- if {[string length $ext] == 0} {
- set ext [info sharedlibextension]
- }
+ if {![string length $ext]} {set ext [info sharedlibextension]}
if {[string equal $tcl_platform(platform) "windows"]} {
- return [string equal -nocase [file extension $fileName] $ext]
+ return [string equal -nocase [file extension $fileName] $ext]
} else {
- return [string equal [file extension $fileName] $ext]
+ # Some unices add trailing numbers after the .so, so
+ # we could have something like '.so.1.2'.
+ set root $fileName
+ while {1} {
+ set currExt [file extension $root]
+ if {[string equal $currExt $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
+ # extensions. Otherwise we might return 1 in this case:
+ # pkg_compareExtension foo.so.bar .so
+ # which should not match.
+
+ if { ![string is integer -strict [string range $currExt 1 end]] } {
+ return 0
+ }
+ set root [file rootname $root]
+ }
}
}
@@ -70,7 +87,7 @@ proc pkg_compareExtension { fileName {ext {}} } {
proc pkg_mkIndex {args} {
global errorCode errorInfo
- set usage {"pkg_mkIndex ?-direct? ?-verbose? ?-load pattern? ?--? dir ?pattern ...?"};
+ set usage {"pkg_mkIndex ?-direct? ?-lazy? ?-load pattern? ?-verbose? ?--? dir ?pattern ...?"};
set argCount [llength $args]
if {$argCount < 1} {
@@ -148,10 +165,23 @@ proc pkg_mkIndex {args} {
# Load into the child any packages currently loaded in the parent
# interpreter that match the -load pattern.
+ if {[string length $loadPat]} {
+ if {$doVerbose} {
+ tclLog "currently loaded packages: '[info loaded]'"
+ tclLog "trying to load all packages matching $loadPat"
+ }
+ if {![llength [info loaded]]} {
+ tclLog "warning: no packages are currently loaded, nothing"
+ tclLog "can possibly match '$loadPat'"
+ }
+ }
foreach pkg [info loaded] {
if {! [string match $loadPat [lindex $pkg 1]]} {
continue
}
+ if {$doVerbose} {
+ tclLog "package [lindex $pkg 1] matches '$loadPat'"
+ }
if {[catch {
load [lindex $pkg 0] [lindex $pkg 1] $c
} err]} {
@@ -328,9 +358,17 @@ proc pkg_mkIndex {args} {
tclLog "warning: error while $what $file: $msg"
}
} else {
+ set what [$c eval set ::tcl::debug]
+ if {$doVerbose} {
+ tclLog "successful $what of $file"
+ }
set type [$c eval set ::tcl::type]
set cmds [lsort [$c eval array names ::tcl::newCmds]]
set pkgs [$c eval set ::tcl::newPkgs]
+ if {$doVerbose} {
+ tclLog "commands provided were $cmds"
+ tclLog "packages provided were $pkgs"
+ }
if {[llength $pkgs] > 1} {
tclLog "warning: \"$file\" provides more than one package ($pkgs)"
}
@@ -342,8 +380,8 @@ proc pkg_mkIndex {args} {
if {$doVerbose} {
tclLog "processed $file"
}
- interp delete $c
}
+ interp delete $c
}
append index "# Tcl package index file, version 1.1\n"
@@ -420,7 +458,7 @@ proc tclPkgSetup {dir pkg version files} {
# interpreter to setup the package database.
proc tclMacPkgSearch {dir} {
- foreach x [glob -nocomplain [file join $dir *.shlb]] {
+ foreach x [glob -directory $dir -nocomplain *.shlb] {
if {[file isfile $x]} {
set res [resource open $x]
foreach y [resource list TEXT $res] {
@@ -460,7 +498,8 @@ proc tclPkgUnknown {name version {exact {}}} {
# in a catch statement, where we get the pkgIndex files out
# of the subdirectories
catch {
- foreach file [glob -nocomplain [file join $dir * pkgIndex.tcl]] {
+ foreach file [glob -directory $dir -join -nocomplain \
+ * pkgIndex.tcl] {
set dir [file dirname $file]
if {[file readable $file] && ![info exists procdDirs($dir)]} {
if {[catch {source $file} msg]} {
@@ -492,7 +531,7 @@ proc tclPkgUnknown {name version {exact {}}} {
tclMacPkgSearch $dir
set procdDirs($dir) 1
}
- foreach x [glob -nocomplain [file join $dir *]] {
+ foreach x [glob -directory $dir -nocomplain *] {
if {[file isdirectory $x] && ![info exists procdDirs($x)]} {
set dir $x
tclMacPkgSearch $dir
@@ -629,4 +668,3 @@ proc ::pkg::create {args} {
return $cmdline
}
-
diff --git a/tcl/library/reg/pkgIndex.tcl b/tcl/library/reg/pkgIndex.tcl
new file mode 100644
index 00000000000..09ef4b0d05e
--- /dev/null
+++ b/tcl/library/reg/pkgIndex.tcl
@@ -0,0 +1,8 @@
+if {![package vsatisfies [package provide Tcl] 8]} {return}
+if {[info exists tcl_platform(debug)]} {
+ package ifneeded registry 1.0 \
+ [list load [file join $dir tclreg10d.dll] registry]
+} else {
+ package ifneeded registry 1.0 \
+ [list load [file join $dir tclreg10.dll] registry]
+}
diff --git a/tcl/library/safe.tcl b/tcl/library/safe.tcl
index 386ead114c3..11161de8825 100644
--- a/tcl/library/safe.tcl
+++ b/tcl/library/safe.tcl
@@ -496,7 +496,7 @@ proc ::safe::interpAddToAccessPath {slave path} {
if {[lsearch -exact $res $dir]<0} {
lappend res $dir
}
- foreach sub [glob -nocomplain -- [file join $dir *]] {
+ foreach sub [glob -directory $dir -nocomplain *] {
if {([file isdirectory $sub]) \
&& ([lsearch -exact $res $sub]<0) } {
# new sub dir, add it !
@@ -695,24 +695,14 @@ proc ::safe::setLogCmd {args} {
}
}
-
+
# file name control (limit access to files/ressources that should be
# a valid tcl source file)
proc CheckFileName {slave file} {
- # limit what can be sourced to .tcl
- # and forbid files with more than 1 dot and
- # longer than 14 chars
- set ftail [file tail $file]
- if {[string length $ftail]>14} {
- error "$ftail: filename too long"
- }
- if {[regexp {\..*\.} $ftail]} {
- error "$ftail: more than one dot is forbidden"
- }
- if {[string compare $ftail "tclIndex"] && \
- [string compare -nocase [file extension $ftail] ".tcl"]} {
- error "$ftail: must be a *.tcl or tclIndex"
- }
+ # 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
diff --git a/tcl/library/tcltest/pkgIndex.tcl b/tcl/library/tcltest/pkgIndex.tcl
new file mode 100644
index 00000000000..b77e989c53c
--- /dev/null
+++ b/tcl/library/tcltest/pkgIndex.tcl
@@ -0,0 +1,12 @@
+# Tcl package index file, version 1.1
+# This file is generated by the "pkg_mkIndex -direct" 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.3]} {return}
+package ifneeded tcltest 2.2 [list source [file join $dir tcltest.tcl]]
diff --git a/tcl/library/tcltest/tcltest.tcl b/tcl/library/tcltest/tcltest.tcl
new file mode 100644
index 00000000000..63b00d3f9b7
--- /dev/null
+++ b/tcl/library/tcltest/tcltest.tcl
@@ -0,0 +1,3259 @@
+# tcltest.tcl --
+#
+# This file contains support code for the Tcl test suite. It
+# defines the tcltest namespace and finds and defines the output
+# directory, constraints available, output and error channels,
+# etc. used by Tcl tests. See the tcltest man page for more
+# details.
+#
+# This design was based on the Tcl testing approach designed and
+# initially implemented by Mary Ann May-Pumphrey of Sun
+# Microsystems.
+#
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 2000 by Ajuba Solutions
+# Contributions from Don Porter, NIST, 2002. (not subject to US copyright)
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+package require Tcl 8.3 ;# uses [glob -directory]
+namespace eval tcltest {
+
+ # When the version number changes, be sure to update the pkgIndex.tcl file,
+ # and the install directory in the Makefiles.
+ variable Version 2.2
+
+ # Compatibility support for dumb variables defined in tcltest 1
+ # Do not use these. Call [package provide Tcl] and [info patchlevel]
+ # yourself. You don't need tcltest to wrap it for you.
+ variable version [package provide Tcl]
+ variable patchLevel [info patchlevel]
+
+##### Export the public tcltest procs; several categories
+ #
+ # Export the main functional commands that do useful things
+ namespace export cleanupTests loadTestedCommands makeDirectory \
+ makeFile removeDirectory removeFile runAllTests test
+
+ # Export configuration commands that control the functional commands
+ namespace export configure customMatch errorChannel interpreter \
+ outputChannel testConstraint
+
+ # Export commands that are duplication (candidates for deprecation)
+ namespace export bytestring ;# dups [encoding convertfrom identity]
+ namespace export debug ;# [configure -debug]
+ namespace export errorFile ;# [configure -errfile]
+ namespace export limitConstraints ;# [configure -limitconstraints]
+ namespace export loadFile ;# [configure -loadfile]
+ namespace export loadScript ;# [configure -load]
+ namespace export match ;# [configure -match]
+ namespace export matchFiles ;# [configure -file]
+ namespace export matchDirectories ;# [configure -relateddir]
+ namespace export normalizeMsg ;# application of [customMatch]
+ namespace export normalizePath ;# [file normalize] (8.4)
+ namespace export outputFile ;# [configure -outfile]
+ namespace export preserveCore ;# [configure -preservecore]
+ namespace export singleProcess ;# [configure -singleproc]
+ namespace export skip ;# [configure -skip]
+ namespace export skipFiles ;# [configure -notfile]
+ namespace export skipDirectories ;# [configure -asidefromdir]
+ namespace export temporaryDirectory ;# [configure -tmpdir]
+ namespace export testsDirectory ;# [configure -testdir]
+ namespace export verbose ;# [configure -verbose]
+ namespace export viewFile ;# binary encoding [read]
+ namespace export workingDirectory ;# [cd] [pwd]
+
+ # Export deprecated commands for tcltest 1 compatibility
+ namespace export getMatchingFiles mainThread restoreState saveState \
+ threadReap
+
+ # tcltest::normalizePath --
+ #
+ # This procedure resolves any symlinks in the path thus creating
+ # a path without internal redirection. It assumes that the
+ # incoming path is absolute.
+ #
+ # Arguments
+ # pathVar - name of variable containing path to modify.
+ #
+ # Results
+ # The path is modified in place.
+ #
+ # Side Effects:
+ # None.
+ #
+ proc normalizePath {pathVar} {
+ upvar $pathVar path
+ set oldpwd [pwd]
+ catch {cd $path}
+ set path [pwd]
+ cd $oldpwd
+ return $path
+ }
+
+##### Verification commands used to test values of variables and options
+ #
+ # Verification command that accepts everything
+ proc AcceptAll {value} {
+ return $value
+ }
+
+ # Verification command that accepts valid Tcl lists
+ proc AcceptList { list } {
+ return [lrange $list 0 end]
+ }
+
+ # Verification command that accepts a glob pattern
+ proc AcceptPattern { pattern } {
+ return [AcceptAll $pattern]
+ }
+
+ # Verification command that accepts integers
+ proc AcceptInteger { level } {
+ return [incr level 0]
+ }
+
+ # Verification command that accepts boolean values
+ proc AcceptBoolean { boolean } {
+ return [expr {$boolean && $boolean}]
+ }
+
+ # Verification command that accepts (syntactically) valid Tcl scripts
+ proc AcceptScript { script } {
+ if {![info complete $script]} {
+ return -code error "invalid Tcl script: $script"
+ }
+ return $script
+ }
+
+ # Verification command that accepts (converts to) absolute pathnames
+ proc AcceptAbsolutePath { path } {
+ return [file join [pwd] $path]
+ }
+
+ # Verification command that accepts existing readable directories
+ proc AcceptReadable { path } {
+ if {![file readable $path]} {
+ return -code error "\"$path\" is not readable"
+ }
+ return $path
+ }
+ proc AcceptDirectory { directory } {
+ set directory [AcceptAbsolutePath $directory]
+ if {![file exists $directory]} {
+ return -code error "\"$directory\" does not exist"
+ }
+ if {![file isdir $directory]} {
+ return -code error "\"$directory\" is not a directory"
+ }
+ return [AcceptReadable $directory]
+ }
+
+##### Initialize internal arrays of tcltest, but only if the caller
+ # has not already pre-initialized them. This is done to support
+ # compatibility with older tests that directly access internals
+ # rather than go through command interfaces.
+ #
+ proc ArrayDefault {varName value} {
+ variable $varName
+ if {[array exists $varName]} {
+ return
+ }
+ if {[info exists $varName]} {
+ # Pre-initialized value is a scalar: destroy it!
+ unset $varName
+ }
+ array set $varName $value
+ }
+
+ # save the original environment so that it can be restored later
+ ArrayDefault originalEnv [array get ::env]
+
+ # initialize numTests array to keep track fo the number of tests
+ # that pass, fail, and are skipped.
+ ArrayDefault numTests [list Total 0 Passed 0 Skipped 0 Failed 0]
+
+ # numTests will store test files as indices and the list of files
+ # (that should not have been) left behind by the test files.
+ ArrayDefault createdNewFiles {}
+
+ # initialize skippedBecause array to keep track of constraints that
+ # kept tests from running; a constraint name of "userSpecifiedSkip"
+ # means that the test appeared on the list of tests that matched the
+ # -skip value given to the flag; "userSpecifiedNonMatch" means that
+ # the test didn't match the argument given to the -match flag; both
+ # of these constraints are counted only if tcltest::debug is set to
+ # true.
+ ArrayDefault skippedBecause {}
+
+ # initialize the testConstraints array to keep track of valid
+ # predefined constraints (see the explanation for the
+ # InitConstraints proc for more details).
+ ArrayDefault testConstraints {}
+
+##### Initialize internal variables of tcltest, but only if the caller
+ # has not already pre-initialized them. This is done to support
+ # compatibility with older tests that directly access internals
+ # rather than go through command interfaces.
+ #
+ proc Default {varName value {verify AcceptAll}} {
+ variable $varName
+ if {![info exists $varName]} {
+ variable $varName [$verify $value]
+ } else {
+ variable $varName [$verify [set $varName]]
+ }
+ }
+
+ # Save any arguments that we might want to pass through to other
+ # programs. This is used by the -args flag.
+ # FINDUSER
+ Default parameters {}
+
+ # Count the number of files tested (0 if runAllTests wasn't called).
+ # runAllTests will set testSingleFile to false, so stats will
+ # not be printed until runAllTests calls the cleanupTests proc.
+ # The currentFailure var stores the boolean value of whether the
+ # current test file has had any failures. The failFiles list
+ # stores the names of test files that had failures.
+ Default numTestFiles 0 AcceptInteger
+ Default testSingleFile true AcceptBoolean
+ Default currentFailure false AcceptBoolean
+ Default failFiles {} AcceptList
+
+ # Tests should remove all files they create. The test suite will
+ # check the current working dir for files created by the tests.
+ # filesMade keeps track of such files created using the makeFile and
+ # makeDirectory procedures. filesExisted stores the names of
+ # pre-existing files.
+ Default filesMade {} AcceptList
+ Default filesExisted {} AcceptList
+ variable FilesExistedFilled 0
+ proc FillFilesExisted {} {
+ variable FilesExistedFilled
+ if {$FilesExistedFilled} {return}
+ variable filesExisted
+
+ # Save the names of files that already exist in the scratch directory.
+ foreach file [glob -nocomplain -directory [temporaryDirectory] *] {
+ lappend filesExisted [file tail $file]
+ }
+ set FilesExistedFilled 1
+ }
+
+ # Kept only for compatibility
+ Default constraintsSpecified {} AcceptList
+ trace variable constraintsSpecified r {set ::tcltest::constraintsSpecified \
+ [array names ::tcltest::testConstraints] ;# }
+
+ # tests that use threads need to know which is the main thread
+ Default mainThread 1
+ variable mainThread
+ if {[info commands thread::id] != {}} {
+ set mainThread [thread::id]
+ } elseif {[info commands testthread] != {}} {
+ set mainThread [testthread id]
+ }
+
+ # Set workingDirectory to [pwd]. The default output directory for
+ # Tcl tests is the working directory. Whenever this value changes
+ # change to that directory.
+ variable workingDirectory
+ trace variable workingDirectory w \
+ [namespace code {cd $workingDirectory ;#}]
+
+ Default workingDirectory [pwd] AcceptAbsolutePath
+ proc workingDirectory { {dir ""} } {
+ variable workingDirectory
+ if {[llength [info level 0]] == 1} {
+ return $workingDirectory
+ }
+ set workingDirectory [AcceptAbsolutePath $dir]
+ }
+
+ # Set the location of the execuatble
+ Default tcltest [info nameofexecutable]
+ trace variable tcltest w [namespace code {testConstraint stdio \
+ [eval [ConstraintInitializer stdio]] ;#}]
+
+ # save the platform information so it can be restored later
+ Default originalTclPlatform [array get ::tcl_platform]
+
+ # If a core file exists, save its modification time.
+ if {[file exists [file join [workingDirectory] core]]} {
+ Default coreModTime \
+ [file mtime [file join [workingDirectory] core]]
+ }
+
+ # stdout and stderr buffers for use when we want to store them
+ Default outData {}
+ Default errData {}
+
+ # keep track of test level for nested test commands
+ variable testLevel 0
+
+ # the variables and procs that existed when saveState was called are
+ # stored in a variable of the same name
+ Default saveState {}
+
+ # Internationalization support -- used in [SetIso8859_1_Locale] and
+ # [RestoreLocale]. Those commands are used in cmdIL.test.
+
+ if {![info exists [namespace current]::isoLocale]} {
+ variable isoLocale fr
+ switch -- $::tcl_platform(platform) {
+ "unix" {
+
+ # Try some 'known' values for some platforms:
+
+ switch -exact -- $::tcl_platform(os) {
+ "FreeBSD" {
+ set isoLocale fr_FR.ISO_8859-1
+ }
+ HP-UX {
+ set isoLocale fr_FR.iso88591
+ }
+ Linux -
+ IRIX {
+ set isoLocale fr
+ }
+ default {
+
+ # Works on SunOS 4 and Solaris, and maybe
+ # others... Define it to something else on your
+ # system if you want to test those.
+
+ set isoLocale iso_8859_1
+ }
+ }
+ }
+ "windows" {
+ set isoLocale French
+ }
+ }
+ }
+
+ # output goes to stdout by default
+ Default outputChannel stdout
+ proc outputChannel { {filename ""} } {
+ variable outputChannel
+
+ # Trigger auto-configuration of -outfile option, if needed.
+ # This is tricky because we have to trigger a trace on $debug
+ # so that traces attached to $outputFile are not disabled.
+ # We need them enabled to reflect changes back to outputChannel
+ set dummy [debug]
+
+ if {[llength [info level 0]] == 1} {
+ return $outputChannel
+ }
+ switch -exact -- $filename {
+ stderr -
+ stdout {
+ set outputChannel $filename
+ }
+ default {
+ set outputChannel [open $filename a]
+ }
+ }
+ return $outputChannel
+ }
+
+ # errors go to stderr by default
+ Default errorChannel stderr
+ proc errorChannel { {filename ""} } {
+ variable errorChannel
+
+ # Trigger auto-configuration of -errfile option, if needed.
+ # This is tricky because we have to trigger a trace on $debug
+ # so that traces attached to $outputFile are not disabled.
+ # We need them enabled to reflect changes back to outputChannel
+ set dummy [debug]
+
+ if {[llength [info level 0]] == 1} {
+ return $errorChannel
+ }
+ switch -exact -- $filename {
+ stderr -
+ stdout {
+ set errorChannel $filename
+ }
+ default {
+ set errorChannel [open $filename a]
+ }
+ }
+ return $errorChannel
+ }
+
+##### Set up the configurable options
+ #
+ # The configurable options of the package
+ variable Option; array set Option {}
+
+ # Usage strings for those options
+ variable Usage; array set Usage {}
+
+ # Verification commands for those options
+ variable Verify; array set Verify {}
+
+ # Initialize the default values of the configurable options that are
+ # historically associated with an exported variable. If that variable
+ # is already set, support compatibility by accepting its pre-set value.
+ # Use [trace] to establish ongoing connection between the deprecated
+ # exported variable and the modern option kept as a true internal var.
+ # Also set up usage string and value testing for the option.
+ proc Option {option value usage {verify AcceptAll} {varName {}}} {
+ variable Option
+ variable Verify
+ variable Usage
+ variable OptionControlledVariables
+ set Usage($option) $usage
+ set Verify($option) $verify
+ if {[catch {$verify $value} msg]} {
+ return -code error $msg
+ } else {
+ set Option($option) $msg
+ }
+ if {[string length $varName]} {
+ variable $varName
+ if {[info exists $varName]} {
+ if {[catch {$verify [set $varName]} msg]} {
+ return -code error $msg
+ } else {
+ set Option($option) $msg
+ }
+ unset $varName
+ }
+ namespace eval [namespace current] \
+ [list upvar 0 Option($option) $varName]
+ # Workaround for Bug 572889. Grrrr....
+ # Track all the variables tied to options
+ lappend OptionControlledVariables $varName
+ # Later, set auto-configure read traces on all
+ # of them, since a single trace on Option does not work.
+ proc $varName {{value {}}} [subst -nocommands {
+ if {[llength [info level 0]] == 2} {
+ Configure $option [set value]
+ }
+ return [Configure $option]
+ }]
+ }
+ }
+
+ proc MatchingOption {option} {
+ variable Option
+ set match [array names Option $option*]
+ switch -- [llength $match] {
+ 0 {
+ set sorted [lsort [array names Option]]
+ set values [join [lrange $sorted 0 end-1] ", "]
+ append values ", or [lindex $sorted end]"
+ return -code error "unknown option $option: should be\
+ one of $values"
+ }
+ 1 {
+ return [lindex $match 0]
+ }
+ default {
+ # Exact match trumps ambiguity
+ if {[lsearch -exact $match $option] >= 0} {
+ return $option
+ }
+ set values [join [lrange $match 0 end-1] ", "]
+ append values ", or [lindex $match end]"
+ return -code error "ambiguous option $option:\
+ could match $values"
+ }
+ }
+ }
+
+ proc EstablishAutoConfigureTraces {} {
+ variable OptionControlledVariables
+ foreach varName [concat $OptionControlledVariables Option] {
+ variable $varName
+ trace variable $varName r [namespace code {ProcessCmdLineArgs ;#}]
+ }
+ }
+
+ proc RemoveAutoConfigureTraces {} {
+ 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
+ }
+ }
+ }
+ # One the traces are removed, this can become a no-op
+ proc RemoveAutoConfigureTraces {} {}
+ }
+
+ proc Configure args {
+ variable Option
+ variable Verify
+ set n [llength $args]
+ if {$n == 0} {
+ return [lsort [array names Option]]
+ }
+ if {$n == 1} {
+ if {[catch {MatchingOption [lindex $args 0]} option]} {
+ return -code error $option
+ }
+ return $Option($option)
+ }
+ while {[llength $args] > 1} {
+ if {[catch {MatchingOption [lindex $args 0]} option]} {
+ return -code error $option
+ }
+ if {[catch {$Verify($option) [lindex $args 1]} value]} {
+ return -code error "invalid $option\
+ value \"[lindex $args 1]\": $value"
+ }
+ set Option($option) $value
+ set args [lrange $args 2 end]
+ }
+ if {[llength $args]} {
+ if {[catch {MatchingOption [lindex $args 0]} option]} {
+ return -code error $option
+ }
+ return -code error "missing value for option $option"
+ }
+ }
+ proc configure args {
+ RemoveAutoConfigureTraces
+ set code [catch {eval 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]} {
+ # translate single characters abbreviations to expanded list
+ set level [string map {p pass b body s skip t start e error} \
+ [split $level {}]]
+ }
+ }
+ set valid [list]
+ foreach v $level {
+ if {[regexp {^(pass|body|skip|start|error)$} $v]} {
+ lappend valid $v
+ }
+ }
+ return $valid
+ }
+
+ proc IsVerbose {level} {
+ variable Option
+ return [expr {[lsearch -exact $Option(-verbose) $level] != -1}]
+ }
+
+ # Default verbosity is to show bodies of failed tests
+ Option -verbose body {
+ Takes any combination of the values 'p', 's', 'b', 't' and 'e'.
+ 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.
+ } AcceptVerbose verbose
+
+ # Match and skip patterns default to the empty list, except for
+ # matchFiles, which defaults to all .test files in the
+ # testsDirectory and matchDirectories, which defaults to all
+ # directories.
+ Option -match * {
+ Run all tests within the specified files that match one of the
+ list of glob patterns given.
+ } AcceptList match
+
+ Option -skip {} {
+ Skip all tests within the specified tests (via -match) and files
+ that match one of the list of glob patterns given.
+ } AcceptList skip
+
+ Option -file *.test {
+ Run tests in all test files that match the glob pattern given.
+ } AcceptPattern matchFiles
+
+ # By default, skip files that appear to be SCCS lock files.
+ Option -notfile l.*.test {
+ Skip all test files that match the glob pattern given.
+ } AcceptPattern skipFiles
+
+ Option -relateddir * {
+ Run tests in directories that match the glob pattern given.
+ } AcceptPattern matchDirectories
+
+ Option -asidefromdir {} {
+ Skip tests in directories that match the glob pattern given.
+ } AcceptPattern skipDirectories
+
+ # By default, don't save core files
+ Option -preservecore 0 {
+ If 2, save any core files produced during testing in the directory
+ specified by -tmpdir. If 1, notify the user if core files are
+ created.
+ } AcceptInteger preserveCore
+
+ # debug output doesn't get printed by default; debug level 1 spits
+ # up only the tests that were skipped because they didn't match or
+ # were specifically skipped. A debug level of 2 would spit up the
+ # tcltest variables and flags provided; a debug level of 3 causes
+ # some additional output regarding operations of the test harness.
+ # The tcltest package currently implements only up to debug level 3.
+ Option -debug 0 {
+ Internal debug level
+ } AcceptInteger debug
+
+ proc SetSelectedConstraints args {
+ variable Option
+ foreach c $Option(-constraints) {
+ testConstraint $c 1
+ }
+ }
+ Option -constraints {} {
+ Do not skip the listed constraints listed in -constraints.
+ } AcceptList
+ trace variable Option(-constraints) w \
+ [namespace code {SetSelectedConstraints ;#}]
+
+ # Don't run only the "-constraint" specified tests by default
+ proc ClearUnselectedConstraints args {
+ variable Option
+ variable testConstraints
+ if {!$Option(-limitconstraints)} {return}
+ foreach c [array names testConstraints] {
+ if {[lsearch -exact $Option(-constraints) $c] == -1} {
+ testConstraint $c 0
+ }
+ }
+ }
+ Option -limitconstraints false {
+ whether to run only tests with the constraints
+ } AcceptBoolean limitConstraints
+ trace variable Option(-limitconstraints) w \
+ [namespace code {ClearUnselectedConstraints ;#}]
+
+ # A test application has to know how to load the tested commands
+ # into the interpreter.
+ Option -load {} {
+ Specifies the script to load the tested commands.
+ } AcceptScript loadScript
+
+ # Default is to run each test file in a separate process
+ Option -singleproc 0 {
+ whether to run all tests in one process
+ } AcceptBoolean singleProcess
+
+ proc AcceptTemporaryDirectory { directory } {
+ set directory [AcceptAbsolutePath $directory]
+ if {![file exists $directory]} {
+ file mkdir $directory
+ }
+ set directory [AcceptDirectory $directory]
+ if {![file writable $directory]} {
+ if {[string equal [workingDirectory] $directory]} {
+ # Special exception: accept the default value
+ # even if the directory is not writable
+ return $directory
+ }
+ return -code error "\"$directory\" is not writeable"
+ }
+ return $directory
+ }
+
+ # Directory where files should be created
+ Option -tmpdir [workingDirectory] {
+ Save temporary files in the specified directory.
+ } AcceptTemporaryDirectory temporaryDirectory
+ trace variable Option(-tmpdir) w \
+ [namespace code {normalizePath Option(-tmpdir) ;#}]
+
+ # Tests should not rely on the current working directory.
+ # Files that are part of the test suite should be accessed relative
+ # to [testsDirectory]
+ Option -testdir [workingDirectory] {
+ Search tests in the specified directory.
+ } AcceptDirectory testsDirectory
+ trace variable Option(-testdir) w \
+ [namespace code {normalizePath Option(-testdir) ;#}]
+
+ proc AcceptLoadFile { file } {
+ if {[string equal "" $file]} {return $file}
+ set file [file join [temporaryDirectory] $file]
+ return [AcceptReadable $file]
+ }
+ proc ReadLoadScript {args} {
+ variable Option
+ if {[string equal "" $Option(-loadfile)]} {return}
+ set tmp [open $Option(-loadfile) r]
+ loadScript [read $tmp]
+ close $tmp
+ }
+ Option -loadfile {} {
+ Read the script to load the tested commands from the specified file.
+ } AcceptLoadFile loadFile
+ trace variable Option(-loadfile) w [namespace code ReadLoadScript]
+
+ proc AcceptOutFile { file } {
+ if {[string equal stderr $file]} {return $file}
+ if {[string equal stdout $file]} {return $file}
+ return [file join [temporaryDirectory] $file]
+ }
+
+ # output goes to stdout by default
+ Option -outfile stdout {
+ Send output from test runs to the specified file.
+ } AcceptOutFile outputFile
+ trace variable Option(-outfile) w \
+ [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 \
+ [namespace code {errorChannel $Option(-errfile) ;#}]
+
+}
+
+#####################################################################
+
+# tcltest::Debug* --
+#
+# Internal helper procedures to write out debug information
+# dependent on the chosen level. A test shell may overide
+# them, f.e. to redirect the output into a different
+# channel, or even into a GUI.
+
+# tcltest::DebugPuts --
+#
+# Prints the specified string if the current debug level is
+# higher than the provided level argument.
+#
+# Arguments:
+# level The lowest debug level triggering the output
+# string The string to print out.
+#
+# Results:
+# Prints the string. Nothing else is allowed.
+#
+# Side Effects:
+# None.
+#
+
+proc tcltest::DebugPuts {level string} {
+ variable debug
+ if {$debug >= $level} {
+ puts $string
+ }
+ return
+}
+
+# tcltest::DebugPArray --
+#
+# Prints the contents of the specified array if the current
+# debug level is higher than the provided level argument
+#
+# Arguments:
+# level The lowest debug level triggering the output
+# arrayvar The name of the array to print out.
+#
+# Results:
+# Prints the contents of the array. Nothing else is allowed.
+#
+# Side Effects:
+# None.
+#
+
+proc tcltest::DebugPArray {level arrayvar} {
+ variable debug
+
+ if {$debug >= $level} {
+ catch {upvar $arrayvar $arrayvar}
+ parray $arrayvar
+ }
+ return
+}
+
+# Define our own [parray] in ::tcltest that will inherit use of the [puts]
+# defined in ::tcltest. NOTE: Ought to construct with [info args] and
+# [info default], but can't be bothered now. If [parray] changes, then
+# this will need changing too.
+auto_load ::parray
+proc tcltest::parray {a {pattern *}} [info body ::parray]
+
+# tcltest::DebugDo --
+#
+# Executes the script if the current debug level is greater than
+# the provided level argument
+#
+# Arguments:
+# level The lowest debug level triggering the execution.
+# script The tcl script executed upon a debug level high enough.
+#
+# Results:
+# Arbitrary side effects, dependent on the executed script.
+#
+# Side Effects:
+# None.
+#
+
+proc tcltest::DebugDo {level script} {
+ variable debug
+
+ if {$debug >= $level} {
+ uplevel 1 $script
+ }
+ return
+}
+
+#####################################################################
+
+proc tcltest::Warn {msg} {
+ puts [outputChannel] "WARNING: $msg"
+}
+
+# tcltest::mainThread
+#
+# Accessor command for tcltest variable mainThread.
+#
+proc tcltest::mainThread { {new ""} } {
+ variable mainThread
+ if {[llength [info level 0]] == 1} {
+ return $mainThread
+ }
+ set mainThread $new
+}
+
+# tcltest::testConstraint --
+#
+# sets a test constraint to a value; to do multiple constraints,
+# call this proc multiple times. also returns the value of the
+# named constraint if no value was supplied.
+#
+# Arguments:
+# constraint - name of the constraint
+# value - new value for constraint (should be boolean) - if not
+# supplied, this is a query
+#
+# Results:
+# content of tcltest::testConstraints($constraint)
+#
+# Side effects:
+# none
+
+proc tcltest::testConstraint {constraint {value ""}} {
+ variable testConstraints
+ variable Option
+ DebugPuts 3 "entering testConstraint $constraint $value"
+ if {[llength [info level 0]] == 2} {
+ return $testConstraints($constraint)
+ }
+ # Check for boolean values
+ if {[catch {expr {$value && $value}} msg]} {
+ return -code error $msg
+ }
+ if {[limitConstraints]
+ && [lsearch -exact $Option(-constraints) $constraint] == -1} {
+ set value 0
+ }
+ set testConstraints($constraint) $value
+}
+
+# tcltest::interpreter --
+#
+# the interpreter name stored in tcltest::tcltest
+#
+# Arguments:
+# executable name
+#
+# Results:
+# content of tcltest::tcltest
+#
+# Side effects:
+# None.
+
+proc tcltest::interpreter { {interp ""} } {
+ variable tcltest
+ if {[llength [info level 0]] == 1} {
+ return $tcltest
+ }
+ if {[string equal {} $interp]} {
+ set tcltest {}
+ } else {
+ set tcltest $interp
+ }
+}
+
+#####################################################################
+
+# tcltest::AddToSkippedBecause --
+#
+# Increments the variable used to track how many tests were
+# skipped because of a particular constraint.
+#
+# Arguments:
+# constraint The name of the constraint to be modified
+#
+# Results:
+# Modifies tcltest::skippedBecause; sets the variable to 1 if
+# didn't previously exist - otherwise, it just increments it.
+#
+# Side effects:
+# None.
+
+proc tcltest::AddToSkippedBecause { constraint {value 1}} {
+ # add the constraint to the list of constraints that kept tests
+ # from running
+ variable skippedBecause
+
+ if {[info exists skippedBecause($constraint)]} {
+ incr skippedBecause($constraint) $value
+ } else {
+ set skippedBecause($constraint) $value
+ }
+ return
+}
+
+# tcltest::PrintError --
+#
+# Prints errors to tcltest::errorChannel and then flushes that
+# channel, making sure that all messages are < 80 characters per
+# line.
+#
+# Arguments:
+# errorMsg String containing the error to be printed
+#
+# Results:
+# None.
+#
+# Side effects:
+# None.
+
+proc tcltest::PrintError {errorMsg} {
+ set InitialMessage "Error: "
+ set InitialMsgLen [string length $InitialMessage]
+ puts -nonewline [errorChannel] $InitialMessage
+
+ # Keep track of where the end of the string is.
+ set endingIndex [string length $errorMsg]
+
+ if {$endingIndex < (80 - $InitialMsgLen)} {
+ puts [errorChannel] $errorMsg
+ } else {
+ # Print up to 80 characters on the first line, including the
+ # InitialMessage.
+ set beginningIndex [string last " " [string range $errorMsg 0 \
+ [expr {80 - $InitialMsgLen}]]]
+ puts [errorChannel] [string range $errorMsg 0 $beginningIndex]
+
+ while {![string equal end $beginningIndex]} {
+ puts -nonewline [errorChannel] \
+ [string repeat " " $InitialMsgLen]
+ if {($endingIndex - $beginningIndex)
+ < (80 - $InitialMsgLen)} {
+ puts [errorChannel] [string trim \
+ [string range $errorMsg $beginningIndex end]]
+ break
+ } else {
+ set newEndingIndex [expr {[string last " " \
+ [string range $errorMsg $beginningIndex \
+ [expr {$beginningIndex
+ + (80 - $InitialMsgLen)}]
+ ]] + $beginningIndex}]
+ if {($newEndingIndex <= 0)
+ || ($newEndingIndex <= $beginningIndex)} {
+ set newEndingIndex end
+ }
+ puts [errorChannel] [string trim \
+ [string range $errorMsg \
+ $beginningIndex $newEndingIndex]]
+ set beginningIndex $newEndingIndex
+ }
+ }
+ }
+ flush [errorChannel]
+ return
+}
+
+# tcltest::SafeFetch --
+#
+# The following trace procedure makes it so that we can safely
+# refer to non-existent members of the testConstraints array
+# without causing an error. Instead, reading a non-existent
+# member will return 0. This is necessary because tests are
+# allowed to use constraint "X" without ensuring that
+# testConstraints("X") is defined.
+#
+# Arguments:
+# n1 - name of the array (testConstraints)
+# n2 - array key value (constraint name)
+# op - operation performed on testConstraints (generally r)
+#
+# Results:
+# none
+#
+# Side effects:
+# sets testConstraints($n2) to 0 if it's referenced but never
+# before used
+
+proc tcltest::SafeFetch {n1 n2 op} {
+ variable testConstraints
+ DebugPuts 3 "entering SafeFetch $n1 $n2 $op"
+ if {[string equal {} $n2]} {return}
+ if {![info exists testConstraints($n2)]} {
+ if {[catch {testConstraint $n2 [eval [ConstraintInitializer $n2]]}]} {
+ testConstraint $n2 0
+ }
+ }
+}
+
+# tcltest::ConstraintInitializer --
+#
+# Get or set a script that when evaluated in the tcltest namespace
+# will return a boolean value with which to initialize the
+# associated constraint.
+#
+# Arguments:
+# constraint - name of the constraint initialized by the script
+# script - the initializer script
+#
+# Results
+# boolean value of the constraint - enabled or disabled
+#
+# Side effects:
+# Constraint is initialized for future reference by [test]
+proc tcltest::ConstraintInitializer {constraint {script ""}} {
+ variable ConstraintInitializer
+ DebugPuts 3 "entering ConstraintInitializer $constraint $script"
+ if {[llength [info level 0]] == 2} {
+ return $ConstraintInitializer($constraint)
+ }
+ # Check for boolean values
+ if {![info complete $script]} {
+ return -code error "ConstraintInitializer must be complete script"
+ }
+ set ConstraintInitializer($constraint) $script
+}
+
+# tcltest::InitConstraints --
+#
+# Call all registered constraint initializers to force initialization
+# of all known constraints.
+# See the tcltest man page for the list of built-in constraints defined
+# in this procedure.
+#
+# Arguments:
+# none
+#
+# Results:
+# The testConstraints array is reset to have an index for each
+# built-in test constraint.
+#
+# Side Effects:
+# None.
+#
+
+proc tcltest::InitConstraints {} {
+ variable ConstraintInitializer
+ initConstraintsHook
+ foreach constraint [array names ConstraintInitializer] {
+ testConstraint $constraint
+ }
+}
+
+proc tcltest::DefineConstraintInitializers {} {
+ ConstraintInitializer singleTestInterp {singleProcess}
+
+ # All the 'pc' constraints are here for backward compatibility and
+ # are not documented. They have been replaced with equivalent 'win'
+ # constraints.
+
+ ConstraintInitializer unixOnly \
+ {string equal $::tcl_platform(platform) unix}
+ ConstraintInitializer macOnly \
+ {string equal $::tcl_platform(platform) macintosh}
+ ConstraintInitializer pcOnly \
+ {string equal $::tcl_platform(platform) windows}
+ ConstraintInitializer winOnly \
+ {string equal $::tcl_platform(platform) windows}
+
+ ConstraintInitializer unix {testConstraint unixOnly}
+ ConstraintInitializer mac {testConstraint macOnly}
+ ConstraintInitializer pc {testConstraint pcOnly}
+ ConstraintInitializer win {testConstraint winOnly}
+
+ ConstraintInitializer unixOrPc \
+ {expr {[testConstraint unix] || [testConstraint pc]}}
+ ConstraintInitializer macOrPc \
+ {expr {[testConstraint mac] || [testConstraint pc]}}
+ ConstraintInitializer unixOrWin \
+ {expr {[testConstraint unix] || [testConstraint win]}}
+ ConstraintInitializer macOrWin \
+ {expr {[testConstraint mac] || [testConstraint win]}}
+ ConstraintInitializer macOrUnix \
+ {expr {[testConstraint mac] || [testConstraint unix]}}
+
+ ConstraintInitializer nt {string equal $::tcl_platform(os) "Windows NT"}
+ ConstraintInitializer 95 {string equal $::tcl_platform(os) "Windows 95"}
+ ConstraintInitializer 98 {string equal $::tcl_platform(os) "Windows 98"}
+
+ # The following Constraints switches are used to mark tests that
+ # should work, but have been temporarily disabled on certain
+ # platforms because they don't and we haven't gotten around to
+ # fixing the underlying problem.
+
+ ConstraintInitializer tempNotPc {expr {![testConstraint pc]}}
+ ConstraintInitializer tempNotWin {expr {![testConstraint win]}}
+ ConstraintInitializer tempNotMac {expr {![testConstraint mac]}}
+ ConstraintInitializer tempNotUnix {expr {![testConstraint unix]}}
+
+ # The following Constraints switches are used to mark tests that
+ # crash on certain platforms, so that they can be reactivated again
+ # when the underlying problem is fixed.
+
+ ConstraintInitializer pcCrash {expr {![testConstraint pc]}}
+ ConstraintInitializer winCrash {expr {![testConstraint win]}}
+ ConstraintInitializer macCrash {expr {![testConstraint mac]}}
+ ConstraintInitializer unixCrash {expr {![testConstraint unix]}}
+
+ # Skip empty tests
+
+ ConstraintInitializer emptyTest {format 0}
+
+ # By default, tests that expose known bugs are skipped.
+
+ ConstraintInitializer knownBug {format 0}
+
+ # By default, non-portable tests are skipped.
+
+ ConstraintInitializer nonPortable {format 0}
+
+ # Some tests require user interaction.
+
+ ConstraintInitializer userInteraction {format 0}
+
+ # Some tests must be skipped if the interpreter is not in
+ # interactive mode
+
+ ConstraintInitializer interactive \
+ {expr {[info exists ::tcl_interactive] && $::tcl_interactive}}
+
+ # Some tests can only be run if the installation came from a CD
+ # image instead of a web image. Some tests must be skipped if you
+ # are running as root on Unix. Other tests can only be run if you
+ # 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)])}}
+ ConstraintInitializer notRoot {expr {![testConstraint root]}}
+
+ # Set nonBlockFiles constraint: 1 means this platform supports
+ # setting files into nonblocking mode.
+
+ ConstraintInitializer nonBlockFiles {
+ set code [expr {[catch {set f [open defs r]}]
+ || [catch {fconfigure $f -blocking off}]}]
+ catch {close $f}
+ set code
+ }
+
+ # Set asyncPipeClose constraint: 1 means this platform supports
+ # async flush and async close on a pipe.
+ #
+ # Test for SCO Unix - cannot run async flushing tests because a
+ # potential problem with select is apparently interfering.
+ # (Mark Diekhans).
+
+ ConstraintInitializer asyncPipeClose {expr {
+ !([string equal unix $::tcl_platform(platform)]
+ && ([catch {exec uname -X | fgrep {Release = 3.2v}}] == 0))}}
+
+ # Test to see if we have a broken version of sprintf with respect
+ # to the "e" format of floating-point numbers.
+
+ ConstraintInitializer eformat {string equal [format %g 5e-5] 5e-05}
+
+ # Test to see if execed commands such as cat, echo, rm and so forth
+ # are present on this machine.
+
+ ConstraintInitializer unixExecs {
+ set code 1
+ if {[string equal macintosh $::tcl_platform(platform)]} {
+ set code 0
+ }
+ if {[string equal windows $::tcl_platform(platform)]} {
+ if {[catch {
+ set file _tcl_test_remove_me.txt
+ makeFile {hello} $file
+ }]} {
+ set code 0
+ } elseif {
+ [catch {exec cat $file}] ||
+ [catch {exec echo hello}] ||
+ [catch {exec sh -c echo hello}] ||
+ [catch {exec wc $file}] ||
+ [catch {exec sleep 1}] ||
+ [catch {exec echo abc > $file}] ||
+ [catch {exec chmod 644 $file}] ||
+ [catch {exec rm $file}] ||
+ [llength [auto_execok mkdir]] == 0 ||
+ [llength [auto_execok fgrep]] == 0 ||
+ [llength [auto_execok grep]] == 0 ||
+ [llength [auto_execok ps]] == 0
+ } {
+ set code 0
+ }
+ removeFile $file
+ }
+ set code
+ }
+
+ ConstraintInitializer stdio {
+ set code 0
+ if {![catch {set f [open "|[list [interpreter]]" w]}]} {
+ if {![catch {puts $f exit}]} {
+ if {![catch {close $f}]} {
+ set code 1
+ }
+ }
+ }
+ set code
+ }
+
+ # Deliberately call socket with the wrong number of arguments. The
+ # error message you get will indicate whether sockets are available
+ # on this system.
+
+ ConstraintInitializer socket {
+ catch {socket} msg
+ string compare $msg "sockets are not available on this system"
+ }
+
+ # Check for internationalization
+ ConstraintInitializer hasIsoLocale {
+ if {[llength [info commands testlocale]] == 0} {
+ set code 0
+ } else {
+ set code [string length [SetIso8859_1_Locale]]
+ RestoreLocale
+ }
+ set code
+ }
+
+}
+#####################################################################
+
+# Usage and command line arguments processing.
+
+# tcltest::PrintUsageInfo
+#
+# Prints out the usage information for package tcltest. This can
+# be customized with the redefinition of [PrintUsageInfoHook].
+#
+# Arguments:
+# none
+#
+# Results:
+# none
+#
+# Side Effects:
+# none
+proc tcltest::PrintUsageInfo {} {
+ puts [Usage]
+ PrintUsageInfoHook
+}
+
+proc tcltest::Usage { {option ""} } {
+ variable Usage
+ variable Verify
+ if {[llength [info level 0]] == 1} {
+ set msg "Usage: [file tail [info nameofexecutable]] script "
+ append msg "?-help? ?flag value? ... \n"
+ append msg "Available flags (and valid input values) are:"
+
+ set max 0
+ set allOpts [concat -help [Configure]]
+ foreach opt $allOpts {
+ set foo [Usage $opt]
+ foreach [list x type($opt) usage($opt)] $foo break
+ set line($opt) " $opt $type($opt) "
+ set length($opt) [string length $line($opt)]
+ if {$length($opt) > $max} {set max $length($opt)}
+ }
+ set rest [expr {72 - $max}]
+ foreach opt $allOpts {
+ append msg \n$line($opt)
+ append msg [string repeat " " [expr {$max - $length($opt)}]]
+ set u [string trim $usage($opt)]
+ catch {append u " (default: \[[Configure $opt]])"}
+ regsub -all {\s*\n\s*} $u " " u
+ while {[string length $u] > $rest} {
+ set break [string wordstart $u $rest]
+ if {$break == 0} {
+ set break [string wordend $u 0]
+ }
+ append msg [string range $u 0 [expr {$break - 1}]]
+ set u [string trim [string range $u $break end]]
+ append msg \n[string repeat " " $max]
+ }
+ append msg $u
+ }
+ return $msg\n
+ } elseif {[string equal -help $option]} {
+ return [list -help "" "Display this usage information."]
+ } else {
+ set type [lindex [info args $Verify($option)] 0]
+ return [list $option $type $Usage($option)]
+ }
+}
+
+# tcltest::ProcessFlags --
+#
+# process command line arguments supplied in the flagArray - this
+# is called by processCmdLineArgs. Modifies tcltest variables
+# according to the content of the flagArray.
+#
+# Arguments:
+# flagArray - array containing name/value pairs of flags
+#
+# Results:
+# sets tcltest variables according to their values as defined by
+# flagArray
+#
+# Side effects:
+# None.
+
+proc tcltest::ProcessFlags {flagArray} {
+ # Process -help first
+ if {[lsearch -exact $flagArray {-help}] != -1} {
+ PrintUsageInfo
+ exit 1
+ }
+
+ if {[llength $flagArray] == 0} {
+ RemoveAutoConfigureTraces
+ } else {
+ set args $flagArray
+ while {[llength $args] && [catch {eval 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} {
+ # Nope. Report the error, including additional options,
+ # but keep going
+ if {[llength $moreOptions]} {
+ append msg ", "
+ append msg [join [lrange $moreOptions 0 end -1] ", "]
+ append msg "or [lindex $moreOptions end]"
+ }
+ Warn $msg
+ }
+ } else {
+ # error is something other than "unknown option"
+ # notify user of the error; and exit
+ puts [errorChannel] $msg
+ exit 1
+ }
+
+ # To recover, find that unknown option and remove up to it.
+ # then retry
+ while {![string equal [lindex $args 0] $option]} {
+ set args [lrange $args 2 end]
+ }
+ set args [lrange $args 2 end]
+ }
+ }
+
+ # Call the hook
+ array set flag $flagArray
+ processCmdLineArgsHook [array get flag]
+ return
+}
+
+# tcltest::ProcessCmdLineArgs --
+#
+# This procedure must be run after constraint initialization is
+# set up (by [DefineConstraintInitializers]) because some constraints
+# can be overridden.
+#
+# Perform configuration according to the command-line options.
+#
+# Arguments:
+# none
+#
+# Results:
+# Sets the above-named variables in the tcltest namespace.
+#
+# Side Effects:
+# None.
+#
+
+proc tcltest::ProcessCmdLineArgs {} {
+ variable originalEnv
+ variable testConstraints
+
+ # The "argv" var doesn't exist in some cases, so use {}.
+ if {![info exists ::argv]} {
+ ProcessFlags {}
+ } else {
+ ProcessFlags $::argv
+ }
+
+ # Spit out everything you know if we're at a debug level 2 or
+ # greater
+ DebugPuts 2 "Flags passed into tcltest:"
+ if {[info exists ::env(TCLTEST_OPTIONS)]} {
+ DebugPuts 2 \
+ " ::env(TCLTEST_OPTIONS): $::env(TCLTEST_OPTIONS)"
+ }
+ if {[info exists argv]} {
+ DebugPuts 2 " argv: $argv"
+ }
+ DebugPuts 2 "tcltest::debug = [debug]"
+ DebugPuts 2 "tcltest::testsDirectory = [testsDirectory]"
+ DebugPuts 2 "tcltest::workingDirectory = [workingDirectory]"
+ DebugPuts 2 "tcltest::temporaryDirectory = [temporaryDirectory]"
+ DebugPuts 2 "tcltest::outputChannel = [outputChannel]"
+ DebugPuts 2 "tcltest::errorChannel = [errorChannel]"
+ DebugPuts 2 "Original environment (tcltest::originalEnv):"
+ DebugPArray 2 originalEnv
+ DebugPuts 2 "Constraints:"
+ DebugPArray 2 testConstraints
+}
+
+#####################################################################
+
+# Code to run the tests goes here.
+
+# tcltest::TestPuts --
+#
+# Used to redefine puts in test environment. Stores whatever goes
+# out on stdout in tcltest::outData and stderr in errData before
+# sending it on to the regular puts.
+#
+# Arguments:
+# same as standard puts
+#
+# Results:
+# none
+#
+# Side effects:
+# Intercepts puts; data that would otherwise go to stdout, stderr,
+# or file channels specified in outputChannel and errorChannel
+# does not get sent to the normal puts function.
+namespace eval tcltest::Replace {
+ namespace export puts
+}
+proc tcltest::Replace::puts {args} {
+ variable [namespace parent]::outData
+ variable [namespace parent]::errData
+ switch [llength $args] {
+ 1 {
+ # Only the string to be printed is specified
+ append outData [lindex $args 0]\n
+ return
+ # return [Puts [lindex $args 0]]
+ }
+ 2 {
+ # Either -nonewline or channelId has been specified
+ if {[string equal -nonewline [lindex $args 0]]} {
+ append outData [lindex $args end]
+ return
+ # return [Puts -nonewline [lindex $args end]]
+ } else {
+ set channel [lindex $args 0]
+ }
+ }
+ 3 {
+ if {[string equal -nonewline [lindex $args 0]]} {
+ # Both -nonewline and channelId are specified, unless
+ # it's an error. -nonewline is supposed to be argv[0].
+ set channel [lindex $args 1]
+ }
+ }
+ }
+
+ if {[info exists channel]} {
+ if {[string equal $channel [[namespace parent]::outputChannel]]
+ || [string equal $channel stdout]} {
+ append outData [lindex $args end]\n
+ return
+ } elseif {[string equal $channel [[namespace parent]::errorChannel]]
+ || [string equal $channel stderr]} {
+ append errData [lindex $args end]\n
+ return
+ }
+ }
+
+ # If we haven't returned by now, we don't know how to handle the
+ # input. Let puts handle it.
+ return [eval Puts $args]
+}
+
+# tcltest::Eval --
+#
+# Evaluate the script in the test environment. If ignoreOutput is
+# false, store data sent to stderr and stdout in outData and
+# errData. Otherwise, ignore this output altogether.
+#
+# Arguments:
+# script Script to evaluate
+# ?ignoreOutput? Indicates whether or not to ignore output
+# sent to stdout & stderr
+#
+# Results:
+# result from running the script
+#
+# Side effects:
+# Empties the contents of outData and errData before running a
+# test if ignoreOutput is set to 0.
+
+proc tcltest::Eval {script {ignoreOutput 1}} {
+ variable outData
+ variable errData
+ DebugPuts 3 "[lindex [info level 0] 0] called"
+ if {!$ignoreOutput} {
+ set outData {}
+ set errData {}
+ set callerHasPuts [llength [uplevel 1 {
+ ::info commands [::namespace current]::puts
+ }]]
+ if {$callerHasPuts} {
+ uplevel 1 [list ::rename puts [namespace current]::Replace::Puts]
+ } else {
+ interp alias {} [namespace current]::Replace::Puts {} ::puts
+ }
+ uplevel 1 [list ::namespace import [namespace origin Replace::puts]]
+ namespace import Replace::puts
+ }
+ set result [uplevel 1 $script]
+ if {!$ignoreOutput} {
+ namespace forget puts
+ uplevel 1 ::namespace forget puts
+ if {$callerHasPuts} {
+ uplevel 1 [list ::rename [namespace current]::Replace::Puts puts]
+ } else {
+ interp alias {} [namespace current]::Replace::Puts {}
+ }
+ }
+ return $result
+}
+
+# tcltest::CompareStrings --
+#
+# compares the expected answer to the actual answer, depending on
+# the mode provided. Mode determines whether a regexp, exact,
+# glob or custom comparison is done.
+#
+# Arguments:
+# actual - string containing the actual result
+# expected - pattern to be matched against
+# mode - type of comparison to be done
+#
+# Results:
+# result of the match
+#
+# Side effects:
+# None.
+
+proc tcltest::CompareStrings {actual expected mode} {
+ variable CustomMatch
+ if {![info exists CustomMatch($mode)]} {
+ return -code error "No matching command registered for `-match $mode'"
+ }
+ set match [namespace eval :: $CustomMatch($mode) [list $expected $actual]]
+ if {[catch {expr {$match && $match}} result]} {
+ return -code error "Invalid result from `-match $mode' command: $result"
+ }
+ return $match
+}
+
+# tcltest::customMatch --
+#
+# registers a command to be called when a particular type of
+# matching is required.
+#
+# Arguments:
+# nickname - Keyword for the type of matching
+# cmd - Incomplete command that implements that type of matching
+# when completed with expected string and actual string
+# and then evaluated.
+#
+# Results:
+# None.
+#
+# Side effects:
+# Sets the variable tcltest::CustomMatch
+
+proc tcltest::customMatch {mode script} {
+ variable CustomMatch
+ if {![info complete $script]} {
+ return -code error \
+ "invalid customMatch script; can't evaluate after completion"
+ }
+ set CustomMatch($mode) $script
+}
+
+# tcltest::SubstArguments list
+#
+# This helper function takes in a list of words, then perform a
+# substitution on the list as though each word in the list is a separate
+# argument to the Tcl function. For example, if this function is
+# invoked as:
+#
+# SubstArguments {$a {$a}}
+#
+# Then it is as though the function is invoked as:
+#
+# SubstArguments $a {$a}
+#
+# This code is adapted from Paul Duffin's function "SplitIntoWords".
+# The original function can be found on:
+#
+# http://purl.org/thecliff/tcl/wiki/858.html
+#
+# Results:
+# a list containing the result of the substitution
+#
+# Exceptions:
+# An error may occur if the list containing unbalanced quote or
+# unknown variable.
+#
+# Side Effects:
+# None.
+#
+
+proc tcltest::SubstArguments {argList} {
+
+ # We need to split the argList up into tokens but cannot use list
+ # operations as they throw away some significant quoting, and
+ # [split] ignores braces as it should. Therefore what we do is
+ # gradually build up a string out of whitespace seperated strings.
+ # We cannot use [split] to split the argList into whitespace
+ # separated strings as it throws away the whitespace which maybe
+ # important so we have to do it all by hand.
+
+ set result {}
+ set token ""
+
+ while {[string length $argList]} {
+ # Look for the next word containing a quote: " { }
+ if {[regexp -indices {[^ \t\n]*[\"\{\}]+[^ \t\n]*} \
+ $argList all]} {
+ # Get the text leading up to this word, but not including
+ # this word, from the argList.
+ set text [string range $argList 0 \
+ [expr {[lindex $all 0] - 1}]]
+ # Get the word with the quote
+ set word [string range $argList \
+ [lindex $all 0] [lindex $all 1]]
+
+ # Remove all text up to and including the word from the
+ # argList.
+ set argList [string range $argList \
+ [expr {[lindex $all 1] + 1}] end]
+ } else {
+ # Take everything up to the end of the argList.
+ set text $argList
+ set word {}
+ set argList {}
+ }
+
+ if {$token != {}} {
+ # 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.
+ append token $text $word
+ } else {
+ # Add the text to the result. There is no need to parse
+ # the text because it couldn't be a part of any multi-word
+ # token. Then start a new multi-word token with the word
+ # because we need to pass this token to the Tcl parser to
+ # check for balancing quotes
+ append result $text
+ set token $word
+ }
+
+ if { [catch {llength $token} length] == 0 && $length == 1} {
+ # The token is a valid list so add it to the result.
+ # lappend result [string trim $token]
+ append result \{$token\}
+ set token {}
+ }
+ }
+
+ # If the last token has not been added to the list then there
+ # is a problem.
+ if { [string length $token] } {
+ error "incomplete token \"$token\""
+ }
+
+ return $result
+}
+
+
+# tcltest::test --
+#
+# This procedure runs a test and prints an error message if the test
+# fails. If verbose has been set, it also prints a message even if the
+# test succeeds. The test will be skipped if it doesn't match the
+# match variable, if it matches an element in skip, or if one of the
+# elements of "constraints" turns out not to be true.
+#
+# If testLevel is 1, then this is a top level test, and we record
+# pass/fail information; otherwise, this information is not logged and
+# is not added to running totals.
+#
+# Attributes:
+# Only description is a required attribute. All others are optional.
+# Default values are indicated.
+#
+# constraints - A list of one or more keywords, each of which
+# must be the name of an element in the array
+# "testConstraints". If any of these elements is
+# zero, the test is skipped. This attribute is
+# optional; default is {}
+# body - Script to run to carry out the test. It must
+# return a result that can be checked for
+# correctness. This attribute is optional;
+# default is {}
+# result - Expected result from script. This attribute is
+# optional; default is {}.
+# output - Expected output sent to stdout. This attribute
+# is optional; default is {}.
+# errorOutput - Expected output sent to stderr. This attribute
+# is optional; default is {}.
+# returnCodes - Expected return codes. This attribute is
+# optional; default is {0 2}.
+# setup - Code to run before $script (above). This
+# attribute is optional; default is {}.
+# cleanup - Code to run after $script (above). This
+# attribute is optional; default is {}.
+# match - specifies type of matching to do on result,
+# output, errorOutput; this must be a string
+# previously registered by a call to [customMatch].
+# The strings exact, glob, and regexp are pre-registered
+# by the tcltest package. Default value is exact.
+#
+# Arguments:
+# name - Name of test, in the form foo-1.2.
+# description - Short textual description of the test, to
+# help humans understand what it does.
+#
+# Results:
+# None.
+#
+# Side effects:
+# Just about anything is possible depending on the test.
+#
+
+proc tcltest::test {name description args} {
+ global tcl_platform
+ variable testLevel
+ variable coreModTime
+ DebugPuts 3 "test $name $args"
+
+ FillFilesExisted
+ incr testLevel
+
+ # 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 {}
+ }
+
+ # Set the default match mode
+ set match exact
+
+ # Set the default match values for return codes (0 is the standard
+ # expected return value if everything went well; 2 represents
+ # 'return' being used in the test script).
+ set returnCodes [list 0 2]
+
+ # 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 {[llength $args] == 1} {
+ set list [SubstArguments [lindex $args 0]]
+ foreach {element value} $list {
+ set testAttributes($element) $value
+ }
+ foreach item {constraints match setup body cleanup \
+ result returnCodes output errorOutput} {
+ if {[info exists testAttributes(-$item)]} {
+ set testAttributes(-$item) [uplevel 1 \
+ ::concat $testAttributes(-$item)]
+ }
+ }
+ } else {
+ array set testAttributes $args
+ }
+
+ set validFlags {-setup -cleanup -body -result -returnCodes \
+ -match -output -errorOutput -constraints}
+
+ foreach flag [array names testAttributes] {
+ if {[lsearch -exact $validFlags $flag] == -1} {
+ incr testLevel -1
+ set sorted [lsort $validFlags]
+ set options [join [lrange $sorted 0 end-1] ", "]
+ append options ", or [lindex $sorted end]"
+ return -code error "bad option \"$flag\": must be $options"
+ }
+ }
+
+ # store whatever the user gave us
+ foreach item [array names testAttributes] {
+ set [string trimleft $item "-"] $testAttributes($item)
+ }
+
+ # Check the values supplied for -match
+ variable CustomMatch
+ if {[lsearch [array names CustomMatch] $match] == -1} {
+ incr testLevel -1
+ set sorted [lsort [array names CustomMatch]]
+ set values [join [lrange $sorted 0 end-1] ", "]
+ append values ", or [lindex $sorted end]"
+ return -code error "bad -match value \"$match\":\
+ must be $values"
+ }
+
+ # Replace symbolic valies supplied for -returnCodes
+ regsub -nocase normal $returnCodes 0 returnCodes
+ regsub -nocase error $returnCodes 1 returnCodes
+ regsub -nocase return $returnCodes 2 returnCodes
+ regsub -nocase break $returnCodes 3 returnCodes
+ regsub -nocase continue $returnCodes 4 returnCodes
+ } else {
+ # This is parsing for the old test command format; it is here
+ # for backward compatibility.
+ set result [lindex $args end]
+ if {[llength $args] == 2} {
+ set body [lindex $args 0]
+ } elseif {[llength $args] == 3} {
+ set constraints [lindex $args 0]
+ set body [lindex $args 1]
+ } else {
+ incr testLevel -1
+ return -code error "wrong # args:\
+ should be \"test name desc ?options?\""
+ }
+ }
+
+ if {[Skipped $name $constraints]} {
+ incr testLevel -1
+ return
+ }
+
+ # Save information about the core file.
+ if {[preserveCore]} {
+ if {[file exists [file join [workingDirectory] core]]} {
+ set coreModTime [file mtime [file join [workingDirectory] core]]
+ }
+ }
+
+ # First, run the setup script
+ set code [catch {uplevel 1 $setup} setupMsg]
+ set setupFailure [expr {$code != 0}]
+
+ # Only run the test body if the setup was successful
+ if {!$setupFailure} {
+
+ # Verbose notification of $body start
+ if {[IsVerbose start]} {
+ puts [outputChannel] "---- $name start"
+ flush [outputChannel]
+ }
+
+ set command [list [namespace origin RunTest] $name $body]
+ if {[info exists output] || [info exists errorOutput]} {
+ set testResult [uplevel 1 [list [namespace origin Eval] $command 0]]
+ } else {
+ set testResult [uplevel 1 [list [namespace origin Eval] $command 1]]
+ }
+ foreach {actualAnswer returnCode} $testResult break
+ }
+
+ # Always run the cleanup script
+ set code [catch {uplevel 1 $cleanup} cleanupMsg]
+ set cleanupFailure [expr {$code != 0}]
+
+ set coreFailure 0
+ set coreMsg ""
+ # check for a core file first - if one was created by the test,
+ # then the test failed
+ if {[preserveCore]} {
+ if {[file exists [file join [workingDirectory] core]]} {
+ # There's only a test failure if there is a core file
+ # and (1) there previously wasn't one or (2) the new
+ # one is different from the old one.
+ if {[info exists coreModTime]} {
+ if {$coreModTime != [file mtime \
+ [file join [workingDirectory] core]]} {
+ set coreFailure 1
+ }
+ } else {
+ set coreFailure 1
+ }
+
+ if {([preserveCore] > 1) && ($coreFailure)} {
+ append coreMsg "\nMoving file to:\
+ [file join [temporaryDirectory] core-$name]"
+ catch {file rename -force \
+ [file join [workingDirectory] core] \
+ [file join [temporaryDirectory] core-$name]
+ } msg
+ if {[string length $msg] > 0} {
+ append coreMsg "\nError:\
+ Problem renaming core file: $msg"
+ }
+ }
+ }
+ }
+
+ # If expected output/error strings exist, we have to compare
+ # them. If the comparison fails, then so did the test.
+ set outputFailure 0
+ variable outData
+ if {[info exists output]} {
+ if {[set outputCompare [catch {
+ CompareStrings $outData $output $match
+ } outputMatch]] == 0} {
+ set outputFailure [expr {!$outputMatch}]
+ } else {
+ set outputFailure 1
+ }
+ }
+
+ set errorFailure 0
+ variable errData
+ if {[info exists errorOutput]} {
+ if {[set errorCompare [catch {
+ CompareStrings $errData $errorOutput $match
+ } errorMatch]] == 0} {
+ set errorFailure [expr {!$errorMatch}]
+ } else {
+ set errorFailure 1
+ }
+ }
+
+ # check if the return code matched the expected return code
+ set codeFailure 0
+ if {!$setupFailure && [lsearch -exact $returnCodes $returnCode] == -1} {
+ set codeFailure 1
+ }
+
+ # check if the answer matched the expected answer
+ # Only check if we ran the body of the test (no setup failure)
+ if {$setupFailure} {
+ set scriptFailure 0
+ } elseif {[set scriptCompare [catch {
+ CompareStrings $actualAnswer $result $match
+ } scriptMatch]] == 0} {
+ set scriptFailure [expr {!$scriptMatch}]
+ } else {
+ set scriptFailure 1
+ }
+
+ # if we didn't experience any failures, then we passed
+ variable numTests
+ if {!($setupFailure || $cleanupFailure || $coreFailure
+ || $outputFailure || $errorFailure || $codeFailure
+ || $scriptFailure)} {
+ if {$testLevel == 1} {
+ incr numTests(Passed)
+ if {[IsVerbose pass]} {
+ puts [outputChannel] "++++ $name PASSED"
+ }
+ }
+ incr testLevel -1
+ return
+ }
+
+ # We know the test failed, tally it...
+ if {$testLevel == 1} {
+ incr numTests(Failed)
+ }
+
+ # ... then report according to the type of failure
+ variable currentFailure true
+ if {![IsVerbose body]} {
+ set body ""
+ }
+ puts [outputChannel] "\n==== $name\
+ [string trim $description] FAILED"
+ if {[string length $body]} {
+ puts [outputChannel] "==== Contents of test case:"
+ puts [outputChannel] $body
+ }
+ if {$setupFailure} {
+ puts [outputChannel] "---- Test setup\
+ failed:\n$setupMsg"
+ }
+ if {$scriptFailure} {
+ if {$scriptCompare} {
+ puts [outputChannel] "---- Error testing result: $scriptMatch"
+ } else {
+ puts [outputChannel] "---- Result was:\n$actualAnswer"
+ puts [outputChannel] "---- Result should have been\
+ ($match matching):\n$result"
+ }
+ }
+ if {$codeFailure} {
+ switch -- $code {
+ 0 { set msg "Test completed normally" }
+ 1 { set msg "Test generated error" }
+ 2 { set msg "Test generated return exception" }
+ 3 { set msg "Test generated break exception" }
+ 4 { set msg "Test generated continue exception" }
+ default { set msg "Test generated exception" }
+ }
+ puts [outputChannel] "---- $msg; Return code was: $code"
+ puts [outputChannel] "---- Return code should have been\
+ one of: $returnCodes"
+ if {[IsVerbose error]} {
+ if {[info exists ::errorInfo]} {
+ puts [outputChannel] "---- errorInfo: $::errorInfo"
+ puts [outputChannel] "---- errorCode: $::errorCode"
+ }
+ }
+ }
+ if {$outputFailure} {
+ if {$outputCompare} {
+ puts [outputChannel] "---- Error testing output: $outputMatch"
+ } else {
+ puts [outputChannel] "---- Output was:\n$outData"
+ puts [outputChannel] "---- Output should have been\
+ ($match matching):\n$output"
+ }
+ }
+ if {$errorFailure} {
+ if {$errorCompare} {
+ puts [outputChannel] "---- Error testing errorOutput: $errorMatch"
+ } else {
+ puts [outputChannel] "---- Error output was:\n$errData"
+ puts [outputChannel] "---- Error output should have\
+ been ($match matching):\n$errorOutput"
+ }
+ }
+ if {$cleanupFailure} {
+ puts [outputChannel] "---- Test cleanup failed:\n$cleanupMsg"
+ }
+ if {$coreFailure} {
+ puts [outputChannel] "---- Core file produced while running\
+ test! $coreMsg"
+ }
+ puts [outputChannel] "==== $name FAILED\n"
+
+ incr testLevel -1
+ return
+}
+
+# Skipped --
+#
+# Given a test name and it constraints, returns a boolean indicating
+# whether the current configuration says the test should be skipped.
+#
+# Side Effects: Maintains tally of total tests seen and tests skipped.
+#
+proc tcltest::Skipped {name constraints} {
+ variable testLevel
+ variable numTests
+ variable testConstraints
+
+ if {$testLevel == 1} {
+ incr numTests(Total)
+ }
+ # skip the test if it's name matches an element of skip
+ foreach pattern [skip] {
+ if {[string match $pattern $name]} {
+ if {$testLevel == 1} {
+ incr numTests(Skipped)
+ DebugDo 1 {AddToSkippedBecause userSpecifiedSkip}
+ }
+ return 1
+ }
+ }
+ # skip the test if it's name doesn't match any element of match
+ set ok 0
+ foreach pattern [match] {
+ if {[string match $pattern $name]} {
+ set ok 1
+ break
+ }
+ }
+ if {!$ok} {
+ if {$testLevel == 1} {
+ incr numTests(Skipped)
+ DebugDo 1 {AddToSkippedBecause userSpecifiedNonMatch}
+ }
+ return 1
+ }
+ if {[string equal {} $constraints]} {
+ # If we're limited to the listed constraints and there aren't
+ # any listed, then we shouldn't run the test.
+ if {[limitConstraints]} {
+ AddToSkippedBecause userSpecifiedLimitConstraint
+ if {$testLevel == 1} {
+ incr numTests(Skipped)
+ }
+ return 1
+ }
+ } else {
+ # "constraints" argument exists;
+ # make sure that the constraints are satisfied.
+
+ 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} {
+ # something like {a || b} should be turned into
+ # $testConstraints(a) || $testConstraints(b).
+ regsub -all {[.\w]+} $constraints {$testConstraints(&)} c
+ catch {set doTest [eval expr $c]}
+ } elseif {![catch {llength $constraints}]} {
+ # just simple constraints such as {unixOnly fonts}.
+ set doTest 1
+ foreach constraint $constraints {
+ if {(![info exists testConstraints($constraint)]) \
+ || (!$testConstraints($constraint))} {
+ set doTest 0
+
+ # store the constraint that kept the test from
+ # running
+ set constraints $constraint
+ break
+ }
+ }
+ }
+
+ if {$doTest == 0} {
+ if {[IsVerbose skip]} {
+ puts [outputChannel] "++++ $name SKIPPED: $constraints"
+ }
+
+ if {$testLevel == 1} {
+ incr numTests(Skipped)
+ AddToSkippedBecause $constraints
+ }
+ return 1
+ }
+ }
+ return 0
+}
+
+# RunTest --
+#
+# This is where the body of a test is evaluated. The combination of
+# [RunTest] and [Eval] allows the output and error output of the test
+# body to be captured for comparison against the expected values.
+
+proc tcltest::RunTest {name script} {
+ DebugPuts 3 "Running $name {$script}"
+
+ # If there is no "memory" command (because memory debugging isn't
+ # enabled), then don't attempt to use the command.
+
+ if {[llength [info commands memory]] == 1} {
+ memory tag $name
+ }
+
+ set code [catch {uplevel 1 $script} actualAnswer]
+
+ return [list $actualAnswer $code]
+}
+
+#####################################################################
+
+# tcltest::cleanupTestsHook --
+#
+# This hook allows a harness that builds upon tcltest to specify
+# additional things that should be done at cleanup.
+#
+
+if {[llength [info commands tcltest::cleanupTestsHook]] == 0} {
+ proc tcltest::cleanupTestsHook {} {}
+}
+
+# tcltest::cleanupTests --
+#
+# Remove files and dirs created using the makeFile and makeDirectory
+# commands since the last time this proc was invoked.
+#
+# Print the names of the files created without the makeFile command
+# since the tests were invoked.
+#
+# Print the number tests (total, passed, failed, and skipped) since the
+# tests were invoked.
+#
+# Restore original environment (as reported by special variable env).
+#
+# Arguments:
+# calledFromAllFile - if 0, behave as if we are running a single
+# test file within an entire suite of tests. if we aren't running
+# a single test file, then don't report status. check for new
+# files created during the test run and report on them. if 1,
+# report collated status from all the test file runs.
+#
+# Results:
+# None.
+#
+# Side Effects:
+# None
+#
+
+proc tcltest::cleanupTests {{calledFromAllFile 0}} {
+ variable filesMade
+ variable filesExisted
+ variable createdNewFiles
+ variable testSingleFile
+ variable numTests
+ variable numTestFiles
+ variable failFiles
+ variable skippedBecause
+ variable currentFailure
+ variable originalEnv
+ variable originalTclPlatform
+ variable coreModTime
+
+ FillFilesExisted
+ set testFileName [file tail [info script]]
+
+ # Call the cleanup hook
+ cleanupTestsHook
+
+ # Remove files and directories created by the makeFile and
+ # makeDirectory procedures. Record the names of files in
+ # workingDirectory that were not pre-existing, and associate them
+ # with the test file that created them.
+
+ if {!$calledFromAllFile} {
+ foreach file $filesMade {
+ if {[file exists $file]} {
+ DebugDo 1 {Warn "cleanupTests deleting $file..."}
+ catch {file delete -force $file}
+ }
+ }
+ set currentFiles {}
+ foreach file [glob -nocomplain \
+ -directory [temporaryDirectory] *] {
+ lappend currentFiles [file tail $file]
+ }
+ set newFiles {}
+ foreach file $currentFiles {
+ if {[lsearch -exact $filesExisted $file] == -1} {
+ lappend newFiles $file
+ }
+ }
+ set filesExisted $currentFiles
+ if {[llength $newFiles] > 0} {
+ set createdNewFiles($testFileName) $newFiles
+ }
+ }
+
+ if {$calledFromAllFile || $testSingleFile} {
+
+ # print stats
+
+ puts -nonewline [outputChannel] "$testFileName:"
+ foreach index [list "Total" "Passed" "Skipped" "Failed"] {
+ puts -nonewline [outputChannel] \
+ "\t$index\t$numTests($index)"
+ }
+ puts [outputChannel] ""
+
+ # print number test files sourced
+ # print names of files that ran tests which failed
+
+ if {$calledFromAllFile} {
+ puts [outputChannel] \
+ "Sourced $numTestFiles Test Files."
+ set numTestFiles 0
+ if {[llength $failFiles] > 0} {
+ puts [outputChannel] \
+ "Files with failing tests: $failFiles"
+ set failFiles {}
+ }
+ }
+
+ # if any tests were skipped, print the constraints that kept
+ # them from running.
+
+ set constraintList [array names skippedBecause]
+ if {[llength $constraintList] > 0} {
+ puts [outputChannel] \
+ "Number of tests skipped for each constraint:"
+ foreach constraint [lsort $constraintList] {
+ puts [outputChannel] \
+ "\t$skippedBecause($constraint)\t$constraint"
+ unset skippedBecause($constraint)
+ }
+ }
+
+ # report the names of test files in createdNewFiles, and reset
+ # the array to be empty.
+
+ set testFilesThatTurded [lsort [array names createdNewFiles]]
+ if {[llength $testFilesThatTurded] > 0} {
+ puts [outputChannel] "Warning: files left behind:"
+ foreach testFile $testFilesThatTurded {
+ puts [outputChannel] \
+ "\t$testFile:\t$createdNewFiles($testFile)"
+ unset createdNewFiles($testFile)
+ }
+ }
+
+ # reset filesMade, filesExisted, and numTests
+
+ set filesMade {}
+ foreach index [list "Total" "Passed" "Skipped" "Failed"] {
+ set numTests($index) 0
+ }
+
+ # exit only if running Tk in non-interactive mode
+ # This should be changed to determine if an event
+ # loop is running, which is the real issue.
+ # Actually, this doesn't belong here at all. A package
+ # really has no business [exit]-ing an application.
+ if {![catch {package present Tk}] && ![testConstraint interactive]} {
+ exit
+ }
+ } else {
+
+ # if we're deferring stat-reporting until all files are sourced,
+ # then add current file to failFile list if any tests in this
+ # file failed
+
+ incr numTestFiles
+ if {$currentFailure \
+ && ([lsearch -exact $failFiles $testFileName] == -1)} {
+ lappend failFiles $testFileName
+ }
+ set currentFailure false
+
+ # restore the environment to the state it was in before this package
+ # was loaded
+
+ set newEnv {}
+ set changedEnv {}
+ set removedEnv {}
+ foreach index [array names ::env] {
+ 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)
+ }
+ }
+ if {[llength $newEnv] > 0} {
+ puts [outputChannel] \
+ "env array elements created:\t$newEnv"
+ }
+ if {[llength $changedEnv] > 0} {
+ puts [outputChannel] \
+ "env array elements changed:\t$changedEnv"
+ }
+ if {[llength $removedEnv] > 0} {
+ puts [outputChannel] \
+ "env array elements removed:\t$removedEnv"
+ }
+
+ set changedTclPlatform {}
+ foreach index [array names originalTclPlatform] {
+ if {$::tcl_platform($index) \
+ != $originalTclPlatform($index)} {
+ lappend changedTclPlatform $index
+ set ::tcl_platform($index) $originalTclPlatform($index)
+ }
+ }
+ if {[llength $changedTclPlatform] > 0} {
+ puts [outputChannel] "tcl_platform array elements\
+ changed:\t$changedTclPlatform"
+ }
+
+ if {[file exists [file join [workingDirectory] core]]} {
+ if {[preserveCore] > 1} {
+ puts "rename core file (> 1)"
+ puts [outputChannel] "produced core file! \
+ Moving file to: \
+ [file join [temporaryDirectory] core-$name]"
+ catch {file rename -force \
+ [file join [workingDirectory] core] \
+ [file join [temporaryDirectory] core-$name]
+ } msg
+ if {[string length $msg] > 0} {
+ PrintError "Problem renaming file: $msg"
+ }
+ } else {
+ # Print a message if there is a core file and (1) there
+ # previously wasn't one or (2) the new one is different
+ # from the old one.
+
+ if {[info exists coreModTime]} {
+ if {$coreModTime != [file mtime \
+ [file join [workingDirectory] core]]} {
+ puts [outputChannel] "A core file was created!"
+ }
+ } else {
+ puts [outputChannel] "A core file was created!"
+ }
+ }
+ }
+ }
+ flush [outputChannel]
+ flush [errorChannel]
+ return
+}
+
+#####################################################################
+
+# Procs that determine which tests/test files to run
+
+# tcltest::GetMatchingFiles
+#
+# Looks at the patterns given to match and skip files and uses
+# them to put together a list of the tests that will be run.
+#
+# Arguments:
+# directory to search
+#
+# Results:
+# The constructed list is returned to the user. This will
+# primarily be used in 'all.tcl' files. It is used in
+# runAllTests.
+#
+# Side Effects:
+# None
+
+# a lower case version is needed for compatibility with tcltest 1.0
+proc tcltest::getMatchingFiles args {eval GetMatchingFiles $args}
+
+proc tcltest::GetMatchingFiles { args } {
+ if {[llength $args]} {
+ set dirList $args
+ } else {
+ # Finding tests only in [testsDirectory] is normal operation.
+ # This procedure is written to accept multiple directory arguments
+ # only to satisfy version 1 compatibility.
+ set dirList [list [testsDirectory]]
+ }
+
+ set matchingFiles [list]
+ foreach directory $dirList {
+
+ # List files in $directory that match patterns to run.
+ set matchFileList [list]
+ foreach match [matchFiles] {
+ set matchFileList [concat $matchFileList \
+ [glob -directory $directory -nocomplain -- $match]]
+ }
+
+ # List files in $directory that match patterns to skip.
+ set skipFileList [list]
+ foreach skip [skipFiles] {
+ set skipFileList [concat $skipFileList \
+ [glob -directory $directory -nocomplain -- $skip]]
+ }
+
+ # Add to result list all files in match list and not in skip list
+ foreach file $matchFileList {
+ if {[lsearch -exact $skipFileList $file] == -1} {
+ lappend matchingFiles $file
+ }
+ }
+ }
+
+ if {[llength $matchingFiles] == 0} {
+ PrintError "No test files remain after applying your match and\
+ skip patterns!"
+ }
+ return $matchingFiles
+}
+
+# tcltest::GetMatchingDirectories --
+#
+# Looks at the patterns given to match and skip directories and
+# uses them to put together a list of the test directories that we
+# should attempt to run. (Only subdirectories containing an
+# "all.tcl" file are put into the list.)
+#
+# Arguments:
+# root directory from which to search
+#
+# Results:
+# The constructed list is returned to the user. This is used in
+# the primary all.tcl file.
+#
+# Side Effects:
+# None.
+
+proc tcltest::GetMatchingDirectories {rootdir} {
+
+ # Determine the skip list first, to avoid [glob]-ing over subdirectories
+ # we're going to throw away anyway. Be sure we skip the $rootdir if it
+ # comes up to avoid infinite loops.
+ set skipDirs [list $rootdir]
+ foreach pattern [skipDirectories] {
+ foreach path [glob -directory $rootdir -nocomplain -- $pattern] {
+ if {[file isdirectory $path]} {
+ lappend skipDirs $path
+ }
+ }
+ }
+
+ # Now step through the matching directories, prune out the skipped ones
+ # as you go.
+ set matchDirs [list]
+ foreach pattern [matchDirectories] {
+ foreach path [glob -directory $rootdir -nocomplain -- $pattern] {
+ if {[file isdirectory $path]} {
+ if {[lsearch -exact $skipDirs $path] == -1} {
+ set matchDirs [concat $matchDirs \
+ [GetMatchingDirectories $path]]
+ if {[file exists [file join $path all.tcl]]} {
+ lappend matchDirs $path
+ }
+ }
+ }
+ }
+ }
+
+ if {[llength $matchDirs] == 0} {
+ DebugPuts 1 "No test directories remain after applying match\
+ and skip patterns!"
+ }
+ return $matchDirs
+}
+
+# tcltest::runAllTests --
+#
+# prints output and sources test files according to the match and
+# skip patterns provided. after sourcing test files, it goes on
+# to source all.tcl files in matching test subdirectories.
+#
+# Arguments:
+# shell being tested
+#
+# Results:
+# None.
+#
+# Side effects:
+# None.
+
+proc tcltest::runAllTests { {shell ""} } {
+ variable testSingleFile
+ variable numTestFiles
+ variable numTests
+ variable failFiles
+
+ FillFilesExisted
+ if {[llength [info level 0]] == 1} {
+ set shell [interpreter]
+ }
+
+ set testSingleFile false
+
+ puts [outputChannel] "Tests running in interp: $shell"
+ puts [outputChannel] "Tests located in: [testsDirectory]"
+ puts [outputChannel] "Tests running in: [workingDirectory]"
+ puts [outputChannel] "Temporary files stored in\
+ [temporaryDirectory]"
+
+ # [file system] first available in Tcl 8.4
+ if {![catch {file system [testsDirectory]} result]
+ && ![string equal native [lindex $result 0]]} {
+ # 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
+ # really exist.
+ singleProcess 1
+ }
+
+ if {[singleProcess]} {
+ puts [outputChannel] \
+ "Test files sourced into current interpreter"
+ } else {
+ puts [outputChannel] \
+ "Test files run in separate interpreters"
+ }
+ if {[llength [skip]] > 0} {
+ puts [outputChannel] "Skipping tests that match: [skip]"
+ }
+ puts [outputChannel] "Running tests that match: [match]"
+
+ if {[llength [skipFiles]] > 0} {
+ puts [outputChannel] \
+ "Skipping test files that match: [skipFiles]"
+ }
+ if {[llength [matchFiles]] > 0} {
+ puts [outputChannel] \
+ "Only running test files that match: [matchFiles]"
+ }
+
+ set timeCmd {clock format [clock seconds]}
+ puts [outputChannel] "Tests began at [eval $timeCmd]"
+
+ # Run each of the specified tests
+ foreach file [lsort [GetMatchingFiles]] {
+ set tail [file tail $file]
+ puts [outputChannel] $tail
+ flush [outputChannel]
+
+ if {[singleProcess]} {
+ incr numTestFiles
+ uplevel 1 [list ::source $file]
+ } else {
+ # Pass along our configuration to the child processes.
+ # EXCEPT for the -outfile, because the parent process
+ # 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]
+ }
+ set cmd [linsert $childargv 0 | $shell $file]
+ if {[catch {
+ incr numTestFiles
+ set pipeFd [open $cmd "r"]
+ while {[gets $pipeFd line] >= 0} {
+ if {[regexp [join {
+ {^([^:]+):\t}
+ {Total\t([0-9]+)\t}
+ {Passed\t([0-9]+)\t}
+ {Skipped\t([0-9]+)\t}
+ {Failed\t([0-9]+)}
+ } ""] $line null testFile \
+ Total Passed Skipped Failed]} {
+ foreach index {Total Passed Skipped Failed} {
+ incr numTests($index) [set $index]
+ }
+ if {$Failed > 0} {
+ lappend failFiles $testFile
+ }
+ } elseif {[regexp [join {
+ {^Number of tests skipped }
+ {for each constraint:}
+ {|^\t(\d+)\t(.+)$}
+ } ""] $line match skipped constraint]} {
+ if {[string match \t* $match]} {
+ AddToSkippedBecause $constraint $skipped
+ }
+ } else {
+ puts [outputChannel] $line
+ }
+ }
+ close $pipeFd
+ } msg]} {
+ puts [outputChannel] "Test file error: $msg"
+ # append the name of the test to a list to be reported
+ # later
+ lappend testFileFailures $file
+ }
+ }
+ }
+
+ # cleanup
+ puts [outputChannel] "\nTests ended at [eval $timeCmd]"
+ cleanupTests 1
+ if {[info exists testFileFailures]} {
+ puts [outputChannel] "\nTest files exiting with errors: \n"
+ foreach file $testFileFailures {
+ puts [outputChannel] " [file tail $file]\n"
+ }
+ }
+
+ # Checking for subdirectories in which to run tests
+ foreach directory [GetMatchingDirectories [testsDirectory]] {
+ set dir [file tail $directory]
+ puts [outputChannel] [string repeat ~ 44]
+ puts [outputChannel] "$dir test began at [eval $timeCmd]\n"
+
+ uplevel 1 [list ::source [file join $directory all.tcl]]
+
+ set endTime [eval $timeCmd]
+ puts [outputChannel] "\n$dir test ended at $endTime"
+ puts [outputChannel] ""
+ puts [outputChannel] [string repeat ~ 44]
+ }
+ return
+}
+
+#####################################################################
+
+# Test utility procs - not used in tcltest, but may be useful for
+# testing.
+
+# tcltest::loadTestedCommands --
+#
+# Uses the specified script to load the commands to test. Allowed to
+# be empty, as the tested commands could have been compiled into the
+# interpreter.
+#
+# Arguments
+# none
+#
+# Results
+# none
+#
+# Side Effects:
+# none.
+
+proc tcltest::loadTestedCommands {} {
+ variable l
+ if {[string equal {} [loadScript]]} {
+ return
+ }
+
+ return [uplevel 1 [loadScript]]
+}
+
+# tcltest::saveState --
+#
+# Save information regarding what procs and variables exist.
+#
+# Arguments:
+# none
+#
+# Results:
+# Modifies the variable saveState
+#
+# Side effects:
+# None.
+
+proc tcltest::saveState {} {
+ variable saveState
+ uplevel 1 [list ::set [namespace which -variable saveState]] \
+ {[::list [::info procs] [::info vars]]}
+ DebugPuts 2 "[lindex [info level 0] 0]: $saveState"
+ return
+}
+
+# tcltest::restoreState --
+#
+# Remove procs and variables that didn't exist before the call to
+# [saveState].
+#
+# Arguments:
+# none
+#
+# Results:
+# Removes procs and variables from your environment if they don't
+# exist in the saveState variable.
+#
+# Side effects:
+# None.
+
+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]]]} {
+
+ 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} {
+ DebugPuts 2 "[lindex [info level 0] 0]:\
+ Removing variable $p"
+ uplevel 1 [list ::catch [list ::unset $p]]
+ }
+ }
+ return
+}
+
+# tcltest::normalizeMsg --
+#
+# Removes "extra" newlines from a string.
+#
+# Arguments:
+# msg String to be modified
+#
+# Results:
+# string with extra newlines removed
+#
+# Side effects:
+# None.
+
+proc tcltest::normalizeMsg {msg} {
+ regsub "\n$" [string tolower $msg] "" msg
+ regsub -all "\n\n" $msg "\n" msg
+ regsub -all "\n\}" $msg "\}" msg
+ return $msg
+}
+
+# tcltest::makeFile --
+#
+# Create a new file with the name <name>, and write <contents> to it.
+#
+# If this file hasn't been created via makeFile since the last time
+# cleanupTests was called, add it to the $filesMade list, so it will be
+# removed by the next call to cleanupTests.
+#
+# Arguments:
+# contents content of the new file
+# name name of the new file
+# directory directory name for new file
+#
+# Results:
+# absolute path to the file created
+#
+# Side effects:
+# None.
+
+proc tcltest::makeFile {contents name {directory ""}} {
+ variable filesMade
+ FillFilesExisted
+
+ if {[llength [info level 0]] == 3} {
+ set directory [temporaryDirectory]
+ }
+
+ set fullName [file join $directory $name]
+
+ DebugPuts 3 "[lindex [info level 0] 0]:\
+ putting ``$contents'' into $fullName"
+
+ set fd [open $fullName w]
+ fconfigure $fd -translation lf
+ if {[string equal [string index $contents end] \n]} {
+ puts -nonewline $fd $contents
+ } else {
+ puts $fd $contents
+ }
+ close $fd
+
+ if {[lsearch -exact $filesMade $fullName] == -1} {
+ lappend filesMade $fullName
+ }
+ return $fullName
+}
+
+# tcltest::removeFile --
+#
+# Removes the named file from the filesystem
+#
+# Arguments:
+# name file to be removed
+# directory directory from which to remove file
+#
+# Results:
+# return value from [file delete]
+#
+# Side effects:
+# None.
+
+proc tcltest::removeFile {name {directory ""}} {
+ variable filesMade
+ FillFilesExisted
+ if {[llength [info level 0]] == 2} {
+ set directory [temporaryDirectory]
+ }
+ set fullName [file join $directory $name]
+ DebugPuts 3 "[lindex [info level 0] 0]: removing $fullName"
+ set idx [lsearch -exact $filesMade $fullName]
+ set filesMade [lreplace $filesMade $idx $idx]
+ if {$idx == -1} {
+ DebugDo 1 {
+ Warn "removeFile removing \"$fullName\":\n not created by makeFile"
+ }
+ }
+ if {![file isfile $fullName]} {
+ DebugDo 1 {
+ Warn "removeFile removing \"$fullName\":\n not a file"
+ }
+ }
+ return [file delete $fullName]
+}
+
+# tcltest::makeDirectory --
+#
+# Create a new dir with the name <name>.
+#
+# If this dir hasn't been created via makeDirectory since the last time
+# cleanupTests was called, add it to the $directoriesMade list, so it
+# will be removed by the next call to cleanupTests.
+#
+# Arguments:
+# name name of the new directory
+# directory directory in which to create new dir
+#
+# Results:
+# absolute path to the directory created
+#
+# Side effects:
+# None.
+
+proc tcltest::makeDirectory {name {directory ""}} {
+ variable filesMade
+ FillFilesExisted
+ if {[llength [info level 0]] == 2} {
+ set directory [temporaryDirectory]
+ }
+ set fullName [file join $directory $name]
+ DebugPuts 3 "[lindex [info level 0] 0]: creating $fullName"
+ file mkdir $fullName
+ if {[lsearch -exact $filesMade $fullName] == -1} {
+ lappend filesMade $fullName
+ }
+ return $fullName
+}
+
+# tcltest::removeDirectory --
+#
+# Removes a named directory from the file system.
+#
+# Arguments:
+# name Name of the directory to remove
+# directory Directory from which to remove
+#
+# Results:
+# return value from [file delete]
+#
+# Side effects:
+# None
+
+proc tcltest::removeDirectory {name {directory ""}} {
+ variable filesMade
+ FillFilesExisted
+ if {[llength [info level 0]] == 2} {
+ set directory [temporaryDirectory]
+ }
+ set fullName [file join $directory $name]
+ DebugPuts 3 "[lindex [info level 0] 0]: deleting $fullName"
+ set idx [lsearch -exact $filesMade $fullName]
+ set filesMade [lreplace $filesMade $idx $idx]
+ if {$idx == -1} {
+ DebugDo 1 {
+ Warn "removeDirectory removing \"$fullName\":\n not created\
+ by makeDirectory"
+ }
+ }
+ if {![file isdirectory $fullName]} {
+ DebugDo 1 {
+ Warn "removeDirectory removing \"$fullName\":\n not a directory"
+ }
+ }
+ return [file delete -force $fullName]
+}
+
+# tcltest::viewFile --
+#
+# reads the content of a file and returns it
+#
+# Arguments:
+# name of the file to read
+# directory in which file is located
+#
+# Results:
+# content of the named file
+#
+# Side effects:
+# None.
+
+proc tcltest::viewFile {name {directory ""}} {
+ FillFilesExisted
+ if {[llength [info level 0]] == 2} {
+ set directory [temporaryDirectory]
+ }
+ set fullName [file join $directory $name]
+ set f [open $fullName]
+ set data [read -nonewline $f]
+ close $f
+ return $data
+}
+
+# tcltest::bytestring --
+#
+# Construct a string that consists of the requested sequence of bytes,
+# as opposed to a string of properly formed UTF-8 characters.
+# This allows the tester to
+# 1. Create denormalized or improperly formed strings to pass to C
+# procedures that are supposed to accept strings with embedded NULL
+# bytes.
+# 2. Confirm that a string result has a certain pattern of bytes, for
+# instance to confirm that "\xe0\0" in a Tcl script is stored
+# internally in UTF-8 as the sequence of bytes "\xc3\xa0\xc0\x80".
+#
+# Generally, it's a bad idea to examine the bytes in a Tcl string or to
+# construct improperly formed strings in this manner, because it involves
+# exposing that Tcl uses UTF-8 internally.
+#
+# Arguments:
+# string being converted
+#
+# Results:
+# result fom encoding
+#
+# Side effects:
+# None
+
+proc tcltest::bytestring {string} {
+ return [encoding convertfrom identity $string]
+}
+
+# tcltest::OpenFiles --
+#
+# used in io tests, uses testchannel
+#
+# Arguments:
+# None.
+#
+# Results:
+# ???
+#
+# Side effects:
+# None.
+
+proc tcltest::OpenFiles {} {
+ if {[catch {testchannel open} result]} {
+ return {}
+ }
+ return $result
+}
+
+# tcltest::LeakFiles --
+#
+# used in io tests, uses testchannel
+#
+# Arguments:
+# None.
+#
+# Results:
+# ???
+#
+# Side effects:
+# None.
+
+proc tcltest::LeakFiles {old} {
+ if {[catch {testchannel open} new]} {
+ return {}
+ }
+ set leak {}
+ foreach p $new {
+ if {[lsearch $old $p] < 0} {
+ lappend leak $p
+ }
+ }
+ return $leak
+}
+
+#
+# Internationalization / ISO support procs -- dl
+#
+
+# tcltest::SetIso8859_1_Locale --
+#
+# used in cmdIL.test, uses testlocale
+#
+# Arguments:
+# None.
+#
+# Results:
+# None.
+#
+# Side effects:
+# None.
+
+proc tcltest::SetIso8859_1_Locale {} {
+ variable previousLocale
+ variable isoLocale
+ if {[info commands testlocale] != ""} {
+ set previousLocale [testlocale ctype]
+ testlocale ctype $isoLocale
+ }
+ return
+}
+
+# tcltest::RestoreLocale --
+#
+# used in cmdIL.test, uses testlocale
+#
+# Arguments:
+# None.
+#
+# Results:
+# None.
+#
+# Side effects:
+# None.
+
+proc tcltest::RestoreLocale {} {
+ variable previousLocale
+ if {[info commands testlocale] != ""} {
+ testlocale ctype $previousLocale
+ }
+ return
+}
+
+# tcltest::threadReap --
+#
+# Kill all threads except for the main thread.
+# Do nothing if testthread is not defined.
+#
+# Arguments:
+# none.
+#
+# Results:
+# Returns the number of existing threads.
+#
+# Side Effects:
+# none.
+#
+
+proc tcltest::threadReap {} {
+ if {[info commands testthread] != {}} {
+
+ # testthread built into tcltest
+
+ testthread errorproc ThreadNullError
+ while {[llength [testthread names]] > 1} {
+ foreach tid [testthread names] {
+ if {$tid != [mainThread]} {
+ catch {
+ testthread send -async $tid {testthread exit}
+ }
+ }
+ }
+ ## Enter a bit a sleep to give the threads enough breathing
+ ## room to kill themselves off, otherwise the end up with a
+ ## massive queue of repeated events
+ after 1
+ }
+ testthread errorproc ThreadError
+ return [llength [testthread names]]
+ } elseif {[info commands thread::id] != {}} {
+
+ # Thread extension
+
+ thread::errorproc ThreadNullError
+ while {[llength [thread::names]] > 1} {
+ foreach tid [thread::names] {
+ if {$tid != [mainThread]} {
+ catch {thread::send -async $tid {thread::exit}}
+ }
+ }
+ ## Enter a bit a sleep to give the threads enough breathing
+ ## room to kill themselves off, otherwise the end up with a
+ ## massive queue of repeated events
+ after 1
+ }
+ thread::errorproc ThreadError
+ return [llength [thread::names]]
+ } else {
+ return 1
+ }
+ return 0
+}
+
+# Initialize the constraints and set up command line arguments
+namespace eval tcltest {
+ # Define initializers for all the built-in contraint definitions
+ DefineConstraintInitializers
+
+ # 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]
+
+ # 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]]]} {
+ InitConstraints
+ } else {
+ proc initConstraintsHook {} {}
+ }
+
+ # Define the standard match commands
+ customMatch exact [list string equal]
+ customMatch glob [list string match]
+ customMatch regexp [list regexp --]
+
+ # If the TCLTEST_OPTIONS environment variable exists, configure
+ # tcltest according to the option values it specifies. This has
+ # the effect of resetting tcltest's default configuration.
+ proc ConfigureFromEnvironment {} {
+ upvar #0 env(TCLTEST_OPTIONS) options
+ if {[catch {llength $options} msg]} {
+ Warn "invalid TCLTEST_OPTIONS \"$options\":\n invalid\
+ Tcl list: $msg"
+ return
+ }
+ if {[llength $::env(TCLTEST_OPTIONS)] < 2} {
+ Warn "invalid TCLTEST_OPTIONS: \"$options\":\n should be\
+ -option value ?-option value ...?"
+ return
+ }
+ if {[catch {eval Configure $::env(TCLTEST_OPTIONS)} msg]} {
+ Warn "invalid TCLTEST_OPTIONS: \"$options\":\n $msg"
+ return
+ }
+ }
+ if {[info exists ::env(TCLTEST_OPTIONS)]} {
+ ConfigureFromEnvironment
+ }
+
+ proc LoadTimeCmdLineArgParsingRequired {} {
+ set required false
+ if {[info exists ::argv] && [lsearch -exact $::argv -help] != -1} {
+ # 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]]]} {
+ set required true
+ } else {
+ proc $hook args {}
+ }
+ }
+ return $required
+ }
+
+ # Only initialize configurable options from the command line arguments
+ # at package load time if necessary for backward compatibility. This
+ # lets the tcltest user call [configure] for themselves if they wish.
+ # Traces are established for auto-configuration from the command line
+ # if any configurable options are accessed before the user calls
+ # [configure].
+ if {[LoadTimeCmdLineArgParsingRequired]} {
+ ProcessCmdLineArgs
+ } else {
+ EstablishAutoConfigureTraces
+ }
+
+ package provide [namespace tail [namespace current]] $Version
+}
diff --git a/tcl/license.terms b/tcl/license.terms
index 9df3e600352..f1dcaa5245c 100644
--- a/tcl/license.terms
+++ b/tcl/license.terms
@@ -1,7 +1,8 @@
This software is copyrighted by the Regents of the University of
-California, Sun Microsystems, Inc., Scriptics Corporation,
-and other parties. The following terms apply to all files associated
-with the software unless explicitly disclaimed in individual files.
+California, Sun Microsystems, Inc., Scriptics Corporation, ActiveState
+Corporation and other parties. The following terms apply to all files
+associated with the software unless explicitly disclaimed in
+individual files.
The authors hereby grant permission to use, copy, modify, distribute,
and license this software and its documentation for any purpose, provided
diff --git a/tcl/mac/MW_TclAppleScriptHeader.pch b/tcl/mac/MW_TclAppleScriptHeader.pch
index 906134f3d74..e2ab7fe6f5d 100644
--- a/tcl/mac/MW_TclAppleScriptHeader.pch
+++ b/tcl/mac/MW_TclAppleScriptHeader.pch
@@ -33,15 +33,4 @@
#include "tclMacCommonPch.h"
-/* #define TCL_REGISTER_LIBRARY 1 */
#define USE_TCL_STUBS
-
-/*
- * Place any includes below that will are needed by the majority of the
- * and is OK to be in any file in the system. The pragma's are used
- * to control what functions are exported in the Tcl shared library.
- */
-
-#pragma export on
-#pragma export off
-
diff --git a/tcl/mac/MW_TclBuildLibHeader.h b/tcl/mac/MW_TclBuildLibHeader.h
new file mode 100644
index 00000000000..f6a6f6188c2
--- /dev/null
+++ b/tcl/mac/MW_TclBuildLibHeader.h
@@ -0,0 +1,7 @@
+#if __POWERPC__
+#include "MW_TclBuildLibHeaderPPC"
+#elif __CFM68K__
+#include "MW_TclBuildLibHeaderCFM68K"
+#else
+#include "MW_TclBuildLibHeader68K"
+#endif
diff --git a/tcl/mac/MW_TclBuildLibHeader.pch b/tcl/mac/MW_TclBuildLibHeader.pch
new file mode 100644
index 00000000000..a7274510274
--- /dev/null
+++ b/tcl/mac/MW_TclBuildLibHeader.pch
@@ -0,0 +1,35 @@
+/*
+ * MW_TclBuildLibHeader.pch --
+ *
+ * This file is the source for a pre-compilied header that gets used
+ * for all files in the Tcl projects. This make compilies go a bit
+ * faster. This file is only intended to be used in the MetroWerks
+ * CodeWarrior environment. It essentially acts as a place to set
+ * compiler flags. See MetroWerks documention for more details.
+ *
+ * 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$
+ */
+
+/*
+ * To use the compilied header you need to set the "Prefix file" in
+ * the "C/C++ Language" preference panel to point to the created
+ * compilied header. The name of the header depends on the
+ * architecture we are compiling for (see the code below). For
+ * example, for a 68k app the prefix file should be: MW_TclHeader68K.
+ */
+#if __POWERPC__
+#pragma precompile_target "MW_TclBuildLibHeaderPPC"
+#elif __CFM68K__
+#pragma precompile_target "MW_TclBuildLibHeaderCFM68K"
+#else
+#pragma precompile_target "MW_TclBuildLibHeader68K"
+#endif
+
+#define BUILD_tcl 1
+
+#include "MW_TclHeaderCommon.h"
diff --git a/tcl/mac/MW_TclHeader.pch b/tcl/mac/MW_TclHeader.pch
index 8a10be868e2..4842d4a4aaf 100644
--- a/tcl/mac/MW_TclHeader.pch
+++ b/tcl/mac/MW_TclHeader.pch
@@ -30,20 +30,4 @@
#pragma precompile_target "MW_TclHeader68K"
#endif
-#include "tclMacCommonPch.h"
-
-/*
- * Place any includes below that will are needed by the majority of the
- * and is OK to be in any file in the system. The pragma's are used
- * to control what functions are exported in the Tcl shared library.
- */
-
-#pragma export on
-#include "tcl.h"
-#include "tclMac.h"
-#include "tclInt.h"
-#include "MoreFiles.h"
-#include "MoreFilesExtras.h"
-
-#pragma export reset
-
+#include "MW_TclHeaderCommon.h"
diff --git a/tcl/mac/MW_TclHeaderCommon.h b/tcl/mac/MW_TclHeaderCommon.h
new file mode 100644
index 00000000000..56ea59cc1c1
--- /dev/null
+++ b/tcl/mac/MW_TclHeaderCommon.h
@@ -0,0 +1,54 @@
+/*
+ * MW_TclHeaderCommon.h --
+ *
+ * Common includes for precompiled headers
+ *
+ * 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$
+ */
+
+#pragma once
+
+#include "tclMacCommonPch.h"
+
+/*
+ * Place any includes below that will are needed by the majority of the
+ * and is OK to be in any file in the system.
+ */
+
+#include "tcl.h"
+
+#ifdef BUILD_tcl
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+#include "tclMac.h"
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
+
+#include "tclInt.h"
+
+
+#if PRAGMA_IMPORT
+#pragma import on
+#endif
+
+#include <MoreFiles.h>
+#include <MoreFilesExtras.h>
+#include <FSpCompat.h>
+#include <FileCopy.h>
+#include <FullPath.h>
+#include <IterateDirectory.h>
+#include <MoreDesktopMgr.h>
+#include <DirectoryCopy.h>
+#include <Search.h>
+
+#ifdef PRAGMA_IMPORT_OFF
+#pragma import off
+#elif PRAGMA_IMPORT
+#pragma import reset
+#endif
diff --git a/tcl/mac/MW_TclStaticHeader.h b/tcl/mac/MW_TclStaticHeader.h
new file mode 100644
index 00000000000..0c1abc2c22a
--- /dev/null
+++ b/tcl/mac/MW_TclStaticHeader.h
@@ -0,0 +1,7 @@
+#if __POWERPC__
+#include "MW_TclStaticHeaderPPC"
+#elif __CFM68K__
+#include "MW_TclStaticHeaderCFM68K"
+#else
+#include "MW_TclStaticHeader68K"
+#endif
diff --git a/tcl/mac/MW_TclStaticHeader.pch b/tcl/mac/MW_TclStaticHeader.pch
new file mode 100644
index 00000000000..f23021fcd3a
--- /dev/null
+++ b/tcl/mac/MW_TclStaticHeader.pch
@@ -0,0 +1,35 @@
+/*
+ * MW_TclStaticHeader.pch --
+ *
+ * This file is the source for a pre-compilied header that gets used
+ * for all files in the Tcl projects. This make compilies go a bit
+ * faster. This file is only intended to be used in the MetroWerks
+ * CodeWarrior environment. It essentially acts as a place to set
+ * compiler flags. See MetroWerks documention for more details.
+ *
+ * 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$
+ */
+
+/*
+ * To use the compilied header you need to set the "Prefix file" in
+ * the "C/C++ Language" preference panel to point to the created
+ * compilied header. The name of the header depends on the
+ * architecture we are compiling for (see the code below). For
+ * example, for a 68k app the prefix file should be: MW_TclHeader68K.
+ */
+#if __POWERPC__
+#pragma precompile_target "MW_TclStaticHeaderPPC"
+#elif __CFM68K__
+#pragma precompile_target "MW_TclStaticHeaderCFM68K"
+#else
+#pragma precompile_target "MW_TclStaticHeader68K"
+#endif
+
+#define STATIC_BUILD 1
+
+#include "MW_TclHeaderCommon.h"
diff --git a/tcl/mac/MW_TclTestHeader.pch b/tcl/mac/MW_TclTestHeader.pch
index 75b5ba95e3d..d94de9dd793 100644
--- a/tcl/mac/MW_TclTestHeader.pch
+++ b/tcl/mac/MW_TclTestHeader.pch
@@ -1,5 +1,5 @@
/*
- * MW_TclHeader.pch --
+ * MW_TclTestHeader.pch --
*
* This file is the source for a pre-compilied header that gets used
* for all files in the Tcl projects. This make compilies go a bit
@@ -30,25 +30,12 @@
#pragma precompile_target "MW_TclTestHeader68K"
#endif
-#define TCL_DEBUG 1
-
-/*#define TCL_THREADS 1*/
+#define BUILD_tcl 1
-#include "tclMacCommonPch.h"
+#define STATIC_BUILD 1
-/*
- * Place any includes below that will are needed by the majority of the
- * and is OK to be in any file in the system. The pragma's are used
- * to control what functions are exported in the Tcl shared library.
- */
-
-#pragma export on
-#include "tcl.h"
-#include "tclMac.h"
-#include "tclInt.h"
-#include "MoreFiles.h"
-#include "MoreFilesExtras.h"
-
-#pragma export reset
+#define TCL_DEBUG 1
+#define TCL_THREADS 1
+#include "MW_TclHeaderCommon.h"
diff --git a/tcl/mac/README b/tcl/mac/README
index e4ff695bf20..edb077e8779 100644
--- a/tcl/mac/README
+++ b/tcl/mac/README
@@ -1,12 +1,4 @@
-Tcl 8.3 for Macintosh
-
-by Ray Johnson
-Scriptics Corporation
-rjohnson@scriptics.com
-with major help from
-Jim Ingham
-Cygnus Solutions
-jingham@cygnus.com
+Tcl 8.4 for Macintosh
RCS: @(#) $Id$
@@ -14,15 +6,14 @@ RCS: @(#) $Id$
---------------
This is the README file for the Macintosh version of the Tcl
-scripting language. The home page for the Macintosh releases is
- http://dev.scriptics.com/software/mac/
+scripting language. The home page for the Mac/Tcl info is
+ http://www.tcl.tk/software/mac/
A summary of what's new in this release is at
- http://dev.scriptics.com/software/tcltk/8.3.html
+ http://www.tcl.tk/software/tcltk/8.4.html
A summary of Macintosh-specific features is at
- http://dev.scriptics.com/software/mac/features.html
-
+ http://www.tcl.tk/software/mac/features.html
2. The Distribution
-------------------
@@ -55,7 +46,7 @@ mactcl-source-<version>.sea.hqx
The "html" subdirectory contains reference documentation in
in the HTML format. You may also find these pages at:
- http://dev.scriptics.com/man/tcl<version>/contents.html
+ http://www.tcl.tk/man/
3. Compiling Tcl
----------------
@@ -70,10 +61,9 @@ following items:
The included project files should work fine. However, for
current release notes please check this page:
- http://dev.scriptics.com/doc/howto/compile.html#mac
-
-If you have comments or Bug reports send them to:
-Jim Ingham
-jingham@cygnus.com
+ http://www.tcl.tk/doc/howto/compile.html#mac
+If you have comments or Bug reports, please use the SourceForge
+Bug tracker to report them:
+ http://tcl.sourceforge.net/
diff --git a/tcl/mac/license.terms b/tcl/mac/license.terms
index 9df3e600352..f1dcaa5245c 100644
--- a/tcl/mac/license.terms
+++ b/tcl/mac/license.terms
@@ -1,7 +1,8 @@
This software is copyrighted by the Regents of the University of
-California, Sun Microsystems, Inc., Scriptics Corporation,
-and other parties. The following terms apply to all files associated
-with the software unless explicitly disclaimed in individual files.
+California, Sun Microsystems, Inc., Scriptics Corporation, ActiveState
+Corporation and other parties. The following terms apply to all files
+associated with the software unless explicitly disclaimed in
+individual files.
The authors hereby grant permission to use, copy, modify, distribute,
and license this software and its documentation for any purpose, provided
diff --git a/tcl/mac/tclMac.h b/tcl/mac/tclMac.h
index 06d3cd9c466..15c49e5495c 100644
--- a/tcl/mac/tclMac.h
+++ b/tcl/mac/tclMac.h
@@ -21,18 +21,8 @@
#include <Files.h>
#include <Events.h>
-/*
- * "export" is a MetroWerks specific pragma. It flags the linker that
- * any symbols that are defined when this pragma is on will be exported
- * to shared libraries that link with this library.
- */
-
-#pragma export on
-
typedef int (*Tcl_MacConvertEventPtr) _ANSI_ARGS_((EventRecord *eventPtr));
#include "tclPlatDecls.h"
-#pragma export reset
-
#endif /* _TCLMAC */
diff --git a/tcl/mac/tclMacAlloc.c b/tcl/mac/tclMacAlloc.c
index f06170cf27d..08e568b6824 100644
--- a/tcl/mac/tclMacAlloc.c
+++ b/tcl/mac/tclMacAlloc.c
@@ -20,6 +20,7 @@
#include "tclInt.h"
#include "tclMacInt.h"
#include <Memory.h>
+#include <Gestalt.h>
#include <stdlib.h>
#include <string.h>
@@ -30,12 +31,13 @@
*/
#define MEMORY_ALL_SYS 1 /* All memory should come from the system
heap. */
+#define MEMORY_DONT_USE_TEMPMEM 2 /* Don't use temporary memory but system memory. */
/*
* Amount of space to leave in the application heap for the Toolbox to work.
*/
-#define TOOLBOX_SPACE (32 * 1024)
+#define TOOLBOX_SPACE (512 * 1024)
static int memoryFlags = 0;
static Handle toolGuardHandle = NULL;
@@ -49,6 +51,15 @@ static Handle toolGuardHandle = NULL;
* the way out. If we can't, we go to the
* system heap directly. */
+static int tclUseMemTracking = 0; /* Are we tracking memory allocations?
+ * On recent versions of the MacOS this
+ * is no longer necessary, as we can use
+ * temporary memory which is freed by the
+ * OS after a quit or crash. */
+
+static size_t tclExtraHdlSize = 0; /* Size of extra memory allocated at the start
+ * of each block when using memory tracking
+ * ( == 0 otherwise) */
/*
* The following typedef and variable are used to keep track of memory
@@ -59,10 +70,11 @@ static Handle toolGuardHandle = NULL;
typedef struct listEl {
Handle memoryHandle;
struct listEl * next;
+ struct listEl * prec;
} ListEl;
-ListEl * systemMemory = NULL;
-ListEl * appMemory = NULL;
+static ListEl * systemMemory = NULL;
+static ListEl * appMemory = NULL;
/*
* Prototypes for functions used only in this file.
@@ -99,13 +111,28 @@ TclpSysRealloc(
Handle hand;
void *newPtr;
int maxsize;
+ OSErr err;
- hand = * (Handle *) ((Ptr) oldPtr - sizeof(Handle));
+ if (tclUseMemTracking) {
+ hand = ((ListEl *) ((Ptr) oldPtr - tclExtraHdlSize))->memoryHandle;
+ } else {
+ hand = RecoverHandle((Ptr) oldPtr);
+ }
maxsize = GetHandleSize(hand) - sizeof(Handle);
if (maxsize < size) {
+ HUnlock(hand);
+ SetHandleSize(hand,size + tclExtraHdlSize);
+ err = MemError();
+ HLock(hand);
+ if(err==noErr){
+ newPtr=(*hand + tclExtraHdlSize);
+ } else {
newPtr = TclpSysAlloc(size, 1);
- memcpy(newPtr, oldPtr, maxsize);
+ if(newPtr!=NULL) {
+ memmove(newPtr, oldPtr, maxsize);
TclpSysFree(oldPtr);
+ }
+ }
} else {
newPtr = oldPtr;
}
@@ -136,6 +163,31 @@ TclpSysAlloc(
{
Handle hand = NULL;
ListEl * newMemoryRecord;
+ int isSysMem = 0;
+ static int initialized=0;
+
+ if (!initialized) {
+ long response = 0;
+ OSErr err = noErr;
+ int useTempMem = 0;
+
+ /* Check if we can use temporary memory */
+ initialized=1;
+ err = Gestalt(gestaltOSAttr, &response);
+ if (err == noErr) {
+ useTempMem = response & (1 << gestaltRealTempMemory);
+ }
+ tclUseMemTracking = !useTempMem || (memoryFlags & MEMORY_DONT_USE_TEMPMEM);
+ if(tclUseMemTracking) {
+ tclExtraHdlSize = sizeof(ListEl);
+ /*
+ * We are allocating memory directly from the system
+ * heap. We need to install an exit handle
+ * to ensure the memory is cleaned up.
+ */
+ TclMacInstallExitToShellPatch(CleanUpExitProc);
+ }
+ }
if (!(memoryFlags & MEMORY_ALL_SYS)) {
@@ -157,6 +209,7 @@ TclpSysAlloc(
if (toolGuardHandle == NULL) {
toolGuardHandle = NewHandle(TOOLBOX_SPACE);
if (toolGuardHandle != NULL) {
+ HLock(toolGuardHandle);
HPurge(toolGuardHandle);
}
}
@@ -167,55 +220,55 @@ TclpSysAlloc(
if (toolGuardHandle != NULL) {
HLock(toolGuardHandle);
- hand = NewHandle(size + sizeof(Handle));
+ hand = NewHandle(size + tclExtraHdlSize);
HUnlock(toolGuardHandle);
}
}
- if (hand != NULL) {
- newMemoryRecord = (ListEl *) NewPtr(sizeof(ListEl));
- if (newMemoryRecord == NULL) {
- DisposeHandle(hand);
- return NULL;
- }
- newMemoryRecord->memoryHandle = hand;
- newMemoryRecord->next = appMemory;
- appMemory = newMemoryRecord;
- } else {
+ if (hand == NULL) {
/*
* Ran out of memory in application space. Lets try to get
* more memory from system. Otherwise, we return NULL to
* denote failure.
*/
+ if(!tclUseMemTracking) {
+ /* Use Temporary Memory instead of System Heap when available */
+ OSErr err;
+ isBin = 1; /* always HLockHi TempMemHandles */
+ hand = TempNewHandle(size + tclExtraHdlSize,&err);
+ if(err!=noErr) { hand=NULL; }
+ } else {
+ /* Use system heap when tracking memory */
+ isSysMem=1;
isBin = 0;
- hand = NewHandleSys(size + sizeof(Handle));
- if (hand == NULL) {
- return NULL;
+ hand = NewHandleSys(size + tclExtraHdlSize);
}
- if (systemMemory == NULL) {
- /*
- * This is the first time we've attempted to allocate memory
- * directly from the system heap. We need to now install the
- * exit handle to ensure the memory is cleaned up.
- */
- TclMacInstallExitToShellPatch(CleanUpExitProc);
}
- newMemoryRecord = (ListEl *) NewPtrSys(sizeof(ListEl));
- if (newMemoryRecord == NULL) {
- DisposeHandle(hand);
+ if (hand == NULL) {
return NULL;
}
- newMemoryRecord->memoryHandle = hand;
- newMemoryRecord->next = systemMemory;
- systemMemory = newMemoryRecord;
- }
if (isBin) {
HLockHi(hand);
} else {
HLock(hand);
}
- (** (Handle **) hand) = hand;
-
- return (*hand + sizeof(Handle));
+ if(tclUseMemTracking) {
+ /* Only need to do this when tracking memory */
+ newMemoryRecord = (ListEl *) *hand;
+ newMemoryRecord->memoryHandle = hand;
+ newMemoryRecord->prec = NULL;
+ if(isSysMem) {
+ newMemoryRecord->next = systemMemory;
+ systemMemory = newMemoryRecord;
+ } else {
+ newMemoryRecord->next = appMemory;
+ appMemory = newMemoryRecord;
+ }
+ if(newMemoryRecord->next!=NULL) {
+ newMemoryRecord->next->prec=newMemoryRecord;
+ }
+ }
+
+ return (*hand + tclExtraHdlSize);
}
/*
@@ -238,13 +291,27 @@ void
TclpSysFree(
void * ptr) /* Free this system memory. */
{
- Handle hand;
- OSErr err;
+ if(tclUseMemTracking) {
+ /* Only need to do this when tracking memory */
+ ListEl *memRecord;
- hand = * (Handle *) ((Ptr) ptr - sizeof(Handle));
- DisposeHandle(hand);
- *hand = NULL;
- err = MemError();
+ memRecord = (ListEl *) ((Ptr) ptr - tclExtraHdlSize);
+ /* Remove current record from linked list */
+ if(memRecord->next!=NULL) {
+ memRecord->next->prec=memRecord->prec;
+ }
+ if(memRecord->prec!=NULL) {
+ memRecord->prec->next=memRecord->next;
+ }
+ if(memRecord==appMemory) {
+ appMemory=memRecord->next;
+ } else if(memRecord==systemMemory) {
+ systemMemory=memRecord->next;
+ }
+ DisposeHandle(memRecord->memoryHandle);
+ } else {
+ DisposeHandle(RecoverHandle((Ptr) ptr));
+ }
}
/*
@@ -271,13 +338,13 @@ CleanUpExitProc()
{
ListEl * memRecord;
+ if(tclUseMemTracking) {
+ /* Only need to do this when tracking memory */
while (systemMemory != NULL) {
memRecord = systemMemory;
systemMemory = memRecord->next;
- if (*(memRecord->memoryHandle) != NULL) {
- DisposeHandle(memRecord->memoryHandle);
- }
- DisposePtr((void *) memRecord);
+ DisposeHandle(memRecord->memoryHandle);
+ }
}
}
@@ -304,21 +371,18 @@ FreeAllMemory()
{
ListEl * memRecord;
+ if(tclUseMemTracking) {
+ /* Only need to do this when tracking memory */
while (systemMemory != NULL) {
memRecord = systemMemory;
systemMemory = memRecord->next;
- if (*(memRecord->memoryHandle) != NULL) {
- DisposeHandle(memRecord->memoryHandle);
- }
- DisposePtr((void *) memRecord);
+ DisposeHandle(memRecord->memoryHandle);
}
while (appMemory != NULL) {
memRecord = appMemory;
appMemory = memRecord->next;
- if (*(memRecord->memoryHandle) != NULL) {
- DisposeHandle(memRecord->memoryHandle);
- }
- DisposePtr((void *) memRecord);
+ DisposeHandle(memRecord->memoryHandle);
+ }
}
}
diff --git a/tcl/mac/tclMacAppInit.c b/tcl/mac/tclMacAppInit.c
index 350afeb5730..34138a49587 100644
--- a/tcl/mac/tclMacAppInit.c
+++ b/tcl/mac/tclMacAppInit.c
@@ -22,7 +22,7 @@
# include <console.h>
#elif defined(__MWERKS__)
# include <SIOUX.h>
-short InstallConsole _ANSI_ARGS_((short fd));
+EXTERN short InstallConsole _ANSI_ARGS_((short fd));
#endif
#ifdef TCL_TEST
@@ -189,6 +189,7 @@ MacintoshInit()
SIOUXSettings.autocloseonquit = true;
SIOUXSettings.showstatusline = true;
SIOUXSettings.asktosaveonclose = false;
+ SIOUXSettings.wasteusetempmemory = true;
InstallConsole(0);
SIOUXSetTitle("\pTcl Interpreter");
diff --git a/tcl/mac/tclMacApplication.r b/tcl/mac/tclMacApplication.r
index 35a4213d156..991d1c4cfa1 100644
--- a/tcl/mac/tclMacApplication.r
+++ b/tcl/mac/tclMacApplication.r
@@ -34,29 +34,31 @@
#if (TCL_RELEASE_LEVEL == 2)
# define MINOR_VERSION (TCL_MINOR_VERSION * 16) + TCL_RELEASE_SERIAL
+# define RELEASE_CODE 0x00
#else
# define MINOR_VERSION TCL_MINOR_VERSION * 16
+# define RELEASE_CODE TCL_RELEASE_SERIAL
#endif
resource 'vers' (1) {
TCL_MAJOR_VERSION, MINOR_VERSION,
- RELEASE_LEVEL, 0x00, verUS,
+ RELEASE_LEVEL, RELEASE_CODE, verUS,
TCL_PATCH_LEVEL,
- TCL_PATCH_LEVEL ", by Ray Johnson & Jim Ingham © Scriptics Inc"
+ TCL_PATCH_LEVEL ", by Ray Johnson & Jim Ingham" "\n" "© 2001 Tcl Core Team"
};
resource 'vers' (2) {
TCL_MAJOR_VERSION, MINOR_VERSION,
- RELEASE_LEVEL, 0x00, verUS,
+ RELEASE_LEVEL, RELEASE_CODE, verUS,
TCL_PATCH_LEVEL,
- "Tcl Shell " TCL_PATCH_LEVEL " © 1996-1997 Sun Microsystems, 1998-1999 Scriptics Inc"
+ "Tcl Shell " TCL_PATCH_LEVEL " © 1993-2001"
};
#define TCL_APP_CREATOR 'Tcl '
type TCL_APP_CREATOR as 'STR ';
resource TCL_APP_CREATOR (0, purgeable) {
- "Tcl Shell " TCL_PATCH_LEVEL " © 1996-1999"
+ "Tcl Shell " TCL_PATCH_LEVEL " © 1993-2001"
};
/*
@@ -73,3 +75,41 @@ resource 'kind' (128, "Tcl kind", purgeable) {
'APPL', "Tcl Shell",
}
};
+
+/*
+ * The following resource is used when creating the 'env' variable in
+ * the Macintosh environment. The creation mechanisim looks for the
+ * 'STR#' resource named "Tcl Environment Variables" rather than a
+ * specific resource number. (In other words, feel free to change the
+ * resource id if it conflicts with your application.) Each string in
+ * the resource must be of the form "KEYWORD=SOME STRING". See Tcl
+ * documentation for futher information about the env variable.
+ *
+ * A good example of something you may want to set is: "TCL_LIBRARY=My
+ * disk:etc."
+ */
+
+resource 'STR#' (128, "Tcl Environment Variables") {
+ {
+ /*
+ "SCHEDULE_NAME=Agent Controller Schedule",
+ "SCHEDULE_PATH=Lozoya:System Folder:Tcl Lib:Tcl-Scheduler"
+ */
+ };
+};
+
+data 'alis' (1000, "Library Folder") {
+ $"0000 0000 00BA 0002 0001 012F 0000 0000" /* .....†...../.... */
+ $"0000 0000 0000 0000 0000 0000 0000 0000" /* ................ */
+ $"0000 0000 0000 985C FB00 4244 0000 0000" /* ......ò\š.BD.... */
+ $"0002 1328 5375 7070 6F72 7420 4C69 6272" /* ...(Support Libr */
+ $"6172 6965 7329 0000 0000 0000 0000 0000" /* aries).......... */
+ $"0000 0000 0000 0000 0000 0000 0000 0000" /* ................ */
+ $"0000 0000 0000 0000 0000 0000 0000 0000" /* ................ */
+ $"0000 0076 8504 B617 A796 003D 0027 025B" /* ...vÖ..ßñ.=.'.[ */
+ $"01E4 0001 0001 0000 0000 0000 0000 0000" /* .”.............. */
+ $"0000 0000 0000 0000 0001 2F00 0002 0015" /* ........../..... */
+ $"2F3A 2853 7570 706F 7274 204C 6962 7261" /* /:(Support Libra */
+ $"7269 6573 2900 FFFF 0000" /* ries)... */
+};
+
diff --git a/tcl/mac/tclMacBOAMain.c b/tcl/mac/tclMacBOAMain.c
index b21d3866853..5af1ccc43b9 100644
--- a/tcl/mac/tclMacBOAMain.c
+++ b/tcl/mac/tclMacBOAMain.c
@@ -49,22 +49,10 @@ extern char * strcpy _ANSI_ARGS_((char *dst, CONST char *src));
static Tcl_Interp *interp; /* Interpreter for application. */
-#ifdef TCL_MEM_DEBUG
-static char dumpFile[100]; /* Records where to dump memory allocation
- * information. */
-static int quitFlag = 0; /* 1 means "checkmem" command was called,
- * so the application should quit and dump
- * memory allocation information. */
-#endif
-
/*
* Forward references for procedures defined later in this file:
*/
-#ifdef TCL_MEM_DEBUG
-static int CheckmemCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char *argv[]));
-#endif
void TclMacDoNotification(char *mssg);
void TclMacNotificationResponse(NMRecPtr nmRec);
int Tcl_MacBGNotifyObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv);
@@ -108,11 +96,7 @@ Tcl_Main(argc, argv, appInitProc)
Tcl_FindExecutable(argv[0]);
interp = Tcl_CreateInterp();
-#ifdef TCL_MEM_DEBUG
Tcl_InitMemory(interp);
- Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
-#endif
/*
* Make command-line arguments available in the Tcl variables "argc"
@@ -318,44 +302,3 @@ Tcl_MacBGNotifyObjCmd(clientData, interp, objc, objv)
}
-
-/*
- *----------------------------------------------------------------------
- *
- * CheckmemCmd --
- *
- * This is the command procedure for the "checkmem" command, which
- * causes the application to exit after printing information about
- * memory usage to the file passed to this command as its first
- * argument.
- *
- * Results:
- * Returns a standard Tcl completion code.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-#ifdef TCL_MEM_DEBUG
-
- /* ARGSUSED */
-static int
-CheckmemCmd(clientData, interp, argc, argv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Interpreter for evaluation. */
- int argc; /* Number of arguments. */
- char *argv[]; /* String values of arguments. */
-{
- extern char *tclMemDumpFileName;
- if (argc != 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " fileName\"", (char *) NULL);
- return TCL_ERROR;
- }
- strcpy(dumpFile, argv[1]);
- tclMemDumpFileName = dumpFile;
- quitFlag = 1;
- return TCL_OK;
-}
-#endif
diff --git a/tcl/mac/tclMacChan.c b/tcl/mac/tclMacChan.c
index 19f970f80f8..9795a18eac4 100644
--- a/tcl/mac/tclMacChan.c
+++ b/tcl/mac/tclMacChan.c
@@ -25,6 +25,12 @@
#include <MoreFiles.h>
#include <MoreFilesExtras.h>
+#ifdef __MSL__
+#include <unix.mac.h>
+#define TCL_FILE_CREATOR (__getcreator(0))
+#else
+#define TCL_FILE_CREATOR 'MPW '
+#endif
/*
* The following are flags returned by GetOpenMode. They
@@ -108,7 +114,7 @@ static ThreadSpecificData *FileInit _ANSI_ARGS_((void));
static int FileInput _ANSI_ARGS_((ClientData instanceData,
char *buf, int toRead, int *errorCode));
static int FileOutput _ANSI_ARGS_((ClientData instanceData,
- char *buf, int toWrite, int *errorCode));
+ CONST char *buf, int toWrite, int *errorCode));
static int FileSeek _ANSI_ARGS_((ClientData instanceData,
long offset, int mode, int *errorCode));
static void FileSetupProc _ANSI_ARGS_((ClientData clientData,
@@ -124,7 +130,7 @@ static int StdIOClose _ANSI_ARGS_((ClientData instanceData,
static int StdIOInput _ANSI_ARGS_((ClientData instanceData,
char *buf, int toRead, int *errorCode));
static int StdIOOutput _ANSI_ARGS_((ClientData instanceData,
- char *buf, int toWrite, int *errorCode));
+ CONST char *buf, int toWrite, int *errorCode));
static int StdIOSeek _ANSI_ARGS_((ClientData instanceData,
long offset, int mode, int *errorCode));
static int StdReady _ANSI_ARGS_((ClientData instanceData,
@@ -136,7 +142,7 @@ static int StdReady _ANSI_ARGS_((ClientData instanceData,
static Tcl_ChannelType consoleChannelType = {
"file", /* Type name. */
- StdIOBlockMode, /* Set blocking/nonblocking mode.*/
+ (Tcl_ChannelTypeVersion)StdIOBlockMode, /* Set blocking/nonblocking mode.*/
StdIOClose, /* Close proc. */
StdIOInput, /* Input proc. */
StdIOOutput, /* Output proc. */
@@ -153,7 +159,7 @@ static Tcl_ChannelType consoleChannelType = {
static Tcl_ChannelType fileChannelType = {
"file", /* Type name. */
- FileBlockMode, /* Set blocking or
+ (Tcl_ChannelTypeVersion)FileBlockMode, /* Set blocking or
* non-blocking mode.*/
FileClose, /* Close proc. */
FileInput, /* Input proc. */
@@ -548,7 +554,7 @@ StdIOInput(
static int
StdIOOutput(
ClientData instanceData, /* Unused. */
- char *buf, /* The data buffer. */
+ CONST char *buf, /* The data buffer. */
int toWrite, /* How many bytes to write? */
int *errorCode) /* Where to store error code. */
{
@@ -558,7 +564,7 @@ StdIOOutput(
*errorCode = 0;
errno = 0;
fd = (int) ((FileState*)instanceData)->fileRef;
- written = write(fd, buf, (size_t) toWrite);
+ written = write(fd, (void*)buf, (size_t) toWrite);
if (written > -1) {
return written;
}
@@ -586,11 +592,10 @@ StdIOOutput(
static int
StdIOSeek(
- ClientData instanceData, /* Unused. */
- long offset, /* Offset to seek to. */
- int mode, /* Relative to where
- * should we seek? */
- int *errorCodePtr) /* To store error code. */
+ ClientData instanceData, /* Unused. */
+ long offset, /* Offset to seek to. */
+ int mode, /* Relative to where should we seek? */
+ int *errorCodePtr) /* To store error code. */
{
int newLoc;
int fd;
@@ -736,7 +741,7 @@ TclpGetDefaultStdChannel(
*
* TclpOpenFileChannel --
*
- * Open an File based channel on Unix systems.
+ * Open a File based channel on MacOS systems.
*
* Results:
* The new channel or NULL. If NULL, the output argument
@@ -753,38 +758,28 @@ Tcl_Channel
TclpOpenFileChannel(
Tcl_Interp *interp, /* Interpreter for error reporting;
* can be NULL. */
- char *fileName, /* Name of file to open. */
- char *modeString, /* A list of POSIX open modes or
- * a string such as "rw". */
+ 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_Channel chan;
- int mode;
- char *native;
- Tcl_DString ds, buffer;
+ CONST char *native;
int errorCode;
- mode = GetOpenMode(interp, modeString);
- if (mode == -1) {
- return NULL;
- }
-
- if (Tcl_TranslateFileName(interp, fileName, &buffer) == NULL) {
+ native = Tcl_FSGetNativePath(pathPtr);
+ if (native == NULL) {
return NULL;
}
- native = Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&buffer),
- Tcl_DStringLength(&buffer), &ds);
chan = OpenFileChannel(native, mode, permissions, &errorCode);
- Tcl_DStringFree(&ds);
- Tcl_DStringFree(&buffer);
if (chan == NULL) {
Tcl_SetErrno(errorCode);
if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp, "couldn't open \"", fileName, "\": ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_AppendResult(interp, "couldn't open \"",
+ Tcl_GetString(pathPtr), "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
}
return NULL;
}
@@ -862,7 +857,7 @@ OpenFileChannel(
}
if ((err == fnfErr) && (mode & TCL_CREAT)) {
- err = HCreate(fileSpec.vRefNum, fileSpec.parID, fileSpec.name, 'MPW ', 'TEXT');
+ err = HCreate(fileSpec.vRefNum, fileSpec.parID, fileSpec.name, TCL_FILE_CREATOR, 'TEXT');
if (err != noErr) {
*errorCodePtr = errno = TclMacOSErrorToPosixError(err);
Tcl_SetErrno(errno);
@@ -1085,7 +1080,7 @@ FileInput(
static int
FileOutput(
ClientData instanceData, /* Unused. */
- char *buffer, /* The data buffer. */
+ CONST char *buffer, /* The data buffer. */
int toWrite, /* How many bytes to write? */
int *errorCodePtr) /* Where to store error code. */
{
@@ -1132,10 +1127,9 @@ FileOutput(
static int
FileSeek(
ClientData instanceData, /* Unused. */
- long offset, /* Offset to seek to. */
- int mode, /* Relative to where
- * should we seek? */
- int *errorCodePtr) /* To store error code. */
+ long offset, /* Offset to seek to. */
+ int mode, /* Relative to where should we seek? */
+ int *errorCodePtr) /* To store error code. */
{
FileState *fileState = (FileState *) instanceData;
IOParam pb;
@@ -1285,7 +1279,7 @@ GetOpenMode(
* "RDONLY CREAT". */
{
int mode, modeArgc, c, i, gotRW;
- char **modeArgv, *flag;
+ CONST char **modeArgv, *flag;
/*
* Check for the simpler fopen-like access modes (e.g. "r"). They
diff --git a/tcl/mac/tclMacCommonPch.h b/tcl/mac/tclMacCommonPch.h
index 5f599ddabb0..c239ba4de69 100644
--- a/tcl/mac/tclMacCommonPch.h
+++ b/tcl/mac/tclMacCommonPch.h
@@ -50,17 +50,6 @@
/*
-* The following defines control the behavior of the Macintosh
-* Universial Headers.
-*/
-
-
-#define SystemSevenOrLater 1
-#define STRICT_CONTROLS 1
-#define STRICT_WINDOWS 1
-
-
-/*
* Define the following symbol if you want
* comprehensive debugging turned on.
*/
@@ -75,14 +64,8 @@
#endif
-
/*
-* For a while, we will continue to use the old routine names, so that
-* people with older versions of CodeWarrior will still be able to compile
-* the source (albeit they will have to update the project files themselves).
-*
-* At some point, we will convert over to the new routine names.
+* for Metrowerks Pro 6 MSL
*/
-
-#define OLDROUTINENAMES 1
+#include <UseDLLPrefix.h>
diff --git a/tcl/mac/tclMacFCmd.c b/tcl/mac/tclMacFCmd.c
index f2c866d283a..86f6472303c 100644
--- a/tcl/mac/tclMacFCmd.c
+++ b/tcl/mac/tclMacFCmd.c
@@ -25,22 +25,23 @@
#include <Script.h>
#include <string.h>
#include <Finder.h>
+#include <Aliases.h>
/*
* Callback for the file attributes code.
*/
static int GetFileFinderAttributes _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, CONST char *fileName,
+ int objIndex, Tcl_Obj *fileName,
Tcl_Obj **attributePtrPtr));
static int GetFileReadOnly _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, CONST char *fileName,
+ int objIndex, Tcl_Obj *fileName,
Tcl_Obj **readOnlyPtrPtr));
static int SetFileFinderAttributes _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, CONST char *fileName,
+ int objIndex, Tcl_Obj *fileName,
Tcl_Obj *attributePtr));
static int SetFileReadOnly _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, CONST char *fileName,
+ int objIndex, Tcl_Obj *fileName,
Tcl_Obj *readOnlyPtr));
/*
@@ -56,7 +57,7 @@ static int SetFileReadOnly _ANSI_ARGS_((Tcl_Interp *interp,
* Global variables for the file attributes code.
*/
-char *tclpFileAttrStrings[] = {"-creator", "-hidden", "-readonly",
+CONST char *tclpFileAttrStrings[] = {"-creator", "-hidden", "-readonly",
"-type", (char *) NULL};
CONST TclFileAttrProcs tclpFileAttrProcs[] = {
{GetFileFinderAttributes, SetFileFinderAttributes},
@@ -100,7 +101,7 @@ static int Pstrequal _ANSI_ARGS_((ConstStr255Param stringA,
/*
*---------------------------------------------------------------------------
*
- * TclpRenameFile, DoRenameFile --
+ * TclpObjRenameFile, DoRenameFile --
*
* Changes the name of an existing file or directory, from src to dst.
* If src and dst refer to the same file or directory, does nothing
@@ -132,23 +133,13 @@ static int Pstrequal _ANSI_ARGS_((ConstStr255Param stringA,
*---------------------------------------------------------------------------
*/
-int
-TclpRenameFile(
- CONST char *src, /* Pathname of file or dir to be renamed
- * (UTF-8). */
- CONST char *dst) /* New pathname of file or directory
- * (UTF-8). */
+int
+TclpObjRenameFile(srcPathPtr, destPathPtr)
+ Tcl_Obj *srcPathPtr;
+ Tcl_Obj *destPathPtr;
{
- int result;
- Tcl_DString srcString, dstString;
-
- Tcl_UtfToExternalDString(NULL, src, -1, &srcString);
- Tcl_UtfToExternalDString(NULL, dst, -1, &dstString);
- result = DoRenameFile(Tcl_DStringValue(&srcString),
- Tcl_DStringValue(&dstString));
- Tcl_DStringFree(&srcString);
- Tcl_DStringFree(&dstString);
- return result;
+ return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr),
+ Tcl_FSGetNativePath(destPathPtr));
}
static int
@@ -163,7 +154,7 @@ DoRenameFile(
long srcID, dummy;
Boolean srcIsDirectory, dstIsDirectory, dstExists, dstLocked;
- err = FSpLocationFromPath(strlen(src), src, &srcFileSpec);
+ err = FSpLLocationFromPath(strlen(src), src, &srcFileSpec);
if (err == noErr) {
FSpGetDirectoryID(&srcFileSpec, &srcID, &srcIsDirectory);
}
@@ -383,7 +374,7 @@ MoveRename(
/*
*---------------------------------------------------------------------------
*
- * TclpCopyFile, DoCopyFile --
+ * TclpObjCopyFile, DoCopyFile --
*
* Copy a single file (not a directory). If dst already exists and
* is not a directory, it is removed.
@@ -408,20 +399,12 @@ MoveRename(
*/
int
-TclpCopyFile(
- CONST char *src, /* Pathname of file to be copied (UTF-8). */
- CONST char *dst) /* Pathname of file to copy to (UTF-8). */
+TclpObjCopyFile(srcPathPtr, destPathPtr)
+ Tcl_Obj *srcPathPtr;
+ Tcl_Obj *destPathPtr;
{
- int result;
- Tcl_DString srcString, dstString;
-
- Tcl_UtfToExternalDString(NULL, src, -1, &srcString);
- Tcl_UtfToExternalDString(NULL, dst, -1, &dstString);
- result = DoCopyFile(Tcl_DStringValue(&srcString),
- Tcl_DStringValue(&dstString));
- Tcl_DStringFree(&srcString);
- Tcl_DStringFree(&dstString);
- return result;
+ return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr),
+ Tcl_FSGetNativePath(destPathPtr));
}
static int
@@ -434,7 +417,7 @@ DoCopyFile(
FSSpec srcFileSpec, dstFileSpec, dstDirSpec, tmpFileSpec;
Str31 tmpName;
- err = FSpLocationFromPath(strlen(src), src, &srcFileSpec);
+ err = FSpLLocationFromPath(strlen(src), src, &srcFileSpec);
if (err == noErr) {
err = GetFileSpecs(dst, &dstFileSpec, &dstDirSpec, &dstExists,
&dstIsDirectory);
@@ -496,7 +479,7 @@ DoCopyFile(
/*
*---------------------------------------------------------------------------
*
- * TclpDeleteFile, DoDeleteFile --
+ * TclpObjDeleteFile, DoDeleteFile --
*
* Removes a single file (not a directory).
*
@@ -515,17 +498,11 @@ DoCopyFile(
*---------------------------------------------------------------------------
*/
-int
-TclpDeleteFile(
- CONST char *path) /* Pathname of file to be removed (UTF-8). */
+int
+TclpObjDeleteFile(pathPtr)
+ Tcl_Obj *pathPtr;
{
- int result;
- Tcl_DString pathString;
-
- Tcl_UtfToExternalDString(NULL, path, -1, &pathString);
- result = DoDeleteFile(Tcl_DStringValue(&pathString));
- Tcl_DStringFree(&pathString);
- return result;
+ return DoDeleteFile(Tcl_FSGetNativePath(pathPtr));
}
static int
@@ -537,7 +514,7 @@ DoDeleteFile(
Boolean isDirectory;
long dirID;
- err = FSpLocationFromPath(strlen(path), path, &fileSpec);
+ err = FSpLLocationFromPath(strlen(path), path, &fileSpec);
if (err == noErr) {
/*
* Since FSpDeleteCompat will delete an empty directory, make sure
@@ -568,7 +545,7 @@ DoDeleteFile(
/*
*---------------------------------------------------------------------------
*
- * TclpCreateDirectory, DoCreateDirectory --
+ * TclpObjCreateDirectory, DoCreateDirectory --
*
* Creates the specified directory. All parent directories of the
* specified directory must already exist. The directory is
@@ -591,17 +568,11 @@ DoDeleteFile(
*---------------------------------------------------------------------------
*/
-int
-TclpCreateDirectory(
- CONST char *path) /* Pathname of directory to create (UTF-8). */
+int
+TclpObjCreateDirectory(pathPtr)
+ Tcl_Obj *pathPtr;
{
- int result;
- Tcl_DString pathString;
-
- Tcl_UtfToExternalDString(NULL, path, -1, &pathString);
- result = DoCreateDirectory(Tcl_DStringValue(&pathString));
- Tcl_DStringFree(&pathString);
- return result;
+ return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr));
}
static int
@@ -629,7 +600,7 @@ DoCreateDirectory(
/*
*---------------------------------------------------------------------------
*
- * TclpCopyDirectory, DoCopyDirectory --
+ * TclpObjCopyDirectory, DoCopyDirectory --
*
* Recursively copies a directory. The target directory dst must
* not already exist. Note that this function does not merge two
@@ -652,32 +623,29 @@ DoCreateDirectory(
*---------------------------------------------------------------------------
*/
-int
-TclpCopyDirectory(
- CONST char *src, /* Pathname of directory to be copied
- * (UTF-8). */
- CONST char *dst, /* Pathname of target directory (UTF-8). */
- Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free
- * DString filled with UTF-8 name of file
- * causing error. */
+int
+TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr)
+ Tcl_Obj *srcPathPtr;
+ Tcl_Obj *destPathPtr;
+ Tcl_Obj **errorPtr;
{
- int result;
- Tcl_DString srcString, dstString;
-
- Tcl_UtfToExternalDString(NULL, src, -1, &srcString);
- Tcl_UtfToExternalDString(NULL, dst, -1, &dstString);
- result = DoCopyDirectory(Tcl_DStringValue(&srcString),
- Tcl_DStringValue(&dstString), errorPtr);
- Tcl_DStringFree(&srcString);
- Tcl_DStringFree(&dstString);
- return result;
+ Tcl_DString ds;
+ int ret;
+ ret = DoCopyDirectory(Tcl_FSGetNativePath(srcPathPtr),
+ Tcl_FSGetNativePath(destPathPtr), &ds);
+ if (ret != TCL_OK) {
+ *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
+ Tcl_DStringFree(&ds);
+ Tcl_IncrRefCount(*errorPtr);
+ }
+ return ret;
}
static int
DoCopyDirectory(
CONST char *src, /* Pathname of directory to be copied
- * (UTF-8). */
- CONST char *dst, /* Pathname of target directory (UTF-8). */
+ * (Native). */
+ CONST char *dst, /* Pathname of target directory (Native). */
Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free
* DString filled with UTF-8 name of file
* causing error. */
@@ -748,7 +716,7 @@ DoCopyDirectory(
err = FSpDirCreateCompat(&tmpDirSpec, smSystemScript, &tmpDirID);
}
if (err == noErr) {
- err = FSpDirectoryCopy(&srcFileSpec, &tmpDirSpec, NULL, 0, true,
+ err = FSpDirectoryCopy(&srcFileSpec, &tmpDirSpec, NULL, NULL, 0, true,
CopyErrHandler);
}
@@ -832,7 +800,7 @@ CopyErrHandler(
/*
*---------------------------------------------------------------------------
*
- * TclpRemoveDirectory, DoRemoveDirectory --
+ * TclpObjRemoveDirectory, DoRemoveDirectory --
*
* Removes directory (and its contents, if the recursive flag is set).
*
@@ -855,26 +823,21 @@ CopyErrHandler(
*---------------------------------------------------------------------------
*/
-int
-TclpRemoveDirectory(
- CONST char *path, /* 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_DString *errorPtr) /* If non-NULL, uninitialized or free
- * DString filled with UTF-8 name of file
- * causing error. */
+int
+TclpObjRemoveDirectory(pathPtr, recursive, errorPtr)
+ Tcl_Obj *pathPtr;
+ int recursive;
+ Tcl_Obj **errorPtr;
{
- int result;
- Tcl_DString pathString;
-
- Tcl_UtfToExternalDString(NULL, path, -1, &pathString);
- result = DoRemoveDirectory(Tcl_DStringValue(&pathString), recursive,
- errorPtr);
- Tcl_DStringFree(&pathString);
-
- return result;
+ Tcl_DString ds;
+ int ret;
+ ret = DoRemoveDirectory(Tcl_FSGetNativePath(pathPtr),recursive, &ds);
+ if (ret != TCL_OK) {
+ *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
+ Tcl_DStringFree(&ds);
+ Tcl_IncrRefCount(*errorPtr);
+ }
+ return ret;
}
static int
@@ -1061,10 +1024,10 @@ GetFileSpecs(
Boolean *pathIsDirectoryPtr)/* Set to true if path is itself a directory,
* otherwise false. */
{
- char *dirName;
+ CONST char *dirName;
OSErr err;
int argc;
- char **argv;
+ CONST char **argv;
long d;
Tcl_DString buffer;
@@ -1194,18 +1157,17 @@ static int
GetFileFinderAttributes(
Tcl_Interp *interp, /* The interp to report errors with. */
int objIndex, /* The index of the attribute option. */
- CONST char *fileName, /* The name of the file (UTF-8). */
+ Tcl_Obj *fileName, /* The name of the file (UTF-8). */
Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
{
OSErr err;
FSSpec fileSpec;
FInfo finfo;
- Tcl_DString pathString;
+ CONST char *native;
- Tcl_UtfToExternalDString(NULL, fileName, -1, &pathString);
- err = FSpLocationFromPath(Tcl_DStringLength(&pathString),
- Tcl_DStringValue(&pathString), &fileSpec);
- Tcl_DStringFree(&pathString);
+ native=Tcl_FSGetNativePath(fileName);
+ err = FSpLLocationFromPath(strlen(native),
+ native, &fileSpec);
if (err == noErr) {
err = FSpGetFInfo(&fileSpec, &finfo);
@@ -1241,7 +1203,7 @@ GetFileFinderAttributes(
if (err != noErr) {
errno = TclMacOSErrorToPosixError(err);
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "could not read \"", fileName, "\": ",
+ "could not read \"", Tcl_GetString(fileName), "\": ",
Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
@@ -1273,18 +1235,17 @@ static int
GetFileReadOnly(
Tcl_Interp *interp, /* The interp to report errors with. */
int objIndex, /* The index of the attribute. */
- CONST char *fileName, /* The name of the file (UTF-8). */
+ Tcl_Obj *fileName, /* The name of the file (UTF-8). */
Tcl_Obj **readOnlyPtrPtr) /* A pointer to return the object with. */
{
OSErr err;
FSSpec fileSpec;
CInfoPBRec paramBlock;
- Tcl_DString pathString;
+ CONST char *native;
- Tcl_UtfToExternalDString(NULL, fileName, -1, &pathString);
- err = FSpLocationFromPath(Tcl_DStringLength(&pathString),
- Tcl_DStringValue(&pathString), &fileSpec);
- Tcl_DStringFree(&pathString);
+ native=Tcl_FSGetNativePath(fileName);
+ err = FSpLLocationFromPath(strlen(native),
+ native, &fileSpec);
if (err == noErr) {
if (err == noErr) {
@@ -1310,7 +1271,7 @@ GetFileReadOnly(
if (err != noErr) {
errno = TclMacOSErrorToPosixError(err);
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "could not read \"", fileName, "\": ",
+ "could not read \"", Tcl_GetString(fileName), "\": ",
Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
@@ -1338,18 +1299,17 @@ static int
SetFileFinderAttributes(
Tcl_Interp *interp, /* The interp to report errors with. */
int objIndex, /* The index of the attribute. */
- CONST char *fileName, /* The name of the file (UTF-8). */
+ Tcl_Obj *fileName, /* The name of the file (UTF-8). */
Tcl_Obj *attributePtr) /* The command line object. */
{
OSErr err;
FSSpec fileSpec;
FInfo finfo;
- Tcl_DString pathString;
+ CONST char *native;
- Tcl_UtfToExternalDString(NULL, fileName, -1, &pathString);
- err = FSpLocationFromPath(Tcl_DStringLength(&pathString),
- Tcl_DStringValue(&pathString), &fileSpec);
- Tcl_DStringFree(&pathString);
+ native=Tcl_FSGetNativePath(fileName);
+ err = FSpLLocationFromPath(strlen(native),
+ native, &fileSpec);
if (err == noErr) {
err = FSpGetFInfo(&fileSpec, &finfo);
@@ -1394,7 +1354,7 @@ SetFileFinderAttributes(
Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
Tcl_AppendStringsToObj(resultPtr, "cannot set ",
tclpFileAttrStrings[objIndex], ": \"",
- fileName, "\" is a directory", (char *) NULL);
+ Tcl_GetString(fileName), "\" is a directory", (char *) NULL);
return TCL_ERROR;
}
}
@@ -1402,7 +1362,7 @@ SetFileFinderAttributes(
if (err != noErr) {
errno = TclMacOSErrorToPosixError(err);
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "could not read \"", fileName, "\": ",
+ "could not read \"", Tcl_GetString(fileName), "\": ",
Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
@@ -1430,19 +1390,18 @@ static int
SetFileReadOnly(
Tcl_Interp *interp, /* The interp to report errors with. */
int objIndex, /* The index of the attribute. */
- CONST char *fileName, /* The name of the file (UTF-8). */
+ Tcl_Obj *fileName, /* The name of the file (UTF-8). */
Tcl_Obj *readOnlyPtr) /* The command line object. */
{
OSErr err;
FSSpec fileSpec;
HParamBlockRec paramBlock;
int hidden;
- Tcl_DString pathString;
+ CONST char *native;
- Tcl_UtfToExternalDString(NULL, fileName, -1, &pathString);
- err = FSpLocationFromPath(Tcl_DStringLength(&pathString),
- Tcl_DStringValue(&pathString), &fileSpec);
- Tcl_DStringFree(&pathString);
+ native=Tcl_FSGetNativePath(fileName);
+ err = FSpLLocationFromPath(strlen(native),
+ native, &fileSpec);
if (err == noErr) {
if (Tcl_GetBooleanFromObj(interp, readOnlyPtr, &hidden) != TCL_OK) {
@@ -1477,7 +1436,7 @@ SetFileReadOnly(
if (err != noErr) {
errno = TclMacOSErrorToPosixError(err);
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "could not read \"", fileName, "\": ",
+ "could not read \"", Tcl_GetString(fileName), "\": ",
Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
@@ -1487,23 +1446,20 @@ SetFileReadOnly(
/*
*---------------------------------------------------------------------------
*
- * TclpListVolumes --
+ * TclpObjListVolumes --
*
* Lists the currently mounted volumes
*
* Results:
- * A standard Tcl result. Will always be TCL_OK, since there is no way
- * that this command can fail. Also, the interpreter's result is set to
- * the list of volumes.
+ * The list of volumes.
*
* Side effects:
* None
*
*---------------------------------------------------------------------------
*/
-int
-TclpListVolumes(
- Tcl_Interp *interp) /* Interpreter to which to pass the volume list */
+Tcl_Obj*
+TclpObjListVolumes(void)
{
HParamBlockRec pb;
Str255 name;
@@ -1534,18 +1490,224 @@ TclpListVolumes(
break;
}
- Tcl_ExternalToUtfDString(NULL, (char *) &name[1], name[0], &dstr);
+ Tcl_ExternalToUtfDString(NULL, (CONST char *)&name[1], name[0], &dstr);
elemPtr = Tcl_NewStringObj(Tcl_DStringValue(&dstr),
Tcl_DStringLength(&dstr));
Tcl_AppendToObj(elemPtr, ":", 1);
- Tcl_ListObjAppendElement(interp, resultPtr, elemPtr);
+ Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr);
Tcl_DStringFree(&dstr);
volIndex++;
}
-
- Tcl_SetObjResult(interp, resultPtr);
- return TCL_OK;
+
+ Tcl_IncrRefCount(resultPtr);
+ return resultPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpObjNormalizePath --
+ *
+ * This function scans through a path specification and replaces
+ * it, in place, with a normalized version. On MacOS, this means
+ * resolving all aliases present in the path and replacing the head of
+ * pathPtr with the absolute case-sensitive path to the last file or
+ * directory that could be validated in the path.
+ *
+ * Results:
+ * The new 'nextCheckpoint' value, giving as far as we could
+ * understand in the path.
+ *
+ * Side effects:
+ * The pathPtr string, which must contain a valid path, is
+ * possibly modified in place.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
+ Tcl_Interp *interp;
+ Tcl_Obj *pathPtr;
+ int nextCheckpoint;
+{
+ #define MAXMACFILENAMELEN 31 /* assumed to be < sizeof(StrFileName) */
+
+ StrFileName fileName;
+ StringPtr fileNamePtr;
+ int fileNameLen,newPathLen;
+ Handle newPathHandle;
+ OSErr err;
+ short vRefNum;
+ long dirID;
+ Boolean isDirectory;
+ Boolean wasAlias=FALSE;
+ FSSpec fileSpec, lastFileSpec;
+
+ Tcl_DString nativeds;
+
+ char cur;
+ int firstCheckpoint=nextCheckpoint, lastCheckpoint;
+ int origPathLen;
+ char *path = Tcl_GetStringFromObj(pathPtr,&origPathLen);
+
+ {
+ int currDirValid=0;
+ /*
+ * check if substring to first ':' after initial
+ * nextCheckpoint is a valid relative or absolute
+ * path to a directory, if not we return without
+ * normalizing anything
+ */
+
+ while (1) {
+ cur = path[nextCheckpoint];
+ if (cur == ':' || cur == 0) {
+ if (cur == ':') {
+ /* jump over separator */
+ nextCheckpoint++; cur = path[nextCheckpoint];
+ }
+ Tcl_UtfToExternalDString(NULL,path,nextCheckpoint,&nativeds);
+ err = FSpLLocationFromPath(Tcl_DStringLength(&nativeds),
+ Tcl_DStringValue(&nativeds),
+ &fileSpec);
+ Tcl_DStringFree(&nativeds);
+ if (err == noErr) {
+ lastFileSpec=fileSpec;
+ err = ResolveAliasFile(&fileSpec, true, &isDirectory,
+ &wasAlias);
+ if (err == noErr) {
+ err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
+ currDirValid = ((err == noErr) && isDirectory);
+ vRefNum = fileSpec.vRefNum;
+ }
+ }
+ break;
+ }
+ nextCheckpoint++;
+ }
+
+ if(!currDirValid) {
+ /* can't determine root dir, bail out */
+ return firstCheckpoint;
+ }
+ }
+
+ /*
+ * Now vRefNum and dirID point to a valid
+ * directory, so walk the rest of the path
+ * ( code adapted from FSpLocationFromPath() )
+ */
+
+ lastCheckpoint=nextCheckpoint;
+ while (1) {
+ cur = path[nextCheckpoint];
+ if (cur == ':' || cur == 0) {
+ fileNameLen=nextCheckpoint-lastCheckpoint;
+ fileNamePtr=fileName;
+ if(fileNameLen==0) {
+ if (cur == ':') {
+ /*
+ * special case for empty dirname i.e. encountered
+ * a '::' path component: get parent dir of currDir
+ */
+ fileName[0]=2;
+ strcpy((char *) fileName + 1, "::");
+ lastCheckpoint--;
+ } else {
+ /*
+ * empty filename, i.e. want FSSpec for currDir
+ */
+ fileNamePtr=NULL;
+ }
+ } else {
+ Tcl_UtfToExternalDString(NULL,&path[lastCheckpoint],
+ fileNameLen,&nativeds);
+ fileNameLen=Tcl_DStringLength(&nativeds);
+ if(fileNameLen > MAXMACFILENAMELEN) {
+ err = bdNamErr;
+ } else {
+ fileName[0]=fileNameLen;
+ strncpy((char *) fileName + 1, Tcl_DStringValue(&nativeds),
+ fileNameLen);
+ }
+ Tcl_DStringFree(&nativeds);
+ }
+ if(err == noErr)
+ err=FSMakeFSSpecCompat(vRefNum, dirID, fileNamePtr, &fileSpec);
+ if(err != noErr) {
+ if(err != fnfErr) {
+ /*
+ * this can occur if trying to get parent of a root
+ * volume via '::' or when using an illegal
+ * filename; revert to last checkpoint and stop
+ * processing path further
+ */
+ err=FSMakeFSSpecCompat(vRefNum, dirID, NULL, &fileSpec);
+ if(err != noErr) {
+ /* should never happen, bail out */
+ return firstCheckpoint;
+ }
+ nextCheckpoint=lastCheckpoint;
+ cur = path[lastCheckpoint];
+ }
+ break; /* arrived at nonexistent file or dir */
+ } else {
+ /* fileSpec could point to an alias, resolve it */
+ lastFileSpec=fileSpec;
+ err = ResolveAliasFile(&fileSpec, true, &isDirectory,
+ &wasAlias);
+ if (err != noErr || !isDirectory) {
+ break; /* fileSpec doesn't point to a dir */
+ }
+ }
+ if (cur == 0) break; /* arrived at end of path */
+
+ /* fileSpec points to possibly nonexisting subdirectory; validate */
+ err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
+ if (err != noErr || !isDirectory) {
+ break; /* fileSpec doesn't point to existing dir */
+ }
+ vRefNum = fileSpec.vRefNum;
+
+ /* found a new valid subdir in path, continue processing path */
+ lastCheckpoint=nextCheckpoint+1;
+ }
+ wasAlias=FALSE;
+ nextCheckpoint++;
+ }
+
+ if (wasAlias)
+ fileSpec=lastFileSpec;
+
+ /*
+ * fileSpec now points to a possibly nonexisting file or dir
+ * inside a valid dir; get full path name to it
+ */
+
+ err=FSpPathFromLocation(&fileSpec, &newPathLen, &newPathHandle);
+ if(err != noErr) {
+ return firstCheckpoint; /* should not see any errors here, bail out */
+ }
+
+ HLock(newPathHandle);
+ Tcl_ExternalToUtfDString(NULL,*newPathHandle,newPathLen,&nativeds);
+ if (cur != 0) {
+ /* not at end, append remaining path */
+ if ( newPathLen==0 || (*(*newPathHandle+(newPathLen-1))!=':' && path[nextCheckpoint] !=':')) {
+ Tcl_DStringAppend(&nativeds, ":" , 1);
+ }
+ Tcl_DStringAppend(&nativeds, &path[nextCheckpoint],
+ strlen(&path[nextCheckpoint]));
+ }
+ DisposeHandle(newPathHandle);
+
+ fileNameLen=Tcl_DStringLength(&nativeds);
+ Tcl_SetStringObj(pathPtr,Tcl_DStringValue(&nativeds),fileNameLen);
+ Tcl_DStringFree(&nativeds);
+
+ return nextCheckpoint+(fileNameLen-origPathLen);
}
diff --git a/tcl/mac/tclMacFile.c b/tcl/mac/tclMacFile.c
index ef40b322603..87c1e684758 100644
--- a/tcl/mac/tclMacFile.c
+++ b/tcl/mac/tclMacFile.c
@@ -31,12 +31,30 @@
#include <MoreFilesExtras.h>
#include <FSpCompat.h>
-/*
- * Static variables used by the TclpStat function.
- */
-static int initialized = false;
-static long gmt_offset;
-TCL_DECLARE_MUTEX(gmtMutex)
+static int NativeMatchType(Tcl_Obj *tempName, Tcl_GlobTypeData *types,
+ HFileInfo fileInfo, OSType okType, OSType okCreator);
+static OSErr FspLocationFromFsPath _ANSI_ARGS_((Tcl_Obj *pathPtr,
+ FSSpec* specPtr));
+static OSErr FspLLocationFromFsPath _ANSI_ARGS_((Tcl_Obj *pathPtr,
+ FSSpec* specPtr));
+
+static OSErr
+FspLocationFromFsPath(pathPtr, specPtr)
+ Tcl_Obj *pathPtr;
+ FSSpec* specPtr;
+{
+ CONST char *native = Tcl_FSGetNativePath(pathPtr);
+ return FSpLocationFromPath(strlen(native), native, specPtr);
+}
+
+static OSErr
+FspLLocationFromFsPath(pathPtr, specPtr)
+ Tcl_Obj *pathPtr;
+ FSSpec* specPtr;
+{
+ CONST char *native = Tcl_FSGetNativePath(pathPtr);
+ return FSpLLocationFromPath(strlen(native), native, specPtr);
+}
/*
@@ -102,17 +120,16 @@ TclpFindExecutable(
/*
*----------------------------------------------------------------------
*
- * TclpMatchFilesTypes --
+ * TclpMatchInDirectory --
*
* This routine is used by the globbing code to search a
* directory for all files which match a given pattern.
*
* Results:
- * If the tail argument is NULL, then the matching files are
- * added to the the interp's result. Otherwise, TclDoGlob is called
- * recursively for each matching subdirectory. The return value
- * is a standard Tcl result indicating whether an error occurred
- * in globbing.
+ *
+ * The return value is a standard Tcl result indicating whether an
+ * error occurred in globbing. Errors are left in interp, good
+ * results are lappended to resultPtr (which must be a valid object)
*
* Side effects:
* None.
@@ -120,77 +137,26 @@ TclpFindExecutable(
*---------------------------------------------------------------------- */
int
-TclpMatchFilesTypes(
- Tcl_Interp *interp, /* Interpreter to receive results. */
- char *separators, /* Directory separators to pass to TclDoGlob. */
- Tcl_DString *dirPtr, /* Contains path to directory to search. */
- char *pattern, /* Pattern to match against. */
- char *tail, /* Pointer to end of pattern. Tail must
- * point to a location in pattern and must
- * not be static.*/
- GlobTypeData *types) /* Object containing list of acceptable types.
- * May be NULL. */
+TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
+ Tcl_Interp *interp; /* Interpreter to receive errors. */
+ Tcl_Obj *resultPtr; /* List object to lappend results. */
+ Tcl_Obj *pathPtr; /* Contains path to directory to search. */
+ CONST char *pattern; /* Pattern to match against. NULL or empty
+ * means pathPtr is actually a single file
+ * to check. */
+ Tcl_GlobTypeData *types; /* Object containing list of acceptable types.
+ * May be NULL. In particular the directory
+ * flag is very important. */
{
- char *fname, *patternEnd = tail;
- char savedChar;
- int fnameLen, result = TCL_OK;
- int baseLength = Tcl_DStringLength(dirPtr);
- CInfoPBRec pb;
- OSErr err;
- FSSpec dirSpec;
- Boolean isDirectory;
- long dirID;
- short itemIndex;
- Str255 fileName;
- Tcl_DString fileString;
- Tcl_Obj *resultPtr;
OSType okType = 0;
OSType okCreator = 0;
+ Tcl_Obj *fileNamePtr;
- /*
- * Make sure that the directory part of the name really is a
- * directory.
- */
-
- Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(dirPtr),
- Tcl_DStringLength(dirPtr), &fileString);
-
- FSpLocationFromPath(fileString.length, fileString.string, &dirSpec);
- Tcl_DStringFree(&fileString);
-
- err = FSpGetDirectoryID(&dirSpec, &dirID, &isDirectory);
- if ((err != noErr) || !isDirectory) {
- return TCL_OK;
- }
-
- /*
- * Now open the directory for reading and iterate over the contents.
- */
-
- pb.hFileInfo.ioVRefNum = dirSpec.vRefNum;
- pb.hFileInfo.ioDirID = dirID;
- pb.hFileInfo.ioNamePtr = (StringPtr) fileName;
- pb.hFileInfo.ioFDirIndex = itemIndex = 1;
-
- /*
- * Clean up the end of the pattern and the tail pointer. Leave
- * the tail pointing to the first character after the path separator
- * following the pattern, or NULL. Also, ensure that the pattern
- * is null-terminated.
- */
-
- if (*tail == '\\') {
- tail++;
- }
- if (*tail == '\0') {
- tail = NULL;
- } else {
- tail++;
+ fileNamePtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
+ if (fileNamePtr == NULL) {
+ return TCL_ERROR;
}
- savedChar = *patternEnd;
- *patternEnd = '\0';
-
- resultPtr = Tcl_GetObjResult(interp);
+
if (types != NULL) {
if (types->macType != NULL) {
Tcl_GetOSTypeFromObj(NULL, types->macType, &okType);
@@ -200,141 +166,264 @@ TclpMatchFilesTypes(
}
}
- while (1) {
- pb.hFileInfo.ioFDirIndex = itemIndex;
- pb.hFileInfo.ioDirID = dirID;
- err = PBGetCatInfoSync(&pb);
- if (err != noErr) {
- break;
+ if (pattern == NULL || (*pattern == '\0')) {
+ /* Match a single file directly */
+ Tcl_StatBuf buf;
+ CInfoPBRec paramBlock;
+ FSSpec fileSpec;
+
+ if (TclpObjLstat(fileNamePtr, &buf) != 0) {
+ /* File doesn't exist */
+ return TCL_OK;
+ }
+
+ if (FspLLocationFromFsPath(fileNamePtr, &fileSpec) == noErr) {
+ paramBlock.hFileInfo.ioCompletion = NULL;
+ paramBlock.hFileInfo.ioNamePtr = fileSpec.name;
+ paramBlock.hFileInfo.ioVRefNum = fileSpec.vRefNum;
+ paramBlock.hFileInfo.ioFDirIndex = 0;
+ paramBlock.hFileInfo.ioDirID = fileSpec.parID;
+
+ PBGetCatInfo(&paramBlock, 0);
}
+ if (NativeMatchType(fileNamePtr, types, paramBlock.hFileInfo,
+ okType, okCreator)) {
+ int fnameLen;
+ char *fname = Tcl_GetStringFromObj(pathPtr,&fnameLen);
+ if ((fnameLen > 1) && (strchr(fname+1, ':') == NULL)) {
+ Tcl_ListObjAppendElement(interp, resultPtr,
+ Tcl_NewStringObj(fname+1, fnameLen-1));
+ } else {
+ Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
+ }
+ }
+ return TCL_OK;
+ } else {
+ char *fname;
+ int fnameLen, result = TCL_OK;
+ int baseLength;
+ CInfoPBRec pb;
+ OSErr err;
+ FSSpec dirSpec;
+ Boolean isDirectory;
+ long dirID;
+ short itemIndex;
+ Str255 fileName;
+ Tcl_DString fileString;
+ Tcl_DString dsOrig;
+
+ Tcl_DStringInit(&dsOrig);
+ Tcl_DStringAppend(&dsOrig, Tcl_GetString(fileNamePtr), -1);
+ baseLength = Tcl_DStringLength(&dsOrig);
+
/*
- * Now check to see if the file matches. If there are more
- * characters to be processed, then ensure matching files are
- * directories before calling TclDoGlob. Otherwise, just add
- * the file to the result.
+ * Make sure that the directory part of the name really is a
+ * directory.
*/
-
- Tcl_ExternalToUtfDString(NULL, (char *) fileName + 1, fileName[0],
- &fileString);
- if (Tcl_StringMatch(Tcl_DStringValue(&fileString), pattern)) {
- Tcl_DStringSetLength(dirPtr, baseLength);
- Tcl_DStringAppend(dirPtr, Tcl_DStringValue(&fileString), -1);
- fname = Tcl_DStringValue(dirPtr);
- fnameLen = Tcl_DStringLength(dirPtr);
- if (tail == NULL) {
- int typeOk = 1;
- if (types != NULL) {
- if (types->perm != 0) {
- if (
- ((types->perm & TCL_GLOB_PERM_RONLY) &&
- !(pb.hFileInfo.ioFlAttrib & 1)) ||
- ((types->perm & TCL_GLOB_PERM_HIDDEN) &&
- !(pb.hFileInfo.ioFlFndrInfo.fdFlags &
- kIsInvisible)) ||
- ((types->perm & TCL_GLOB_PERM_R) &&
- (TclpAccess(fname, R_OK) != 0)) ||
- ((types->perm & TCL_GLOB_PERM_W) &&
- (TclpAccess(fname, W_OK) != 0)) ||
- ((types->perm & TCL_GLOB_PERM_X) &&
- (TclpAccess(fname, X_OK) != 0))
- ) {
- typeOk = 0;
- }
- }
- if (typeOk == 1 && types->type != 0) {
- struct stat buf;
- /*
- * We must match at least one flag to be listed
- */
- typeOk = 0;
- if (TclpLstat(fname, &buf) >= 0) {
- /*
- * In order bcdpfls as in 'find -t'
- */
- if (
- ((types->type & TCL_GLOB_TYPE_BLOCK) &&
- S_ISBLK(buf.st_mode)) ||
- ((types->type & TCL_GLOB_TYPE_CHAR) &&
- S_ISCHR(buf.st_mode)) ||
- ((types->type & TCL_GLOB_TYPE_DIR) &&
- S_ISDIR(buf.st_mode)) ||
- ((types->type & TCL_GLOB_TYPE_PIPE) &&
- S_ISFIFO(buf.st_mode)) ||
- ((types->type & TCL_GLOB_TYPE_FILE) &&
- S_ISREG(buf.st_mode))
-#ifdef S_ISLNK
- || ((types->type & TCL_GLOB_TYPE_LINK) &&
- S_ISLNK(buf.st_mode))
-#endif
-#ifdef S_ISSOCK
- || ((types->type & TCL_GLOB_TYPE_SOCK) &&
- S_ISSOCK(buf.st_mode))
-#endif
- ) {
- typeOk = 1;
- }
- } else {
- /* Posix error occurred */
- }
- }
- if (typeOk && (
- ((okType != 0) && (okType !=
- pb.hFileInfo.ioFlFndrInfo.fdType)) ||
- ((okCreator != 0) && (okCreator !=
- pb.hFileInfo.ioFlFndrInfo.fdCreator)))) {
- typeOk = 0;
- }
- }
- if (typeOk) {
+
+ Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&dsOrig),
+ Tcl_DStringLength(&dsOrig), &fileString);
+
+ err = FSpLocationFromPath(Tcl_DStringLength(&fileString),
+ Tcl_DStringValue(&fileString), &dirSpec);
+ Tcl_DStringFree(&fileString);
+ if (err == noErr) {
+ err = FSpGetDirectoryID(&dirSpec, &dirID, &isDirectory);
+ }
+
+ if ((err != noErr) || !isDirectory) {
+ /*
+ * Check if we had a relative path (unix style relative path
+ * compatibility for glob)
+ */
+ Tcl_DStringFree(&dsOrig);
+ Tcl_DStringAppend(&dsOrig, ":", 1);
+ Tcl_DStringAppend(&dsOrig, Tcl_GetString(fileNamePtr), -1);
+ baseLength = Tcl_DStringLength(&dsOrig);
+
+ Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&dsOrig),
+ Tcl_DStringLength(&dsOrig), &fileString);
+
+ err = FSpLocationFromPath(Tcl_DStringLength(&fileString),
+ Tcl_DStringValue(&fileString), &dirSpec);
+ Tcl_DStringFree(&fileString);
+ if (err == noErr) {
+ err = FSpGetDirectoryID(&dirSpec, &dirID, &isDirectory);
+ }
+
+ if ((err != noErr) || !isDirectory) {
+ Tcl_DStringFree(&dsOrig);
+ return TCL_OK;
+ }
+ }
+
+ /* Make sure we have a trailing directory delimiter */
+ if (Tcl_DStringValue(&dsOrig)[baseLength-1] != ':') {
+ Tcl_DStringAppend(&dsOrig, ":", 1);
+ baseLength++;
+ }
+
+ /*
+ * Now open the directory for reading and iterate over the contents.
+ */
+
+ pb.hFileInfo.ioVRefNum = dirSpec.vRefNum;
+ pb.hFileInfo.ioDirID = dirID;
+ pb.hFileInfo.ioNamePtr = (StringPtr) fileName;
+ pb.hFileInfo.ioFDirIndex = itemIndex = 1;
+
+ while (1) {
+ pb.hFileInfo.ioFDirIndex = itemIndex;
+ pb.hFileInfo.ioDirID = dirID;
+ err = PBGetCatInfoSync(&pb);
+ if (err != noErr) {
+ break;
+ }
+
+ /*
+ * Now check to see if the file matches.
+ */
+
+ Tcl_ExternalToUtfDString(NULL, (char *) fileName + 1, fileName[0],
+ &fileString);
+ if (Tcl_StringMatch(Tcl_DStringValue(&fileString), pattern)) {
+ Tcl_Obj *tempName;
+ Tcl_DStringSetLength(&dsOrig, baseLength);
+ Tcl_DStringAppend(&dsOrig, Tcl_DStringValue(&fileString), -1);
+ fname = Tcl_DStringValue(&dsOrig);
+ fnameLen = Tcl_DStringLength(&dsOrig);
+
+ /*
+ * We use this tempName in calls to check the file's
+ * type below. We may also use it for the result.
+ */
+ tempName = Tcl_NewStringObj(fname, fnameLen);
+ Tcl_IncrRefCount(tempName);
+
+ /* Is the type acceptable? */
+ if (NativeMatchType(tempName, types, pb.hFileInfo,
+ okType, okCreator)) {
if ((fnameLen > 1) && (strchr(fname+1, ':') == NULL)) {
Tcl_ListObjAppendElement(interp, resultPtr,
Tcl_NewStringObj(fname+1, fnameLen-1));
} else {
- Tcl_ListObjAppendElement(interp, resultPtr,
- Tcl_NewStringObj(fname, fnameLen));
+ Tcl_ListObjAppendElement(interp, resultPtr, tempName);
}
}
- } else if ((pb.hFileInfo.ioFlAttrib & ioDirMask) != 0) {
- Tcl_DStringAppend(dirPtr, ":", 1);
- result = TclDoGlob(interp, separators, dirPtr, tail, types);
- if (result != TCL_OK) {
- Tcl_DStringFree(&fileString);
- break;
- }
+ /*
+ * This will free the object, unless it was inserted in
+ * the result list above.
+ */
+ Tcl_DecrRefCount(tempName);
}
+ Tcl_DStringFree(&fileString);
+ itemIndex++;
}
- Tcl_DStringFree(&fileString);
- itemIndex++;
- }
- *patternEnd = savedChar;
- return result;
+ Tcl_DStringFree(&dsOrig);
+ return result;
+ }
}
-
-/*
- * TclpMatchFiles --
- *
- * This function is now obsolete. Call the above function
- * 'TclpMatchFilesTypes' instead.
- */
-int
-TclpMatchFiles(
- Tcl_Interp *interp, /* Interpreter to receive results. */
- char *separators, /* Directory separators to pass to TclDoGlob. */
- Tcl_DString *dirPtr, /* Contains path to directory to search. */
- char *pattern, /* Pattern to match against. */
- char *tail) /* Pointer to end of pattern. Tail must
- * point to a location in pattern and must
- * not be static.*/
+
+static int
+NativeMatchType(
+ Tcl_Obj *tempName, /* Path to check */
+ Tcl_GlobTypeData *types, /* Type description to match against */
+ HFileInfo fileInfo, /* MacOS file info */
+ OSType okType, /* Acceptable MacOS type, or zero */
+ OSType okCreator) /* Acceptable MacOS creator, or zero */
{
- return TclpMatchFilesTypes(interp,separators,dirPtr,pattern,tail,NULL);
+ if (types == NULL) {
+ /* If invisible, don't return the file */
+ if (fileInfo.ioFlFndrInfo.fdFlags & kIsInvisible) {
+ return 0;
+ }
+ } else {
+ Tcl_StatBuf buf;
+
+ if (fileInfo.ioFlFndrInfo.fdFlags & kIsInvisible) {
+ /* If invisible */
+ if ((types->perm == 0) ||
+ !(types->perm & TCL_GLOB_PERM_HIDDEN)) {
+ return 0;
+ }
+ } else {
+ /* Visible */
+ if (types->perm & TCL_GLOB_PERM_HIDDEN) {
+ return 0;
+ }
+ }
+ if (types->perm != 0) {
+ if (
+ ((types->perm & TCL_GLOB_PERM_RONLY) &&
+ !(fileInfo.ioFlAttrib & 1)) ||
+ ((types->perm & TCL_GLOB_PERM_R) &&
+ (TclpObjAccess(tempName, R_OK) != 0)) ||
+ ((types->perm & TCL_GLOB_PERM_W) &&
+ (TclpObjAccess(tempName, W_OK) != 0)) ||
+ ((types->perm & TCL_GLOB_PERM_X) &&
+ (TclpObjAccess(tempName, X_OK) != 0))
+ ) {
+ return 0;
+ }
+ }
+ if (types->type != 0) {
+ if (TclpObjStat(tempName, &buf) != 0) {
+ /* Posix error occurred */
+ return 0;
+ }
+ /*
+ * In order bcdpfls as in 'find -t'
+ */
+ if (
+ ((types->type & TCL_GLOB_TYPE_BLOCK) &&
+ S_ISBLK(buf.st_mode)) ||
+ ((types->type & TCL_GLOB_TYPE_CHAR) &&
+ S_ISCHR(buf.st_mode)) ||
+ ((types->type & TCL_GLOB_TYPE_DIR) &&
+ S_ISDIR(buf.st_mode)) ||
+ ((types->type & TCL_GLOB_TYPE_PIPE) &&
+ S_ISFIFO(buf.st_mode)) ||
+ ((types->type & TCL_GLOB_TYPE_FILE) &&
+ S_ISREG(buf.st_mode))
+#ifdef S_ISSOCK
+ || ((types->type & TCL_GLOB_TYPE_SOCK) &&
+ S_ISSOCK(buf.st_mode))
+#endif
+ ) {
+ /* Do nothing -- this file is ok */
+ } else {
+ int typeOk = 0;
+#ifdef S_ISLNK
+ if (types->type & TCL_GLOB_TYPE_LINK) {
+ if (TclpObjLstat(tempName, &buf) == 0) {
+ if (S_ISLNK(buf.st_mode)) {
+ typeOk = 1;
+ }
+ }
+ }
+#endif
+ if (typeOk == 0) {
+ return 0;
+ }
+ }
+ }
+ if (((okType != 0) && (okType !=
+ fileInfo.ioFlFndrInfo.fdType)) ||
+ ((okCreator != 0) && (okCreator !=
+ fileInfo.ioFlFndrInfo.fdCreator))) {
+ return 0;
+ }
+ }
+ return 1;
}
+
/*
*----------------------------------------------------------------------
*
- * TclpAccess --
+ * TclpObjAccess --
*
* This function replaces the library version of access().
*
@@ -347,10 +436,10 @@ TclpMatchFiles(
*----------------------------------------------------------------------
*/
-int
-TclpAccess(
- CONST char *path, /* Path of file to access (UTF-8). */
- int mode) /* Permission setting. */
+int
+TclpObjAccess(pathPtr, mode)
+ Tcl_Obj *pathPtr;
+ int mode;
{
HFileInfo fpb;
HVolumeParam vpb;
@@ -358,13 +447,9 @@ TclpAccess(
FSSpec fileSpec;
Boolean isDirectory;
long dirID;
- Tcl_DString ds;
- char *native;
int full_mode = 0;
- native = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
- err = FSpLocationFromPath(Tcl_DStringLength(&ds), native, &fileSpec);
- Tcl_DStringFree(&ds);
+ err = FspLLocationFromFsPath(pathPtr, &fileSpec);
if (err != noErr) {
errno = TclMacOSErrorToPosixError(err);
@@ -416,7 +501,7 @@ TclpAccess(
* files of type 'APPL' are executable.
*/
if (!(fpb.ioFlAttrib & 0x10) && (mode & X_OK)
- && (fpb.ioFlFndrInfo.fdType != 'APPL')) {
+ && (fpb.ioFlFndrInfo.fdType != 'APPL')) {
return -1;
}
}
@@ -433,7 +518,7 @@ TclpAccess(
/*
*----------------------------------------------------------------------
*
- * TclpChdir --
+ * TclpObjChdir --
*
* This function replaces the library version of chdir().
*
@@ -442,25 +527,21 @@ TclpAccess(
*
* Side effects:
* See chdir() documentation. Also the cache maintained used by
- * TclGetCwd() is deallocated and set to NULL.
+ * Tcl_FSGetCwd() is deallocated and set to NULL.
*
*----------------------------------------------------------------------
*/
-int
-TclpChdir(
- CONST char *dirName) /* Path to new working directory (UTF-8). */
+int
+TclpObjChdir(pathPtr)
+ Tcl_Obj *pathPtr;
{
FSSpec spec;
OSErr err;
Boolean isFolder;
long dirID;
- Tcl_DString ds;
- char *native;
- native = Tcl_UtfToExternalDString(NULL, dirName, -1, &ds);
- err = FSpLocationFromPath(Tcl_DStringLength(&ds), native, &spec);
- Tcl_DStringFree(&ds);
+ err = FspLocationFromFsPath(pathPtr, &spec);
if (err != noErr) {
errno = ENOENT;
@@ -496,7 +577,7 @@ TclpChdir(
/*
*----------------------------------------------------------------------
*
- * TclpGetCwd --
+ * TclpObjGetCwd --
*
* This function replaces the library version of getcwd().
*
@@ -514,7 +595,22 @@ TclpChdir(
*----------------------------------------------------------------------
*/
-char *
+Tcl_Obj*
+TclpObjGetCwd(interp)
+ Tcl_Interp *interp;
+{
+ Tcl_DString ds;
+ if (TclpGetCwd(interp, &ds) != NULL) {
+ Tcl_Obj *cwdPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
+ Tcl_IncrRefCount(cwdPtr);
+ Tcl_DStringFree(&ds);
+ return cwdPtr;
+ } else {
+ return NULL;
+ }
+}
+
+CONST char *
TclpGetCwd(
Tcl_Interp *interp, /* If non-NULL, used for error reporting. */
Tcl_DString *bufferPtr) /* Uninitialized or free DString filled
@@ -583,25 +679,24 @@ TclpReadlink(
Handle theString = NULL;
int pathSize;
Tcl_DString ds;
- char *native;
- native = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
+ Tcl_UtfToExternalDString(NULL, path, -1, &ds);
/*
* Remove ending colons if they exist.
*/
- while ((strlen(native) != 0) && (path[strlen(native) - 1] == ':')) {
- native[strlen(native) - 1] = NULL;
+ while ((Tcl_DStringLength(&ds) != 0)
+ && (Tcl_DStringValue(&ds)[Tcl_DStringLength(&ds) - 1] == ':')) {
+ Tcl_DStringSetLength(&ds, Tcl_DStringLength(&ds) - 1);
}
- if (strchr(native, ':') == NULL) {
- strcpy(fileName + 1, native);
- native = NULL;
+ end = strrchr(Tcl_DStringValue(&ds), ':');
+ if (end == NULL ) {
+ strcpy(fileName + 1, Tcl_DStringValue(&ds));
} else {
- end = strrchr(native, ':') + 1;
- strcpy(fileName + 1, end);
- *end = NULL;
+ strcpy(fileName + 1, end + 1);
+ Tcl_DStringSetLength(&ds, end + 1 - Tcl_DStringValue(&ds));
}
fileName[0] = (char) strlen(fileName + 1);
@@ -610,8 +705,9 @@ TclpReadlink(
* we want to look at.
*/
- if (native != NULL) {
- err = FSpLocationFromPath(strlen(native), native, &fileSpec);
+ if (end != NULL) {
+ err = FSpLocationFromPath(Tcl_DStringLength(&ds),
+ Tcl_DStringValue(&ds), &fileSpec);
if (err != noErr) {
Tcl_DStringFree(&ds);
errno = EINVAL;
@@ -678,39 +774,40 @@ TclpReadlink(
return Tcl_DStringValue(linkPtr);
}
+
+static int
+TclpObjStatAlias _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_StatBuf *bufPtr,
+ Boolean resolveLink));
+
/*
*----------------------------------------------------------------------
*
- * TclpLstat --
+ * TclpObjLstat --
*
* This function replaces the library version of lstat().
*
* Results:
- * See stat() documentation.
+ * See lstat() documentation.
*
* Side effects:
- * See stat() documentation.
+ * See lstat() documentation.
*
*----------------------------------------------------------------------
*/
-int
-TclpLstat(
- CONST char *path, /* Path of file to stat (in UTF-8). */
- struct stat *bufPtr) /* Filled with results of stat call. */
+int
+TclpObjLstat(pathPtr, buf)
+ Tcl_Obj *pathPtr;
+ Tcl_StatBuf *buf;
{
- /*
- * FIXME: Emulate TclpLstat
- */
-
- return TclpStat(path, bufPtr);
+ return TclpObjStatAlias(pathPtr, buf, FALSE);
}
/*
*----------------------------------------------------------------------
*
- * TclpStat --
+ * TclpObjStat --
*
* This function replaces the library version of stat().
*
@@ -723,10 +820,17 @@ TclpLstat(
*----------------------------------------------------------------------
*/
-int
-TclpStat(
- CONST char *path, /* Path of file to stat (in UTF-8). */
- struct stat *bufPtr) /* Filled with results of stat call. */
+int
+TclpObjStat(pathPtr, bufPtr)
+ Tcl_Obj *pathPtr;
+ Tcl_StatBuf *bufPtr;
+{
+ return TclpObjStatAlias(pathPtr, bufPtr, TRUE);
+}
+
+
+static int
+TclpObjStatAlias (Tcl_Obj *pathPtr, Tcl_StatBuf *bufPtr, Boolean resolveLink)
{
HFileInfo fpb;
HVolumeParam vpb;
@@ -734,11 +838,11 @@ TclpStat(
FSSpec fileSpec;
Boolean isDirectory;
long dirID;
- Tcl_DString ds;
- path = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
- err = FSpLocationFromPath(Tcl_DStringLength(&ds), path, &fileSpec);
- Tcl_DStringFree(&ds);
+ if (resolveLink)
+ err = FspLocationFromFsPath(pathPtr, &fileSpec);
+ else
+ err = FspLLocationFromFsPath(pathPtr, &fileSpec);
if (err != noErr) {
errno = TclMacOSErrorToPosixError(err);
@@ -785,18 +889,18 @@ TclpStat(
}
}
if ((fpb.ioFlAttrib & 0x10) || (fpb.ioFlFndrInfo.fdType == 'APPL')) {
- /*
- * Directories and applications are executable by everyone.
- */
-
- bufPtr->st_mode |= S_IXUSR | S_IXGRP | S_IXOTH;
+ /*
+ * Directories and applications are executable by everyone.
+ */
+
+ bufPtr->st_mode |= S_IXUSR | S_IXGRP | S_IXOTH;
}
if ((fpb.ioFlAttrib & 0x01) == 0){
- /*
- * If not locked, then everyone has write acces.
- */
-
- bufPtr->st_mode |= S_IWUSR | S_IWGRP | S_IWOTH;
+ /*
+ * If not locked, then everyone has write acces.
+ */
+
+ bufPtr->st_mode |= S_IWUSR | S_IWGRP | S_IWOTH;
}
bufPtr->st_ino = fpb.ioDirID;
bufPtr->st_dev = fpb.ioVRefNum;
@@ -811,25 +915,14 @@ TclpStat(
/*
* The times returned by the Mac file system are in the
* local time zone. We convert them to GMT so that the
- * epoch starts from GMT. This is also consistant with
+ * epoch starts from GMT. This is also consistent with
* what is returned from "clock seconds".
*/
- Tcl_MutexLock(&gmtMutex);
- if (initialized == false) {
- MachineLocation loc;
-
- ReadLocation(&loc);
- gmt_offset = loc.u.gmtDelta & 0x00ffffff;
- if (gmt_offset & 0x00800000) {
- gmt_offset = gmt_offset | 0xff000000;
- }
- initialized = true;
- }
- Tcl_MutexUnlock(&gmtMutex);
-
- bufPtr->st_atime = bufPtr->st_mtime = fpb.ioFlMdDat - gmt_offset;
- bufPtr->st_ctime = fpb.ioFlCrDat - gmt_offset;
+ bufPtr->st_atime = bufPtr->st_mtime = fpb.ioFlMdDat
+ - TclpGetGMTOffset() + tcl_mac_epoch_offset;
+ bufPtr->st_ctime = fpb.ioFlCrDat - TclpGetGMTOffset()
+ + tcl_mac_epoch_offset;
}
}
@@ -894,7 +987,7 @@ TclMacFOpenHack(
int size;
FILE * f;
- err = FSpLocationFromPath(strlen(path), (char *) path, &fileSpec);
+ err = FSpLocationFromPath(strlen(path), path, &fileSpec);
if ((err != noErr) && (err != fnfErr)) {
return NULL;
}
@@ -994,16 +1087,18 @@ TclMacOSErrorToPosixError(
return EINVAL;
}
}
+
int
TclMacChmod(
- char *path,
+ CONST char *path,
int mode)
{
HParamBlockRec hpb;
OSErr err;
-
- c2pstr(path);
- hpb.fileParam.ioNamePtr = (unsigned char *) path;
+ Str255 pathName;
+ strcpy((char *) pathName + 1, path);
+ pathName[0] = strlen(path);
+ hpb.fileParam.ioNamePtr = pathName;
hpb.fileParam.ioVRefNum = 0;
hpb.fileParam.ioDirID = 0;
@@ -1012,7 +1107,6 @@ TclMacChmod(
} else {
err = PBHSetFLockSync(&hpb);
}
- p2cstr((unsigned char *) path);
if (err != noErr) {
errno = TclMacOSErrorToPosixError(err);
@@ -1021,3 +1115,128 @@ TclMacChmod(
return 0;
}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpTempFileName --
+ *
+ * This function returns a unique filename.
+ *
+ * Results:
+ * Returns a valid Tcl_Obj* with refCount 0, or NULL on failure.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj*
+TclpTempFileName()
+{
+ char fileName[L_tmpnam];
+
+ if (tmpnam(fileName) == NULL) { /* INTL: Native. */
+ return NULL;
+ }
+
+ return TclpNativeToNormalized((ClientData) fileName);
+}
+
+#ifdef S_IFLNK
+
+Tcl_Obj*
+TclpObjLink(pathPtr, toPtr, linkAction)
+ Tcl_Obj *pathPtr;
+ Tcl_Obj *toPtr;
+ int linkAction;
+{
+ Tcl_Obj* link = NULL;
+
+ if (toPtr != NULL) {
+ if (TclpObjAccess(pathPtr, F_OK) != -1) {
+ /* src exists */
+ errno = EEXIST;
+ return NULL;
+ }
+ if (TclpObjAccess(toPtr, F_OK) == -1) {
+ /* target doesn't exist */
+ errno = ENOENT;
+ return NULL;
+ }
+
+ if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {
+ /* Needs to create a new link */
+ FSSpec spec;
+ FSSpec linkSpec;
+ OSErr err;
+ char *path;
+ AliasHandle alias;
+
+ err = FspLocationFromFsPath(toPtr, &spec);
+ if (err != noErr) {
+ errno = ENOENT;
+ return NULL;
+ }
+
+ path = Tcl_FSGetNativePath(pathPtr);
+ err = FSpLocationFromPath(strlen(path), path, &linkSpec);
+ if (err == noErr) {
+ err = dupFNErr; /* EEXIST. */
+ } else {
+ err = NewAlias(&spec, &linkSpec, &alias);
+ }
+ if (err != noErr) {
+ errno = TclMacOSErrorToPosixError(err);
+ return NULL;
+ }
+ return toPtr;
+ } else {
+ errno = ENODEV;
+ return NULL;
+ }
+ } else {
+ Tcl_DString ds;
+ Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
+ if (transPtr == NULL) {
+ return NULL;
+ }
+ if (TclpReadlink(Tcl_GetString(transPtr), &ds) != NULL) {
+ link = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
+ Tcl_IncrRefCount(link);
+ Tcl_DStringFree(&ds);
+ }
+ }
+ return link;
+}
+
+#endif
+
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpFilesystemPathType --
+ *
+ * This function is part of the native filesystem support, and
+ * returns the path type of the given path. Right now it simply
+ * returns NULL. In the future it could return specific path
+ * types, like 'HFS', 'HFS+', 'nfs', 'samba', 'FAT32', etc.
+ *
+ * Results:
+ * NULL at present.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+Tcl_Obj*
+TclpFilesystemPathType(pathObjPtr)
+ Tcl_Obj* pathObjPtr;
+{
+ /* All native paths are of the same type */
+ return NULL;
+}
diff --git a/tcl/mac/tclMacInit.c b/tcl/mac/tclMacInit.c
index 095455957d5..f39ead01f7e 100644
--- a/tcl/mac/tclMacInit.c
+++ b/tcl/mac/tclMacInit.c
@@ -25,6 +25,7 @@
#include "tclInt.h"
#include "tclMacInt.h"
#include "tclPort.h"
+#include "tclInitScript.h"
/*
* The following string is the startup script executed in new
@@ -33,9 +34,10 @@
* init.tcl script does all of the real work of initialization.
*/
-static char initCmd[] = "\
+static char initCmd[] = "if {[info proc tclInit]==\"\"} {\n\
+proc tclInit {} {\n\
+global tcl_pkgPath env\n\
proc sourcePath {file} {\n\
- set dirs {}\n\
foreach i $::auto_path {\n\
set init [file join $i $file.tcl]\n\
if {[catch {uplevel #0 [list source $init]}] == 0} {\n\
@@ -46,25 +48,28 @@ proc sourcePath {file} {\n\
return\n\
}\n\
rename sourcePath {}\n\
- set msg \"can't find $file resource or a usable $file.tcl file\n\"\n\
- append msg \"in the following directories:\n\"\n\
- append msg \" $::auto_path\n\"\n\
- append msg \" perhaps you need to install Tcl or set your \n\"\n\
- append msg \"TCL_LIBRARY environment variable?\"\n\
+ set msg \"Can't find $file resource or a usable $file.tcl file\"\n\
+ append msg \" in the following directories:\"\n\
+ append msg \" $::auto_path\"\n\
+ append msg \" perhaps you need to install Tcl or set your\"\n\
+ append msg \" TCL_LIBRARY environment variable?\"\n\
error $msg\n\
}\n\
if {[info exists env(EXT_FOLDER)]} {\n\
- lappend tcl_pkgPath [file join $env(EXT_FOLDER) {:Tool Command Language}]\n\
+ lappend tcl_pkgPath [file join $env(EXT_FOLDER) {Tool Command Language}]\n\
}\n\
if {[info exists tcl_pkgPath] == 0} {\n\
set tcl_pkgPath {no extension folder}\n\
}\n\
-sourcePath Init\n\
-sourcePath Auto\n\
-sourcePath Package\n\
-sourcePath History\n\
-sourcePath Word\n\
-rename sourcePath {}";
+sourcePath init\n\
+sourcePath auto\n\
+sourcePath package\n\
+sourcePath history\n\
+sourcePath word\n\
+sourcePath parray\n\
+rename sourcePath {}\n\
+} }\n\
+tclInit";
/*
* The following structures are used to map the script/language codes of a
@@ -132,6 +137,11 @@ static Map cyrillicMap[] = {
static int GetFinderFont(int *finderID);
+/* Used to store the encoding used for binary files */
+static Tcl_Encoding binaryEncoding = NULL;
+/* Has the basic library path encoding issue been fixed */
+static int libraryPathEncodingFixed = 0;
+
/*
*----------------------------------------------------------------------
@@ -344,20 +354,30 @@ TclpInitLibraryPath(argv0)
* by querying the module handle. */
{
Tcl_Obj *objPtr, *pathPtr;
- char *str;
+ CONST char *str;
Tcl_DString ds;
TclMacCreateEnv();
pathPtr = Tcl_NewObj();
+ /*
+ * Look for the library relative to default encoding dir.
+ */
+
+ str = Tcl_GetDefaultEncodingDir();
+ if ((str != NULL) && (str[0] != '\0')) {
+ objPtr = Tcl_NewStringObj(str, -1);
+ Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
+ }
+
str = TclGetEnv("TCL_LIBRARY", &ds);
if ((str != NULL) && (str[0] != '\0')) {
/*
* If TCL_LIBRARY is set, search there.
*/
- objPtr = Tcl_NewStringObj(str, -1);
+ objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds));
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
Tcl_DStringFree(&ds);
}
@@ -369,18 +389,26 @@ TclpInitLibraryPath(argv0)
/*
* lappend path [file join $env(EXT_FOLDER) \
- * ":Tool Command Language:tcl[info version]"
+ * "Tool Command Language" "tcl[info version]"
*/
str = TclGetEnv("EXT_FOLDER", &ds);
if ((str != NULL) && (str[0] != '\0')) {
- objPtr = Tcl_NewStringObj(str, -1);
- if (str[strlen(str) - 1] != ':') {
- Tcl_AppendToObj(objPtr, ":", 1);
- }
- Tcl_AppendToObj(objPtr, "Tool Command Language:tcl" TCL_VERSION, -1);
- Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
- Tcl_DStringFree(&ds);
+ Tcl_DString libPath, path;
+ CONST char *argv[3];
+
+ argv[0] = str;
+ argv[1] = "Tool Command Language";
+ Tcl_DStringInit(&libPath);
+ Tcl_DStringAppend(&libPath, "tcl", -1);
+ argv[2] = Tcl_DStringAppend(&libPath, TCL_VERSION, -1);
+ Tcl_DStringInit(&path);
+ str = Tcl_JoinPath(3, argv, &path);
+ objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&path));
+ Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
+ Tcl_DStringFree(&ds);
+ Tcl_DStringFree(&libPath);
+ Tcl_DStringFree(&path);
}
TclSetLibraryPath(pathPtr);
}
@@ -393,13 +421,18 @@ TclpInitLibraryPath(argv0)
* Based on the locale, determine the encoding of the operating
* system and the default encoding for newly opened files.
*
- * Called at process initialization time.
+ * Called at process initialization time, and part way through
+ * startup, we verify that the initial encodings were correctly
+ * setup. Depending on Tcl's environment, there may not have been
+ * enough information first time through (above).
*
* Results:
* None.
*
* Side effects:
- * The Tcl library path is converted from native encoding to UTF-8.
+ * The Tcl library path is converted from native encoding to UTF-8,
+ * on the first call, and the encodings may be changed on first or
+ * second call.
*
*---------------------------------------------------------------------------
*/
@@ -409,7 +442,7 @@ TclpSetInitialEncodings()
{
CONST char *encoding;
Tcl_Obj *pathPtr;
- int fontId;
+ int fontId, err;
fontId = 0;
GetFinderFont(&fontId);
@@ -418,8 +451,10 @@ TclpSetInitialEncodings()
encoding = "macRoman";
}
- Tcl_SetSystemEncoding(NULL, encoding);
-
+ err = Tcl_SetSystemEncoding(NULL, encoding);
+
+ if (err == TCL_OK && libraryPathEncodingFixed == 0) {
+
/*
* Until the system encoding was actually set, the library path was
* actually in the native multi-byte encoding, and not really UTF-8
@@ -460,14 +495,19 @@ TclpSetInitialEncodings()
Tcl_DStringLength(&ds));
Tcl_DStringFree(&ds);
}
+ Tcl_InvalidateStringRep(pathPtr);
+ }
+ libraryPathEncodingFixed = 1;
+ }
+
+ /* This is only ever called from the startup thread */
+ if (binaryEncoding == NULL) {
+ /*
+ * Keep the iso8859-1 encoding preloaded. The IO package uses
+ * it for gets on a binary channel.
+ */
+ binaryEncoding = Tcl_GetEncoding(NULL, "iso8859-1");
}
-
- /*
- * Keep the iso8859-1 encoding preloaded. The IO package uses it for
- * gets on a binary channel.
- */
-
- Tcl_GetEncoding(NULL, "iso8859-1");
}
/*
@@ -496,7 +536,7 @@ TclpSetVariables(interp)
int minor, major, objc;
Tcl_Obj **objv;
char versStr[2 * TCL_INTEGER_SPACE];
- char *str;
+ CONST char *str;
Tcl_Obj *pathPtr;
Tcl_DString ds;
@@ -653,6 +693,12 @@ Tcl_Init(
{
Tcl_Obj *pathPtr;
+ if (tclPreInitScript != NULL) {
+ if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) {
+ return (TCL_ERROR);
+ };
+ }
+
/*
* For Macintosh applications the Init function may be contained in
* the application resources. If it exists we use it - otherwise we
@@ -692,7 +738,7 @@ Tcl_SourceRCFile(
Tcl_Interp *interp) /* Interpreter to source rc file into. */
{
Tcl_DString temp;
- char *fileName;
+ CONST char *fileName;
Tcl_Channel errChannel;
Handle h;
@@ -700,7 +746,7 @@ Tcl_SourceRCFile(
if (fileName != NULL) {
Tcl_Channel c;
- char *fullName;
+ CONST char *fullName;
Tcl_DStringInit(&temp);
fullName = Tcl_TranslateFileName(interp, fileName, &temp);
@@ -734,9 +780,13 @@ Tcl_SourceRCFile(
fileName = Tcl_GetVar(interp, "tcl_rcRsrcName", TCL_GLOBAL_ONLY);
if (fileName != NULL) {
- c2pstr(fileName);
- h = GetNamedResource('TEXT', (StringPtr) fileName);
- p2cstr((StringPtr) fileName);
+ Str255 rezName;
+ Tcl_DString ds;
+ Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
+ strcpy((char *) rezName + 1, Tcl_DStringValue(&ds));
+ rezName[0] = (unsigned) Tcl_DStringLength(&ds);
+ h = GetNamedResource('TEXT', rezName);
+ Tcl_DStringFree(&ds);
if (h != NULL) {
if (Tcl_MacEvalResource(interp, fileName, 0, NULL) != TCL_OK) {
errChannel = Tcl_GetStdChannel(TCL_STDERR);
diff --git a/tcl/mac/tclMacInt.h b/tcl/mac/tclMacInt.h
index 73b99a3513f..7bc1d8c89b9 100644
--- a/tcl/mac/tclMacInt.h
+++ b/tcl/mac/tclMacInt.h
@@ -14,18 +14,16 @@
#ifndef _TCLMACINT
#define _TCLMACINT
-#ifndef _TCL
-# include "tcl.h"
+#ifndef _TCLINT
+#include "tclInt.h"
#endif
-#ifndef _TCLMAC
-# include "tclMac.h"
+#ifndef _TCLPORT
+#include "tclPort.h"
#endif
#include <Events.h>
#include <Files.h>
-#pragma export on
-
/*
* Defines to control stack behavior.
*
@@ -46,6 +44,11 @@
#define TCL_MAC_STACK_THRESHOLD 16384
+#ifdef BUILD_tcl
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
/*
* This flag is passed to TclMacRegisterResourceFork
* by a file (usually a library) whose resource fork
@@ -63,12 +66,12 @@
*/
EXTERN char * TclMacGetFontEncoding _ANSI_ARGS_((int fontId));
-EXTERN int TclMacHaveThreads(void);
+EXTERN int TclMacHaveThreads _ANSI_ARGS_((void));
+EXTERN long TclpGetGMTOffset _ANSI_ARGS_((void));
+
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLIMPORT
-#include "tclPort.h"
-#include "tclPlatDecls.h"
#include "tclIntPlatDecls.h"
-#pragma export reset
-
#endif /* _TCLMACINT */
diff --git a/tcl/mac/tclMacLibrary.c b/tcl/mac/tclMacLibrary.c
index a36f3733c1d..7936d736605 100644
--- a/tcl/mac/tclMacLibrary.c
+++ b/tcl/mac/tclMacLibrary.c
@@ -26,6 +26,15 @@
#include <Strings.h>
#include "tclMacInt.h"
+#if defined(TCL_REGISTER_LIBRARY) && defined(USE_TCL_STUBS)
+#error "Can't use TCL_REGISTER_LIBRARY and USE_TCL_STUBS at the same time!"
+/*
+ * Can't register a library with Tcl when using stubs in the current
+ * implementation, since Tcl_InitStubs hasn't been called yet
+ * when OpenLibraryResource is executing.
+ */
+#endif
+
/*
* These function are not currently defined in any header file. The
* only place they should be used is in the Initialization and
diff --git a/tcl/mac/tclMacLibrary.r b/tcl/mac/tclMacLibrary.r
index 7c181a421b7..d03332bc334 100644
--- a/tcl/mac/tclMacLibrary.r
+++ b/tcl/mac/tclMacLibrary.r
@@ -34,22 +34,24 @@
#if (TCL_RELEASE_LEVEL == 2)
# define MINOR_VERSION (TCL_MINOR_VERSION * 16) + TCL_RELEASE_SERIAL
+# define RELEASE_CODE 0x00
#else
# define MINOR_VERSION TCL_MINOR_VERSION * 16
+# define RELEASE_CODE TCL_RELEASE_SERIAL
#endif
resource 'vers' (1) {
TCL_MAJOR_VERSION, MINOR_VERSION,
- RELEASE_LEVEL, 0x00, verUS,
+ RELEASE_LEVEL, RELEASE_CODE, verUS,
TCL_PATCH_LEVEL,
- TCL_PATCH_LEVEL ", by Ray Johnson & Jim Ingham © Scriptics Inc."
+ TCL_PATCH_LEVEL ", by Ray Johnson & Jim Ingham" "\n" "© 2001 Tcl Core Team"
};
resource 'vers' (2) {
TCL_MAJOR_VERSION, MINOR_VERSION,
- RELEASE_LEVEL, 0x00, verUS,
+ RELEASE_LEVEL, RELEASE_CODE, verUS,
TCL_PATCH_LEVEL,
- "Tcl Library " TCL_PATCH_LEVEL " © 1996-1997 Sun Microsystems, 1998-1999 Scriptics Inc."
+ "Tcl Library " TCL_PATCH_LEVEL " © 1993-2001"
};
/*
@@ -96,7 +98,7 @@ resource 'FREF' (TCL_LIBRARY_RESOURCES, purgeable)
type TCL_CREATOR as 'STR ';
resource TCL_CREATOR (0, purgeable) {
- "Tcl Library " TCL_PATCH_LEVEL " © 1996-1999"
+ "Tcl Library " TCL_PATCH_LEVEL " © 1993-2001"
};
/*
@@ -125,24 +127,10 @@ resource 'kind' (TCL_LIBRARY_RESOURCES, "Tcl kind", purgeable) {
resource 'STR ' (-16397, purgeable) {
"Tcl Library\n\n"
"This is the core library needed to run Tool Command Language programs. "
- "To work properly, it should be placed in the ÔTool Command LanguageÕ folder "
+ "To work properly, it should be placed in the ŒTool Command Language¹ folder "
"within the Extensions folder."
};
-/*
- * The mechanisim below loads Tcl source into the resource fork of the
- * application. The example below creates a TEXT resource named
- * "Init" from the file "init.tcl". This allows applications to use
- * Tcl to define the behavior of the application without having to
- * require some predetermined file structure - all needed Tcl "files"
- * are located within the application. To source a file for the
- * resource fork the source command has been modified to support
- * sourcing from resources. In the below case "source -rsrc {Init}"
- * will load the TEXT resource named "Init".
- */
-
-#include "tclMacTclCode.r"
-
/*
* The following are icons for the shared library.
*/
diff --git a/tcl/mac/tclMacLoad.c b/tcl/mac/tclMacLoad.c
index e1b46f9cff5..2d5c6f0f57a 100644
--- a/tcl/mac/tclMacLoad.c
+++ b/tcl/mac/tclMacLoad.c
@@ -76,11 +76,30 @@ struct CfrgItem {
Str255 name; /* This is actually variable sized. */
};
typedef struct CfrgItem CfrgItem;
+
+/*
+ * On MacOS, old shared libraries which contain many code fragments
+ * cannot, it seems, be loaded in one go. We need to look provide
+ * the name of a code fragment while we load. Since with the
+ * separation of the 'load' and 'findsymbol' be do not necessarily
+ * know a symbol name at load time, we have to store some further
+ * information in a structure like this so we can ensure we load
+ * properly in 'findsymbol' if the first attempts didn't work.
+ */
+typedef struct TclMacLoadInfo {
+ int loaded;
+ CFragConnectionID connID;
+ FSSpec fileSpec;
+} TclMacLoadInfo;
+
+static int TryToLoad(Tcl_Interp *interp, TclMacLoadInfo *loadInfo,
+ CONST char *sym /* native */)
+
/*
*----------------------------------------------------------------------
*
- * TclLoadFile --
+ * TclpDlopen --
*
* This procedure is called to carry out dynamic loading of binary
* code for the Macintosh. This implementation is based on the
@@ -97,52 +116,69 @@ typedef struct CfrgItem CfrgItem;
*/
int
-TclpLoadFile(
- Tcl_Interp *interp, /* Used for error reporting. */
- char *fileName, /* Name of the file containing the desired
- * code. */
- char *sym1, char *sym2, /* Names of two procedures to look up in
- * the file's symbol table. */
- Tcl_PackageInitProc **proc1Ptr,
- Tcl_PackageInitProc **proc2Ptr,
- /* Where to return the addresses corresponding
- * to sym1 and sym2. */
- ClientData *clientDataPtr) /* Filled with token for dynamically loaded
+TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr)
+ 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
- * TclpUnloadFile() to unload the file. */
+ * (*unloadProcPtr)() to unload the file. */
+ Tcl_FSUnloadFileProc **unloadProcPtr)
+ /* Filled with address of Tcl_FSUnloadFileProc
+ * function which should be used for
+ * this file. */
{
- CFragConnectionID connID;
- Ptr dummy;
OSErr err;
- CFragSymbolClass symClass;
FSSpec fileSpec;
- short fragFileRef, saveFileRef;
- Handle fragResource;
- UInt32 offset = 0;
- UInt32 length = kCFragGoesToEOF;
- char packageName[255];
- Str255 errName;
Tcl_DString ds;
- char *native;
-
- /*
- * First thing we must do is infer the package name from the sym1
- * variable. This is kind of dumb since the caller actually knows
- * this value, it just doesn't give it to us.
- */
- strcpy(packageName, sym1);
- Tcl_UtfToLower(packageName);
- *(Tcl_UtfAtIndex(packageName, Tcl_NumUtfChars(packageName, -1) - 5)) = 0;
+ CONST char *native;
+ TclMacLoadInfo *loadInfo;
- native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
+ native = Tcl_FSGetNativePath(pathPtr);
err = FSpLocationFromPath(strlen(native), native, &fileSpec);
- Tcl_DStringFree(&ds);
if (err != noErr) {
Tcl_SetResult(interp, "could not locate shared library", TCL_STATIC);
return TCL_ERROR;
}
+ loadInfo = (TclMacLoadInfo *) ckalloc(sizeof(TclMacLoadInfo));
+ loadInfo->loaded = 0;
+ loadInfo->fileSpec = fileSpec;
+ loadInfo->connID = NULL;
+
+ if (TryToLoad(interp, loadInfo, NULL) != TCL_OK) {
+ ckfree(loadInfo);
+ return TCL_ERROR;
+ }
+
+ *loadHandle = (Tcl_LoadHandle)loadInfo;
+ *unloadProcPtr = &TclpUnloadFile;
+ return TCL_OK;
+}
+
+/*
+ * See the comments about 'struct TclMacLoadInfo' above. This
+ * function ensures the appropriate library or symbol is
+ * loaded.
+ */
+static int
+TryToLoad(Tcl_Interp *interp, TclMacLoadInfo *loadInfo,
+ CONST char *sym /* native */)
+{
+ CFragConnectionID connID;
+ Ptr dummy;
+ short fragFileRef, saveFileRef;
+ Handle fragResource;
+ UInt32 offset = 0;
+ UInt32 length = kCFragGoesToEOF;
+ Str255 errName;
+ StringPtr fragName=NULL;
+
+ if (loadInfo->loaded == 1) {
+ return TCL_OK;
+ }
+
/*
* See if this fragment has a 'cfrg' resource. It will tell us where
* to look for the fragment in the file. If it doesn't exist we will
@@ -156,24 +192,27 @@ TclpLoadFile(
fragFileRef = FSpOpenResFile(&fileSpec, fsRdPerm);
SetResLoad(true);
if (fragFileRef != -1) {
- UseResFile(fragFileRef);
- fragResource = Get1Resource(kCFragResourceType, kCFragResourceID);
- HLock(fragResource);
- if (ResError() == noErr) {
- CfrgItem* srcItem;
- long itemCount, index;
- Ptr itemStart;
+ if (sym != NULL) {
+ UseResFile(fragFileRef);
+ fragResource = Get1Resource(kCFragResourceType, kCFragResourceID);
+ HLock(fragResource);
+ if (ResError() == noErr) {
+ CfrgItem* srcItem;
+ long itemCount, index;
+ Ptr itemStart;
- itemCount = (*(CfrgHeaderPtrHand)fragResource)->itemCount;
- itemStart = &(*(CfrgHeaderPtrHand)fragResource)->arrayStart;
- for (index = 0; index < itemCount;
- index++, itemStart += srcItem->itemSize) {
- srcItem = (CfrgItem*)itemStart;
- if (srcItem->archType != OUR_ARCH_TYPE) continue;
- if (!strncasecmp(packageName, (char *) srcItem->name + 1,
- srcItem->name[0])) {
- offset = srcItem->codeOffset;
- length = srcItem->codeLength;
+ itemCount = (*(CfrgHeaderPtrHand)fragResource)->itemCount;
+ itemStart = &(*(CfrgHeaderPtrHand)fragResource)->arrayStart;
+ for (index = 0; index < itemCount;
+ index++, itemStart += srcItem->itemSize) {
+ srcItem = (CfrgItem*)itemStart;
+ if (srcItem->archType != OUR_ARCH_TYPE) continue;
+ if (!strncasecmp(sym, (char *) srcItem->name + 1,
+ strlen(sym))) {
+ offset = srcItem->codeOffset;
+ length = srcItem->codeLength;
+ fragName=srcItem->name;
+ }
}
}
}
@@ -186,44 +225,90 @@ TclpLoadFile(
ReleaseResource(fragResource);
CloseResFile(fragFileRef);
UseResFile(saveFileRef);
+ if (sym == NULL) {
+ /* We just return */
+ return TCL_OK;
+ }
}
/*
- * Now we can attempt to load the fragement using the offset & length
+ * Now we can attempt to load the fragment using the offset & length
* obtained from the resource. We don't worry about the main entry point
* as we are going to search for specific entry points passed to us.
*/
- c2pstr(packageName);
- err = GetDiskFragment(&fileSpec, offset, length, (StringPtr) packageName,
+ err = GetDiskFragment(&fileSpec, offset, length, fragName,
kLoadCFrag, &connID, &dummy, errName);
+
if (err != fragNoErr) {
p2cstr(errName);
- Tcl_AppendResult(interp, "couldn't load file \"", fileName,
- "\": ", errName, (char *) NULL);
+ Tcl_AppendResult(interp, "couldn't load file \"",
+ Tcl_GetString(pathPtr),
+ "\": ", errName, (char *) NULL);
return TCL_ERROR;
}
+
+ loadInfo->connID = connID;
+ loadInfo->loaded = 1;
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+{
+ Tcl_DString ds;
+ Tcl_PackageInitProc *proc=NULL;
+ TclMacLoadInfo *loadInfo = (TclMacLoadInfo *)loadHandle;
+ Str255 symbolName;
+ CFragSymbolClass symClass;
+ OSErr err;
+
+ if (loadInfo->loaded == 0) {
+ int res;
+ /*
+ * First thing we must do is infer the package name from the
+ * sym variable. We do this by removing the '_Init'.
+ */
+ Tcl_UtfToExternalDString(NULL, symbol, -1, &ds);
+ Tcl_DStringSetLength(&ds, Tcl_DStringLength(&ds) - 5);
+ res = TryToLoad(interp, loadInfo, Tcl_DStringValue(&ds));
+ Tcl_DStringFree(&ds);
+ if (res != TCL_OK) {
+ return NULL;
+ }
+ }
- c2pstr(sym1);
- err = FindSymbol(connID, (StringPtr) sym1, (Ptr *) proc1Ptr, &symClass);
- p2cstr((StringPtr) sym1);
+ Tcl_UtfToExternalDString(NULL, symbol, -1, &ds);
+ strcpy((char *) symbolName + 1, Tcl_DStringValue(&ds));
+ symbolName[0] = (unsigned) Tcl_DStringLength(&ds);
+ err = FindSymbol(loadInfo->connID, symbolName, (Ptr *) &proc, &symClass);
+ Tcl_DStringFree(&ds);
if (err != fragNoErr || symClass == kDataCFragSymbol) {
Tcl_SetResult(interp,
"could not find Initialization routine in library",
TCL_STATIC);
- return TCL_ERROR;
- }
-
- c2pstr(sym2);
- err = FindSymbol(connID, (StringPtr) sym2, (Ptr *) proc2Ptr, &symClass);
- p2cstr((StringPtr) sym2);
- if (err != fragNoErr || symClass == kDataCFragSymbol) {
- *proc2Ptr = NULL;
+ return NULL;
}
-
- *clientDataPtr = (ClientData) connID;
-
- return TCL_OK;
+ return proc;
}
/*
@@ -245,12 +330,17 @@ TclpLoadFile(
*/
void
-TclpUnloadFile(clientData)
- ClientData clientData; /* ClientData returned by a previous call
- * to TclpLoadFile(). The clientData is
+TclpUnloadFile(loadHandle)
+ Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call
+ * to TclpDlopen(). The loadHandle is
* a token that represents the loaded
* file. */
{
+ TclMacLoadInfo *loadInfo = (TclMacLoadInfo *)loadHandle;
+ if (loadInfo->loaded) {
+ CloseConnection((CFragConnectionID*) &(loadInfo->connID));
+ }
+ ckfree(loadInfo);
}
/*
@@ -275,7 +365,7 @@ TclpUnloadFile(clientData)
int
TclGuessPackageName(
- char *fileName, /* Name of file containing package (already
+ 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. */
diff --git a/tcl/mac/tclMacMath.h b/tcl/mac/tclMacMath.h
index cedefb7f078..45ba217e2e9 100644
--- a/tcl/mac/tclMacMath.h
+++ b/tcl/mac/tclMacMath.h
@@ -135,7 +135,7 @@
#endif
#endif
-#if (defined(THINK_C) || defined(__MWERKS__))
+#if (defined(THINK_C))
#pragma export on
double hypotd(double x, double y);
#define hypot hypotd
diff --git a/tcl/mac/tclMacNotify.c b/tcl/mac/tclMacNotify.c
index 2ed857a060b..117168d54b2 100644
--- a/tcl/mac/tclMacNotify.c
+++ b/tcl/mac/tclMacNotify.c
@@ -266,7 +266,7 @@ HandleMacEvents(void)
* system event queue unless we call WaitNextEvent.
*/
- GetGlobalMouse(&currentMouse);
+ GetGlobalMouseTcl(&currentMouse);
if ((notifier.eventProcPtr != NULL) &&
!EqualPt(currentMouse, notifier.lastMousePosition)) {
notifier.lastMousePosition = currentMouse;
@@ -296,7 +296,7 @@ HandleMacEvents(void)
*/
while (needsUpdate || (GetEvQHdr()->qHead != NULL)) {
- GetGlobalMouse(&currentMouse);
+ GetGlobalMouseTcl(&currentMouse);
SetRect(&mouseRect, currentMouse.h, currentMouse.v,
currentMouse.h + 1, currentMouse.v + 1);
RectRgn(notifier.utilityRgn, &mouseRect);
@@ -351,7 +351,7 @@ Tcl_SetTimer(
* Compute when the timer should fire.
*/
- TclpGetTime(&notifier.timer);
+ Tcl_GetTime(&notifier.timer);
notifier.timer.sec += timePtr->sec;
notifier.timer.usec += timePtr->usec;
if (notifier.timer.usec >= 1000000) {
@@ -481,7 +481,7 @@ Tcl_WaitForEvent(
* the current mouse position.
*/
- GetGlobalMouse(&currentMouse);
+ GetGlobalMouseTcl(&currentMouse);
SetRect(&mouseRect, currentMouse.h, currentMouse.v,
currentMouse.h + 1, currentMouse.v + 1);
RectRgn(notifier.utilityRgn, &mouseRect);
diff --git a/tcl/mac/tclMacOSA.c b/tcl/mac/tclMacOSA.c
index 168553e3d06..5c2c424c733 100644
--- a/tcl/mac/tclMacOSA.c
+++ b/tcl/mac/tclMacOSA.c
@@ -2067,8 +2067,8 @@ tclOSAStore(
short saveRef, fileRef = -1;
char idStr[16 + TCL_INTEGER_SPACE];
FSSpec fileSpec;
- Tcl_DString buffer;
- char *nativeName;
+ Tcl_DString ds, buffer;
+ CONST char *nativeName;
OSErr myErr = noErr;
OSAID scriptID;
Size scriptSize;
@@ -2105,13 +2105,14 @@ tclOSAStore(
if (fileName != NULL) {
OSErr err;
- Tcl_DStringInit(&buffer);
- nativeName = Tcl_TranslateFileName(interp, fileName, &buffer);
- if (nativeName == NULL) {
+ if (Tcl_TranslateFileName(interp, fileName, &buffer) == NULL) {
return TCL_ERROR;
}
+ nativeName = Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&buffer),
+ Tcl_DStringLength(&buffer), &ds);
err = FSpLocationFromPath(strlen(nativeName), nativeName, &fileSpec);
+ Tcl_DStringFree(&ds);
Tcl_DStringFree(&buffer);
if ((err != noErr) && (err != fnfErr)) {
Tcl_AppendResult(interp,
@@ -2120,7 +2121,7 @@ tclOSAStore(
return TCL_ERROR;
}
- FSpCreateResFileCompat(&fileSpec,
+ FSpCreateResFileCompatTcl(&fileSpec,
'WiSH', 'osas', smSystemScript);
myErr = ResError();
@@ -2132,7 +2133,7 @@ tclOSAStore(
goto rezEvalCleanUp;
}
- fileRef = FSpOpenResFileCompat(&fileSpec, fsRdWrPerm);
+ fileRef = FSpOpenResFileCompatTcl(&fileSpec, fsRdWrPerm);
if (fileRef == -1) {
Tcl_AppendResult(interp, "Error reading the file: \"",
fileName, "\".", NULL);
@@ -2286,20 +2287,21 @@ tclOSALoad(
short saveRef, fileRef = -1;
char idStr[16 + TCL_INTEGER_SPACE];
FSSpec fileSpec;
- Tcl_DString buffer;
- char *nativeName;
+ Tcl_DString ds, buffer;
+ CONST char *nativeName;
saveRef = CurResFile();
if (fileName != NULL) {
OSErr err;
- Tcl_DStringInit(&buffer);
- nativeName = Tcl_TranslateFileName(interp, fileName, &buffer);
- if (nativeName == NULL) {
+ if (Tcl_TranslateFileName(interp, fileName, &buffer) == NULL) {
return TCL_ERROR;
}
+ nativeName = Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&buffer),
+ Tcl_DStringLength(&buffer), &ds);
err = FSpLocationFromPath(strlen(nativeName), nativeName, &fileSpec);
+ Tcl_DStringFree(&ds);
Tcl_DStringFree(&buffer);
if (err != noErr) {
Tcl_AppendResult(interp, "Error finding the file: \"",
@@ -2307,7 +2309,7 @@ tclOSALoad(
return TCL_ERROR;
}
- fileRef = FSpOpenResFileCompat(&fileSpec, fsRdPerm);
+ fileRef = FSpOpenResFileCompatTcl(&fileSpec, fsRdPerm);
if (fileRef == -1) {
Tcl_AppendResult(interp, "Error reading the file: \"",
fileName, "\".", NULL);
diff --git a/tcl/mac/tclMacOSA.r b/tcl/mac/tclMacOSA.r
index 26d81128307..e0eabd9396d 100644
--- a/tcl/mac/tclMacOSA.r
+++ b/tcl/mac/tclMacOSA.r
@@ -20,33 +20,35 @@
*/
#define SCRIPT_MAJOR_VERSION 1 /* Major number */
-#define SCRIPT_MINOR_VERSION 0 /* Minor number */
-#define SCRIPT_RELEASE_SERIAL 2 /* Really minor number! */
-#define RELEASE_LEVEL alpha /* alpha, beta, or final */
-#define SCRIPT_VERSION "1.0"
-#define SCRIPT_PATCH_LEVEL "1.0a2"
-#define FINAL 0 /* Change to 1 if final version. */
+#define SCRIPT_MINOR_VERSION 1 /* Minor number */
+#define SCRIPT_RELEASE_SERIAL 0 /* Really minor number! */
+#define RELEASE_LEVEL final /* alpha, beta, or final */
+#define SCRIPT_VERSION "1.1"
+#define SCRIPT_PATCH_LEVEL "1.1.0"
+#define FINAL 1 /* Change to 1 if final version. */
#if FINAL
# define MINOR_VERSION (SCRIPT_MINOR_VERSION * 16) + SCRIPT_RELEASE_SERIAL
+# define RELEASE_CODE 0x00
#else
# define MINOR_VERSION SCRIPT_MINOR_VERSION * 16
+# define RELEASE_CODE SCRIPT_RELEASE_SERIAL
#endif
#define RELEASE_CODE 0x00
resource 'vers' (1) {
SCRIPT_MAJOR_VERSION, MINOR_VERSION,
- RELEASE_LEVEL, 0x00, verUS,
+ RELEASE_LEVEL, RELEASE_CODE, verUS,
SCRIPT_PATCH_LEVEL,
- SCRIPT_PATCH_LEVEL ", by Jim Ingham © Cygnus Solutions"
+ SCRIPT_PATCH_LEVEL ", by Jim Ingham © Cygnus Solutions" "\n" "© 2001 Tcl Core Team"
};
resource 'vers' (2) {
SCRIPT_MAJOR_VERSION, MINOR_VERSION,
- RELEASE_LEVEL, 0x00, verUS,
+ RELEASE_LEVEL, RELEASE_CODE, verUS,
SCRIPT_PATCH_LEVEL,
- "Tclapplescript " SCRIPT_PATCH_LEVEL " © 1996-1999"
+ "Tclapplescript " SCRIPT_PATCH_LEVEL " © 1996-2001"
};
/*
@@ -60,7 +62,7 @@ resource 'STR ' (-16397, purgeable) {
"TclAppleScript Library\n\n"
"This library provides the ability to run AppleScript "
" commands from Tcl/Tk programs. To work properly, it "
- "should be placed in the ÔTool Command LanguageÕ folder "
+ "should be placed in the ŒTool Command Language¹ folder "
"within the Extensions folder."
};
@@ -71,6 +73,6 @@ resource 'STR ' (-16397, purgeable) {
data 'TEXT' (4000,"pkgIndex",purgeable, preload) {
"# Tcl package index file, version 1.0\n"
- "package ifneeded Tclapplescript 1.0 [list tclPkgSetup $dir Tclapplescript 1.0 {{Tclapplescript"
+ "package ifneeded Tclapplescript 1.1 [list tclPkgSetup $dir Tclapplescript 1.1 {{Tclapplescript"
".shlb load AppleScript}}]\n"
};
diff --git a/tcl/mac/tclMacPanic.c b/tcl/mac/tclMacPanic.c
index f059f4aee6b..08d5519e25c 100644
--- a/tcl/mac/tclMacPanic.c
+++ b/tcl/mac/tclMacPanic.c
@@ -1,9 +1,9 @@
/*
* tclMacPanic.c --
*
- * Source code for the "panic" library procedure used in "Simple Shell";
- * other Mac applications will probably override this with a more robust
- * application-specific panic procedure.
+ * Source code for the "Tcl_Panic" library procedure used in "Simple
+ * Shell"; other Mac applications will probably call Tcl_SetPanicProc
+ * to set a more robust application-specific panic procedure.
*
* Copyright (c) 1993-1994 Lockheed Missle & Space Company, AI Center
* Copyright (c) 1995-1996 Sun Microsystems, Inc.
@@ -17,6 +17,7 @@
#include <Events.h>
#include <Controls.h>
+#include <ControlDefinitions.h>
#include <Windows.h>
#include <TextEdit.h>
#include <Fonts.h>
@@ -28,6 +29,7 @@
#include <stdlib.h>
#include "tclInt.h"
+#include "tclMacInt.h"
/*
* constants for panic dialog
@@ -40,56 +42,29 @@
#define ENTERCODE (0x03)
#define RETURNCODE (0x0D)
-/*
- * The panicProc variable contains a pointer to an application
- * specific panic procedure.
- */
-
-void (*panicProc) _ANSI_ARGS_(TCL_VARARGS(char *,format)) = NULL;
/*
*----------------------------------------------------------------------
*
- * Tcl_SetPanicProc --
+ * TclpPanic --
*
- * Replace the default panic behavior with the specified functiion.
+ * Displays panic info, then aborts
*
* Results:
* None.
*
* Side effects:
- * Sets the panicProc variable.
+ * The process dies, entering the debugger if possible.
*
*----------------------------------------------------------------------
*/
+ /* VARARGS ARGSUSED */
void
-Tcl_SetPanicProc(proc)
- void (*proc) _ANSI_ARGS_(TCL_VARARGS(char *,format));
-{
- panicProc = proc;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * MacPanic --
- *
- * Displays panic info..
- *
- * Results:
- * None.
- *
- * Side effects:
- * Sets the panicProc variable.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-MacPanic(
- char *msg) /* Text to show in panic dialog. */
+TclpPanic TCL_VARARGS_DEF(CONST char *, format)
{
+ va_list varg;
+ char msg[256];
WindowRef macWinPtr, foundWinPtr;
Rect macRect;
Rect buttonRect = PANIC_BUTTON_RECT;
@@ -100,7 +75,10 @@ MacPanic(
Handle stopIconHandle;
int part;
Boolean done = false;
-
+
+ va_start(varg, format);
+ vsprintf(msg, format, varg);
+ va_end(varg);
/*
* Put up an alert without using the Resource Manager (there may
@@ -151,7 +129,7 @@ MacPanic(
part = FindControl(event.where, macWinPtr,
&okButtonHandle);
- if ((inButton == part) &&
+ if ((kControlButtonPart == part) &&
(TrackControl(okButtonHandle,
event.where, NULL))) {
done = true;
@@ -175,7 +153,7 @@ MacPanic(
if (stopIconHandle != NULL) {
PlotIcon(&iconRect, stopIconHandle);
}
- TextBox(msg, strlen(msg), &textRect, teFlushDefault);
+ TETextBox(msg, strlen(msg), &textRect, teFlushDefault);
DrawControls(macWinPtr);
EndUpdate(macWinPtr);
}
@@ -192,44 +170,3 @@ MacPanic(
#endif
}
-/*
- *----------------------------------------------------------------------
- *
- * panic --
- *
- * Print an error message and kill the process.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The process dies, entering the debugger if possible.
- *
- *----------------------------------------------------------------------
- */
-
-#pragma ignore_oldstyle on
-void
-panic(char * format, ...)
-{
- va_list varg;
- char errorText[256];
-
- if (panicProc != NULL) {
- va_start(varg, format);
-
- (void) (*panicProc)(format, varg);
-
- va_end(varg);
- } else {
- va_start(varg, format);
-
- vsprintf(errorText, format, varg);
-
- va_end(varg);
-
- MacPanic(errorText);
- }
-
-}
-#pragma ignore_oldstyle reset
diff --git a/tcl/mac/tclMacPort.h b/tcl/mac/tclMacPort.h
index 48f6e8798af..dc9ddfde577 100644
--- a/tcl/mac/tclMacPort.h
+++ b/tcl/mac/tclMacPort.h
@@ -29,6 +29,15 @@
*/
#include "tclErrno.h"
+
+#ifndef EOVERFLOW
+# ifdef EFBIG
+# define EOVERFLOW EFBIG /* The object couldn't fit in the datatype */
+# else /* !EFBIG */
+# define EOVERFLOW EINVAL /* Better than nothing! */
+# endif /* EFBIG */
+#endif /* !EOVERFLOW */
+
#include <float.h>
#ifdef THINK_C
@@ -55,7 +64,7 @@
* However, MetroWerks has screwed that file up a couple of times
* and all we need are the defines.
*/
-
+#ifndef _FCNTL
# define O_RDWR 0x0 /* open the file in read/write mode */
# define O_RDONLY 0x1 /* open the file in read only mode */
# define O_WRONLY 0x2 /* open the file in write only mode */
@@ -63,7 +72,7 @@
# define O_CREAT 0x0200 /* create the file if it doesn't exist */
# define O_EXCL 0x0400 /* if the file exists don't create it again */
# define O_TRUNC 0x0800 /* truncate the file after opening it */
-
+#endif
/*
* MetroWerks stat.h file is rather weak. The defines
* after the include are needed to fill in the missing
@@ -98,6 +107,7 @@
# define S_IXOTH 00001 /* execute permission: other */
# endif
+#if __MSL__ < 0x6000
# define isatty(arg) 1
/*
@@ -109,6 +119,7 @@
# define X_OK 0x01 /* test for execute or search permission */
# define W_OK 0x02 /* test for write permission */
# define R_OK 0x04 /* test for read permission */
+#endif
#endif /* __MWERKS__ */
@@ -148,6 +159,11 @@
#define WTERMSIG(status) (1)
#define WSTOPSIG(status) (1)
+#ifdef BUILD_tcl
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
/*
* Make sure that MAXPATHLEN is defined.
*/
@@ -205,38 +221,48 @@ extern char **environ;
#define TCL_SHLIB_EXT ".shlb"
/*
- * The following define is bogus and needs to be fixed. It claims that
+ * The following define is defined as a workaround on the mac. It claims that
* struct tm has the timezone string in it, which is not true. However,
* the code that works around this fact does not compile on the Mac, since
* it relies on the fact that time.h has a "timezone" variable, which the
* Metrowerks time.h does not have...
*
- * The Mac timezone stuff never worked (clock format 0 -format %Z returns "Z")
- * so this just keeps the status quo. The real answer is to not use the
- * MSL strftime, and provide the needed compat functions...
+ * The Mac timezone stuff is implemented via the TclpGetTZName() routine in
+ * tclMacTime.c
*
*/
#define HAVE_TM_ZONE
+
+/*
+ * If we're using the Metrowerks MSL, we need to convert time_t values from
+ * the mac epoch to the msl epoch (== unix epoch) by adding the offset from
+ * <time.mac.h> to mac time_t values, as MSL is using its epoch for file
+ * access routines such as stat or utime
+ */
+
+#ifdef __MSL__
+#include <time.mac.h>
+#ifdef _mac_msl_epoch_offset_
+#define tcl_mac_epoch_offset _mac_msl_epoch_offset_
+#define TCL_MAC_USE_MSL_EPOCH /* flag for TclDate.c */
+#else
+#define tcl_mac_epoch_offset 0L
+#endif
+#else
+#define tcl_mac_epoch_offset 0L
+#endif
+
/*
* The following macros have trivial definitions, allowing generic code to
* address platform-specific issues.
*/
-#define TclpAsyncMark(async)
#define TclpGetPid(pid) ((unsigned long) (pid))
#define TclSetSystemEnv(a,b)
#define tzset()
-/*
- * The following defines replace the Macintosh version of the POSIX
- * functions "stat" and "access". The various compilier vendors
- * don't implement this function well nor consistantly.
- */
-/* int TclpStat(const char *path, struct stat *bufPtr); */
-int TclpLstat(const char *path, struct stat *bufPtr);
-
char *TclpFindExecutable(const char *argv0);
int TclpFindVariable(CONST char *name, int *lengthPtr);
@@ -285,9 +311,11 @@ typedef int TclpMutex;
#endif /* TCL_THREADS */
typedef pascal void (*ExitToShellProcPtr)(void);
-#include "tclMac.h"
-#include "tclMacInt.h"
-/* #include "tclPlatDecls.h"
- #include "tclIntPlatDecls.h" */
+
+#include "tclMac.h" // contains #include "tclPlatDecls.h"
+#include "tclIntPlatDecls.h"
+
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLIMPORT
#endif /* _MACPORT */
diff --git a/tcl/mac/tclMacProjects.sea.hqx b/tcl/mac/tclMacProjects.sea.hqx
index 73f0e087b9a..a0686bf9675 100644
--- a/tcl/mac/tclMacProjects.sea.hqx
+++ b/tcl/mac/tclMacProjects.sea.hqx
@@ -1,3063 +1,3864 @@
(This file must be converted with BinHex 4.0)
-:"h4ME#jcC@%!39"36'&eFh3J!*!$U[S!!C82!846G(9QCNPd)#KM+6%j16FY-6N
-j1#""E'&NC'PZ)&0jFh4PEA-X)%PZBbiX)'KdG(!k,bphN!-ZB@aKC'4TER0jFbj
-MEfd[8h4eCQC*G#m0#KS!"4!!!+Vk!*!$FJ!"!*!$FVZT$D@P8Q9cCA*fC@5PT3#
-PN!3"!!!c!%#d(A&cYA@&T`#3$318HJ#3!mN!#QN8!!#U-3!&G'0X!!"plJ"p!"!
-"f3(!!q!!N!-"!`Irq2r``d!!!)!!N!HPN!3"!!"!!!#dSEb`YA@&QJ#3!h)!!"l
-l!*!$FJ!3p(`!!Gq)!!!GcJ#3"!m!3Np"Ae4ME&0SC@aXFbl2J!!!Pla069"b3eG
-*43%!N!q!!*!(3X(8l2p5hM-$&C9ribC2'j,ULBN*qKDqd#'1YLX&QfqFP)&&aU1
-`bJbB$#pqB6Z,dNYIZ&M+&rKa+M(Z[NphH%[fj#J529$lZ82SQ*hD8*h%!aT3kpS
-j5-Pq*b&LiZFM2AVQ%85qik!QZSAd%"0B!Da(*4!lBQmadjIRR0MNc-@1a43-Bf0
-R#rR$[F$ZN!"e,*iqp[I`UMble)lKD5AN@LCXcI0b*b[8D9)cdE@DN9TKdKS#H4!
-[(66X3D59CGDBmrE6dDq0,`"*'d%'(3i$!r1V#+&JU5P&C8PrXq"T`8bBjjGe%8L
-kKl'aa')@MQlj9Cp))PZCM)b,EX&cKJYH-d%eScP@)MhmM40bq6@6Q3"SIB%0I8k
-`dKmMbl&5)PeQqE(3$"!3UBJ`"NhF!+[re)Tq96+qLH'"LmG*m6BT-XYaY!f-k9q
-qRkLD+K4N-S$%U!,XBEKZPSjd4#EFV4q0`-EB,3[fp-&BTX`8)Jb$6`'4X(6j#BD
-0'J2@B`+3!)$4Y9cD3em!iVf*@&$,#kE)Kc-hRK)k,$@l(8'[leU`i"UP2$Gp6FN
-fEr9iIKV[Yhbl)@,8H$kM(&@ZqTQ$##J3rZ"9[U$b4qKZH[N,9ZldAqp#X*k"HL)
-QE#2+ZRDr'VG8[S&%dX62Gc4!XJVfEU@0'3[9+9RRfDYNhApb&[UXDc2b+64)-1V
-ZY1-amDKqY,aYC-f"6YQU4S#)fdBP(U#2EdKRD1K"XM9V%bS$*`*2$%GfA[D*&QH
-#8#MCNkK",CPC@1JrI"FC"IIj,(H[9D"mJlb)p3Yr(1NJ39AiVHq![K+Rlem1F(Q
-1m+1LKR+de+d+8aL9j$q[e'Gq4&meFp2[+kS)D8i[)&8jR69YVLrZ-*`!,5")kdp
-Dir1QSi6,h#H"1@5hIe9L)BLRaGbX-+ahh0m4qXrCdV8A3,@5ICdT`U,`,bNLGEb
-SeF`UY-624'H4-)dU-cVPb$+IlYABlkF[!#mj!de3MZVPDPNjja,5+qcR1J-ZS&&
-P"a'@1rp58h2VKkfEh9T8+q`4(hb`qH``[c0F,j+&FM6)2AcRad9PkrhNYKMX*da
-A5hB6p&3+(%8S5Aq9YJ@MhPpP`8p&iF!I3)UCR$ei(*4[U1&YcpU60)'2GN4cqLS
-Yfa6"'h0P0Dd@TmPY@$Y0"MFVY,0F39'T6UQ%['428dZC2`MSr'k6aKZ6d#3(GDQ
-UScLm!)K`SK9-2[$jiJADf3"VrXe"iaa+5TrMmNa)H6X,iZf8@4A8S$mSbF#*df&
-FGK*fehqPEC!!q@IaSlrMlb-i-VX8H%mM-V#05-Ga@G!45#ISlkhEHpeF&S+"pkD
-lqf!E,40,$'a@)0V&R4Rci5Mi,$+[-&G3"ZAPdY)-6#96EVV`mHPd)%I'H@c+,8M
-hU+CU[%8dL#AZUZ*c!'(kd2cqXPcjXB$XD(aJa%TZ5Hd([h[mb`%l1D,NiY5Ac-,
-Pj&EBhPhHRSj6"Q0$jaf0$F,e,$K1m!a6qrk@UDc'ZlXaTmD4Y!eQD"q(AVq'%0)
-kkRkX)ZC8$CXpX[,EEAF"LBTe'AR+leqpj6*-SZ'-Fd+Fb!IK%HKY+Se!jNde6R8
-lQ,M5)(TEBkIc&h4ekhTrS`%V3*0S&qd"EL4M15EPimTP90l'fi$60)M9jB5TC,i
-FL(FcZ&X#&S$eJQIVJMc(Ga*c`Ep+$SQCG0[1309C9Z'1Yfa-LJ1&K([rq6XJ+AL
--lI)NeA!G,b19Rib6T)DD&Ea[TJc&#RBAGHL8ibITA@$P+-Ii1XXM,j+V"VZJAc,
-[!+9(HcYFGJ(aH'T%F9'MM)lTKA`&FiUE0m6kE$01%8#KcaB2(e$S*cFi+mT`-`L
-3!%GACdJ%ic@EJUH&ZZNBTX)6+BcMf'BHUdA+$LNGCM+f%ZRYNA1!j5`DL`$mh1[
-pA#6c$I*CiP3BZBI+h`%Mlj3L2G%65RBS@6KBc6D$$9LBD0#Ppa%`HC6FAV-J,e!
-G$hIP-DP#cY+f'd,BR6f@@0*%1c'r+kra`cE&Mq`$D2mq4'EEC@$G!,)Z%IJ(QHr
-A'a@0QmFqS6,qKSBjZ5e$I#$P@[dE1*2F@NAGhaJ@m3VPKS+DZbfZI4Jk-q15[AU
-1fQ5LVdc,ed"Z+`PR!9c9f"E#B-[Vp8bZ)A'@82Zh'ffKRG5kJV8f2R'25)QEkhI
-Bm,j64@Xe&C-lVL9CGNhc$9qXScZFF)m$"S9"C9c1K8TX)bC!h#$5c80(8ALBakU
-SbViMhll3JpHCr$pqa&l&2YZ8M'hVHbr8k&%Nl%K1Jq0)h"`q#I+3!#-(GHYjH#1
-`&13'BDl!6(V#`[+iY[F,`Pbm+frfN9MGLe&FakGS)'4'rGddIZhDr-l88-$NES#
-FY(1iXPA'P&EU"&'@elHH0ZqqqlGjTYaV*KDSJrdfYJ!$3HH[@C5XCdXB5!XUI)M
-rJjETV+q"4Hh1#&TT6p*e3NN[@(U$1ZUb4mUh&'0(LVSRI,r8J9j#6K)be5)VXA#
-f,YmcmT!!jLqj,GA*)L0)UMqa*bmMeV(i2FP,CZ@lXqSE2"cP-QbNim1KNq(QK"#
-leJ0i1c3VjM-`IHkF3#m)4Nc02Abp"!1pTCM2fjTRLF4X%qB3PaCGUBrq0Y(3qMk
-ZHM&4i`2eX#i@DP39eHCDb5f-ZhN&V,#8VVIYAj@82NYGKZ6fN6&*Q"HQc`FjKLY
-#Vc1KE)!)3HAA9[IL2,U%'XeB+HhS2HT#Tkr4Pp%eI0-9PSrIX#%`aS%2a6L05q-
-*)"XPL-fCG%0XbSM&0SFlm,,IV5-(XKUjhQE4eZU&CH-58"8*&N,ilIfiL6JbhL#
-!&1-JQJ@4N!#VQ*k1VF2*3Dd56aZ1jc+VH&RSfRJjYI2IT*)'IE2EEj58H43XHpR
-PeeFliM6FM%1)S9N#j!rb%D+9*4ah59hH"#,DD"3IThPX6'bUS""dC0(pSY9fCDN
-8[dfpQI&Q'-aEIEHh6eKT&G1G,Dm[8'4S&#ZQIiXPS5e'Y0%JTJ$QI6,[A+BCB3j
-VF1PPNeq62)4VpGfEI#38Z"AhZXPKB5h[$5'mDEB4'h,j$H'P@a&%+kpJ@9kIeH*
-p'F#`N!#kqCZ[EX3F+@2hG(!QE4&YdVR)1FekDAa4N41HhXfimr3'IpD,"5,hEA[
-"PRFmS"hLBCk3!%$"r3-@E$r0mZ+,+(*F0U"Q,5mbKS-lHJGD10!cVXFFklUiL,*
-(5KLJ*e8i`Jh2iBB+'KCeM2'#j%N*4[+EmIlSVV2&**LX)8%b2N#E'-X%LlcETRU
-QfhmcD[fmrIiS9Eq"PaBaja$+H$iEL"([#ih*q*Vm`A,JFC%ImEqMqC*A-l[dK2B
-lR5l%$5fH4R#i0[ETZFc0JXrJ#)TN!@"+mCh1E#dGRUfdlflK!CR%lZAJ@hVPfI4
-%(rN#G55&#C9X8CC+"X),-rj-#V*S4$@-BKX2h5"T)I)iJF#@jCTTDP2*EFJKL5U
-UAJ+eEaQBRaXSfc3DD0dZ96K0@hPcb1Rbe89c*Gda,2L%&9R3[Dp1$CKb$cm$4KH
-fK8k`aH+L4*IeI[fQGDpY[N@j8jTX&*rQFB'0c'1I%8)E-VSYb0E5H)@3!%I)m*3
-m9,YfTe@a6q4(P,dh6S$HKK`599HQR-Xp#(DdJJq0*b(jKT1lqp1T)NYYNGrQFS6
-9),DR9@%-GA"$'PRlGj`+3Z)kP6pB8Vrk4C!!K1pkl-Gci`)&Q!aNTJIQaZ+Uq6H
-h-L$aD0d"'JVkc@eSPSf!&IJh$`V)GSiTA+M-H!r0!3KK"K29XHm1Q!eMZpl"`S$
-NSXdhmQKae@)EifJH"4Z-U1f!BNhPNN!)9'X5ffjGJJPSA"P4lfm-a$ZL$6e!)6F
-N&`M#QVPT"QSpB5XerJDH5&KKTrLk99Y@UJD@"JRfe&"a*UNNJ1fGQZDZ+V,PL1D
-cTUhlmT(9B94l%*cKL4DDRcN!Xda#KIHk*FM1XfkSa2f!P*L$Vq)$XGkNCTLK(5[
-VPcb5U&"!Zif8QM!GiX!A#M8rV4*0jZE%jeEH9m-q+a-!@`!aM(k9YM3bGmlc&c5
-M'GdFfrZpLCJ336qhJdPLk0erl&P%D+L-IVT#fI2ECMUb9,"[S![aVLGl(c3-iJS
-`cf*DRmUr@@dr!8dND!IPVMPeLZRkGINNak+d[LZ1X!C4HVAjr9+-pVdiq"9VGjq
-E+pq0F'RA51YelD5RaVFN+2`qaPK44"8IAeSU,5*T6R6E%Q#85mCI'V"N!3ee*ZZ
--)&AE!b`k,,T!p9hmYDC"qQqhA$q6Y8JLCDP%)MB&qh[CZ",E%IBQ1Q9eP$GNji"
-UT"K)L@aLb-0"ETCRhe)fVL9SL%kN2lQh1*aMH(JKXl`$i*8abj8[*f)K*%ITU#@
-EYV,NPj-3[-Cer-Pbi*p+++LNB$$h8JeD59a8!-ZUJM+dVA#9D+U5)PC`IT[5U"9
-AMFb5japbi)*`8UUCK3,eHLT1I&i8r60bkA'E8`q8De#li441*4H3!-[T2h6SBF%
-X!TcU5Kb4Gb#KR)$J4b6[Y#Y-A)*'JX-++p0LGhFiQB,&69SJr&2I+'9*@GfpMZj
-0EMSZbfIf"3L+lEcLcQk*P1Z[j1SH1"VrZiQ&('1#MFJN9iXpp+JN3iR%DE@hS"A
-AMP1H!GEC3Tc8VH$(A!J,TaUR&(hTZ'Xh0f2D#R6@eG[,jFDl5dcqfBipBL8,I2)
--GGe%Vj!!2I22H*!!&@0D6X2Cd[SBqdE9i#0IRQ8Lci9$DVZ*hpLl!#@5)4p`C2(
-[PJp)Ei4IG1k,2-B@T5krfC5p$$TH%4AqdK%X"ABR+Y3K[$flD"#B2E-f"C(aqA*
-!(3&jLHjLESjdG4S*E2a)HHEHS3P+5KJDAfkh#QDL6Z+"rc4am&h6bQK8X4K-+&2
-F`a#QH"K1mPD&$,FcNi[",&3-4-6rI"El9C+QX-iQB$TlAbU03#9N6ea%NcEbeEJ
-"jZFK9G`b1LjYe[5lR9NS-%+LJD-q&V-dEQ,#90kFBUeHRlPT4(apRrT*hH-(B"%
-SB*!!C124K89d0IK-2-)JE`Dc+!)YJMqcd15!''&,X$#8"kQpBhK"4fdiBQM$'2'
-Nd1[eI8liX5pBCZ1hQAa8LS)!"5,#[N0I"#PcF3"Zkk8fEAQ0h-&@`$h[`LhmRA-
-&V&(&'`'0$dT-q[*YV2jKfb2[p1KJT8&%li3FNPEI[r$f`p9d!C,IUKN+`Y)c`6N
-3PQdqFI9MSl'MMlA8`-5*EMXX2XFED%)frES+b$H)6F)fE8J*T[rTI2J#m8fYk1Z
-feNP%A1k%,b(BBK@D1a*6-EKKHB'p62RK'#Zr1kl1IdQ40(*@qrZ'p!XQrjDjBY5
-2X$&@6PdeK!#@YY#%(MpPQiP[29lM!eFQiG3ee$miTjA`G*!!)%*TH4R4PLBK4kA
-ZhC!!R15d0a*#(M4%k''GMTNbbTr-X2Y2Gh31`c8E3$r"L*r98XiePFSQBZphI[5
-aEQFrqEMCVeq0*8C(lX2I0kH8l'V+PI'11YVD(H,Q1eU'c,QV,V"m5j'0SX!(Fml
-8"A#`lh189f(E3EV"rpKk@L1b@EDIhclE)HMUF-0dc)H$cacqR([a!P"$"'5N#VS
-!ZGVa&4X)p2ce$Ak8IA"6LcKl-dM#9%46f4T5RMj'%,MeX)`0qX$GRX'SF#PA2Fh
-0Fr&AB%r21lK#kV',ebP-*3dT)61fMf$`$Ah8bMS!i$1N&Im#[9JN*dUepN5#a'Z
-L4NG0-CNPYThMiG60!T6f9C5RVrc3Mc-p%(9'aJ)Vr[S[%!*r*0a[LKFHXkM5&N,
-85&kBGLC0i6-U2YYCmL(cL%cYjXV,iS2&ll"!H#Ra!#cqP!i9)r-B$R08F)p221$
-U`"FqRaMVSKX%d)#CHGc3GGb"#AIQ5U%TDhd1C'J+CmBq+"4%`%Id*%GFDZ*kjja
-32JjDSCV--9EYhq%FSR3'%PH+feCichkYJ$2HXcAN$kHki!fk[S'*GRiSlMb4-1F
-@e56qKjV#4Mkk8Q+a4bQ@1S,b)9f$!VRp*j*'!3bZD9*61h,c9&,[94$GN@L+%)p
-6miCX-@%&+TNf#HhRa6GSekfiXcMYb2(e"DRcc,LBKCEkeI+`N!#l558VHee)5`9
-R*H[,3BlL-CH+68-UR&-F*-PhTfI'JfXlpRDV9YITdVD4i6K(i9E)kpSa(`5,E$Q
-Q8&b2rH8Pbm!#$R*0S-pBrXc[YI(dNB64Cp&bK+,@qbjbeH#D2bZfaNINJmHR0-C
-,bi@h2FiLX#9RCk&0%'R'*mje0H#Rp9"Y!XHEqe3JU3b[Zk`IGr!YhRj$8AAR"5G
-HG*['#jQ*"+Md*5p*#+Z#T@N%Tlq9F6L@NNr'qUGq9KN8d"YeQiJY*iI#`1,k[i&
-FMkeb6[-Lpp#hGfiAY5rVlR9jc(%f2U8P82EA[`2DC,AV2m'SB[X'-%r(6[hG!RM
-6eUC6XV*bFjdX3%LL6A3**R#Q`G4A#)%pPJAlrhU6dJR!IBhJ!EllI("ZQ)Br@UH
-Ql-dB#Gp3$rI@34J(D#JDV$qqh+hJ`f&EkYJ"&Y'VbM4mchd-S0iN(35NeVp[P`N
-9D8q"R3[8[Ed3HZRUHc-*dMfiXN!56RBiHa*2H6AqM0d0aIK#$CJfFa[8HYJr8la
-(35k[fi@!`e+MVXU[APD'kV3),'m#F1QRH9J%5'kSd13peQab"6K&2SE"#cRNCrJ
-,a2Q2j3`$[`pRb%$l-iIY,+0mi8,qkAa(j(&!A53!c8E-CJ'!LpKCqVj+[GjR23R
-)Qh8l*6$('k@,2b2c#&2rc#D-hiEV%V0DY1EaP-jFU#cVZc,@YeF!,X14@8B13EM
-2l"ca%Dm@`kFE'0GK(@klH-9re'jp&+d@S@q3!1@3!1`U*3%%fDbYEdpE43a2QjX
-2bQ0"lYNK(5-NVeHcj1LlI1,ZbAr3)*jHC3X204%A)@Lj9&ZNa6)qHe1R[eq$-Er
-V[!34E,4@-#apF*Nr-9Uc2"L3!'Hl*(B`LBeVe%8rZ[dX4AcL`qGVZ9h+cNN5K@P
-m`fHereF1'NK0ed#"q@Vj(GZG,BP$bk50DLB8UI2'peqbBh9Vf(XbZ"Ci5Fc"[91
-CmUMre'+DqS$q($P@c(Y&1(e-qCA9PQ(Fqe9i(N(eH#q4iIKeBfaK`QHJfYM98F1
-2(0m!*YEN`RZI&`SEh*%d%9DjBR6plT9)-5hdG+h1cCj*[(pLFj59-ab'i2cT,D`
-MTP2KV3r0h'l"!eCUFlP)pA)TFQDcD%6pJ@`-[r0YAJU3!([J,LMD!!aTd@*X-'a
-+Na%bT4PkUb'ZSP9,Q,2)+ZpE'B(P*PrLFB(8Yh2`GEJ9Fbp[k*9T5T`-@i8Bh2Z
-0P4+hhaI6Xe*H4RFc'#[q"Pe!`%PSZ1&QjHKAF1rdq#XL(1I9)!Ha6C1@NjFYk*!
-!2Rbh9l[%rZSGFTa-fI@dIf!8fb83a&iV6X-'d0KUm`8)9KM+Db14k8eXKIXe`BS
-Q2`6JcpiNm4XS*r'+&3SB'$pV)bh446)*VXc5Va"cMbldQ4fGBqHHJ4LkbRKaA`B
-Me9lYk)%NYV91HGLSbqhKe-!aEYF+HEq2#f4VS[&ATMTDeL%Q0R-8CSYZb*)Ehd&
-FP0jmeI5KIRSLNZPjPr%1D4S4dlbe[4+dAB'NGG-1TS!D94UE6EbVYa)kc-l,(Fm
-+Xib3!%`Z1aQDe&VpjB"Y-3qRS0Z&4[T566LNaJ)1em6FmkEhEH&DLb#9339"))4
-f@*m`ZU(rh*ILmbhIdVTZBJ0ULIrF)3("rYN95$Sd-qc`fd%q9m+S`MaXRKf!p91
-$@qhiV*pKSN4B#VJbb)ecAd#DjNcJ&hjKNYh$qdYD5eP,CI"*3f`k,YN2![a[fVc
-chk5T'(%Z&HHBR5$Jj(V40Zd1r3pIbfFLDilQbHfEr%3D,H'pe($*Q[#k#c05FH4
-L9b42(UfP2HarfQRf5VN@@PhEaY+((5H4S`M`4q)Xr1JqXp1e$'4)RP5Ypc*-5S,
-h[L,YL4)Cdh15$hh,X`*Ma(D5Q*i-L(62CENM62LSYJ&Gq'Xddf3%1a,d)S0CfQA
-ATGr@hbZFNVfLPBY6&ji[Sm&YK`b[qJUARa$Hb*aPhkQ'h5[K-QFj5R9F*AaU$f@
-R"C'5hE)VCEaDR2P@+E+BI3,AI)CFN!#Hd)LE4'@RMS!BTJGYb)ZJ`'TmchRPU'+
-jhqGpLaJ!ml(LlD0R1QRa,ir(LYahAUmSVMLfEFfUFX26r"I&eX(!94lPM&FZP85
-$1QqZ)[Q#K@*SF9V$P(R'Z,cT9j+Ad6SFPfFL1hpFe[[9T8C[3)rRUX(['1UDa,f
--E[Ba1H3*(E-@$f"A13kIU[JNQ-IpGqK1C46"A9hAGjZdVLB6V#+`$k(,eBH1!k2
-cE(6cFG5Hl#I8-043`$3&c+DllHPc"hhNHUb1b#RT`l1%`SMB+B[jU+rePFb93Uk
-4T2hKlq3(,qaSq(E2!r6a*V9UVNUrbjrDFM1#KhaCV2FA,P$`Q$4YIb)pm4mC)Sc
-lbI%8J3EfP(AG9Ek6f3r'2Xq3!,Ni#%E#e)MB@SJLqF2A[,GLjR-imTYEfPL%@3%
-i(T%5bSJ@ARq4#((G8@Ll@2&''Tb+Sf9X$NTqr*'(X@B'"bV&Xk95mcfdi%8Xh8T
-R!`@QPj3lURIQK$B-@H[HEV'05Z$lSh2AiGZ)Tp2H"4SKjGe1IE69CpGcNa,43Z@
-M!dHSQ2"([A$kG0c@VSY#Pq(Z#!QFf[F@&*Rl9m01kSI[b1P$T`Lcj4XjF-b89Lf
-5$mc0mVhr[%IG&E!)eKfr#h#F+m#UU&)Lq`1C$J&'8CdfL-8H5)d,j9f0*%%i(kJ
-q1)bm0Jk8jY@F+pC5SPX%mNZ$mF%+kJ#FGZ8eG#BD@DM-U!bJ68!R*ibqmcUa,HH
-f%I21)M-r")%Z"1dFKe-1#%$QY2Fqa15H$G&J!["FBNJPq$$,2CMI3i01XII0PcT
-Z4jRTq`0%)adhZ[P`!N954KYIj$d*6$8-VEpUL5lk5)RK+Ce+a!*&4r*+FkRK#QG
-BMM1STL@cd5Kp&1&,)Ze$dd"ep[*G,TS@`29Cqifcr*I04j561Aa1F)d'h54ejlG
-2AB#AN6@`V-$j3hRi2dJ,F9TVPclA!"FR5!#qQIlRPrm,G3IUPGYTcl-)`bTc)R@
-3!&1Yh2H1MIfm"k-j%*0U35B,r4c[#"lV2159K"lT1K8GRGe3cedfSMricXB45)V
-8q`Hi+SmDhhf"$XEID[`1,F!46aqcZF"qJ8N6*[M4ZHlQAI)KS68`XMkc9Jp-d!Q
-IfZ#Mq![C)I$KAC!$M%cJIa"LiaFAq&GJP63d(C2`+V60N!"aXpl$Y[),"I4TXNP
-06-jm4RirqJE8XLEj$+,C1$(jQJ,i(V)[TCj(qcE6[KhT3f+mNYCr#Z9lKTAXq$$
-A(cC#8dB$M2Y"Y2%GqBd!APq&ZX4rG(#Re&+fC"!%RIL`L%8U'b4#620[YIQZE6$
-R9Ri*HHXiN!"DrIDA1jB2EF0Q!Z`Vida2C`YeQHYYh'6cI#PJ(0jMZB5%a0PqFA`
-bFNk5I9El3+QQ%#UQZreh[MlZNeY!fF9CZKJdC%[*GUIR5Sj"T1&+C"3lLM6bK`+
-M%*0i1BQP@(+'pU&hR!h#l0!R[i)KEc#63Ziih&!3Ecd!6A1!T(NlE$ip-6*X&N1
-%5-#bIhE$0"9E(@3e-[p5ZReRV5P6F*bfBZk[Uiq$Z,bbT@lP@BHFc1KN,1#eIdH
-ZDdBABBKDLI#f4decqY53!'H&9YN&[j%Kl(YYX2#,kmaL9!TF`pqY%r6lCA`0(DA
-2#0#ULG3l$Y8b&R`V$p,#J3N[6X-h`A*"R(G8$`AbYR'cGl&i&aX`NSRKSjjFFMe
-X[I8Idi-QhGVbAEEH(d[d5ZMdL+p#1G`ej-J2K-cFadSE&`KIVNMK9i$Ba"h&R(U
-HA%kl%4A)eERr+EaTH+L!E(KYLa(iFJTPFJjEP!!V#@6H*M8klB[cFXd6IKelR96
-KYNcFJ+)3)R%hfBJD(MAl`#c'%jUSV-8SR1,6QX-Y#Y2Lm$5`'F4-TGfY8&@GQ#i
-@99p[JQLVEUiNdB+mSGD+NFJU#K9Y8%6MhKFS(-28a9V)+-&EUTE#-(R$fZcX&Uq
-3!+QC%f&[l`$UAe#1!G3jiTFiG*LK*D`(9Gd'NQ&q#a4*i&V!Bm0!U634lm'0[b,
-Id1C(ehIf0K*dT!!9l#")%VU2UGHG(-&BeUF2A"Bh&!UH)3I')X[QB"j[)-HiAMc
-Zl6l'1G!!)hmVpjp2*H6N`Y60h[2AAcHQbfcKNJA@[9HI+eHFTS#PN!3"!!!p!!#
-dSD%rYA@&Q`#3!mN!!$@q!*!$FJ!0c"8!!2Q-!!!@BJ#3"!m!6@&M9'0X)%e66#l
-2J!!!Pla069"b3eG*43%!N!q!!*!(3X(8U2d5FX-%RaJS2$#I![1[jq-`QFq6`ea
-SNFV9'KiZ3PRUH1$XZPlZXMY#AQadC2S%D'#b@LJMBJ&U@6,A4&`!D,e5(RJd,3V
-$f3FjLH40PAh(VGfVkZHc9e$Dj!K9DYAmXm21*-T6R!hYY6bqqF1('`C9peXG9QA
-%hU5f(m`&#ApChjcKc8epBR&U4)Vr3XBljUQFm`GEPU,G`ec,,2c6%!`IZ2QU@NN
-#XE3bC(K`@0TqUNl+Z*(rHR$ij&mrrBN2e(`*Z4b1`Tl5)5``p32"KXlR"5Khic'
-N1f&pKDLZGE)"-b2+RESe*+dHai-%MD("LMk3!'$"c*h,T+50PJ&jd9MreT5i-PL
-1FKUZiB"CEZ-B5E8P2aF&*pSGZ"SkPTjiMNjZ2TrjF452'D"!4'lm!-JYjedS0QP
-$NmC-ZMZ*BS8KRE@*dZVjSDTXJi,P*8SIl4$0&$G2X6JChUB@$efkrffSZG)9hIe
-*9L+f)hD)U&(LdqbhP*!!NemL'a+He[eH"aX09b%*#IfZ2HE'P+*cE+JE-#NrPH4
-2(q*@$V6a34DiJ`qHaXPSC-Ce%#%CK)3PIGT4'qSILH6Qfar11RENaFX89`0L-0)
-23'"qcP1iRR5MP'B+KJD*F"9mPMbaa$3K-#"0hIk`l'&P5J%S%*Gl@$qmX80jTjk
-Q#S,C(hcPieYSm(4!!RK0d[U5FDpI0ia&LQ)HeShKNVkL"3[Fp*-j1-iLe,K32PD
-9q-[Ce9caYE69#abKJ,5(BL#-GfU+q"5"-UE(+@K*mGr&(UT6(*16SH#@0qUL[c4
-5D`p+8IMP5E5K8e*bF22ADkNN@f[I`2hUd#k,#IZZ-Y"alb"V,4EKaT9bSDPVEUc
-Qe31GTSF!aKjcA9i,p3D@HH"Yik1%`8`Xbr)K%X3E)*hbbkLre@k$YjKD9%$p$M#
-!14V(A28@+4jT('Fd#ZJI6HV0ZJ$S15`+b!rLYImE1)V-1a@1@ae+3ih'ECI5rpI
--U$2FCF2NGrP+H$cK`IcKJX()&ES2Kl@*1HICNU`8Y*LJ2fJ[cYRD[[%JIDjDKjd
-Y,Y6K`HUB-(+"-I0E@B%aJ"4$G'rH'NVJeZ[N'(dV1c1*b),ZPl&*2i3@XcG4%I9
-p%aYrIKR96apXh5jL$*JS%X)5ID"0c)EU*3D!"F'2*"RQc23"q*!!"kNK3Q*`Y(b
-5MamCkrC$8A8-J8j`AD0`UDEh@k5qr#6Q4[%U`FYCBJJ1MaQ#Ajj2RQ)%L2SEE$i
-i9$LD-MBd)HXHa`PF!iCRbA[5FLZjUbY8ZlXm13kb%Sf@M(l%L%G2#H"AISd1JQ$
-q6k3&l45(pAA@N!#XKaGS*(!1T[LXVY2RHAfk,HJGJ'D-NC[QaU`-TRmVV0frI-Q
-#2Xi+JpcrI0dl[,KS*iN2MAiLS%pZ5Dka1RhlIIS6G@keaVrDDr+$"0Y$a4'kPr(
-l2L)pRilVP!11H,[V!p@m(6JC3)m(*GpMU#V06HKl'Bl2LFjBJVFdm"#8mI@UaLR
-Ll-0-Q"+&4Y1R`KcNPU$Neb4dVqI8ZEL#Ef+C`-3HX#,G&-m['aQGqFNEdPHF[[Z
-iBmMPpI5Qp%!q"ZR$8"bUQR4`h(C@e3m,Y[86IRJM(p%bEdc+GT+lb!ZKLcC$cIR
-8dc0MGmbPVKrVm&bHM8keac2hdVT,lbjjaH8+*Eeqb&P)%-li+QaCUbSceH$[TKm
-)0TJSrS0E[31&KqGfVei9`bA8PXL%2-Iqm%qDBJf1,LHS5kAG31!P%+T3Qb#pZIr
-&G(E!m!KCVi0+be2iMG)9'3,b-J$9e9pqZccp(Hqjm[1SrUP"[jP"QKMYE-9VNRM
-arRGRPSeai+bL9K%EL-USiAl-iI9CS$c6XQHdT$ET""iK`$NAJVraGLFqRf02aDB
-ZF$0D6M!L@X9XD8",*&lm189*Zj%53$0e@H5F+$32ad-&S9S1-YL%dka0!V")Rfq
-p$3i0&9`SPIpjl*4PA1d0lYK@1eG%#[aJUlQdic$i%`Li-X`GpB+'brPUc#EKbDf
-8YfC1Hf"+BffchYJQ(H*#F+S(Fhr@Q9p&-B+pmk(SIm%eHe%L-4pplD62p*0([LZ
-[0+IT&`eeNL(C6&&"Xi2kcBqiAe0*Vi+5i8jY(drpHSAYAS-FTI8li[HaIHjhmll
-c+TBN0%+(I-9+9SL)0S"%-PE[l"LDB3N4He`*#(J[R%YY@Hh2mB8N'&,5V`0PmY4
-03k5kf*m,J(Q"R$l6k(0DEc'Cp,(&XqaZj,XL(3qUD'MGf'fA)&(b'+a+%E6H8T3
-U4(h@PF[8R!`*FGb@Km!c5+ReXb-GEfQL)$$"ZSqH*-G1+NM)(+DLd%%0Lc&L*)V
-BPk)GQYK-k(hqJ"0`pcjE5N"HV@)PK+*PMRDAaMZe2(MIR`2"dDJ8Ki3*+''VhV`
-r4[SN3kCXEIJLF[S"XTE4c#%Mb1c'dG2eIk3(XSjZqI6-RKY"TFD%N!$fa"%-MUk
-KEkN#+NcHIGX!VHRKQq-"(L#i$1G)(`5MCT'r6)@")LlT8R&VaJRD(C!!Lj)0(NA
-&c&85eURMjDfK0fZfdh@Nam)+MfQqXDNMkGX@'28ST,%dm-X&KQ2p)fGS&"Y%&6G
-L1EF8k822hVlqmN2i1U+T'kIl6bVeY4rd,m'P%,e',$jYU3kB*9VaK(alaEQ(6rm
-q)q(3A$hp[Q1BXMII,D#3!&bXG($ih`mV#JhQ#TVZ[qI*`55q,Cm@r`a*6%YlHEc
--Ff`[`MJa#ZlX-pN(*jT+rH!0)2*jqrQ2rH[kfr`'*l$68kF'3'c$[jIB'-3!)EC
-bKm'aT"6dPSPCaBYJepLFBm&J+jE(Y'1N%Ck90YmpcMcbIIi4[1PS[2Pb`jjN"%F
-m!TAMBcjPp4-`,LH"G0FC`pApi9'ePFMU3h"@"A)Xr4"'q4p-"B*HqQ-UlikaH"!
-5R-Q6C3EGY`N4k"Ki%K3K2d%AT#XK02M1a"!&0,a11VCcm1V2mB'""TcV9)&*@k*
-Xb'af)Qf9N!#'lmKk5&je8eQhM%5lTGC#c')N)V$0JrTkT##,R)A`5S%3fCYr`XC
-Z"@N6B6CVEP1F@S(f"P%AI2d-CR!ZYXP`2PjDQ-ZKESYlq`q%5NhUYeEDUmRlr!k
-5j[04TpK3Ddl%RMBe`,aVUrNeT3GB'p-r@2[B[X,m5LTYqVqGS6#$cJZ)ZTRJd+U
-TSH-NK81E[DICTd,G&!KM3Nbj39eYP+')PlPRqMA8iZe+I-r@EL,fAkhQU""@mdd
-DL[FPTeQ62qa0Tb(+c2IB**ZbHXRiaCNdPlB4pcVXr&9fDUD9&'2S#!F`X8ljbPV
-3P-,AX8`jaN1$S)pdCmircAE4&FHqSDTcKr6Db#0djJNSJ`HJP9MiQrapJe%&m-m
-Xp"Z"3fkQS9Tj6'aVPQbkU,RAh`!Gjm[P[braGY4NkKq4+aQRR68cQ-Z#4f6pC+$
-2%)&(L%k$ZSCN4+dTf@4f#TSB24Yr)p4jK-B2$3#ahdc9Zlj$1E@"$[@T2X`#--A
-+!H)MBlX6efJa0T'e!qbXf+[N8`8k%Ea,4+J"ESJb4hfRpjre@kE(ZLh+(G,crGp
-ba)l@X+%ZdjY9GDFB#haT304RN!$eK)Pb`SRIBk)rjkeJ(A'Pdl$ZX&0eP%,RS"Q
-QKlXMj&'LUXaZJ5`USTP4r'-2,bKKiYLbFiAqR4MZfZN,X*cX8Q$&-T!!b2SVc#l
--jAR*Y@m6mV)9N!$320b*q5G1j,Na6m4YIkMBGjCBXk-[hc&0r+CjC0V2r@XhQB2
-&DTC)QKbClB+c!NTb4,JP1H(PUJDeQ%r2*&4%!BkphpkBR[[-TUfQ3kYLpiq%m"'
-p*c4@al%R3ba-d4Tlr(AY)!R3fXjBAk$%9K-TIdV*,Y`rAaUUpJD-Zq9b+4k8caY
-9@U5&0hAYBS(1k(`@m8M!RiEQrQFVrqc265`'!C'"@XmQA-J2e*F$Gp8`P"Ml5Hh
-pUB%1FkQ"AJX!k)KS+*l0(0'fQF`%020V%eAmjbZbVeU&ra%(0qMFp4C0iD![NPI
-0Z00PMY6@r*H#cqHLAX+Bbkq(m'e3h@2J4-C2'KNaNGVlp1YG*SjE2k1`**`hB)+
-i"243MAck6q&Ybr-YS91!YQ&S8Ze5f@rqZhir-Q[#$j'@5%&VC89N`e)p"'Xmi&'
-FNcQDG0HdRR3G,NKe[M'$QU%&+h1DP,LlC!$-10C6,)irG8!qIbj0H'`dl6'lc+Y
-NUTYM!LFLqdYJm2cG9fd(##I%a#CqRF4,QlHHB"ZQ&ND-183E*6rR,M%XV4F@'L8
-m*VhH@Z5ELA`0f&F@[+2*$&d,bCe)Hbk1@hdGUG9b($,E-q-rfma!QpYAq!Q+,0@
-I&p4ab!XiAe&X1q,i&N)rP$br3NUiQXP5%ASSK3EF,"Bq&c#K4e+0pX+k`[0Ke"4
-3eAR#"U1,(LY+B4MN'A8bDq*5kl5kMfAGM0I)RB"S*lX35XA3iR5R!mN,KZf#YeJ
-JP#b)(V-6DmKF3Q6qSeXiGqA%-@8)P,PNCVDb4Zc1cl1SdM,h!QSfHkp5YNU2r@c
-C@Q`!-&0D[@F&Aq5([2AcCGj%)qiB86))YJp*FJY4B3H0BZmhjQlD1%C2`B1Z4,M
-)l1(#PEd-[fNCRShPJ`rES*'+c2"XSSI(['0`q)dj8i@Ck*p`dGD0Y'b!K*AJM9#
-+l`6)h+#m"rN*I)Vj6hT&kL,cr(KFBVZq2)C$ZFFID61bS!58*q[@UL%9cf'iCU@
-"[M"Fh'!@ST,3a4-Bqeej[8f$K,E0$Rh,3mZ+F2[#f)fDlTC)AZ["Y%VD5QK@J%d
-MR!#+bST&"fc3CXKj%A%@+9Q(mTfj4&@UJq#@@e"5"%cSFIJmXFL"B[R'M9IaZJ,
--SB#ThPVC&20UCd1B3`r[cpfq(QJalXl5@e`QC5FD+9r33cTFq+k!edFp%AIIF@C
-1X*&0G1ap5ka(APR-KAVGa$24EAMU%#BA3,VXKT9k(8YQ-1TmZRMrL`M['N`'YPN
-r+PJ(`)bY0Sde!IRZc%*V8M(!d)G,6bq$TC@0irL"2EYTJpB*"98mrU4#"Y"l8C@
-@Vd@q(AIjPPc'1b'@)lb-B6)'aXK@G)ZB38pXII*+6rXUPC!!$3&+h8K#3c4'QZk
-&pb-i(jI`B%AlRYI!S)i1'Yp'DFrNrPCEfQdVkd+Nm+(2SaBX"0e2[QKB*K+@X)k
-T'D@QDAk%C`1rJc(,RUkM98,12L*eQRGYGKl%+d@-aFCYNX5Xi@)ClPe,&Vm(Um8
-*eiVccHQ-SVPeU#Fa4TRDmK3MAFcVcmchdI-5`K'KCUA8plGJYN[UBR%"c#XP!Xp
-4&eU@A*rrfFK&qaVpGk5+EPFqlG[UiaKcNDVDf*!!`4FRiifd8",cm'@3!-1XB0e
-I$U-2[)6RJM3`C!kk8GEd1SajaLlS-LM[k'!QkCdTE&!r5[)&b@[!hLqC8aVNKPr
-B8LqV1Ja[q8,-S49#dbFB)hh94NYfk,Y"[k`@C%2Q-G*U)#,%R@+i$Ek#AjaC`!*
-rkiTelMHTk#QK$JN&[aj@[f#BY6H%i3K@ebcN3640f4'@+pKffeEf(#G[2+%Z3dk
-+B)RAQ0,XIe6%"X'Qi2HUVhFG+F%bBI2k5ai`!k5maXAX9NA1kXV*qR2,85[E8Nb
-Z,dH&E)f+lfb4H@cM#,RXecJ4)j5cA%CRI8ac4V0)JKL!G4$(khX@[B#*DlH,UH)
-Bk&!amJ'VV'A)J404UV4)YFNLfYXPl++MfQl'#lL-SEcEmZ9p#I1'qB#N%'6f#pJ
-`h,&-De+MYdiK#&K2jkYN@cUC*G4P9U,9S#@8iZZ`Qm9J896I`IB,hh)eDD,9V`C
-)a6Naa9!9f`92jFEAC%ShkHChbEjeKk"qkESXqASNcVQIXl-HA0TSSf'ILMpPm4C
-3+VMUcJZ,4`9@$6(fqAmC6@#EQ0MN%dF-&FL"hjB@dA1i*J&pPdA&bK1ZQXlJmEB
-%F@CFL8%eBC4DaD1Dqk"-08Db&AC$lLIL!Ir@!#Q3!#dRafRGhQc61Kb'p9Cm4`F
-'LaQ'fG%*"[FH$L,#pDP86(G#HV0!aLG(M$#4T'cL1LQK5*%RaKV,0bG#J['a(3N
-XL0-f5Y$4iH+UADXHkBMj14q1mK)d9GP*G`)l0XQFQ$Lr0m(Xe!5(6,V+#P,B,Y3
-e(1dlk3q!0NC&3PFIDPPL3i%16GLT'$ZCpK82((94Dp'[JiMakm-``PVPB1XYb!)
-im[X2)Thr@P#4DpKk'@FS+*(Jd5B,`qSNZ6lFXUiLMh"FRm@X)9L*TfTc%@!Z*eX
-*,4BeBZpY6&hZLB2ZAkL#5Y!54iG8rdE1Zj8kB+VK5QI`bGCYTRc"Smd'QXK4-pX
-&@I%#H,m%+@9RDUc%i4UImAUj"CT!%FM`%T)p*`cPIZRG$4K&qG0d)rj"P#FUkdi
-0e5P-N6S#SG'S)AJ[-I$-0L[2)QPHqhc9clGdh0HrQci2+adaU`FpEH2IrE#d(,-
-mC&&p!)+j"3R&lUFXk6ZhE9)k@HPaEq@P9X(mUHJ)E&XdhAR``If2FdNRhSekS@m
-dP)bK6A&kHQDNDkYM')p"Z1CbXcG`JJT648)I!lSGQlfBS)2fXK1GiHQK#ES'QB8
-X656Ua&+fA-JZ3,+hlH'KD816PD&Y)2c,m9PGC"D6JaErpa)JU@)+k+B6N!#C!FZ
-CA1KbM21i1bmIH&N6,Ra%T4DiX9NcMKHV,aB$#)0AUkApHcQDQB)$1EDYB-)C9e`
-mZ'5#p2HMB+"'5TbRA5hlaaQZ%+qI840LIp-L9,Rb"*FP,@Ypp1f8"(ACYEk6MSA
-%PAMahXY`D`mEJGER[FI,SpLQ)QNq'bASej8ZFId%0&+Z4cbE$$r315&!Yl9eGfd
-Ra[NhZCc#Xrl2Q#TARiL2q5RCTif&"(@eAT0ai[kkPJJTT@%6BLC0m+&)JmY+QaN
-pdqDARFDL,A)!iKk'Z[ZQ9Qk@%e`IA[hYjJLidLQ)-9S-4HGC-pYFX,6DkSdURAp
-I4q(2@%"GjY%F+cE4VQM',M6Rjm6qIf3[CZ,84E5cKTPZq19G8EpbAr5ZE@l`L`l
-(@dkEr"5-b8DrmU2V4b1Dk(Mk''D[9H*KF%aRBbermpC`k+GLTa$%+8[KFGj9qrR
-$kI[02#5+SG,ap8&lUDbqVk3KBm[,A!'NVH#&S4I&rImF[*cM,J-N[Cec`49e5Xk
-RQ)UqUp*Nab*adj-+PU%ZVPEJqdIJ(h!$GXV3+R[U#-d*a5mB,40%r-X0S'4kL#X
-UG0-DlFEHhZQ5T#C0JqImjTHlBB*JCrJ+(CBK#V9If1QLm@#UR$K)@rX[BKhb8YL
-1+MbmHRF&2i-Qhm9C@IkfC1[,Jl"5C)`B`mNcUlHd*jDLC2U@,Dd&`p+1UaY`GFS
-pr`GchQ1K-G12YY2IMF&al5-8U8**X!SlaLHZZAarTLE,(hj[(HAP*+S5*ScLHBI
-P5pX%a@YDNL&e&2*a1Sfq[5LJdr([lViJ5N8L4P*fc"m3(a6q,cG@!U!3SU5(KGC
-C*hE$e5Qp@Jk!ZZaqiKCUATkpT-DJ@08R1V%,@#EQ*qP4R,3bF@X*e"F+ARJqb!F
-a#mR(&YDiK(J0(-I*86hlGb@$%#I0q3[8b!r"8p#P!"GdMjmdM'E-$[966E4&#K'
-*eB*mZC!!5TfD5d,cJNbXHJ6Ki"Ni6j@)`#6jlQ!BT+h#h5TPT(FZU`D05f)S*j*
-%F3YDJl6XVJ#PN!3"!!""!!#dSDNkYA@&L!!!([X!!%k-!*!$FJ!4UCN!!@3N!!!
-BD3#3"!m!9'0XBA"`E'9cBh*TF(3Zci!!!*Hm68e3FN0A588"!*!2J!#3"d,"e+p
-l1d1Njj!!@,!Ie3q,(Cc0pVijaaUp,Sa8D%lRR8"5#X"PVHC*dC)N*,kVP0feT3#
-,Z&M&)cpiKKaI'U)LURRTV0ZS[j+!Q,*q#[&*HED'b0`f)CqhAJ,Q#jd&mCRaSGB
-5J*b0T5V&@MlM)D1,!YF,R2(BNrkE6JTI"kd&G1Y,(Q-E3#0NjUe-[R(!4`lC#Ud
-FHjFTBIjXCCH([[5IG@B90L*G"FdkbT@N[%-)CRCP5jP6%SR9M@F,"ra+Z)q-Mq6
-!*2F5I``dIIPY6C4edJXU,3aD5IX(IU'F+5#'83hblS83DZ96e%*2d$Li4SUDT3#
-AmmqA"Ee&4c+8PLhA`a`i+@`6[1#+2)9HB$+1q(i,K&9%kLj0P)+E'GPkNYFbi)i
-EN@(5hK1E*hP-6,ZmR9`+JCfGl2V9#PK+%h)J%iZVQi5@P#**p%-PQD4UrbC2MZT
-+$D)*0SVj6%Ca5m)T!R-er@1Ir,-B+659h,a@@(X$K*G(lGD*,KZDS8AYNk9#2jR
-il1PNIhdqRh$S@K%G2b3mLAj#cqKBZE!Yh'ElA'NhErkj&pcS3LpKjX&1c3qDRSC
--)PP0Bl5QEdlJ+G90Vr[lM4@(9"@l$dJ1Bbk"f'KJIeFkl+a$'-2$3%)R8VKEB2,
-8qd*d6&f23E6q1f!3-CMH%JV%1"$B+5E*JGA*['UqlKM-eI`Gd$P8-ZY(rlq5MV%
-MDQUSqS29prHVD(R'Y,Dm,6kb8dE+f+'&-[2P"U@%Im-8qLdlf%Mm9NZ$qq9q4r`
-#2rId4`J'YRTRa-$)1qN+a-%FJ$#+",BK2dZ22m36,9pZ1[9p`VRYm@RqdV!c"4U
-XrNYU@pUK12R3Ic*(QDEHE98iB1MPGP,ql&8``9Mk38ml-%D"`0qJK59%'f%*GYp
-Pm8LbK'8*"bFFq"GR#j&cdr-`q%3TmGjeI&IB%GV693MLiJ'H@P%)Vj`Q9PjU1N[
-LeFHM-T(`C*!!9p"AmVY$ihH6,'*K2S)#L&kJ@#-PT(+a&"keL15'(IM-a#C'%3b
-PHf$l"'$,F[CT1!ST()N26"j%TrGR(E*89Fp$-*18cE+QJS'8#h5,*LZ9Ir@)A[U
-ND)h(bPFJ+*UNfAe9$&ReXS[+mANX%V@RGSrcdqqLB3ilC,QQq'+DdYAPR*ALRAY
-mL&mXp&+mVcDG3EX6m2&FAHqP$HXpJ[9Zqdjc9H5hZZUY421J5`aL)!$kr)'S*r9
-TXp(N"HhARC58CI+j`iZmNq6*#4R*cNc%IEpRpqeeYY()iZ4@j!(RIPRA3SFRM%Z
-""%l'R)JVF%L4fdHYQ[,@UeRbFR@ch&&YTN@i2(hZ,'I!f$bGUUI!8XUa4VBZj&*
-RCR)R4,3@Bh$*Hrq18$bkQf[r%3i3"YEa@h`@T6-`cZQ)2`9BB&QC0KQLR[&[&4F
-%GBh`c&pR(N8REM4R#$%TPrX,&-JkJSc[68'fX[GATJGFN!!LpiI$q@i)88J%&CA
-SK5A-Lb$%1c-UR$QaV3-E&PR5E4dcd%(h8HGiJT`Ne3,S3cl,QFr#!+#C#pm[H[p
-bF-BXXbZqZ@qHNcBfhcS$r#&TL3jbIqrQVQ`F)@',Rd@0Fb&mDjZX&()`39Q@'j3
-GPLcVPK5acLmH)(ZhK6dm9F-(RIfB6LXcTDFLrDjN&@V`H$&Gec$+Ch8YBmiSX@h
-S#)Kqk#-#arK$)*XmJ[4lERMqZA@5CQ0S'3i-9,@TNGYE,EK2r(E3C8(`Mq&A*#)
-9BPB+%C8D*8Md66lCrX56!8'EqV0L'#i1h,3DH%M'I6XDlaI1E21dIiGPD8pMlL[
-NhNjZZGXNM%[iap0R,"*Y#5m*Qk*cTYaM[R)4*pr*NDDA,"acCfpAhr%9cq0e4$m
-T(*MH,('2*f+Z#B3Q&Bl&`4ii,'dBE2V1c6"rGRe-qFkC8NSVc(DZ@ADSjGBlqp@
-$+AAhCe9jfPrKV23)PeI4G2P&YaYGQYPL@D#8VVU3!,+afN)Jm3ej59K!q8U-Chh
-ZD9J2L4#kG1Y'&k6rHZ$ea,6P1XM`q&pYfM4i40c2@9L6ejf'b(3BV6Z49E2#SdS
-EUdKa15`HQ%LR`hVD5p`2"%CH8NqZMT1),km1kX39aJX9EP8T!@YjAD,"$YNZ0)T
-UTNfI2XVqhAJMVY2h`l6+-NTH$U$Z,LVdpNNA6`1$m*0'(XecB-HVBPb+r-4RLBd
-4L)9bh%*`$NIZX+B-M!,pI!0895)dd8#9pdjfJLJJ5b*)BS)KBQXQ45$rR!)M46Q
-YqqTcMqMkHeZCYdjV35aqYXY5$U23k[H6S,GJTYMLk9j'VC+@i5U($8j!Eqfb"0p
-*V9EpPHRDYLYSKR8L%QmhGkUrk49aiUF2TcBT(mV'"UqlFlP&a-+ZZ"N[e)#h-Sc
-`B`3!mUE+N!""aN41,ddb3I"KCi-`PBm*#bj%q2Qeec*,X+FLZ59V+[NP*ZNL$3'
-RPFFhb0N-*Di8r5I1FQ(h)QlHDYhdHqFX$aQ%,!2+&E+f'Nd(BJ,Fi$05ji3cdCR
-hS1SA@,jbHZ2f"VMi9,Mj[iUa,eME(H2kP')Er9@T$SpKflh0aYCm'M)"m2hJ@9k
-p0EC-FiE)"qeU'K`lqZ3PjiTYJ[jh2)$NhDk(R4$MVNV1*hBHlQ'3!0+*#T&NcDq
-#LPCF&@pfYka6qAhc984Bj#ieIqr2qZVS&GL-%D(*jj+,jUdra)p$HmT22$6IN!#
-Nf(N,%G)LGP3j4,lZQIFPL(KR&hT-Ip(qF+*kk$a&FdkI@MbBJrX%T4DkAIAb6Zr
-X(pLbbZ32&JX#PQ(DSkb6NFSK+%i-0[)"JHK$GkrD0CblH,F$jEA3D0X$cqKdH,X
-G3LhVVN,I#mXY0#++Hc-iARq"h(4ci)52aDS`)K[""Aa4RjJUJ6HM&phfcII'C65
-F'G9&(2G[E'aPEm!fF#`GX0V,aSE4pmiN*D6Nk-mr4ceXl+KG*6PPfmiAR)VNAF@
-Yl)Jid,CHDd@f-M8`&jTIqdP6Ulef9N`"S5&dcj[HB'Yek$kkFMNk'3cPUB2`UL0
-53$dPbq$-Z([4Vpl+qBldbq6"'ih85r#YacaR"fU&VP#f6qm#[BlpJ&iBIT%8NZ8
-p0SMHD6LfH2VUp(,I"L5Y*NqE#q`KXBJP[ZR[m%KMG3iAR"TXaX-QKEG@'-ljk30
-a#Z'!ilESMD"-CrdY@K8X2"GKGkAV5Ej%`TJZebNIZXR$fQE[CP2m3658QY#3!%S
-c'29rL40NY3DCi3NFYKRb-B4Se`J4,J+r&kM[2V6$L'(#5#[HIZRmE-Z&BklHK8Z
-0(rAJ9AjSeb6deMef6QC'fG33Ii-J$'8$HP248,@*)rBi5$6)!`2HS#H5&9qpCef
-*$i0+,DqSM[%9$k*3HReS`p*-(Cqr*#-qrk5+(ZH"E1Ie6h+bc0AfH4BRr4,`$D'
-%2951`X1ETITVB0E-26FrL6B62M3NSG42KD%H3f2Z9-+1F##r[EBpTmU0F2)Z`rM
-pall$jNcA0rH5eA++SepARQBMfB!VQ"rI'XHYbM+L0*5T*@&JEjK*j38KV#9fFC1
-JXa'83L@CU-IP-"VNJ[5,[ZLCI-jq9cjLjH4#H`&$(!P`l@dH3hG21U"X1NBJHdm
-#q&Nr#RQ[&bec40fSQ("prEh8KXm2J$B%i*Rq`2r%cSKNLZb8p(5kM3qKH#hEi#L
-UB%V$kplJV1Kp5RIFH-eN-FSpAPC#)&Ym["1[F3LKP95UZV!"dr&D9+F'cQffEk6
-LC-PXSTPce9)@[[IfmXarT5&ihU'pK"mAF9H@QfbAJZe"cj!!hRrMJm9(#QeN"kB
-Hh&)*@Y%qU'#4,#lKV*X3$M[`+TX2%fL"cYi*YKR1kpY(V)PUX0"5cPf6GJF%h`L
-Eh,Bc9Pk2l*br2f,G)[5Prq8kDL'&fDRpKZh$B+AlrXXTc&jkJI*Jb$aEir%JI2H
-H9QMap)8FK5%k93*-2EkcbIVKNGSCU(kV0ImQ1fU9S!-ha098mZZZr0b8MG3hF)e
-PGhBa@R4@`H&EMB0Ki9Rec*qc6N`L'BkZ,+kBK)1pm-NT9TY)ZFaa@+Z(5TY0UhZ
-#fM$T'J1kV9NbRM8*G*[C,Y)q"A#+`iKf''j3dhL@Z)mSlMCH'B9%U%VV8&Z'`Ic
-bm(`N,,NR[@0d-bdAE+3U82P9FPIapUGjkT2*m6fVM,8cd!"-B*lKKX(m3UNBbKH
-mKe5c1j6TJG@e*304R!Llq%VEY#P*2,[4ilKJ'G5qU5fHaV%f+ci-XlTQe@f5pZF
-'G$4$EP56XpGdj)a+1Y2EpNh@8`jq9kDkfYE[Y0UIj25mjp0eGq@FPFZ&*&lpP8d
-J%l1&`I"Yd4F5aC5X3'Ui2c51LIr"!M[cBYc5-p*-#RHcAVa&(MY!UrdCIB*LaG,
-e$rH5(HE3TQC`+ec6*+blSk!NCZlpeC(4cY-MI9N(Y!h$(,N6G15RF[MG@'ZjPB[
--f"l9Z$EpPRkXr4c"10"k!8qYEF#QMJ1N,)T#,i@M'&C[mGe#4`!5Kj+rF*&jEP1
-a*q6c+IQEciPQCUp2EpeTNdN`Ujfq'-RX5XpJP(leX%)l8+q&[G&fmkkKhlZ6&AE
-3K#(Mp!"0Z#Z`lQEc3IHZD&Lk8[6`m*!!4'Q`qLrDQ+AX#`[H(9+!BV5XU8[ZdcI
-SC4P`jk2B4XG+2ql598h892j1U)RY4ZclMh'Nm94%8iHlPCQPeKA('UcmFKK429h
-c)',3J`)VGAaM!+kS65,SUIFh8I+ikmiNAI10)$Xj3MF[GLkKX%*NJF9+CNY2!r*
-cLVS%YP,$&S3F$5UIk#M2G#,3HJjB6(ia*!5AUVcMr"&Q*fB401pC$dbk[l%m*-"
-c#A1[BFPLI"LK@+qDMRF%P*l"d-3(92D`[DcYRjI!I@eTe6@50'6b[lpP8r4plf(
-@U&*k3IBP#9jjTD3E#H0NF[Uf%E&5qT%p*Dq3!*CXXFNi&@i-rA-GcC[c6&414SB
-AHk!h!'(06C(e2R+QchReU944dJjJ!e5kcCEdB!XKGl-i$&Ad1R0bBj1aj%94hmm
-kCiKI$H+L,Hcc4)bMcG3jaD9I(TTAe!P)qTr1a#)TPZESQXp*N!$E*+Q[DB38F$2
-h3q[h,X*K1HDa[hP&8GDbX+rL-*0AV+0-fLIm*$FM[#BKGKdU1S!D+$k)E2[*`MY
-A4,4pM"bjeZr&Jfk'i#cmfEbmDE0Q&Q*[MX+0j`eZk"1TXKIp$fSQ0a#1,6kkdQ2
-d&iDiVHJdF5*i3-3hiVQ0b2SmAmAVN3fj2plZh*!!!GSTYZ&mVBIQ3hQTmIFqZ2N
-&kPH`@!KqF'0Gd9@RS%9e,bUcZ0*JYNZBSipIjH`'lcaIM1q+3GmiN[THVpQiH$q
-&$'"9+,HDbT!!1&S`)jRf0&#412J5lSiZ@jIBrEBE6!NCNRb`ki@[DiYBiYeq$Be
-a@r62ap&FIZXFjH0-%GFC+YhP@lTVqmddRHiP4HV`8106(IB*+IAXDh9PqN%`ePZ
-G91"&AEkmT2a)Y@IaFk3SQqa6%BU8"[F([*%L%h#Pf9!iB8k43IM2XB3p@ph8E!M
-b'-A4bC1+&)EU)Nb[59@S5C6(keG8M&,5+e5jDP@lJlHdEdM,JUPNUASZkSZ1Ia-
-PF"T2FEVY!fIa[e0@2'hiLF#qBTPI9q)Z4efHHR6E(6jLQ,[Ve2l[fABm$+[0T1[
-D0X,qpM[r2!'T'Z!3@pXapCG$b5*5EM*l@cbeT9m[RY1P#6Q14JF[S`&4(U-9DKI
-'i'a3[`a+ES-V"F#TI6I%NMPY,jacA$EqB2JA(Ddj8r*04Y)IBlH2#!XQp9a&L*2
-b2(@1LQq)FAk%EK(8V6iBiG-Sa$DmVGlKeaIqHaA!"4Smbc2MeP%ILFIK*#0Z$'f
-CaIA,J1brBhA,V9K4XA5(dh"fjF[MlBc(+l1@'')qZjMbV`R1@jjep0S2h*95"e*
-RF!kfZ&6A$qDIYA059bpb)9,AqK1r3Z63A#EC-`[Y(J(-e+CD[CUEf25BBEBYl02
-MMV6FbPbB!ZTI[4LG%bhZf9cqU@mke96AEih*kY(Cp)-`RJX$ap[EHaQA!mbN%3R
-r$MPLZBpN@Sbl-Z0RBdm5aK3U3aI8[h"XHN`l#kIZXp%r5HTZcYekrNe,8MX1MN4
-j`GGDBZeD4QcpfT('aGHB!QH3!0@4XUpaLNjaBZaVYL*[aBmDIk"D`aEXmLEpSB'
-+GrE01'Mdqf4QiJGQjpX2"DM(h-!G3(9BP*Ke#FP6bQ-DcL"+Ka3AYHkE2Ze@T`'
-c'I&YHrTr-4ci@X`U,)5hIhKKH,#,21YR-"Q549T&SHK)X%p-"#XYhrD%,f%m2('
-r",iLeXPG,jJKp!(A@H'BDIbVR%GMV3e&Kk[H5Q+#N!$J1KAmS$,9ZD9HV&,lEB1
-p)+c*HF4+&FUM3U$LSkT$r)5cTa,B(l@+@4iV[8(mKI'(8N,lNJ4T*pfk8,XhP*Z
-[(dp6mLIf`+kU[GV-llLQT+G(,IbAB-9("+X+`H4Ir6bFF!Tr1ZXU*A1GE(EAYSj
-Ybr)r'%"&5iKLD"2SD#R8X+B$5)Q@qQk&h`HacSbe,XVi,BlXrJlaM8C"i,BX#1K
-,[Nm@l4VJ&YiQkYCCk5a[1*,UXI%ZHJ@TNN-fU"lXFFr0Y@lj0*&l'1TF1$FHf[M
-cEp"K!F'H+%D*jffL&S9ej1ZD!%6S2b9KKJYpM@AGG`2CI`a$j*5S$4b6$kkp#ED
-$[GIRiF@5(*plia@FG`-FAm1SeGMPDp@pe19'ZXM(*,,EF[cqS'!Dl9%&)NmV(iD
-`*X"2Zid2GF!%*!(#L)Y4e#HC1!L13fcT,J(p-Fp0N!$2L-LN0fb!iQcDU$cldr[
-p"Jk+'8rLmDMk(8ce$Aa'M,AL#TYLI+8Y4qBl&I0ImaJh5Sm5rT+,5p04316C5[5
-$8ZZ8d+S,)PbBD9p'e(L*6l*fZYZcA1cDL,N-1VeJB&T`TDZ8QFB6*"4Zq@9MRPd
-EEAPY*m&h@N$H!*!!ILE@a*Ep3epF,,*Ae,VpMU9RYIa,Q`L@aJhM*aTq*)"`dpP
-0Y$1qTrADXb(#*IT$G[(cc2ac"J6plrE6bKVcKdL*Df9fDa!3-`bEYa)[&m+Ib5#
-%N!#*,5M&-C!!%!-5he1TBYm&RG[m[YTcTGY*P(MqiN-'0J9Bb(XVbPQq&pYMl4b
-LXB0[b8P-VVE(Y6BjbDARB9H-dkkq2MNAJQSNG1JjCm@amcX4#-0V0l$F#9I9%d#
-pph&-l&'(m-9%T@V,Q(kM6FjU8U)-jlX*C!HLPc1KS)T-*&V5PV)-REN@J"S3Pk%
-`P)mSq!lhbC!!YefK64qmU+#!1c"[TaNDQN3bU9D&SD!qJ3`Fd-!h(MJXBQ-Q+9"
-D5f&DDUBTEpb4%CYmSapmHER*Xl5H%E'2'8!U&N@4A`m-S-+`D@%-)hqm%hbYILm
-2bL`L",XY1T2@E+AL3`l'SFaY%Em$G'Pa%(H)CjQ%4pQqKm-V0MPPUkEIL#fRRSI
-!Zc%(pLl4V@pI!-AlL8PfQ99)kF(hT2R&QkU@Ci06qq,([RbM+1Irk`(#!9Xif#V
-h3$LP@rBq,K'JK%M#&Ffd`0EH#EH*D,&316S9N8Sm%YEIic()EkbeKpqNPhrI5Y'
-%Fl`RUlRNI2NNP")33'44ed'$4k@qfEA)[2ZR4fcUTR`@-*`Ue'JccJZJR*%0N!$
-2qqk5Gbhqd%3,-C6MX!('cXa%Y-,KCCEXdmP1#2T#3e-r`q+M&J*D$%B`p*C+a!5
-8LQ&kJSN5D6-&#Dq[qL%Ae@!)2cDX2VGCBlA9PSY)GF%'b$(#8+Qa`8iZr"@XQ5S
-jpE+L0&F@c`bXI9+aCNm6QQS4V!DEdSUVLN*Em0A!2k*@Fc#!Jad+$LVHIaK!U",
-'1E[YC65-1XC0-J2MR%#L6'06DeJMh)#[369H['3mRD-$DZJ#GdKEdl3NQ$"FDqe
-P!Im55*M5)JKB$6SSm(,BrMf$8Pb19EAkHBq3!#+"&r&[3lbR3aLG3ib%(@T-&aQ
-3!-FTS&E3eZUKNR$GI4jL5RSZGU$eIe%d8r%GUUR-E1+`E%)GEdMTV2cMA4-lL6k
--2r$"LjC-)bqMELfb(Gce%!ifq*!!Pi6T1IHQIpCDcmeld-#hPl(fAlA8S$3XkL#
-SV'XD$0r-U$3qP8YQi%&F4IK-cXcm$d8)bSJ-@jISrj-jL%))ML%TF@6&b4Lrr+F
-ZecAk-&U8cMqGETeH5%,B6$Q"R[R2GX(`)BD5MiQ!JJD-a4BAd@Ll1Z2(X4MYPCD
-k0dE$!'CPl99C)qpBQ%*+#%AJT8*V2T!!aFd[CZmbl1(-2SfLbQPSN!"0+4Q!G6(
-6%Hl+P5ZmBGpZT!YQZq0U`iZJa!jN+ANj)q)Li`RaY!Db[Nk`k9RV,1DNTeJc4G'
-HYR5b5(%,hd[F,$3G1P#NkYm%ZlZhThVF2rj)5[r&!+@3"!%!!$m!!,5KSlDeGB@
-E!!!e[J!!Jm8!N!0b!!p(MJ!$HBm!!$6@!*!%$`"8Bfa-D@*bBA*TCA-Zci!!!*H
-m68e3FN0A588"!*!2J!#3"d,"e4`CE$lla)K&BDBbZk2[FITLL&CcR+epC%hYGe(
-hM`#1qe$mAR92H%jj-)qQiLIZ)RdVR5FcjBB94`6["IYD40CSqi'-h*8TfI'HlaR
-pUL!hZ)+ra6*F"9RYDZ+8cl)`f'AGBlJCh#'Gjim)HZXJ-!11lemC[$UPq)bD$S%
-%#Q@DUb'-XSN"%cXL)Tp[$I[%ZaJAK+lJAKb0h&UC)Xk$DqB2K0LNK$YMAR41ej!
-!XbK8bPMT$,0)0I'd#A@PQARB0`-mbG2qj@ZL"G+FF6e5X`q,p%Ih5V!VEP3Vl@-
-@cZc'Yb@l%'R&!XijkKqkaYM,J`#'`*q,c#hYqBX["26MpjmpIX`,G%1L3*L+kVq
-S&(0UY%)G#-ip"B[5f2hpl1TfXUVe-2KPL[2T89YMK4dQEp+K8,F-D02(45Z8RNi
-11A6r'rBLE$224#BR,Hkl1I-1e"33pF6F6!ejb-!CfRJ5P"(mfe3UBlk,a6%+rmF
-FF(IM&HEe%S5LLEL#[Ua)U++c-qHh(iD*KE`d*1lIMLCqXDlD0G@MF`VT[&$iPXQ
-T-"i)"ja4F9X$UdK0SNpVaLZ9`LNCh`C*H4PPC3&La2%2,#6-,mEPRcff624GpSb
-"42eFc"eI,p[BlVjQl6SJFipb%N1dZZ2MkZ[5VmDj5qjp#8A8BK!GrZ`(i3aYS5+
-mreIq0L%[cKTmJRFj+@h1+!!8h--5bX@LVAj`3XL(im16T6UTk-!EY(ec1lhjG!K
-$U4`A2`[lc6+JL0Krdi4H03RIi@"SLDMF,6j',U#pNEX1#GUHAEQeiAC"DY)[j0c
-3J6,H$[DF&@SDJhVMk@GE@GREYXBq+eDYp%h*VlPVGe9+*q,GAMRk44VQp%ZI(V6
-0`VIU'TK)aVcfmCZ05dV50HN2E!b$@e!kaY9"&f5jC[5qI2DLIXep[X["eDr9P+U
-3!)@BiC90lM1ILGKBbA+)Sl85@m,IrdJZ1V$lYG&MFN[3PRT0pD(e$H&&6DAie&V
-N`5RHMMZ9b2RCq3[9M)R&Pa3q#@IHYFAa5h@[$$`0eFXD*T(HDCHLbLkTHdR2q6"
-Gr#24,9N&6LHdA1Va*$k@R5j!phS&HYfJ@aaf+R&KUc%YjhH)(!jF9C!!-)FN1C)
-,rMjG6qKRfhCVF%i4LP@3!"'Q!h#BM,dHCEY0lXDa9,9EJ!2VHereGqHH2)X#TI1
-,'$ZR(P2p$EFH+ZmmN!!jY'Nke-Spla*p@9kFX3LEA'U$1cIH3R(*hjq(c4H`paX
-TQ"-SR6i*Xa8)e6-U'`HXBh!iSjQ$em@$dhV66lS19epVVl`cpl4XeGLAlZpi23)
-!N8,+M9e,je3HjpPpkT0aMcGH0qDDBQ1&U"302Ea-QK![@"#"B+D9VA#c*),AJ!`
-R4c'jVjlKhj&p,D[jI$B*b!,CZpe,Y0la-iCCLP@JjeaVDL1-3b*!(F"mmL,316,
-1D1$(lB0BQBSceT0*FUDkRPAljK&Up@Cq'PJ2lZQYeHijKp-24qJfMKaT--#Za0b
-LXkB*6+Y+6fLG0Pk@e!SIFAl98@JkkH5iL2FkmZpm&MREA+8UC$d#84r,`qJT+Z3
-rGe+Y4VFDI!j'@18Re9(QR"IGp64c&`cMDK-HjXV)QS4j#hli84'0m,CZ"VE*j(M
-(URjAMqGD93er8qf[q!`UYrBCF`,hjjVZC`JYEH6,lCL+jQC`hfq#,V[LqrG,dq@
-AHJ9a,kQ0m)hh*jU9m+1EMqBD+MiTif['m#`I[`R1h#NUBDD9B$2d`e*h6pFNiB*
-a)p1K+'rTD)bB1eIdq2#0k%2MR2@I[lAXf*TiRHHriV+lb`5)jd'h'B"YXickcL6
-pB`LfKTqEA"UR,b1j2LG5JFNQL)(RBakd3L$!k6M6aCL6EfZ93@d$#-8a1$Ya*mS
-iC0AIEjpF!YK%VS8rQb9KpSU2PX-DZD%3)[T&cA%Vb)5Y5H+XY9*9,+'MRhqlG"$
-4@CB)0bc*@KMN0JHa2iG4SQIbZZ+lUbI-mU"2k*KMi'%EG+a1&!kPF$hV`5a*Ef1
-4dlb-a%!rFc'TKKSeEFZ3!&%*BB8i%34D+N,BiQKPQHVZVqcpF!`PNPBB3fpF"0f
-4T(bSPVd',e`QG+2j'$h3Eq[%e`T0F,4`YSm6J4cV*f,9dliX4mmM&,q-A!Y`Qhm
-er,NRFpF`)3FFe@TMcB)SfGSkIp9Xie,9)q+JMQ"eY[qBT!$C[F3`$aT"5#I*T5&
-Y#T!!q6'2Y&i'`J#0q6HleI@Yr(1MYL-1NeJaLLYIDB&Z,8T%a5PD([[b+QQV(Jh
-3b`5THQ%QB(HUT-j0Y2p8cX[-9'P6rckHf4m&Hm6rU(Y6m%3DaT%%!IUF5`p'53T
-M$SeF&p!ddGepCiBejJSQ[cKirTSVGV'%"66jNi(iKq#8RHaklp!@8PhQ!paqd"Z
-S0pX'RJPYX"KZKK#mY`CL0G+U(93l'#[2)NTlYJ5ZdZ3C34pN#iX4Lr-D'aGb)YU
-2N!#)*[Emq%cY&lTrX+Gk`'aQJDl3dHb83l1``0Z+f"rZpJi@%!ZaK!`6hGNhHFE
-3Z"`6JG9,)iSC1*NJC$(l%QRRE!'#FCTiD51,KI`1KCNmTJ0`bYLSkI+PZ3h4aSP
-V8lH*+dT4'p"@1)3((Car*"iS5M,1C5emXPiYp$lT'-riXi(qcS9Zb5'6hFRhJ52
-Z-4qFNhqS3dFdaeE+Q+ZJ4"jCUcDKGbK9L5edl'H$RL4MkKlqjBAC(H)GD&frNM1
-Xm1A0U['99hak@mAIam!mA[@YmqGkT)+2F1`S"+q5@46--8ed@e8Dm4Ld,*hf5$m
-IKeXN)IJ9p2M[SI(f*@T`li$G2Sa9PclVjq3,i(CVIqf'REpii8)Ye[k#F5"YN!#
-(F-,B!L&69rM4XA1$mfDCd@VE(0El2l(YkYMKYRjKmj,U-43SUb'$"+h@ke@qc!'
-(p6H536YB-GC9b2Rh"pp9`'K4!j+Y,%kMk(S*r1miNcNT2#-Ulp%keFk@l+GhP$M
-c%@VT%AYQEb6AIp(T!396MM&akL!Iefe'TGaZ!lfHr,i"l32mqeI1U6@eecKceXC
--*eXGT9AIlj6A1G``p%F&Q82*T3qS2F4Y@%a#+h!ldN2PX'58+brlLM*DDK)%(DK
-!%3VfkL6Z9cI#Bp6#FB,GeQ9aja-qiCKmHTc,d(5UYU%B,B@M%SPJ)4pL'XRJ5@p
-90KkrqH-bf9e!BQf"Dp+TGPA-3(Y*8d$52YG$35%%@m&r`KAK$H2GYKKlJTBee%b
--brj1!Bi2Pq)-GHr@JESNpV,Ah`PV`-UV`*JqJhbXbq()54@&T@%$BP""DkVkjSk
-3!$fl[NT+5)-AkJ0)fh`l#f0pF52K62lM6++0CmKX)BbQDf6@M24"mh0-e&Xc8Y8
-PRJUAK"di)MHEJ`LEQ*Q!,%+$[jpcE6$9Ik!Skfh9HkbY0'NY@BBAid3i$lbY*V4
-)5UHl&k0J*`UX-GhiU2plGq)ZJa5rh%3i18EYMXGLeQ32)U)4GR'5'NCJe5"2LH`
-GDhE@a1fJD*L1!T!!2i[qXL3BAVPrP*5&)+`%a1aCZ1"Vl0$dEUlG+$pL`M@!bcj
-ST`f[pD4#2"QX3UZjAH[&DI&qc3!3Ir'F0ZY%+LFB-i&QH,@42Ub'F4`ABeU3!&9
-(2eGGA8m-PDNkGk[I*D1+cZ(NRQ+KiGB&p396p1U+ZqITYbLNb*AmP%J3CYBcl&'
-TcT6MqJGMbX9VESHSE`6G'Z5H2a3YIk*ViJU+j0L1$(aK"N#15`,GZi[lJ+pR)`[
-hV,d&YiUQACV5[Xq#LRD6ilV`Y5EC!'qJ2,e-i3jT5,m3+BNX$TAj$ck0`l3B2bS
-LY@HCXQmVLXl!(KVCITFCEGl@0DfY#RNZiBc$'S,`lAr'NG[E(,d2Le9@$d2E1`V
-ZrR1DS[3N,d,6m'SkCDN'!Ma$l@eBTFiRqY1cRU!-`r3jeHKbhl3elT3+YX@Y*U8
-,i,VC$SGmYX9Q%mp-[b[T0Ue[f3$'A$VA&$T8$k[XLkU!+AY"M%(iI4!T3S)H&c6
-`h!)MabF1G6S#`,MUL"U)3)1#[JPEG8HS`&kl`hFRL-%*-lP%K,)!Q-D02bd!XC!
-!p1pFfaUeN!$(PSekqI"GeBC4%!',"Fh[Gdm%L+j@AE-TA!@Xj-I+VZc1Rjlc5XU
-Nm+($Ak6BPk0NjGbMm#i4UE1X`X4!ca1&CF+@%0T5I'JjcD["MCZ#GT!!3(0!&(2
-J'!SeCk*BI5[cQZ@4$98q)0QdL5T#VE&Z5i4mfh(0q$*$hKBPU+c[-Y-&dXL'e1B
-(pN*5JQBS#'(H+,lPA*@!PpcE0D(kXHj3[0H-*hKqcQ3X,ArU@VQ4eD-SK889h(M
-N!ZC!m62)Um5QM#2kC*X$NqU0KJaH@4-L4ck0CAfIm3"rp"K8PQJ)L!*Hbjp*K!I
-LGPiHT+N$a9DD(qD'j4[-I-jYj`Ri2)B#Iaa+q,25D5$@*mckkG20M-`Uc%q`c*P
-#XCCHBP"+3lq#XqC@PQlGL&[iRdeeFSS,08Cc&M`jFf5$EClRX5XbrA[fbc59Hk2
-5"2KTpTq8,(N(V$)jHK@BA[fi5%V2`"!ea'U*(&XF'#)C8lL!p%e%MU5dq%9lNaP
-,F+YpCZifCiDCfD)G-9A8l#80SjCl-h)K`hlMaJBUbmcC9kK8-BelTShDQ'3*H[U
-Pl,A`l0C$[GmG*q6c@[Mb,8Gh'C`rDmaC8CT0HKF#c,Y`GkS$X&fN#NlFN!!P2"B
-`E$cimC[ppT%C)T[*m4h,ENl'FJ6ZKTA[NbVD9+8#*aeGJfVU9XDFL[*l-)&&(lp
-9B(i[`hjG#-8#De#+)Rbh-()'NMB$fiSfEP,%8KA9Zr$R#Vd&A#hlC0ajL,(ZY9D
-l'pdQ'RZd1Z2$Zei!lY&ka0-2G`J[B1XE%X9$H8fj$QL!(bNV9F-D3#aBjVlA9CZ
-9e0bkDL%1Rj)2655I+6Li*'Ma*99ZJ,Gj1DjDVG-@X*Hm`H66,T!!iFR+NXP"QGq
-pea`T61T3pXdlFeaN*Tmd&lN"%(06"%pKci3rC#+rbp2IeQ&VBEV9`6'E[2rUTf@
-Ze4Kp)ejTpM&)ek5k6l"cUPq6BL'#9&ZNTkRLV8LT[-j*Zc8RB(pNZqbZ4eKkf2m
-3GZkK[B$Ch+'#T*%&VZ$ACdk#9'i"[ZBZb-DP5p-3Be-YjLccA"42fJAXH@h6XAG
-&jL,GGBCh(["ij"5K&R,1QfRSJKMeLYa,klfU'`P9P*XBR3DLciG)'#L'KrC(p(I
-VTmVm5K+HB,PaiFTr3J"#TY+Y0E)Em-4i!G!#h1mCbILT#Ndkej-jrKC(kFa`6Lf
-h`L%(Ek8kai0VfHC8N!"S3R-kim`6$b+U!llDa@+SkCSM4hY,SNHh`[,'hd$$KZ2
-R[UElHam[fHd)fE3H(11&Y9,)0d1!+G0M+!*SK1eX5IBqERGS@e5%b1eMX(rY2AD
-kR8Lrb3GlYqpXc0Xr'ZbicBE)mm9%NG+5DB4c+J'$8I8Z9'5'@l0-K$GK`MV(XP[
-QJ%V"$8Gq6HPUm4$3)1j,'B!G5$)%frYFJcGbr64'Z01bQBa+*,+eRdcKk93mDa[
-JSd1FKhTUL2i,r**D*Rqqam+3!+6JdX'iQ5dj6&[UVa#%466miQMQIf2La*TE6(T
-XrdY-!aZf6)4@)4@qGeGJpHVU`NIp3MKZAVeE6Qd+d3!`'lQ6@YJD8G$0[MqISPl
-HYR-pa-j@Yk@2(C&[pZ2QYCUTQ0-kYE([F"R2JcaF!Tp*0hcVjj0pGjBSbEL)f+b
-@h#QKcp2(-QmbU&"FaYB#H-QfMNDQBkPHJ*28FSc&B&akQ+i3!l*ppS9FCGTl&K-
-!q'qd#8raHMce*LIe$*ej5Fq@pGcb,"bQ4M(MZ),1M4NB5MUNq4S`MqJUU4BZ#Cb
-9-'C+l2fF&AZ8lhPLY5JZkH+q1p4!f1(aZ3m#4mrmQP*P1d$f"ppI(c1lqMB6"Z1
-*F@KV3p6(Th4BbRP[Q,Qbm3$"FqfC)rM6i)C4(l8VK)NAeDS0JMd`Fahk$lKU%@E
-j@h-@)f!qjEDUM4pTJUKiXJ)28E95KL6HS&MfQhIfk0)!f%RFq4M&YKQTkNJH&Jp
-`N!"RZb!H2hc8L-k8bB"%K9X2$VebHV(FN!$TeS0LicR!Fj(D"I5,i(GiJ))%+4'
-bM9Rr!'G'FXQ6H51LM-Q9,cm#cJZrpFHbqTS!j9P+pNlhTI+"I-i'5k+4&k$dP1b
-GpSZje#AfI)Vl[E20a+lJ`A`bAdB,N3`p9ArAbY0-fX+Kc@MaL%qJM%20,$@3!&C
-)9aGL!IEVUAB0KR#mI[`X%2Um5@@'CAGHUM"KFmD!pPbc,ZU*YPSiKhF)HCK3TBr
-4d%ec*!PRQ2(J!SUTL@A,M"IClQK*rlQ4c@0@!MJiR"q,3&"mIA$9c%qcC!h,b`G
-!XPV%19&XKYeX,(ZY&0Q%IcYF!hmmdX8,5Lq9KG153hf-LJ19+NcJ2PIGRj,%LIr
-ee`ad3"b,1XUP,*(p6RC%jm-S[-dKdiVGrYN9@c)qd2Q$,Hd$LN1J@Qm#CNCQ4)S
-&r(ZADd%*X*dYYP+9K&l)$j,!eVicJ)rB"QThNIVda'ah$&28-HUE1jNZ1[DS(c1
-V@[T8lJb4"$VT3CDB&*DN"rbF"3,P!p2@9pi#e%C@P9S+GC93K"FFD(4G5YeRqbC
-h[2H3!'A!G!Fq+USID,pjGi(p"$S8STY8)0K!CU@p&`9cIKkE`@8[&@&eUD0X%)d
-6ES9+e!HjF@8lDrY&#Lh&FM@Q,@XMdiQE1N,YRZ!5[0`,2&)#N!!HJ-YN5(DHifj
-[Y@PUcc)h%NDUaMr&Iccd5NdD5`fpTP%Q1Sd,6G9BU%em)5SI[)S@0T0c,)cFTZj
-MQp[!M#HPZ#bJaRHY61"(iTqI"qER2LQbDl!#TpP6P0jNd,+VTTY+*fGLY`5h5i!
-fR01qYCQB1[&q,Ji%6kd[384#l$QkCqj9HH3dPNa8bIlV6-0236G&!KH(GDQUl[@
-6I1&*Hr4&eNTl-PBGYc8V32Q054aj3`L,8!4'KqY,RrGKCe89dkf2,UUJTD8p'fH
-EjBr`kkVLIlTZZ5+bLI,V%'mPp2Zl&+R@YaAV,[JTL9`jk5$cE**X1$lGr)J2p0p
-4QR0#@(ik%Z'Qj,Ee2+S-00IK6EDNAa+cFC3"49P+M5`haNH)F-L"YkddCA[mPRH
-R6P)Il@1)AaIF3r-heJiRCP'E@PmM)-l2j6h[aVeQ32BU)Nd2LQhhNS[l[9S'UE0
-[&hG,`$dLjFYrbK6,QTr)Pi@c8$RIM40a'ClTbHeTRm(YCmNq!0`"BB`mF3"QkS[
-1G$#2V1BqI-K`GF65Ea@)*JdV(c[+%(&&3BkpX$A0p9p`ql@2bkrMclKF0KVD*X(
-*J"!rUhm,cSe2MBe+2Q4#QhK'X-$NM2%DKfGEGT32Pk8AYS0rA!d[mdm%q@LBFU%
-Q,Z@Q2$3)Pler@rKR-9JQ!HX@3bGE##2iGhGVZ%KJQ#61MeD`J[ac2J40UH8ZXX[
-(DZfH5kGJ1dm9Tf@Y(UREB$rkYUCQHpm-Pap(bF8G-GjXhTql4A+@%i*D,mlmB5E
-96[`C$($F5)lA)h1G!!L(m5%GdSRbD1X"$`j2K,VHa,8#&K9`NR1NrjM&00e%AD'
-'eMm-'b91P-FZ+#M6GPT(39TX!J"p21pqmdpILD`GEE%BBGEb`pDQjrbAFX59QlF
-!mj%c#dJq6i+E-#I)J"[1kYQViQqcF'fVM0BJD@G2+U&Z!SiKd6re!ZpReHfTmGS
-+hc90T$6-8qH6pLcUYJDTYM9DCbLbl-UI+Hj&D&IATU+9ShCZKU$'i*HU"ppKPYI
-%pcCB%R15kC3UP)))RjAC&VFr2Y1i`[BQU$95#q%$[r-jG)[,3"9AVN2XM2Kicd9
-RkKqN15kJ)"RN&N!TDFSJAaH*U2-IqiAJLSlJ`Yqd6kHf(JIrmPQP"MHm1rG4+UD
-kHmN2PNd$cEVe&U-1b&m*rYP@S3k2+4)PcL,0`T90r*X[rLl6hm0$*CEDA$fJ$NN
-)lS"'%13r2iLGT,Qf!Q,*!+HM@(ac&SGX3pECUkU*!rBX48-CaleRd2VrjImP**m
-'bDVV)E%1NAEH2JhReU)qJjJR@K#"HkM1,UBQ,A[![b[9XP1SQDkhid6JcallFmF
-SHbA35EGl9e)LfbKUU,IP#I"a36hI14RLF9Hd6l1SK2$XShB#&aq#"ikDMr500de
-e'c0fqG9F(85(rFd63$&[GB(U&0+Z&6@CmVZ,%LBU8c-BDbYr`k#SrqrK%#4bFAV
-[NC+3!)JN!H#S&3,I!8H"ZYGf2EYY2dpU3$XE)JGi()CHdm#ke$l2``)%D-TJV5'
-'qLBKE)dm+lV3`$NHBF&l&SX!h-5L&X4a,m"IkA-SdR"02qMDpp`!)I[%3IV(iJc
-eV3h2lF0$b)4-XY@Y(b"(&J)KQ3X1S"EXXKI*BYPM`*YAA)BVJ$!HXB#1ITcV#&1
-9!mG%#!dXrkV@(ZGhpbFcES!$$P4[Y9BNVB"!jK#HGl'X,RHrrFrNp`qqp-T-VN9
-N*4F1)ELfQ0'TL604'GC&AZ*k)aQ((j!!cp[Qc%2)b&(cdXRZJSG,TCTLI,*52*J
-DqY('RmpaLcK8Fh@'b2*KG(@1D62e,@X"S)YTrZ,QT!"$kbKq+6(`j6`q)XB#Kl+
-6Tlr%FUY-`ad#cBQB"V``*Tjq!+d+i*p[R%2",bNcEep9,"i%9F$kDej`Y-,`6Ll
-"5%RBfhT(,2c&r&5r+X8q!iZE#+"fC*f!,HN@c1$YmAU,4Yi&`i3&"-ZaU-6%'kU
-6kTXGp%9G-)&IA,%fckp+c*cfA6%)frXqVUJQbi"P0i0Lb"lDjV`(kqLCiCFVi`C
-Z$!!MBVBPeifECPRUR2hU6BZ9lhGqJF03F+PG`*V%Y,Qf'$BV6SkXMM!0A00hCj2
-`,fV2R["6%98F68Z#k2$q[3IXSEQPh)h$5'5@Ak'ZS,ZN3rZmJBL"Gk)S"TEC!b&
-(-)KH*&ri0ADkDi30kkR8flX8L'5#ek#aCSf-D[jV%lckrVA0b%#T9$-e!LJ0pfT
-"EK&-Z`G'QBcV4DJ$hqRNT%chK!bp6YRYGVC5!c[j"2m-,"bMN43&B*BqVMQFeNl
-6e!BTMjk,LRe&E[,8qe,eKj*Zd&0mjl+J$,"VqD3Mp"4YYrFLdb&IDr$bH&EBQ$a
-%N!"%T#-S@P*aJQFdY+*,$m+GLG8e-Q#bV%"VTljhFkhJcBZ#E`kQk5@j`q4bFJb
-h@Z[$APY0b)ZRV%c+La$,1dK-pDHQc%&iUCJlVfJVh&@8!)c+rhCpdA%mA(M'0YG
-Kj81f[c3f3YbN#ICc'@X+TkI6#lbj+aKRHHT'fTS9*4S*IPkR(0FN'QTC9J0$+qa
-3!KNVMV,6IQTD`)6U'rV2ENB$aD@0pl@KN!#1!hbeRZ,U9mV5Dc@"9M3rUFLB$qm
-aRfM-rVRr(NC,B6jf4CCrBY5%PTil8cI&HKE(Cq*VR$m%1QPY#m6d@i*!S@*8ljL
-fIQ5RFZ"GaV(eDm&EN!"hAM5@-YMcl2bj*2G1c-eMc!QAIfj2el#50XUXXVbC4Pp
-YLbH'9hLGb6adVb1JH`kD1"`DZ`GUD3iIl5VH`c+(90-i93'09AX%)"Lk!LP-Apb
-a"dRM-jHQY,@B`aA4R%$Q,XNCmY2Rm+Pd@LDV!bmMQPTDAJm0bU,GUA#c+f'Aa(-
-AL,SS&c8Nf1+kP%cBZ&eAb8hPEUKBeZb#YND,XK8pkTCJ4R*a#lBjri8)mTY!l6e
-Zmi)2+Cb9)PeZ`4I@cqCkDkIFJM'@Nk-p5288C3",DJI0l!N3Lb(`kD&hN!$ca#5
--#lEA(f5J,pVbe)`1rSm'$CNZ'1[C3*a`Pm+YpKH5N45GBUmAS-!ZiUYPGU(kV%K
-Y$Gbl5H30Vq&k[jcM-&DjqielAqiZ0LNLX$%,5D"JKN*La*YpSfLL%4`ea+4Q1YV
-m*FLd4&aS%R-D"X`HreLVTfj!!'&mjeJ%9818d0,!d*!!%AjCh2c54QaDYq4I8Zj
-'qeR(T,UbV8aV#a20%R,Sra[Yf%-N#J2M8M49&[IJ%IbDc6NV8,S'p%`KiMIir[9
-DC`c8c2XTf4)e#eD'0*J51Je`XZ@+eYdbh0GELaFJ5#U-[8kiCPl$l0`r'r4JbZH
-$3FlH)f$E6[Dm!`hdce'PNC'LGGPERZlXJBJ-lBI2)D+m`(HblURl2NUQ@8&R)K(
-3BQB8"9)H154kR(e2*EdUTL)eC&41JmR"mSl3"&mFXJ90PZC36i-`a+$PJ#@!K2*
-cSRSkKkm33NGUTdXPq[L8`2AP%ZVUpB+j+D`VM(m`N!#3!'UJqKQ"D3G&@3mh,C@
-Ah2BjKTBD0&2`UY*j!Lq19m(q2&h,ep9kNXPdeNr!@GKI3fkc,map'1-E2j8Pq0k
-SfX+&MDKT&i4VRL@drQl(iMU'0$R&BQUIDRC*1DLbj(%mTH85J42G-ZMd08NeS'!
-RAR%rDlPJEq&I#BBqd1eF53BKTjE*UaaSCp[X!T4'iJ,-!(#df*3q'MC!G&bUkiC
-UbjEk(!,c5LfZjFHdb5Yl'Z2rf`V1ah+P9E,X@C8%f0,G-2U&3LSR@'$-VJ$2kQ)
-(pCX-@N#*H14R46APl2QrV)NDSm'q#UX$$M!KALSk%!$bJZPHZq2X+0-Hl[J*YY3
-V[Ib5li5,IkXIpajH28V!MqbE`rjdp8XS1mRX-T@R'*UY!-Z"j"6kbq4(E'AF@mC
-RQD'G-HcB`ZbH@6L!1*)cjqDqqlYbKAJCmfhdp64C0JM"NjSf!8%$h4$)(MVfV0&
-V!lP[`SfaATe0pX)`8EM9pKHD%f3l#*eHT2505h1FUB`9VRHYfa)$lCTmb,A5N!"
-cVflG9Z'f2PpYUakAe'KmK08"'3YE2hpm(`*l1N`CCqL')kieeZ("Dq$`GfDaN5R
-jX'"c!*SR$S,E4F#!#Xbj$0qPP&G&b#AL,2BP1k3#eNLXU&kIDA#9"ThGMIAS+TH
-)r,A(ATF4jFN2`EqR#+Ec[83j0TQPb%Y8+8a-K#TQQ5,(3qBMp0)Va6#$C6D,%Rf
-LA&T$6GVMJ58NMM2PPSL,*BIUi!dCbSmSdkCQKG',h@*@(cKjm-9$5I*DqFHHef'
-@h`!+8NMfmkAL9)-eLZV2M`h)HGNdL"QFMT5h6RQE#CB5X22a-@Qd-f,$Kbfb%X[
--"*N1dpQ)1Z-J0VMiUDYJMh%c(#X,Y&$ma!D(AYB%VX"0IfAJaGS*%8(l#N6AMc"
-hI3Jb-&"+V5IK'#[`+TRJdA(#(UA%G(YL-())ZC26hljK(X00Tiq$#Sr-qNAI-Ak
-,eLTRUc8NHNAiJZY@E[E`[+UmVNCG%%A,@69CQ4qQDj&P!,qkkFch+99dk+1##6J
-4$BTE0*&AafLlR,BcSC!!I!h6Q,kbK4JQ'5E-(jBM$Lp98$K*8,@Q'N"h$&ir09e
-lGUh1eh"HN@KdffcSU,+!c"Cr8lE#8j1Jpkj*JplDX(M1LpJG,ScYGISIBhZ"YC3
-PGS08X',Le[qkpq[f`!l@Z5#+dbBURQ1PJZ')lDdF&%HpdCGE('[!MkIXCY1e$5p
-LK9[KX0jFj6qGZ4m6)KHl)+TpMK2YMGDTj@kY5[k"emBr%$'0Q@K,!bEA$cQ`"Ta
-YMD(JNpk3!"!V81ZI[DVI*h)kkKKI'fr2b0)L0ak!IE*L*PXp(J3qb[4FTk"`NJj
-PlI2`jMphA(-U[Ecc2"4Ci8bM&8&H2rXpdm"(q@(F[hU"Ah3K%4NfkS2iQMDZ(di
-)'UM1Y+9kQmVrr%-[IUTm4`*`QR$)D@5U*Me[PeV66c(IQ4S#$SHm$F`5d@rTkr"
-)f%NpK6Za'!h,M$iB*-D0@mR9l)8)4IrF6mU6XdMR#m3%Mr4&JTqT+2VGFN**D*!
-!`M@)cU[q-EYF13-QBiYI&Ll+Rl9Ql@jDmdaRIL5Te-TcpG(,KMFadB1iIDDpP(,
-Ypl"69CEeTdlK$83m0$blJIL)8eA@Qd+25FX#pS6!@6RViT("Z1qJYBDiI@,pS$D
-A)Qe*%SJ,RQJ5iqGR`e66m%QhF+LZckZlFQP9fh+P&2f!0bP%D#d!#HjCTj9+8d@
-*19SlEb[V#i8(ArXeTaIVZ!YX`TU#4cME5)VQp9,NPcaGQ-T6q&*&BX5LRRDXil%
-[2qmDf0rLbCT#meKmi&*2,i@IDhp&bf$4r#S(-c"CHXXE4!9i0#e9+*5S"me)6IA
-4+96IqNMrX%"[X0T&DDV2F13M)@[eekIT"PSLMA"EcKBeq@[EadaddGP'c'cJTK+
-pr(bk0AL68*1)'RQCB@L8(TF-R2-,kK&6"XZH3Hjh!(A@Mp!P&PPKh@(YAJqY2+D
-L4QilAH12$CD2EJm*JmcV&JPh[Hf*4U,PkR(5P`dKN4,Hh'6iY($QQP,!$NTr*`c
-)RJ%jE$c3l5VHGkC(Nc%Qhj1hE&pZ@2k5pkQb2ZAiFpN&#3mp0A,f"qUY8'['+p!
-ci863l,qqpk0q90GYpehkN!$(61Q`MPm,$PZ$l!P*ZheUl""!$a%I#5pRT,8eE0e
-85Y'FT"Q`K+T0jiYT&#08dSJe(ej'P1*(1SaC(@Xl"")#a'`ScX[B2Y9ZFZl"JZ[
-Xk&[68J0$NbNL3erd'P[j(fmVS4)+,1VNh(3UpqmPqM)mH24&4m!5(9X@I*c+aKL
-(D(pXH(df1`EIBT3U!H84!m#SU"f"pHejeAXGib"KqPY2%l$NFdCPjEYlhmk@TDH
-K5f*T"5iEc31,@IGU-j)aYZ5eTa'!GeKYFla&lhFJ``K-BFhkh5!%G"(0Y-rMJ)C
-Dal,L9$5lmb6Pa*PcHHMaq`5)@6E%mJ4Db)A-R!5hi%hJrZ0UL&)Dj@f86ZF"1LK
-T!Fb)!''0fiB$lmaRS2"pB4DHbHrj!KaG@G#2I9L&h0R)+SYa#SIMa!(bdACF%h#
-*9i60eQ-LB0UQJLFbip!#Jm+[2C9%cDK8r*))e1#(ARLIiqT8j@Bb-c+P,`e"m$H
-[,64*30Qe1Q@4Ja,Kjd!6QI`ba,!(D[EC*AMX)kQ8,LhmqkG'fRi9Bp$9S8F&bL`
-%-2PBT&E9ZIFVHfA&4MTp)E38"CqU3@"jmr1b8kL8Hf&'PbMYUYVGjl@m1rpETee
-l#ki+[-e!5kb`YIiKN!#e0"f+FDd[dI1eRLXHR$,b*Gf-%X86Bpai,K,9+4946Pj
-fTS3K$B[F4*iP-05BDZ1piL9pLTLmh5E9Gbp,5fQT%l&4[4IhK4jD$+fqh&cXV!"
-bXlCIR3d3a'YX*LicY($6!d0Qd$FAVHf!$rM024[VeAa%MLeTTG0Uh6q58V*#MSr
-r$eP0U`Gl8LmGqcbQeJj16eBK#FQ&95,KIK2ZbT[r008,!)"Y#"q[3""NB[5`Nke
-K3m+1YbjBG#aQkA0bXY!Z*l!Prp2-DAb+`El6*Xc5m$r$S2rrE&6p0l3CMFK#AKm
-,alDV"(jp8Ql0m'YkQSd6j&qLLFq0+8p99kK#)eN4L4A[$Q*5+RCSc"!&8QAZa!#
-P`"#Pl4'IM,MI,JQ'ZAA5lKq0j63NNG%Yhl31cj4JqT0e&LRcEH'bR0!KlNbr10$
-M$AjU&NkjffaH"%2f(I*0H6J',I8kq$j!TD!SibLGB[[Xb`Rq,8$8f+ZU8"6LkkH
-$pfJY#LP*UrD`35fMH,Xl#8(2mDqN8BqpATNSS--q&UZ#J2)r(*UF5#3QIKc3dEc
-J&qGd3fCYl,#i,IH3!!a8HYXk8a*cUCTb(BjpSl$Pr)h4'lE1f%6&R!h39BY0UY*
-fYh20JKNhARqIDIbIe5E*)e#2fE-%+aJ+6TN5S[bdj6+3!*MN+KY3bpLRYb5&@-R
-f%eY[*5X+biY6Q+cq1GX-@U!ZP3mMC590#a"bK9hUmCp*Sm[@)r8N2TMRD2Em9"+
-k"G0*0('-(F6@1JB#TCDjfiee3miZpB*L+RXQVMe5T!AYe5!"m[*f)iq+j$8Jp!p
-,j3@)C,ALS#bDQ2(ABFEN[lT3i'&Prl,(h3%V6*4`DYh)M"59M$-BM$3@&4`R1Nc
-(4de@@%AcmTee@Aq2!%Yh!`DeVBjX(4&5(,[AKGmiPG*pF1X23I@Dm,hq&-eZcF2
-h8K8dm59'CF`"B(N@',DRR(NSKT9bValF*RhJ0``C09m*#-,SE$2crCdU-9Fk$L$
-XREi+&['aI0PSY6pUi%M"+,Y'EUdDdlpdl9kq32b#eLM9QU"&C)6aDZURMp%VFi+
-U3D1!&l'hFBc8YeLkpNk0AdULA3NN&mUFIPV$d%`)eI8!R%1@prl4XN331ZQ$p[R
-`1D5Y)1+J`b$q`ZYIl@2il'8%#$p"m%`LFmlpI'IpCIJ%N!"j"`khR%Sq(YZ*h%q
-R(,JJS*3'M[VLl$"95**$&i[frXcdD'GAF5GT&FiV6`@*e[K%1K-E`kNVDpIDp-$
-HLJ%CFH-r")4ApD(24)`cCN[bT4dHSmM#i#p2MhKef8EG`UUIhGY0FI"Q&m!Pqhm
-K1q""Rk8%@DeNTM9"q$)+*rHEkhi0$&IEfq,5I@V8BUFaaNh'YAaKJQ4N2BaU@H+
-T!DDQbAiL`R#+Xe8XrU1B5XKQPe8*1h0HNNQ')lCkpPa,IKcUHl5k&$(H0Kc%F6j
-"I6Z8"jVYh8kA5T%Imm0#lAPY&bLeQ[`A$@9S91h$@EZ0VFNJ8[&`k1r&92VZ*0X
-rec'6T,Ylh3k!a8Vie3IJ3FF9[e5D%Xk@GT4B@9N9b%HZ8AErjKKemTN8(Ai2&c1
-JKK9$D6K`0J3@%$(80TESTGd!U*!!l-SU["qm,'F*IbK')A%)Cc*RC(RM@L!KNLi
-$q)hLRdR6@I%K*Qc"eDSf[94)ZkcI"PfEl!Db`R&4b*!!1cZ4F0-Ga%mL,SIQ41l
-60kS%6`c)a',5XjjXchiaJ$JR%+iAHD1kE#lS*8UcQ'#Re!V&%p9M"0(aq3PVi#6
-T9h0S(E+1VGE3fqAGFZ(RJ%[1SZrG#L"rPeE-9l-DL9j-kBBCIFr"3,*+l`+25!6
-q+e!CNd1bLb4HHFUe5$JAqTa1l*(9elQYj2APE`rH4aG5KU3KPIJDFF,'bT`lBm)
-!B`YHLQdJL)[edi+YqbrVeB3"B4PAZTGP9T!!8'%-4mD&Z#pc4QJ,)B+(j6,j#kR
-&22(ahMG,9$Nc$paf1M$42kXZ9VXQ)CS"Ih@fQ`f-piKGH"hAGlGMfFM-CEEfR9&
-QR9%kchMmKq'X435*!'MpZibG8hl5#Y,q3&XN`jQI2&JaE2)@Y,fF$ibhk0X`m9q
-SKXl5$dGh!XPlCbK%*Yr(546Ae&KE*@*q"ZQbJb",YDN6Xc5LfYqBBUmjLN,T$&8
-rDe`jia2[LMB2A$%,#&13!-q$H6DlmadrPqGrSj6!-#"NMA6LEQ9AQTNYQ$*E5!Z
-eS'EQG5rj$B%$B`AAi`H&DmTVl$mIZMfeD"XKN@N9jN@)hf@`MLpC`FImdf$PKpH
-D+%(S[Li6fM#A,C!!!Rb9!(8&FjllNkfC)+9KJ)#Ckj@"rXjjPSZ3!&e0FQV-%X`
-Jl-5d-h3#LZII85URY+&Fc!mLRU2qbJAEP1+DFPT%hE[SBf+JV9281b5YlSM"4Gf
-3!0A6XMhpPdV[6D$M6FQL8$BE@b$+Tdc%a"B3PmfMTq(c'RVKrX[)ai8E[J6hr#'
-k`4L#b6kqhqPRV!2@(B`dpam-Tb#!RArMLe9Z5!'$[1*b#3UXU*BT5ck86S2#1Y@
-LpUblFTh$fl+RNp*ak"m$r@&1BMY0Uf1$J`V5Q&Di!TM!kVdB1-8d8@I[GJMP66+
-Z`qVRcRjUXkF%SSKpYC(#@E6aB,19U0LARGp+"E[fIUmSPHBTpAE2DKaQrmRXj6M
-J+E,5c6-pF$G9@6$3b-h55qAi-Pb(j[T8!0Z0ZMq16@9*`5aEPJQi"9aEr!0"Ed6
-ch*!!Ra)ddFMJ1,Bf@FUP4,U#%KUN+)[-NQj6,!lC9f`i!Kkk@5EEl9I&a`)Z,Np
-1VQDRqr8p5ePe)5@CE%bfT[R8U$A9PIa(jM*9B$lB5CdfLZPaQNDL#8MYSQLUp6h
-c5TrrR0VEL3E0b1'lFlAfkR4ZrZ)2*(c%Y%T%N!"SdPXdMVI6&HEfi)FNPcQ8D,m
-KlE[2`L0DFYYCZH)Te,K6&f&f0p3qGD'8@ihZ2K$DYe2fq(8r@fS['"j(ALmJ(dk
-!kL6Z&jqaSUQMX[K1)Ic,4195T`TerF14-f%m3SL%4mM,kbihAd9SHc3!&@Ei+(V
--5LUdZkq3!%UR0qm0+lEeU%4m)4HR$r@eU51$Yd2maVKNlM&'l90k-&8$NBUd'6%
-Yh'+4rL(p9L0h)Z91rYqI*1"IBm!j[")&AlL)0DY*4jp(CMTm)p3A"'PUD4ir1C4
-,l3)cHb25c6QYT#)AhaCS2KKIl9-Amh0XCfX*dVq8@AMae&If)j-FZ"R)MFG@ZY8
-ZMJ#%DZQ``U1+E6Q)M%H54U*LCY6!4`AFV!E$FR2h4,-E4#8M2S6r1[cF,HRZ")N
-505U98k1@`-qQrU$XpHme$6UdHr'6TSX$60,,((#d!&eH#aHfT!!X$kk*Nk*ZGA'
-``&&K!"N)8[!VR!e'f*rl%DVITRAdXlp5k0'N%K`kX9L6QkGYUX)AmS5EFZ&H#Hh
-cda"`ArZ[iMdJjIVKV4fT$V*mC[8I,'&j!C,KjZ@%'Gp@mXV5r0aTPijN*c-&c4U
-3!!mFC!d*Jh,YkZ,410q$lC*kHN'cJ'CPi!Y"6+UK%05H0BE#0qQpEBKGhN,MMf0
-epR!rX*e-a1q0S6d*FNYkN!$E9lDYVB4cr`lS!X$lciC#+RT+6!'T`(f*`!RT-X8
-ePIQF8VM8``bpkCRE0UKFHC8k2r(eYVLR!@IL0eaQ+13c&S,'eeBFP2CdB"FmRqS
-c,rlVfe9V3ZPJ-5rm42ZRC)MPRCPL$@XQFl2EYEHE1D@4kBXAcSK$LJfRYZLmQ)2
-48-1"+RH!@Qe"-"3a@Z@YS&GH!11Vf+9,PYR%kL3dpElRT55YpqcYKcki!#'9JQM
-CFVFEpY$kIq3rQ8Y4fc6IfjF1ca)K4R[e0cN*!aTe3S*mrr@)qdV,DeNe3NDma9[
-@BUdLmGfl3-VKcq!")LVIP9a6#B#ChAYFilrF&'8,5KNCQM*Y(*!!(Vi"YA`4fY(
-%&EYqH,4M8XipirCQmBTmh"*+N`96hlqC`QB2A`HaeN@H)#iKa"EB4-A)VE'hmIN
-aT*JTj9kD-r*6JjCAR3"JdbJTk2pZ$2QAPYK,Sl$EPZqNLk)NmE)F!QRZQ(DV6$5
-fbfIp5cH@3B&#HLTjQQ+P3P05@%2&kiIXU,!fa&VXb)J'b-5B84C,$HFe'+C@p-I
-PIUhmI,AZ!JG6S(([EfkSJV&8#!JIIA-T(T+YU-PSE#Y9j)L@!Bi#edjZf$ZlHj!
-!A,KcSj8)BqjMSJfF,"UkI09Q+&bVB9FjSl8kpNYhRb009CNqLp[S"0cR-%lK%@a
-$H+[Ar&$J"DLB-cepY!XIN`6SiU(f1E+DYb6,FpF!NM+$GGc+XZ[(NYE[PBC@Cb%
-VK+MQeU"#f5$5h0pJ$A1H``jSBpe,cDp9AKk4Ja5i(icj6Gb9pc3r0bVY&*60U1X
-4(!%',+lIAAp(0#FT@CkM#l+Z[ULcAq!6`cEerEQF-lPJ)q62*%rBDUTZCK&RERL
-GCd!0)e%6bYYm4fPC&6fa&&FIdU$j+D`(3Y5Fj#cV$P[1$D#(hFajb&mjeXrRp3d
-LUS+c"XUiGXTCd-ed&ATjd&fM6MX3q$1%fBTDG%M%D9ZAc90&plhGQR"l2XVZB*h
-5*@4R`UaLHlpYqSD&N9ralPE*JGZ89D"3P-#UpVjEPIcT)E-8p-(i)r28bqc4dGQ
-UCSFm1%eJ-0,a""LAp([kVfifk&q,bHMF[`hN&q,bA&im4Arme5eMX'aNfDPY"8$
-mh4K$IZ+!2KHa1`XDIk@c,hf(T[0I%FQ"R(68DPUU$Q[%"SHLUl[rQk9eMe01GX8
-Q#q[h2qXYA@K6"0AZdNpSLUl5LN+h-#S@C2FM[-'2'Se-lCHZQd'FT@NkGl2pZhf
-JDXbJ20JGPqeSP&#C)c4@22KI[eS-+)SI`bK8DY[+"`AFBhjB95mYjBZci!J"[*b
-,AGlehRpL%TB"Ap4*B3f,-PjPeq3Jr5ljl)Z8J9Nr)p2#H[NS$(F4Mb[eR9eZL+'
-j2%%DHCEK)4"Qje6)LaX#BDp0J'-"A[B96eIr4L%1LAL48rS4F(2PPq8b3,J2E!C
-EEf'df!(%DKehIQa&V`#PN!3"!!!m!!#dSF5TYA@&A`!!6S`!!+V+!*!$FJ!-q(d
-!!V*0!!!QT3#3"!m!9'0X8fKPE'ac,Xq!!!#(`de08(*$9dP&!3$rN!3!N!U!!*!
-(3X(8XS-3Ul8c6l2[hhpr1D-X0LT@X5M[fqqi+1$$(ap3lJaVD$,,D&S[M+MafqH
-q8+51NM(PIc8LBbY32kLpUI3'm2)5apJ,lN%i4SJ,#&6F@pI",iq)M4m9A(1rp6J
-YP[',HCqNqAm`peQA3+Y6BI`G4R-EC'Z#G64i(L3-Ip&'[")PC"&V8-&cie9q`bU
-QVq#)fP)i1",AYci(3FqNV581&!H"qR03M1L86,Fj(CL"PUj#%PJe)GB$,)e(LJQ
-4MP@VaEelAf@c4NM"ccNNdrRS5r"b-USr`5,r,G8K%dkFT'T!%h2Shf5G8XGiKNh
-C*q)r`&qeC[&Lir#3!0Y#akVAh'[XdB+RX9F&ZdFaCkqIKEVfm$F0CmbIH6!qXpr
-C'T1l&S+3!)+Irqi0&2Rp'LB!Q2(rSrVJBk*h'(*91QREq8eAHpU)*M@KKYl-2#6
-@(Pd0M9SbUBJiiX`a[[Q,$Ec012i!CLd0qcY[ETlm)[ikaFLQ5R&S5XC9(bKk2DZ
-NU*e+m(qIP*RIJAX*UNjC`fRDb#4L3I+"B-#4MKjjQP*b-r*YF9j)Ybma5%FmY'N
-YiYm@KT0k-2"CI,FHR*'%9m*pcE9-[%C"aMIG$dBI26$Gd+!SS10TGYY+MF8H&D2
-1FE*12VQSE5`AeJ(ULF'hRX+*[$!UHXM1lYN26-2@M[8YedMkf!eTi6R`@8Yc#[X
-ST-3CbmNQL6(&ij4b+UQZ@$RZY1hD$ReiEIKM"``(#Gl$5Sj6P)#(ecT+%*PHS6!
-3DfCDA)4@lB(ecda1GMAIIA3%3db`%%A[9"FBV-jiF@T0IM%eFDa-XIVd"3dpk0,
-Ch)rKRar8iJ)EpCbP0&0CFB0pliFi$&X2@Ql!UU0UcmAc-E,@cf-6ZUYdid3"S56
-BdXMH8JH5b)MSlI1A*I6q9MY(M09Ui&V+LU,U9pDf!EFEr0!qemcNfB,[0##MG@M
-rJfrjKi3TR*9GT@,Xq#%Yh6m4IKLpC[%,fV*fCPE+Hi(2Rpl6kJNB%HiIXRCA!4&
-YGH0,0i##4)'qQDHhhQ)j,)TGN!#HIAURGSH+0*q`6)5h'emdcUhU"EFlSUdlr%)
-bpI!1GSIqR[VMh!Sa+M6kkUpj6A4RI-Hkf&[h!D!kF,M25N!BTI[Tj)b%T+b+#6$
-5'13Si4dhfpRG0(JcXF&8Jim!AH9mMJ9&RKp5aZ+lb,8`)ip')&ra+PpD!`4&-Yd
-4p!Y2dPmE#2,EB-*jm"DQ6GAJVbk4U!BDDYe4*-UqCNAX8IJNU1`3`lhpYq(d,Mi
-#[B[6fTfB$NfLi-*TFkcIGM*GpVr6A[hZ,b!Db,jli6irXSf54mKVhGfqES5Ed%P
-["3%N@L'0lY(Z#NX@3)P5(PSfJ1$+0kAXmC4UZ22N0L%[VUbHrrdK-Im!"HLB'j6
-l,CJH$1SC@"8jX1CKUJq`N!!rDJMY(U8#DFGe99@-2j!!#bRBETSilA+hY&AM6Aa
-K9kj6j&+hp1PVf`5,6T'd'eC1[$&[9D33@b*h,Z1e%L+,'cm,8C&5AJl![-PFPJi
-L!06IA4G01Xf"ri!IV5BHElK#+,I)`XLH!(`a%#Ri#0Q@2Ff0JH3I&3m5@I`i*MU
-f"-X@EQMLK4TA41q-qmNFaadJS4*Y(4JP)ped"JL(B"U65$!Q(RUEZrPh9hS[ALL
-N'`r`+)4)N!$RN8pr)&rB9YXj$K&NYHV(b(Rfa8[YY`kJ5+&m1ZJbie`b6N)VKpQ
-fP0Z2[YCDHXmJ@PNH%0D2E8D@m(5X#-Z)R#5qeK@R0Ji[`5VfBdYR3+IlH3&m4fF
-BIBEQlk@CD2@XM0el0-YN[$%-8+THTH0$FMj#p@4"!G+Eq(N&e2#m3ZRNJ',Rfar
-aIkb(9#U$lfT[IEVd*$V!&BCUZjEef6(r@+ALDA[Y2qlX#XTDrkR)FCB)2YX,G5,
-E3flmh9q[3'[cTiliT3c8(@jPi66c*)rKBL`LCTfe$hl0!2`c1VZ@(4mdNre+2%V
-pl#[2e`bi%@qSIZ,$MZ+SU%2CMX$#@dU!dFbSfik23V9XDfc-q2G&Jja8p`dG908
-IB5(-1ar3hNi@X"GFmY!U05c,'`&ER62@em9pN!#6"lG0f5bdjQ'j5c)1b+4CXXb
-,0[(XqV"&[E3'Y2X15q`%$"lAfG)$&J+)4!mk(ARde[*68DrI)cbIJ,IP*C0P8I!
-#JSGjbpbH5d$bIZT96VLBb"9C*fGK11JTN!"0KE'HJI9lYc-6B[LG!c&,ihCpLHR
-B[T,AiJ*p9a691fpV8[EYYjYSrEcifDY5dD0+%QKcCk@mG%hf03j+Xj[#@U"9+Fc
-qY9)qP%2Fr*p2(Ra5NK`RkN#k+-B!Uf)FfY+`F,!bfcJ`PMNfMDRm#f6Mki@ZKM)
-T!JmTHH-BHKbVhlNB#J$ReKAK,%$HPQ+2"SB'VMDqF!)@SmhAdXc#NP`HZ3D0eI)
-iRNkpJq4*l-RKe2H&'K*b'Z8V4m#5caS24T5R0&6b[$'$,B`%!cUVTfSc`A@l)4i
-KT,X0b((-*BH"kSLFLjT#pDEMU[U5f0Dkj,b4Dd-rK!`5h$l*HXTrkc*$P0*DcI4
-qqeR#`KXN06P`Pq99#c+jKUdEPZ,,DE%8$m-PVi,kNBdSc()CE$ceafXTiHqEReQ
-MT!TB4Di0YZTjXEkK)*%AUqdd'aN&X5f`3UT58326Gb%(i))RAM-%S&,CUVGr+$K
-R!P-Xeb8-jRAS@N9alCmXKP,*6TM@+#8!RlBB6"@p$1eAce'+pI'r3"#hjm2LVLe
-J6Gh[dXV-V3J!MXTQqLG,EdE3!iRIQY+PZc5PNUZZVbZ"m@a+8M#'AB8ALE$4,,D
--ScZ#IQacj%-6%1V%Mp5!%hKI8MlNaK"ajF#%e8`59S#D`T8KKbM'*fhYe"$ZSN%
-CjiCk*hlN"+%4#2TXB&9V+KRefD*)Kc%J$&,KH2&j#pNVk,M*i0Ep#ZdF9#ENplr
-G*mrdR-ajVSJZUm-1I,*X-@6bM!ZEE-#p4A9QG1NC#ffqmZ*I(,`03'0D04malXj
-m$I-l1`T1jaQTrHh[d&D4,!a"ahUeUl1@%dA-,jfC!ldNaU#LHRTU+q+-8#mX(X!
-H"mR2BHqFb"3Fh!`TGP9c9`VLj&@+++He+KR6!BK(I-$81aSMG*9RIF153bJ-Je3
-(9J2Y,Bde4mG!f)2bkplYMXqi&iIA-R'VYC!!"(VaHF0DA[$$QfHI!-2B+3hR%5[
-IFh9",qEXX[Vq4$PY#jkN2kDaTF8j6!8T[5#QMV8"A$21aU1DfTLZmX$-L'%TYiA
-G5U#D)4-K!5VLdNVLa,iPc6+dabV!"-F95D9ElKi(R9%Q#[b)Ek%epl)hGQ"r-5@
-rj-ebX'F-+$QXC4FCUjf[&VVE'Zrdf*fB41INKR1IcF!)"r%'@[4GjEFH%+Aa*F6
-f,i!P9'-j$`S$me`LlBR%`MFkK%aCa&KrSDqfm5iNpG)jGIIBb"!*USCf#$4Q2D3
-ZpZ1e@`*Dbp*C6pAar-h1H(P4C+V[V"TM,&#`X1`U@R@FH+KR`%!ZNES[Yi)laPa
-rpmUDG3%jbMc)cd3G'aF2)K2`eEJhUH[P+AX9REmI-@QC$lF&P%fQUK,-$Pji+#@
-AV,Pa(IRPb8,aUJ6EhLDKi!-,aV2Ur2HB"@[d&Mdla,Edd1*Hbj3bbUB0V22aHCF
-6SK0MENPpL9Nl&1lB'TJr3jC3&%pqU5&c[[@Zpm2I"(QD1'dEdJI@e63AG6#MZ&9
-iBRa+ceBHa5028rKUC+,Z4Bhq#X-[Ghb@KMa-2P@CY9iK#&*9rK+GK1jbrTiC,FP
-dJ-428V@qjZ4`*J(,hYHaj&Uj"cr9@d3pQ5)4QABNEG5)Rf`FI`(6j`%CLbV69L)
-+HIEcLKmJMYEG#SJ0D`eV+dS8)i@FXpJ'TSZ*$3U3!!`%5q-bi[k"rU`RqAkHFZQ
-(IqQEepdR`+hPiI#@*aZf`((9QYeD+lN0k*D```06Kl1&QT,&VkC-XIb$phdLf&X
-'MabJ%l-B9jI,eMQh[+Ijj*XN)3!2CI+!QaQ3!'iFD$UAl[JC&RPlR6%!"Aq43fF
-NQZfZ(p*dP6Kp$0PETkS-Gh[%Y&9cKUH@b)+J,G@[[Zhi@B"Y`Nd!k$R'fV'T(R1
-&SQBA+0KRA`!cPrK5f$4%QQBFjBbY,'e1@LdpQ,@-eQLRcKZHGQcXf3Kc[+ASeC!
-!S``'Xl$m9DS9[2rADH3,hTYQ$4d5)1'M%#)XqZT'5#$&24+b2+`86GTq5%3U3,#
--#KP+UiB%!6NdRjS)V8IEK'8hE94EMLfKa+e"RKS!IEk$5S+kHKJCE3TMYT!!SXm
-f$+Y&1FFXA%mpq!jElFS1@VX(V"@@`"R"A1lRMT99Z@U)X#FeRlPSA8!D-aXQ6JT
-ec`p'kmSBYXC`1[)@pJ5G(l5$bUc`$(X69GilRM"SPBJJiFh"U6k`5kj&F3Zi+PP
-TbA8pPXUbB*962kkMq(!(fe2,IM[A3eVlEcQf@Y,3P6lURC4LQ"h#jjj3(8C[9US
-GCAIq`TSEX'f&ZK46+HHI8-1dX@MI836)HicB9eFL$GeEJ[HEQ3GmV8J22Kip1V+
-ME+jKfhA9U8-`i15J0#!Tj9XYX#eIa4ha1*aKU09ALXC3$44@qJE&NL'jkTjfU82
-m4h3G!N!kLYfE5+k9MMFKk'a+1JJhHcMA"Q4KEJGB*QdBVDVpfV9Jd$6`U5UG--c
-["*@PekDqL$Dj5@3*4(GacL(e4VGmDY8P#F)rXPRf&0d`55dMlU2hK+b0lcX*%qa
-(2!h#5ATbiUAA@Em5pBI1Z0ZAA[l54cX3XFKDUQB[ZK&2XJh58DQVcBBFXT*m(J(
-5*SeE&HcjMIN!lf13!+K9%Rc2I"XNrGF8`Rm`Q[MF-djj9,EVqqH8'K!2,4me6!D
-@m2NJk+bi-rCp5keb%*i@bXl`cjb%4f%E(k@9IB8l&F'`ed-"$(q3!&Y@G(kkQ*k
-`fY5bU*1!X%k9X,kkApZVVk9,r9YhpkUmiBPDNT[`e+fMD6THEQF3P0T@N80FihE
-2iYTG%E0PkcdHSfmYNh*kXjeGR2ZRfBNR1[qkC99A[1F%k0UJXF4-+CFU'['LQSL
-(q"[i`Y`FZ4j5'6D-FeDE`SNA1mrjf1UiKHYI%Vbp'-9p)hN+CUK1BqQ('XNhCBQ
-2Uf'E'VVq6@H0fTN#Te%3VlJ0E"b(QUaQPMIdacrVp$VYb#h*5-Ned"13!!@R`HQ
-5rNpB#De458P8B,Kcdj,l&+VHTBLBK5NL6`(h%6NT,!di6GP[-#Cj*G@ClMiXI1i
-,2f)%SULEfaSRmDa2*$R@8$IFbB*+*Q$mXCG*dp)E0`R%jJiX-P-9DC,+lVLmLEM
-TPaN0bGjXjHJ`f8[Z"FFGq*UaV+-GpadfCl'0"J%Jm[&"l-a`eZ&mB3B'TImNUdK
-i3+0qdEjlS-M`2JBdq9([PaB@p3[T3&S%HL[+)10Cr-b!D9iYQGI[%e&lVcJifS(
-bN!!C`9q)HREHdePjK4+r0%9J[&eMjj0&M4E[HFD`lcaZJpUIKUZ"@X9JE@#rqF9
-Ih,`%@!i$kYerM)IK'Ebb1H+2-Dm!VCNBMNL0ddP[`(BD'83&dN0Ur0&HZG[Vaab
-M1+HFj+SifLR8+8V1iG"iYd(LfqR$k!ATE#XZ-Q"$#6@kfc!C(2DaHp+6Cmm[*qT
-Zie-6BB9mL`Gi(TKPZjI-rS'YM9`Q"%[KjKrb9),X)YZ+GBJ[SQ3@rbpLS@l0-6J
-jcYZfF2DTFCQKJS[BGjbRF#P4c%Y2VEZfbI!126PQ)Z-2`II5)ah58a!M'(*Uc"L
-0Z$`lLZU"kY9a`Tm,3I@Ze6J@p-dTYfhTK@!5!PEpGMX0!3d0Cb`*H4$Jh68q*rT
-%CbfSjR5T,DV"f"Qr"K+*XCEcX8EZLZ`&48r(e[54-5')bF6cac$Fqc)*aap3!C-
-6"$IA+lE#rBHq&RRblKp2*@03R-QH*V9j,pV(IR4Ja!pj2eEbfP-rFSd'epjk0CU
-LX4(X,'6LZpF0jbaQ,P)jDPLjYHV"5FjU6+Y%FlT!+@bAN5K-ApHjKq3RcdIC5aI
-D8h'qK2ID%"-[T4,-+Jir%eUSRIUZ&J%aTMAEJ02RTM&)DB1T1kMl[RZ&*fch!LF
-l!p3&eC8k@2iYHpbJ635rVZhqBafRZa[@0CBl6+GmC`[l+GTThh'mkck81e$6Ab`
-CTE@6%3ZScJ5kK+3S$1lmIcf8UL8DS1LVF6RGF9ZN$Kp$YqVaL(1!Ih-T5TkGUPZ
-44jRKaNU92(Fhp,4TVpq"1VdP"U92%)RX*2(TQ"D@%m*KA[`2H3MjD+)Cl*IQT-j
-!aUc!C!L&X23N#R&(-0A*BmSL@d1NT!+'pkq'XQ0H#NIRSc3DQ@"1mL,#1HDiRac
-"b'#qH81B*SG58"Q8hTT&-,@H@FmLd`3+2Tb[+2LjFQA)d(UXhaDr2@B`2LeSGb5
-p#6M!j3FekH&a3ZJ)V6fIDT!!bD6PqJI'alT*0mT*T[2N*F3K(TdYMK5(H,%(-Ef
-qiq6R$FAc,)M8JaEI3Xrh1#I@'48m$MR&$DURplIcrl+GM66HZb[C'2qQTl$iXUr
-bULmSR"rKi+$j[p#F5455`2P&pTSqpd&cm!K`Z@6DX4qb)J@QR[P"T(3jfmfUki3
-,V"MPKhqb1CDI4[e`9S4eZ-LkRPN(qq+pI0q$0KJb%cf`-N,Ahl$!r'`LeST0b3[
-ZX*b(+qD#)+eHp+QfDN,4CSi1dd$+3lUSLQ&XfLX8ECjrdh[X90Cm*5QX&8"2fQ)
-hYq,96ELP6FjlBE,,mVhL(XM`B"I2B8K&Kl[V!-e&mkZZ''6JCRCcV`BY6UY,0kN
-(I+U(JcRCZ!$iqEq$4Jf+m'cQ-`l-*e4*@bp-80kHJkQ[KKf@K0V$+a9(KcH$ad&
-e!QrkR1,ImXm*"mMUflpj9GFl!S&N,VCK!ZFb*ec1Q&+aRH3XpC!!f'J0i3'HLQH
-*beT(F+UC%#AC*52GE,kY6rIaKjSV'+-PVT1`PhG)j9Gc3#cIBBXk*A!SbI1Q*pP
-ch*X510bZ"D%G(%dG!q422G)d$l,GCBP$r6r`'hc'ihAmeI*`XPF&cPUBdBEY@lK
-+TGHGLD@6Q,5k#9[X"QBrQ4DI$fSadI2eQ1QHk`NN9Y'[KK9T(FP1PeE-i'HNQq#
-XH*S&dlDVc4b8a65RQ2$1Lbfd9phe2)UeE&jVdG0JUR-5K61)i"DmfG(Mjq'aiK-
-@eEfEG'+4a6eJ8K%@i#p#(&Fkm2VEYQ#&iQJpbIcb[Skq8rld62QDN@ZdUq*'ZCe
-B#Zh60Ta#*PqKj)i1rQa&Z20'XH'%E5ejTBUlpT6F2)E[TGiqQ'U5`c#fEXHe2k+
-4PPbjccVk'lRH6!5U2jQhHQLD(2Lr1FPr@jXDUE$ZN!$(hM2dDT@IbB,3H,&j,*e
-QM$-$KT[H0rD[4hKYI)YK!9'Xm,UJIE2lJJ&$SpF"HUHp0eBmRi)[Qi)q%l(8JUh
-T0j-AP,*H-,-'I9G5d35!k,QTjrdj!XVB%CBqHcp2YB+66&(f`3),Uf'f)Tb"0V"
-T-IN)Y%ANT'EV-'JK*LQkdCm2ID6fDhm)[Q+L*48K,+L@I1iJLDrdZ*Q@%p`Z!8)
-@X24G2)bBmdPE[mS[C[`'$U*dT8,k+If$N!!Kj#CdUV6jBY'QP$R88Va1NND1aQU
-erX&R,a8jE54c+I(,D#pYrb!kFk02SEhaTqS$9m#REG&Z1G5,90RN2kJMaB+@lq+
-dE**+IbUf4JUpc20TM9r(KP)Gph1"XBGdQe'qFcC10EI56(&ZY-j5+#Z"@imq`9+
-@eU1kqe!8Jch,[Ej0FDaMekii`qqh$kX'hb,BLd8EaPkl0CU@fF)@+,V`NL#3!$M
-@fd+ZmJl,c$Ma4kfVK!Mh(CQC)cm,9KPU6!kLFdF20FUQ4Uf,2$12App914$cLDe
-['5GYmAD8"TF(M5(I9'he-Qli0PreG1B*DJCjT%kBCC-'M`%MhqB"XfUeD'1e9!C
-8M66kK,3"LYp[Y-Hr44qERHUkCJepVK!Zf3RjcFi3fS3!f'A43+PCkAi)%J'kYrN
-9HdcYb"+J'2L&k3*X[kZflB1jB1Y3FlkZhQ9(@b$Gq5!L,Ja3[e2j#DCrHMZr'E,
-Z@Jr0lHeplU9pB&52hT(fr0%c8'Kl@afc"-aQ!@)%bN4%lC-*-CKPKi,5mLBcI9m
-`5l(%IRq#1*(&`1cpRc-%NX6A5S6Fa*SkhEVdi2GrTZ&9F25p+FV1V!8"(I"AjPD
-iD&alTPYPZ,pf(P)-(4eC01q%rPcZ2qhPDecelTEj%'N3CM"b6EIbBh@*$QIZ-,U
-p85,e4#KJfApS3kAKp+#AIrfq[(VDI5X1rM1B4LI4*r3@)lGUFpING6Uk(X68+qr
-Y)a-Y9C(K[AlhIe&,eM%mBI)FGR8"@b8b0@9'QKD&2i`[&&1`VLb@LQ"$(k@CjH6
-9Y-XLf'e!lb&Fj,@8$ARmM+bV*+0*K!PEqrS3&NY"+80kcmKPS`B`E"9Ir8G#pV#
-)VImeUB&1TRPmP"9#MIAp-a"b"IB8M1hl"8S@AhCRR`S0TMr[GN!ZC1V[*krSaM0
-GX'U`@0'0BlP4@4%)LR4EQNej%)Z!QAHBMqiD%S@UhZVL59ib8&%ikYh+5eX%aT8
-ELqiVl)4pP&Bd%E%qR)F)NSTEPflS++Vrq*R03YE0R`l@%9&b1AC0bRpa(ar%+%Q
-*&-bqhFcpb'0N[mZ&V$h5Ym--RQle&AF*SQI!p49UL9+114L&*912bPcHic*)5G"
-LVbcE)A%GLU5!pKM`60U-J!p%%92Hd+X14,-Ma%CqhLG&P6mI,HHN(M$Q%BQGB(+
-1)&m'`Z`,JLA'2V10I-A'lCNp+G-KjhV9,33++l#)1*Ge$Ufd"bkBc`Ur[*8kT#2
-"QheJpYF%[4Jcp%JaUdIYPA,#2$8%FCb*NI-Gk&"#+9M+r[he4N46U4BfdYb8L#H
-4r%Sf6kjeG#+lA+DMVcmAkQK6a[#49@a8iE"N+&FMP`8qd((3aB(Y&`jqrFQ!18I
-HcAd`Z9-()'kila'URI+Ylc%,'F4T8Jq$+YG+Y'42)je[6)hr893Imc)CcHVA'3M
-QBP1XV#Ab[-G!rI*8&h2HPR2ZUFLcSRk2[bfb[RNYS[Yd828@T09,1+E(h-jk5qT
-CIDIme$hCq$[A'C!!N`rE$pc$UTVc#jXZPiH$HI*T%lJjQH(2irlC+"UNE@*NXSq
-UehqmYi1jRbehIGF"+CS5N[QjHU9c8PT[$LEY,ESrJqKDl&,K1d4KjLhLS@-MQ)-
-mL)mUTm6KRB25`XH4i5!e4j+Ml%%-AZm9FhCC,Kq)dP[KJ(!P6*kdeSSl-RX0dB0
-I[X*r$eJ+)jCiPR*YRMpXBDaa2e[jTN4'SP*U(K499GG"'FjCrS-9rl*)[4$8[@e
-bk!+SVS#*%%XiM,hZ8N&dU0f*0T-"GX(fhEZjP[99qbbPQR,M[[bcrkEMeE&'UpV
-3X@EF)I5jEbfH5e,3EUKqK((LJRhF1h@c,$ZdHN,IU1lLr(*f0L$M`1kHB%a3Jd+
-cb)Z0iCHV2iLDTU%VpL2415GMQbGMl(Nm&!3NYDNjP)MrQ9h-C'HG'6H'aUl2cLN
-T9(X@K,TN,K5(9N`ir-X[V8KFjIKL&`$L$*H5BAQjc1'f"`&R`2TdpS8K@6TERNQ
-lVDc)idY*4K-hPieA1mlll#C8jeTe9rjKUQK3j!3&56,N"X5ZU6aRiC4qk"QXAN0
--KT4XA0[FUiA3-@2#dP[dfN53!#GGP,hTEp6'QF3Rl5'M'P5lbHJ'II!9ZNJ,Y@e
-I*U`@0B428YYmXhTJVm5!B6%NI%c"Gb8V9i@*#03bN!#1!jSPNA@Y2$`H"ZTD03C
-IN!#q!G5j'FfXK5YM2CYBYE'NF-4&-9'1'*ElJj5Ti#c5+lRJ6+fa$l3LeNiZ2mR
-I%r*dmQ[Vq(%-khApZlfmr)'H2,ZK0Y3brFAESj08(KB6[)eTecc$rZ#'m'`FiHa
-`H69Lm0mFka[GQlj(PRHU3-A%jDf24U1lA,2N#"ULZ"1QM@URaiQcl4CZNCAD`@m
-6(eL0qqllqS@[mdT0ASUYkB!q4"hrR5Zm%)a!56KpZCa1-(m`*VR1'JNUS6i3L(e
-qEaS4daiQ#IJJh!'6ScD8S$`*cM@`@RjDP`E,eLbB'pjdXUcRdKB31Xjdbb9BY0K
-CXZ)mk3pP6Ae,L*5QMR`hTH4)j46rT93H,"d[MkS41I+jed5ZVR2Zh9I$'BJ%$dk
-*Y[`APLPqG)GD-Hqk6+J!X[E&)*ZA3SLpUi"096I*"JCEGfk[[QfNN!$,C%JcCTl
-3B4[rX&ZXHU`@aNqRdXqalei,iePRB4KXa#`6[['(D0"A-I(21K@(JGiTT'5099@
-q3,pE4A,JZ*!!&UMFXV&U%-(5-`Id,6+2pCD&#$p1UkQ9+0+-bQR@38MVR`DBFPQ
-L#k1YQlqjqI1&9kMBGK9(Sb-iRU-aF'EH*F%mm#L$FJ,)ah5$Dl5,6kKa-9,3B!5
-XT&I+aN@L#!b!&Z,ebi`DSZ3*C"SYrU[qPr8R#h"LqE3T+H+mi!6"fIfL2Rqq$HU
-c,mr(pbYeGKS&0CJ!3c$N*a*G5ENTU3@YSBeR3D#1af'!6"i92S1JSKB2l0Y!J0"
-L1BD`%e2K"(jXXdGE'd[NfS"SD*cC3[(ErbA9U2#++3c+R*!!5hZ3!$b@4P`rCJG
-%JrCC#ZKBjCV--"-N5286'J9YB"Gb'Jc`DNL#8cEk")E(P8fqP-e-aSjSaZYJDZc
-%1RQk,Tal`94F"r2'K%df4ZN'(AQT1+)ap&*r$qkfcHLp(Qak!Zf$$S9!8r%1&Bc
-UPrhh#LADrQH%"2AQFE'HVM5dpclFJ*IAGD&GjHd6-8)f9r"Y"ci2FPL"VZD-,pf
-S%iiHA``L'94`G0-F'%!eMZRZJTqU'behrp`YA8UAGSRTqrhA+X1X-38S13dI%K`
-0)ErAm-0PPT,BaRQSFAZLqiXZe2%3P)a%[X"8haciA-qAAia(+B,,#qPC$HeBVHm
-R,+4I!YG5F3eFdEiA88Hf1V,CArKU+"%bADp3EXY*B*ed4cF(`kl1h(&D@e5qVrB
-G4ikkUi6dfUeSL6E'K$,YjE!K-0lX6FqJ0Va64fLXCA!ReaiN0[%a*'@[,la(KVT
-adiNM+q(KC*!!``*5E6,2aVrC[2SUG1$)eJB[pPPlBca42eL+arNTdahXTqY5#eL
-ie-k(C-iN*,ijZ4G#miah2lLjU*DSF`9QAAqX$r1ZjJ)KASYVah-Mc150)9%VVUa
-ZVk`$62AkZ!T3jfl`h%f$"VLhU6%D9mL*aG#k)rK5jr*mNhUrV)k0[p!CYBGC580
-5QV63S`p[Mjbl$MIS"V&aY!5aUV[r@cCq8Tc6(`*0Bl'0'FG*%bcJD+9M"LZbl3C
-,K3[Y"ppSNp,6M%@dSP[[V6'1$AqQ+fU9Pl(E-R9B&qjqS'9Q,@dbLD[-`T`jD$K
-l5kUJ4jihmUSPcSfZ3qDNq5Dqe5#Q5eV1#"LVDT3ZdYIBr5MrqCYd%CKF&T%!lA,
-fMN[IX53PmfGddI4QKj1JAmI,b6G0iCff&kTp-F@ir%f&qI6`!p$Q(qmLJcFQYLk
-Vc-d')dePeJ#HjCNEC,Br4pI5de5K5EeHB,ADYK@6L$!pmHjILZ",0e[S(D+E4'c
-`#k`"Hh&9leL$I([2XJQK%r-TQJUlSIPFiLqTIaPRNC8HTHR3jM2)4c*&V!EZRUl
-D@-)jXP@LMB6L[)Rd3k[A82PQkKhkXb"Ce,dA9lHc9[6Sk4SbqRIE5Bj$!la"-dl
-$#IqfAirqhZeaahj$ah[PE8%bSrmLNlbb55-d`IaLHU*h&ecaVkKY*l"*-H%Z6Bk
-[VZ-&!a'"#+UQIljG8DaCYEL6`md%CF0%,cDIeQ[+#D%-BA@iLVF0&KN)*TX#6mq
-,"4UpIVG@dIHiHAcHQBF(CrZG[NdHj&51Ca3PCEiSR&'(iiHKpI#ZcJLEp3SD@S1
-3!"Q9FHY(aI"#k"TCf1ED$ll`"C8-iZ0E%p&8lFCp68e5A#imi68-daa,l8j,fPS
-V6F&C5"d*)2P+F3AlFb'c35Ejc`D#22&,$TJ6p&m+l6Deh@ChA,ZfEU'pbJaMh,k
-Hp,Fa)20af[q0%0k0)YBI$k-Hb49I%,JLb4A-Nb-E&SaT,r***+hP4+a`B+[4i+l
-"kqZqkQhEpkHI1@M-J@SlfG5L4d[F`P4F4XXRLLN6H'dTfrfUI5VBN!#5`PYhY4C
-e9ia,6IDUQFk1BrX12iJ%EV`LlU%%6hH19qh6HbEAPBQ(B*a),SGkZ0RI&VQBb%S
-H$GeBfcPMj+Ud2@k3!2ja@dAeYAMp`TYR*+G`5ZCiqpK+E8XNA"LSEbQ&-MXPAlX
-V6mlfhq8C2AA%E3KCRLmVHiN@eEU`%q*3HRh(RVTDARe$FmQFIRASZS#C[(I(Ulm
-5KA1FM&e$Khp%GSe%RXmBERH8+P)[C'@f[pTXC322lKKE8eRL,q4,m2Rk-ZN0+c3
-LIGQA6#[AI3BCL*`iYmSFJ@D`(V8K8IS(iCAK)%QS01lepcMk(X#$BKN#-I3A9KB
-dI6SV"[E*Qc*qCb[Dl9p5pkAd+CrejMJ4cM0@l-BX0HdV&FT4#r,2*hIYc$YkaH`
-LC2Hk8DIl+!c5UXK-Apf9HQ5KB,$KSF24iG1j)%cP5V30`BQdq*NUDS(A,9!#G3T
-*&jlNrd-F#el1D`5''M(,ilFV@%dRLH$INr)H*d*k+XZkQBa)8qeG4#UA#!h&&jp
-EB*aRfhJMUJ!5qI%`80G6AeDBj(Z`R-1A"UkF&fYlZeH6,lL5ZAbJ+Mf@*0)faQ%
-c*35T@TlraBNUERpe8U4Mrbbi(c&eV'8`UmcT)jV'8f-(T,2N6l`pE&Nk+BP9SkU
-rpd0S,[FE!2CR`aciSSMQLTVq%Q[r4*RHCX8TeVNfk`+Fem6l6$I1Z5ThA%59bCk
-6f8F&LQ344d6f9#i99)YJprqB@*YBC#bFmTM5P6q[68LpK"'k1#V2[KcVj5-5mHL
-)4F2bSK`Q"Q)e0A3-Qi4#U'`4HAAbMGJhja%pZCZKd#d$8YDp%k)dK65)A*!!1@(
-'+ffNUKQP"MpJaqJlVf4AP`GCTcTeS30KQTrTDPV0eN*GpCTQ%Gr9q)%J)Vha(%Y
-kSIeQG6%@N!!Pf3irph4B(rL-HE2U`I#@UEI4jcG#4Xe,@P4+6KE"#,3qejI@-if
-qVjVRi$1Af6IUE3#PF9pMpj56LJAQShSPTQ)riA0I*,9%AZfRh1#&&%X[414Ud*B
--jfq4Ab-mmdP5qe)j*FJ3R3'`X"$N"+APQi2(bHG@FHVNP)e,8(DG'`#PN!3"!!!
-`!%!!N!U$a3#3"h)!!(*Srj!%!*!+3b%!!!%!!!'3!,F!!Bqh!!!%@!#3mh`!!3#
-3"@N!B`"p!*m%!Np,!*!(23"J!21)A&4SCA*P)'Pc)'j[G#"PEQpeCfJJFQp[E5"
-[EL$5AM$6)(4[)'0[ER4TER9P)&9Z8h4eCQCTEQFZ)#""EL"KC'4TG'P[EQ&X)&i
-a)'*jG'9c)'&bC5"ZC@9NC@3Z!*!$8J!"!*!&E3"Q!)%!SJ3#6dX!N!8%!%J!C`%
-$L$*6Eh*bH5`JBR9d)'%JC'PcDb"bC@aKG'9N)'9bFQpb)#KH-#NJD'&c)'pMBh9
-bFQ9N,J#3!d`!!J#3"6%!C`"&!+d%"&&eDA3!N!8+!&!!(!%3L"T9EP0dG@CQD@j
-R)(GKFb"cG@0MCA0cCR9X)3#3"3J!$J!S!#kJ!J!"!*!$I8&%3e)$!!"q$9-+Ni3
-"Sfd!l!Yb!l5b-LXVieY0hP[[D[HQELEAJ$%!3!-!N!1kY3b!!!PT+[lJ!985,2Y
-+b&X1iq9cZS94MV)rcirrVL!j0k`Dq"(+KM9jKQ+MCf[`V&ir"HlX#m#`U3BL1%a
-A2VhVbkfM'32&(&P,'cJ,!*!$@J!"!*!&A3"`!(%!V!3#6dX!N!G+!&8"%iJk8fp
-bFRNZ)#"*ER0dB@aXBA4TEfiJBf&Z)'pZE(NJBQ8JF'9bCQpbE@9N)'pZ)%K'8b"
-fEfaeE@9c,J#3!fi!!3#3"@J!HJ"m!,B%!Np,!*!(5!"H!5@)6P0[E@8JDA4PEA-
-JGf9bC5"cDfP`F'9N)'*PBf&eFf8JG'KPH5"KFQ8JEQpd)(0eF("[FR4PC#"LH5"
-dD'Pc)(0PE'BYCAKdFQ&MG'pb,J#3!eS!!3#3"9d!F!"a!+`%!Np,!*!(5J"9!41
-)1P4SC5"QD@aP)0*H-0-JE@&j)'*P)'4KE@&RC@3Z)#"3E'9KFf8JGA0P)'Pd)(G
-TG'JJBf&eG'P[ELi!N!-S!!%!N!A-!)i!i!$5"!K$EfjdD@jeC3#3"33!"!$$!@,
-!!J2S!*!$e%&%3e)$!!%5$9-+Qb3!1iU)LKA2&Y"cV%4X%28X2hmrl0HG[qIZcJb
-R@0KK*5TBK999BZ@rm35aUJ8,XQ8l6L$jN!!I!93NQ2Se[)@RhFACh8h5b(U5[Ad
-I,N2FaCI(T3X@qBdi9dq9p3XN2%U1NN'qk(5em(4U&CSL2JAQ6XFXGBZPFi&Plh`
-8(,JebXbQG8"2"b%-6&H8@CbY`EYPFb)Ah(i-H"r`2%#L6q-DV)Mdc!mhH5K3fic
-)FDZRR-9M@e'jc-h@kB'VP$IIbIX-kIp8rmPY!*!%1J!"!*!&8!"C!'3!N`3#6dX
-!N!8$!%3!5!$SL"P8D'Pc)'&bBfKTGQ8JDA-JC'&YB@GPC#iJ!*!%5!!"!*!&4`"
-D!&X!P!3#6dX!N!8#!%8!-3$SL#GCEh8JD'&fC5"PER4PFQ9N)'&Z)'PZBfpbFQ9
-MG#"`BA0cGfpbC#i!N!3-!#J!+!#f!4`%!999!*!$$!!J!!J!SJ%F!)*993#3!``
-!BJ#5!2!"Q!#&998!N!--!#J!+!"e!6`!Ke99!*!$$!"'!+B!ZJ(@!)C993#3!``
-!)!!)!+)"(!#!998!N!--!#J!+!#Z!8i!Y999!*!$$J!S!#J!`J'N!)K995J+!*!
-$$!!S!#J!P!%5!J"993#3!``!+!!S!)d"&`)"998!N!--#e9Z8h4eCQBJBA-k!*!
-$#!FJCQpXC'9b!!!%-d&%3e)$!!Ch$9803b)5%HCHEK"N,4P%D[*%*!X3@DZQ*LH
-h2BZ-i(ERb%Qh-e2bQAph[qrELM`EhmbhY8#5eFlXbH4*f,ilNa'5j9ENLDc)laq
-42j1IbEcCeRB454B6XMFYb5)S31)(rdjCKT&84$LS#cYiiLGf)5c5J1e3aD%@GK*
-H(mq1D3bR6lpC+R)6)mRY[@4[%r6@hmf'R%[)+8FIZEr5&V,ejRAjaL3*5bPTf0k
-N&a@6NPGC,a$mi-RK`KFHI%V$*QM4BN6+hFfqTX2b,*5j55k)jb(*(2h&i)XDJqi
-m&Fee*9$cG*JIMZ6*i#SGjViNe#Xq)@+3!*h[`af,NK")heX@$ED[(5XhPA-`LA1
-fRcbNbSE0RBqrZ,m'l)YVm[NQUD!A@)"Ck2@aqNDT+'b%UlJKdF4%D4j'8D8QKLJ
-RXm5(8JQR40@4X8N6+L,JmB-'82KL!,85ECR3J#8d%@TbLdfC`eLTT"qR$+aeU)[
-Di0J#T6DMFe4B`aLflrdNJ-)Z!m3jBTLiESAmcl%RFHbLl9fAJNh,JDRU`pD$+ZF
-dM(GdeX@!G"Z$#pDfYBXaSNc2)HBbh"2bA1lEQ20L2d(0f,[Q&#I)A'ZQ2(KBb@@
-qIDUNT-rSkShVZbh3b(2j4EE#Hi"%aD`5%YXK48JPi!JpjfESS#*')G-lpU&Zma9
-#N6ZP%AF+hP-PhjBJ16hDlDNc*qDmR%1jlK@TB-cEfPh+FK[jplG1#3aZ,GrmP`r
-LNbG@J3Mpl)N"@`NmD#E1Ye,'NV,SJ&0-'N"4lGDH(L15jV)kGQArf*KLjXEBBNT
-+ilSFVqIQ2L6S6,2!-qdr5A,SM5rZ8%e+qrrFIEa)TAK+(ePf3"KU9mH96KeiJM&
-J8-CCH2(UplHlTpQ8&pIV!mfS&!eYS22Y"H59K,,GX(5'$iDUN!!D1!1%4[Dm+R'
-d+EK+q$Ll6eBP[SHY1Jm&+*f0f9@c1LPl$U`!LB0EA#,N"l-#h9`&eEjM4RfXIVf
-`GZf$Y!rlJeGII3NEUUX[JA!5-Xp,Z*!!K9k#PFalib#6LH[)jR!53fYB8Y@+#cA
-4e!fZkRA5eL(bC5reTB0Nq+`1N!#ULm1*SfpKL@KA(V8&MK(J'6fDpK)ZJ-$X$'l
-TUd'pQXb1L-Hl60lqhlJ2YkIbbBfVNkBAI5lbXT26-1CCQI@i%dADZX@J'V("P$4
-5$f-VG@mlh@!+D@pipZKGMr,CUC9ZcXXMqF'dI'XXGU%XA8IkajQ+#fPh$2Aj@FV
-RjqVrINKT#[0r9hl1a'Bar[EhjGLF9@FZ6fPZ&[UQ90aX9RVbi))fT0[hNY60m9P
-ip++5qIc2PqqBK`c8pE9GaLXRlhFHm(""&mY9YB2CTqfiUkZ$G385RX(1bd[ERX3
-qk'4JZaVPpDGj!R%'T["3[!PH+Gc$PhJ`"hHqIVA3@F0Eeq31!*!$'!!d!!!"(!&
-S!!%"!!%!N!8$k!#3!j3!N!-m!!8%)'pQ)!FJDA4PEA-Z"&0dEh!E5A4PEA-JFQ9
-YB@PZD@jR)(4[)&9Z8h4eCQBk#e9Z8h4eCQCTEQFk!!!)`N&%3e)$!!q!$Pd,V")
-NGQeRhjerH,HaE(HH0fCLf0QFadb@D1p6'b-S1Qp(X5GD$AH6&!QPSb`MVD*U#kY
-+Rfr$#'qGN!$YZF%SSpR5d3DU+Y$UI81Y&!rS'1d#*De)Ubk0bCE3P2H9"J6XIAM
-Ilflff5+TQPE9q`-0rN!M)f"L-b*%)83elYAdTa[%MpAh@,9!I4Sl`c1T[b#Q4mm
-rAcEf`62IrVq+cHQa!)kNeiF[b+S+V)bKrJkX2pHRJ(SG0[k*S(rkL&0!`X"V3'U
-4`(3'#R9!A+9%!ma[5(BC"SN9L"U%U3lK&+4jQVl"pUk-hT(C(`CfpBqprI$G,Y,
-P$Si2"&DZrR+i4U3Ff1hjAr(%8GjLkR6`qH9jHBkb"SGYb*[,SRMR(Bp-q+[%BPU
-fmEmZre[!9Rhm@lD*,+U2j@dZZpc-1k#8cm&c+KGaD#QV6FdSjA$ff+-lA1jYPV(
-P),qJ,V3%Bq'!IkeAf93MkQX4T42`bjrB$d)r9I0'[R+MIJEYK@S$KP&#Z&&ZqQL
-[$[-qfUPN0U*Ub0%X+l$f9j,CQkLIKBN1PGYkE#adrmUe0G,b0qkG2MLb098LjPe
-,R$H91mlE,I10[0Nq&,RVAFb*qH8Mh8qPFNI[Ghed3B8mNJ,[BPCeAlN$r[bFi,(
-2X1QmmZHP00qhA-k[2ji,Vfr`V'MX-V0B,f`p(Y&2'NIr"4Uf2T(XRHRq4Ep3cDK
-["+HZ5kjGiMSKVP0d[BqZe4,UHY+%qMTiVIBcBLGVJYJ464)l$6@aNrB6X41q+iX
-GXefPh3ZdLqUIq1R4$&-69IK((L2fmZ!l"B,BNcU6cC59h[2-qIDX2lEG$LPTSr,
-5aff#f)B1)L1f3SALcr4@BfV@)8V,Xik(@BH!`fDjK#J(0hcePL!fIfE%KPGmD,L
-@&EhF,+l*ZLp#*$lE%`lk#8BeZ#Qq#1d6bY0p%Dq5*U,Vmc*FL@cA@k[KPTP&C&5
-#p1YJG&!4iPAJ4#8%@c[UNNb9KmPT`&*'YB,li-@NC8FSQK#ZApmmdV[PkV99rII
-'a`BL65ZdFkXf(jYd2J$*F3[(#fdPeM50JY@(GkhmMEb!aH20TD+He0UKJ-Zmb2`
-6T#G2Q*N4mUaLDCr[AJ(TjJ-QKFEhFTTN@QBA3fG!JJ,#`#iK)*C1@(dhE3kHMaJ
-dQFpT3bDIH6(N!LNL3V0GL)LPhF1q)Q&,YlYPIXAN4'ik@TLVjZB[0k6DA#"*BAC
-b$G0#D4EeCq(3PD)R`E"2SUU#U,b"ibG3Vd'0Z1cJ+jl+XL5Sm1%LAP!%#R`Re`*
-hRh)9*#E$E$Y`-!DHEH!8R8T$B)P+,&9rI2fPPkDhlIYkm&AhffH[(aXimSGVHMj
-9V0@AMlRP([JGK*bQU+#1q(bHaG!PrJ&[IcNe&&S-c9UBI#TH3q"FfDHFS+VU%,$
-r-YJcUBRTa9$#%MT$K@aLGAj!pQ99THJ-8d$45-V@S+"p900Xi1bUUP9Xqr!pGYT
-Ci!TmkKj1[6Sj'l*j3LkUEfZlq*DC)SQbRC4&pC3KmJ+iQDNpE0`*ihVYBFlG4m9
-F9Ie2'KkX`q!Be!M*dX+DX1bHE%0e#U+-(qQd89dD`VJ9qd+NIFXP,TBSYN(!*))
-U*5%M+Lf9I'Apj8-DGiQ6!GSY&lRAYC&V[4[(pK@+SD[FmV)hG94Ef(RZdjXr@HQ
-963mF3RHHak-h@l)TRcG&fTN3"d*TmpEr(5KAi$1H`HCjN5UQP#`ajCa-T*!!Pm`
-pF0KF%C0(-NSj+2AKC-RbkYb5Ik%T,(IX@GT+rP[bV0$6FX'cX[Q#iV-l#)'L3P+
-mTYD#NX+64Si1QT!!TF%B*',Je5Ki8clj!p)Cd66pU%Epp+[T3Y!4%X9SG+SE"MG
-CM8h"qlfG$X*p%$UI5QCHS2ZQ'F4a)k-UQ3m*C++Ye[hDZ(q`pm6kjkli39(9NmP
-NV08kVPdI(([hBH(l2jY+*S-dfG4kFEaq-,bllH%[Rp-h)&BU+HULkSZYf[LJqcm
-pTF'(cR5UJkBk+R[VR8eIZp`a-192Cfl3DP1peRkYepRE-a$mirF()IFpC415NY[
-ifQZpcVeY26X("Tb`L3iP+9%6J%UX4rA!rLSK!3Y%IiG4Q,3lCMAdqIFB95q0MPU
-0Q2)qbUG[r6cCaIT'Ik8RZqCEEp(135p8fCDiMKUMqKP35#['jR"XkFShR@FaGR5
-ZfNPIq`l!CS@i6N#$3,-6!LL+#q2PVamkJdFI8k!%KHa#UQ2Al9elqLb$pLpG$Rj
-ecVNdmhVC#53+i`J#dr9Se-(rb',ZY*Mk8[b$fk2#dXa[bZKrLfkUpkFaHhcd3+6
-BmP2Ah+Dqm`R(k9(rdN+aQ6N-5`KFX@A*0DGVC6E!m)Mr6E$(%Jkqf'*fj8cD[d&
-e4S9LiCD#eIZMQj)EQdTdY*EYfY1G'pB1$36jZIERl`q`ZSMCP@pITJk&MdAEN!!
-FFm1B"Q25KX2IBMU$fem42@Q%ClK!N!"rqb,A!Rh48DK9,PrV)ABbFG4J,%TJ*[@
-N%4qX5[KN*lGTT@kT[Y%GcZ3%bVhb"1bPFb6mb)ra#8P06'RQ"!IJireh@6irIbN
-bZ#2r8AYKY2'URXD$XpaZ#H-*54BN69A`iAJlaFXjmqc`lL%2-GXCLP-2XJQZE"0
-1ET2)!@PR6-'jH*bepM@U@bEYI2`l6B60a*%@*`P*LfIM-QF'h#&Rid(!k9B%$A"
-6&GkHX$C6I(Dil,ipHbZGLA$F$eX40("(UH)1MVY,F9[q"c[bipZD&KS9[)pqTY,
-6i'S)*$USQeccCX000CNf+98LYeaTh&%!eY!!89GeTNhL-#+l&CZc6!)BK'dp*U3
-YSP`h6$415aN'#GG[ENJm[P9M-`eLd#5A*pU$NC%M[M*j1&jNbE4(&4eQ4(2XPI'
-[@iV+C#lZ-fHD)k0ddKS-,3fd*p-D9A3UdaLF5'FESiVqJT4KLc!T5L@iJeel-Qe
-K0raECha,LL'kdQ0U[E1bbJbI4q43lT8V!*!%'J93J!#3!`-e,M828h4eCQC*G#"
-648%J05ie!*!$$J93J!#3!`-e,M8$05ie!*!$&3"8!'3!L`''!!%"!*!("%X!N!3
-B!$`!3!#`!CJ!!3%!N!F""`#3"J%L384$8J-!!iS08`UE*!"rKN@`h6Nj%l$&$Pe
-,6NmGf`%9!pZaqYJ-9[A12LLS@(eX`@kXkXE!2f0r925rrfq2mhC@'FEU!!ZC03e
-F9Shd`Bj'pkj6'Z`%Xr-S&0c&iM*#YY5j)-Pc#j!!hfq#GS,Td84dcbPjXa2G[-R
-Z+i@%-ma,@ZUD8SSG#ciIQp0r"2"krMRUbY2UD[qIAfl(Ujrp3rrlNCBP!VJcDU1
-#E9E"5#Dm4DYXM&@eAPXqBTZhKHeK&AhF&mE5@NbNP,3#F4p-ISc$ekiEjSHQ'HT
-6frC0h3qk%'KDJ#F%b!#F!%bpqLd!rZS*!a&r!2#LFZ%#%"b#J!'#BQ!Y1)Z43Bc
-I$%,N%MVLkQ15c,dSF4p-hh6j4F3VE-XB!*!$Gd&%3e)$!!#!$9-,@b!$!kCJ`kT
-UXc#`!5*LB$G,XGYCPD!JBX-HkYR!Q&8a#f-UZ[HR8k`+#iPMb,ELGpB!8LMpiEh
-!JNUia8#RBdJbMUrCpbBL$VrTa[llf*mk9dmSTT%&(C'kJKQiSm8DVUKU*k42-JV
-[4Fi&!*!$6!!#!*!&#!!d!"S"'iJE8'aPBA0P)'PZFf9bG#"NDA0V)&i`)(GTG'J
-k!*!'#`!,!#X!+k!#"%X!N!8G!$3!,3%BL!*H-3#3!cS!!3#3"6B!K`"+!-%%!Np
-,!*!&!J"&!#m"2iJCAM!JBA"`C@&bFb"dEb"LC5"NB@eKCf9N,NX!N!1U384$8J-
-!!,B0@`Y6-!0hFbeQ"Z`CdmT9aMFdilke99E'2fp2lp9kYqiprq)E'J!!m!d!!1J
-f$3!!#l)Y'i'Pq!GfCr[jjDdYFp0@cGpCf*-4E6ZY!bFUCeRCbDlbH0Gh4)AJ8X4
-rJKJ8[N3-RI0#5DL'!59#J#kS$Yl9"F#6K4bJ',6dJeNIl`L5Cd'q)0q+c@'mi[e
-VN`@PK4)VLVPbh1Hj`Y*8H1AaB3%!N!--!#J!+!"r!A!%Ve99!!!"!*!$J!!Ird!
-!)!)J!#)%N!!!*JR)!#)6j!!L)!)!)N!"!##(i)!K$r"!)K``)#3Cra!S'SS)-M+
-+*#BbmM*10!Bj*QAd-K*P&#3)Cr`)"($!%!)ri#!"!B"!!)E!J!"!!3!!)!)!!"2
-N!!!*b!!!"*!!!!!#)!!!!8!!N!1!!*!(J!!Irm!!2rrJ!$rrm!!rrrJ!2rrm!$r
-rrJ!rrrm!2rrrJ$rrrm!rrrrJ2rrrm$rrrrJrrrrm2rrrrRrrN!-rrrrq(rrrr!r
-rrrJ(rrr`!rrri!(rrm!!rrq!!(rr!!!rrJ!!(r`!!!ri!!!(m!!!!q!!!!(!!*!
-$J!#3"`%!"rrq!!J!J`!*J3+!#N)#3!L%!L!*#!)3#p!$q!JJ!!J)3!!)#)!!#!N
-!!!J+!!!)$!!!#!J!!!J)!IJ)#!2m#!J($!J)"Rr)#!DJL!J-S)J)$!')#!d"L!J
-CI3J)'8F)#"Rr#!JF-!J)$rJ)#!"J#!J"X!J)!!!)#!!!#!rrrrJ(rri!$rrr!!r
-rri!2rrr!$rrri!rrrr!2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!r
+:%R4ME%eKBe"bEfTPBh4c,R0PB3""8&"-BA9cG#%!!!%Y3J!"U09VQe0dG@CQ5A3
+J+'-T-6Nj0bda16Ni)%&XB@4ND@iJ8hPcG'9YFb`J5@jM,L`JD(4dF$S[,hH3!bj
+KE'&NC'PZFhPc,Q0[E5p6G(9QCNPd,`d+'J!&%!!",8)!N!0b!!%!N!0b)aJ0TD9
+5CA0PFRCPC+@P!+@3"!%!!$J!4,Ea6[1fm8mc!*!0#)B&!*!$cJ!Q)L%!!5ad!!)
+Y2L"#G@PXC!!!&e)!43!L!9-#3J(!rj!%!alrq2r`bd3!!)!!N!HPN!3"!!!f!%5
+d(A&cZ#2FJ!#3!h)!!5`V!*!$FJ!'h`-!!!%S!#BJ1`!"+`-!##dq)(4ME!!!M%i
+!I3!3!GN"p!(!rj!%!Klrq2r`bd!!!)!!N!HPN!3"!!"!!)#f"X)LYh!(iJ#3!mi
+!!#$+!*!$cJ!3j3B!!PXD!!!I2J#3"!m!3Np"Ae4ME&0SC@aXFbl2J!!!3,*069"
+b3eG*43%!rj!%!*!+J(!!N!C#`G4TA)3FKdFB9Vjc[S"j9Z"(P%(IQk8f+56NDRU
+5pB3pqpZ&4hM@%p(`!kJSMT&0c@IMqN+AIQQ9Ur&[KCX)&PHl[plQD92bUEJb1P#
+LX&0[E0r+,YJ!B(fUT5+hHLGS(jYE-EDeN`13!&1EZ"El+m5VENB!"J``M8UlNiQ
+*(K)5LJFl$C9ckF#P20mJCC[TGPc*B*!!T5pZ5009m21P8ZTTCBU2+Ub4D*YV8kk
+&5VpeDRcm(+!3J&`P4RKN'`CE,lET`HT,,2)NaZkVbaTFPB`#Y*65c8m9pD`1hpk
+D5R6B5ZcCmU8r,"aD4[-FST3F6j2i#IRF#Rk#4[)@AVV58T*LT@hf`4@cX#h#AMD
+i"lQ"f,H)S2(i'[DL3[0FJS*IV3$[L$*fa@f"9!Ml@JqKPYDcMPDKYNhTa2K'"BD
+lLV0`[99B8HY"QZTJ%c1Akp8rRPUL)*,AFMD@+RE(%FLD9U#3!0FeKP'8-k&-k,*
+4+aT'SqiJ'&R4K$KdL8Hb2BEN+"Hf9rp)K#48hNrDmp"JH6!iLAY`TqhFBS09JVC
+L12KTL)%S0&b5Y6HqHl(b%)Dr,91$h'%if2jIKi`VrZ@5K%'SP@`cb)96C[ccAQ%
+N-qDTZB6aJHD'II09NlD59M4jLbT6YflN-MPVZFfQ%cHIGe%2CmNV"+1PYTS+eVM
+q)45!m&3bP,3D@Y0GNHd$C,UPVUPl4@5+[pp!40YK4jF$)'f+60X[QT4&UhRC((*
+aSL@1mNCcACUe@1CK[EDGMkVJK0Sc8d+MCCRG)[qcT[mcM9(bb!J2@HE"liQ3!0Q
+IEe#NCTeVM4j8+1@[(C--KjifTc0LG,"e8mYMDaDL5#Q5P4ZqD"KF`[r6#5'$er0
+EQa6J%&Gq-bDhUB[EmV8V1EK$*@@b+e#CZ!Qif!ST,@)2aKE0iIkrj*S3-`bZKBD
+PqYH+`FiDQEqSM[9epiMp$49kTT+aZ223MdY$S8D2&Z2*k@Vjf$l0Z()"m&KQIi@
+l3dGB@B!&a1[1F!SL#HCdb#6N[e"4D&LR,$1CA$1Zak2pfKR6b-VArq56D1i)lRE
+BE[A0!q5D3X$FYC!!I0jrVYdbk6rJGheYN!#J4bk'9c42D+MmeJQlD&MDGpe@21`
+8ZdHNJp9c*rYR[UJ2Hfk`ErACJAP9#If)V'p5*1@S!5Y%+HmT%#lMCG0`+c(Qq-N
+@3UBEM8LBB0fmBbam#k`a6C!!`,B1rccpZ!DfaVc)YDA&@dMXe6Lh8I'+(KkN5YQ
+d13TS*(VlCDir!A6-dPaHR0QafC@RUpQ!6-$T$PF3X$0d6%(!#'2aVhI%i5FHP)Q
+q&J)9-Z@$LH*J$iB*(q5EBVJ0jj3G,YI+c-`3YZ4GbK$#(+DKEM*iZdER$5lhl,&
+Aji#rTEBMHU%X)0U2US&Pp,cRSEH)RGbBXlm5&"*iL!2DdUGcD$92ZI`D&-IATrN
+NG,!X,V!5j%!&fq$JA*cUIrha2P#Mh2LX#mCTQJZJ`)KdHJLE+mMQrh3*[E8Jdk,
+9Y&%0CGJAGQ#&[Vf22qKjG&*2Y+F$-L5"T35f-jq%!12"hb0$CD)-9$q+BAA[#q[
+mZ2bEN!#H),UV(NV%)prrFI!Zl2,3h2(J9GPk0+&ibYfajY2*EVGE-kl"B+Jk`$6
+IAMAXR`6EdZi"G@)EGV!#X8'#!%(c'"G[lpM0U%k9Z1rj90[5)Hi1q#BCDFSdLD1
+Af29+!b)T3i*E#X)#5TYbQ$l0hm&E-mPjfm[3!2ce@@FS5!qV2[[J3Q9Vc+4Jp3(
+Qf3IU'!0)f4lPFS6%[rI(q#L#,E2SKXKVe,446)fl'TYm#L(QV`"ZUSY`+1dip6U
+@*'0UAb@2Im4&Z)5II5HcS@b0TZUdh@J2Hd6d4jc-%,)[C-N`EfH#mQa*m"4`R`b
+ah4X2AImZii5fH),c&CpI+&4mP8$NL,2G*pjFqN8V2'qZf#ECRTJ[VA8Um-@!Zj&
+S8DZGrjDS["SU(35G2PMZU$80U)%qh%Np+NAG&6fPeqcA@fG2JPak82@"DQ33*%2
+%Dp(KcR0dQ`*6RC9A-l03fp$[F*c8jSpj1dpqr%cX)+e**Vak`"`dmXYU`XJ@mD#
+%dUfU`+jGQ@88Zh(Fc,B&5'l``8A8bhHS#hS&)Hje"15D5k4lQP-lYFlM%c9Y+&-
+CpaSc9"SIG1$!MMcDTqalhK`M[Qm!!dmMDJA1Ei$h#IA6Q-"iAFGN*R!bG&H3!!E
+&YTABa85dS9AA`mSm*M#Y$j21r5)!`RFkKB,&'m8Xr43i8("3L#P8kGKQ6P81i6e
+`-aTa49mrNS#e8BD%&ekQ!Mj0`S`NcZAVhLJPU-L#$c%[f$+-Sk-YI,YKp@8mBUc
+#4(%jD(4mj+LAEZTTpEFMc%R@GUUmpEq,6E%3D5-B-j8MpPr-@&8B4Ej9C69E8p,
+T066D$(HiN!!XE!8j9LjlJ26SU'8f!*(+6@b%YH!"`QZc[PiEkKS&([FTCp!jp0e
+i-jbATcBTUm!bb1*Lm@F!m88jpkVPCq'FQb6444jRI@8dNUUXmMJlJ'J,(ETECb[
+Lfclqd5HeN!"kpS(TdGqc%S@-V!iQSX`ii6AG2C!!bP[q0'PQmH@2K8rrL*PQS44
+1B5h`)0p$Pbq%DmJfPEAUYjI&i,Y[J8#"qTZETRb6(YT-bD$*qVRNPdCPfFQeqbU
+ZYaEr,e##+Ph0@)+mdd@-CY1M64*!HrfUY!'KeaN#`*!!8C(qpZX@MCfU9$h@J9H
+SJ8bA@&1[G%*%F+0*ZKCmf`baUkJr('M0#%!Ch8UGiKC4Z,Y!1fP@3eA6MeUVqdb
+Dedji3Z4QQF)ciFd-9D4FS(BISI!Z!bTPJZZ3!("Y2P6DVHC@38iFq31IZPUf2VR
+pj!B6jT*'ANUd'ml8e9RVQ"k0``c)Z2d*kTAGLm,21P$X3FR!"Xe$2bYD#@4%%9[
+,TET3EL"PF`b$%P4YCFFEkbI'1MR,&%GM-Q+fA4D$0'"p",B-D%SL!Pj!RhJ[McR
+YqX`jfm#ajGLF%!B#,YJfD5NY6#QjlK)AA,QH0kbT6rRdZLCGi&9+&pFfXakXL(l
+dJUre)[D3!1"-QlT+r'3'fTHIJ+P*c`&c2QYj-2iU`H'h!ZaQJm&rY,E6lm69j`C
+0FN[$[QakJ2Sa5+(XIF`qk@CTD3l"!rSpkB&'f(*P`p6L+D93*$C3I"P$26F8Ye-
+&Xmrdi9eZcc06%--!1'1-b658"lJ2,hJN![Z8fip6jV$Pd@Nc%N16RZQ*Dc2M$d9
+X3FL!bGDA5DSC&#N5iHT#%UJ4-l3G1($hR`VqIkB#EbC,JC9lJ@&P8BhQ[,KKc,a
+e!bZeX%e,rIYjqA#+Jr,p-G1"h3fCiM,!kV!QN!$h%iaNrf$!Mc9`V&96Yik#M#D
+#Q"%R",ApXEA9@X+Kh*!!(EHP1[-#2l"(Ufc+)hl,REYZP6lXPB()E8QG-+[EcY'
+([iHl(YJSlNbEhFYfl,h8$F(6[jB8-#&`F$G$,b`CK9C@1I&2JDAKS"URAF(JDN-
+Khf4*l-4DH%DR%CR-0icBSNDd6khB8T)bDCEK*NhFfKGGCe%DT%eP"Xk@0@[29D+
+ZCj9Aa&`N,6SC#-Nih)@j)h(XjHb('T14h&1I-2UDd)SSF13YK+J!&9HAjEDMN!"
+-5P!Y-AP&$VhKZdqXlP6JNm66ZqAebah[rb[R'$XiRTD@#6[q*-51X@(FJ&5+CVh
+jJfUkYk#4bZi9p0HLire*U3Rm9a![[J+"2QIfpjZ0*R,T@`Uc[4lQ8m%BV3-bG+Q
+cT[)eB*+Gcm[DA3qM62%--+Q'APIf!M3hCf2R&m6XRXC3[UZ+aCE(`Zaq#N)LMkp
+6L'*ZiTcBCJB![dHbGPfh$UX!fBPY11U`$TT%jZ*KA*(akpDk1TR0#02h4P9'a&Y
+,ID8-Rrci8&"Y)R3M*8NMlrFHZFhMG)@ipQHaZ2'4YUX19jT[SFXTqEqcFC,22`l
+ecP1$e"9C2'4piD-cH@*6Sf"DX0Lf2M831GE*@i[bl+bCl)T-T-[i-kflh*8Ch-0
+KbdCAV2DY3"0*2@@TjLT2Z`j8Ud0NQA&"(SmQ`G`S6K[ZqD`XU,B)hP"$,CcL)2b
+%r1Y*I-P2cjAVe&a9B$5!-!Yr&RkT"Lb02+b$h4FiK!+pPbbTm5rP#jMG08iIcT0
+8ZeGY5A9dY5KeVSR53B60cm[X%@6#Qb[!Y3MR3#a26N*hjB%Q8YEASGLS+EB"IqC
++fE5E!eqLP*R*(HX+KDfF8&BEr8H#leK9pI`Z*K&hUXcp5M#DMbh)4,rp[p#Rd0f
+8,qfQ+L%,m(!'Af@3!#B-[-G9B1qk`!e&"1CJe!*aDESdF1(`RJJ#Y-X(06MKU3D
+Rf4hkfS$%5Q8,J8bHr4DiB@Nf[hXVj[mfQP"c32X0)LLRrae00pb@E2EA+0Hjq!%
+F)UNjF)h&e[,$@Ck%A%A4U-DeCK"@!bJ#Y@D21NYGKVHbe9kcPE!j-l4a!lh3E8C
+rqP[ricTbj4hN2h2IJGeQL$$2fc#SF)$0f1M14mp"GHUJ9`Q%3SPHpc59ep'p*D#
+6@,f0fMTR+@LUdYmQ$k+j#3+-(TSA8VC,c)+YLJYElJhY0@'XGq-ZHlN*2$Y52dc
+(0,+pS["2056hF%&lK30eEVIDbk`hL4TV6a1Kf*jrE-3i"RMXeVmM2m8rBS"0ZDm
+8$P5*T(UIaN`6Ffk[A+j50Xe*4i35'DE+)Xmi[)ZTkb%GM,KmcrM'dh"S)m[@rbV
+Eb`1SRpCHD*6la$++-h2EGJ0c!lQB$j@0@`CJjN(qEF4qp$kH4*eZ#N256(PTc0G
+)"dK9rU2`ZY11k(k00aRe#MA`F5C(VJMY%,ie24a55S"LkT55e,K6J*K1S2S-E(Z
+Tc5T,S@F&fD'8R$a5C+ZCT@IP1ADSD1h39GNJr4E[Vj2imV"3`(YJqCTSdUV4%J0
+cAJXZfMJlP0a,eip3SL,EAK[N["#FlSfiKX+h-*!!(Z8`F4*Q+aH`QJSS4L9C)G@
+%*+80jNCa-`T&NCJ$P*`MV%a4K%68qDjTjdleQ+L#$#U`e$!Dh+4DN!!%",VY*U)
+rkI*d#Dm"'BCCZK9""QaGc+FN8ja53FKfQ2`[$F5Dfa(I9A'c,AlA"m@b,dc6Zbl
+)5,0iBZc"Pm!4UPj%pqVQ&PKD$HRJcQ3feR,*)A@#mBL%k!-MYkh9!ZR8%c89p'D
+S03TbUJ54%+*HEMTfBa*X8EiC5imq&-XKi%T6md%2c5hCS(m"j0SjHa+$1*S4j#Y
+d0aCCh5@$6e`!1)Abr!'"3$k[1-["hS0+5+e99(L5"3ZHc(%pKKmPU4h2@4GM[Vp
+3Y@RX,jCIH1ibQD`j*`cRh5V2E$Dh9I#8b)F%)Zkkb`HR4#I&118B4-i6J$LBXCe
+QGM5e)BT"+Dj*J26ip)mTKLi&)IJZ$KVNZhFPeR`A2LSE30hU[4@6#$+VaP4!9'i
+8khG80*6+qVZ#rR4UN!$pNK43#+I#-Vb+!Q8hIF(0Ga5"6Gl9J`I&(p2Y+P)paE$
+T3qY*8i5mhIqpN`9*GFQ9EFDCqH+ldSBLNiNV"`*J0rB5J*64b"+kbhp1((K[+a9
+HV)Xi1-KJPA1@IDZJSR#+LN`9!eeeQ+#8rYMY'Api3Ikm2"dXAjlM+KRQiSq%@(5
+IJ!V2e14QFMV4fD+E4QTQTP9R(K$GGXfVAVL`m[NE&)1GU(&b$'`,24Lh1VMT0i8
+$ik,34mP[AB*k@TbRUc5@B!0%@Dq&[,e`r!NJ3iN5j#`Y(F9H&ULb-3DkI5r3L1L
+)ZP"$+P"bQ+b4L$i[pBLFML"1'E'%2mRA`M(9`5*J(f)j@U13!0&`jd2r64BY3F$
+)"`E'GU91"Q8ldUbQ%"TZh4ICS@',l`0`+-$Q5)VHV1`MjU3Era&rmL2Tmf8bF%[
+`1U!TBRm$#-F6SLJb@'m5*rU9hIG61CMpEPBir!SpSY*$lAp,jJqbM&Am[UVN$JQ
+f4qm)er8X+aceFc2CDhC$GXICJ-*HR(D8jPfU3B1-GDjKCd#d"mcmH02,'Q@LdpL
+j0"eeqMIQHFD!Ke!h0Baa'k%3lG)F4`+BNUGbrV[dehZQCqE*HbZ4lXTbC3j-(TN
+UB&&!Jh(DY,*m'#h91bXQ,1kB4b,lmdBaQNV"KTqGb0L@dNh1hKH-E`18&!@ESN%
+2'C&J5L0iTfE1@SQZk6`+qTJC&LX3'k&C!IU&jPKR8`-MbF9dU+(AXmZ)X,[,*h'
+B3!fMG19K3T0E8IRcrdh#!T!!'!M#i0Q,2NYJh5Mr1Nl'*cl,D#qYTTT3k*T6J90
+D&A2G@$f(+,8NA)6M&EIRN!$`*E5BEl2`hZTCe#[S1QG)4(8-8eJh#'f"%EJ%ReM
+Ta"SfUXQp8+pfdhbF$Di95U*FLUeX$iFSLrL"[0qlT)"-%Tki6jJN!!2j%@HM#0H
+ElK1CMA0I@92[&TkCj(-hPUik&mRcIll1NrHN'P$1$p845hm6qjbH3mqf-KicTp*
+Pf@8BEc!i"ekdUFCT389rbdA"DQ!pN3ZZ2%`J)9([C&l`aX%FMH(5jJ*D4LRaiSB
+5@M`-hZc4)D4N`akFRQe4qELI42R%"bTfIEj[r"Q&ar1e4h")V'(VKfT,-pj&krC
+TV'eRL8"cS-K1dZdXkA'l+bS!XAa3LiTZ21cpqE%(YYRK9kd)i&IqR9Ml6-B$6UU
+FIrUh1([lNhI6DVql"d86iV0e4,rFI[V401S%1*AJDfh&ZS3XG*!!PXfU0d"SSlP
+&aKbd`83ahV`Z`j,HLN2JlBC&3eC*cYHB%h9194%TILjD&ckD*Im#AKCH9hSMS!E
+Ki6jPjdD0YK0FP!3q'kCbbUBLZh&Xkj)C8jJ,S2e4YlpkFD2J#U*Rm@#XQJ5NkaS
+L`+c-EJ`([0YapB&F+X8KQb`L-RH%$`0FG&f@`'@',3N45R(FGi144K*4rG4&"Ke
+FSa)dm59(N5U1K`AN1rC8fR+e2*%qHKB+`6Be[qYimB*2#04*%q@3!&'D24M@5I8
+Y,,[+RkNU*Rq$&e$2KM9mJ'DIiFF,N!!h`R3#YU+Dl+55+Z%ljhZ0K&IbM,QCr"`
+eaQQh$GM,Uf8q'VS&8#c9E+LU@fUd,YX[EAeVj@$f)AY1-5Y8!(A5F-Q#6#Ui0[C
+,I,bj%1!Y0Car5eliKf3i0"RmbQfYcP,[JHAiBRC11p)U*(+Z0'$*508(+ddDHF`
+L+KAMdTVA`$1#4X0XKamDATD9$G)d+N0`f5RS+S4Ik2Ger&dS@NkRaUA2J1NFmZX
+-EGRj!#m80i9Sr,KT,#&-je2QHM2JQ(50CdENr)a4,'*`c`1UP)PUVpPh#9D(!Cb
+Tjd6Bc['GV(aqY%CPaqp!q8dmdSUekMBC*DacI&ErJq!18%YXCk5r2T!!*jbmb,d
+913a$3(PRmS4@+hP+IU"L@'",8phdqmbCa,6PCc!!S"m1R5G298@iT-[b3k8Uk'p
+peAX[V#KTqbNQ'H*qK$q5!8i2KE1TK98`p-8,D`XThIi$mqh&1A(ZA[iJ5'0`hjC
+Ak8mY&644Vcm`,d*)R,QTrHrLLDErcVafTiMLpH'h3@k-6P9pChk3!29$,J10Ej'
+Q([@EGqISc+XqKGNIp$"D1#C!83%'Z1$&G$AM)aQ5HiijS#)HQ-*AIUT#Dc'C%1f
+!*)T8TGTS#Vmp(LpEL&fYeJh[eUlAcC!!8eErLKbkl")2G0jS$&URXZAjA5FMl1H
+M@RKAdVGV[FGJ*Kc%k$aVhfk%PV&!Qf,J&(&KlFA&MCKebbXG`3,RQ[c#6r3l0V1
+TjU"2k85(mbE""4lJc[r(lkcY-"G3ePi8)T4RQT68!%A69U@'ikIXRYFKUJP59I(
+A[@2dflJeR*Rr@5iqSTj2@$pHhSG`iCHm%[A)aHQG)Afkl5#$AAE#l%M)ZcLc00[
+`5rLi*P`Z"akjXR1r[LRPMf)A$)H29-Zla)Fi4%e%5M0"b'i&maa4(HLAi8DXT0d
+#Gl`PC*I%9mRM"#EPG#X+A2Ce`q3&(V"'hrq-#jCml,DI55QIL'qk0XcaAjkX5YG
+2PSk)UPLZ`ZF(M"lImSe#m!EP&SfDpa&h306P35@MM$TFq4JLJ8#c4m2K'9LccCS
+F,GkLIIjBMcLi18@c@X'CXYEBemM#@5+N+1C8F%$Fk2l6UX1eRekFL[%*N5eYh)h
+lJ+U*CGPEJbpSH5G9pFMGcJm)A2%Z*i#%5hT-,3@0U5UBFHdr8$T4d9qb+H'Ep-4
+AJ+3BPYLj21,AEekEpTS"T8F6r*Gada,!@93`G9bb&'EEY'bRCG)(Zq4d@pq6!9q
+aHR"Ij#kP[CeXR'VfQS&df,&@JhpGEj'Fj-)m3V)[k)hDC3bLiCcRP3CUe%UA&)b
+D`V5RT"jL4MLp69+@R)*&6I0N+I'0JSS)*Jk+5+3VehC+X3a$5q4r,XLma$h-3M2
+HA26QqXFB3DNU!*&LM!QD"BhUR+4V"qq21jd)DLaFcSC9[*L@5Cil[l6%a%61IFp
+Bb@d0DhTl0Pm!6CD9dQ3AH9f2Qq59@JBrYZ3jGNPjP+kG#UmES6@5eqGVCIYf$Nb
+iRK)`Zl4brB@4%aZaqbXEP06+DlZ+T5%m`5T6c"YX!SGG[0Y,88Qi0%FD[5[hA[Z
+K!Kp#8bP1-cNTHU,%BH90"r$$03VMp!+C&Hb)dC9,S4"'`bHUA')mGIC1$*E3Ffm
+QdPTRP#DXi,qGS`fd&hD"2MLBkeH`h0B@PTSf%9)P29QCKb#1&IErj+YFQ@r!,Gm
+N1lP@k2%(E`bCNi8mph*aSPF%[(ZATlc09",ADXpEmIe[EAIXcT,E@H1c0qF!bP@
+1qANCl,JPBeVHhMYMPK2#&@bcAlM5QT8!%"2mUZ-1Y'8J$%`GA@CVYLaaG#KYBdQ
+im0Zpb6$JBq`,A)YN)HRFq-iKdNNDr-lme%l0YU0J&BKE!M"!`I[GH0e!b9(XJPF
+(d-X%jHe`$b4fUQirUXj[2bK&AE-b8Cl9lk*1,dr#Hc%TGXZPX9F%&02qlB88XpE
+@*2UTD#l&LT(c'Z4I'RQL,H@IVS+2p5[J!PTiNXl-)8-Gr(`&R6,-BVLbrSZ5aZ@
+X`$j[5RQK1Mp&!FRfVdqliSKQm+M35rQ$U*Dl5@T,@ZS2mad2[Q'XeXR6cX0eiBp
+&S[6'`d0$ENHf0qV$$C3D`5"le2-fB-SPCXDi[idEeG`ZJIG"Dh%IkSi[&b3bZFU
+rB5i&a6+RZ6+GBCY,jiEM86L&YIVbim8&"E4epej[VEmGVeMMSh$X(NkeXEPY3bR
+a0`B@8-0%JL5*a!VHL&JTqH`[*0XRlQ)pUhVYDcNFr4[M&#`pY3kX0[YLX*GE%,h
+2j4A5A30RUZdRMi3"kMdQSl!fp##MHZ@CiCq#a56PpV1hq@arb'-Ub1@e@54T)h-
+R*N#ZkFZ"0*A)9N8@iqPd1#J(4MA6BM5ZKh22#c(@K)QAb@H+"`@1I`)pIdk+RLQ
+jI0I9aQ*BCdJScl(Kea"J#Xq8lJd!Hr'lme1Q0!6Gj1VU)T'#2%@fBPhD`@ki`l!
+eZ5$Cd(&VJe1CLf6C&"m81X[MbeRTFjIef!SXTa[,P*NV$04$b,+X#X[EBe[M@p5
+28!&(YS#GSd8JQMHXfCLSe[dX)k0lNEIGe`p"XBf*F+#@`pjqea)kC[+IMlFDmHp
+01`di*6FNb3@ICQmG#J%4'8h(8ji5M9e1,d8P@1#3!'22aKXI[4KR@-R9K8DLdX(
+$LrGTfkd9)IQ6KNkQ+3@Y$+KK*&NmbaC6lce%9hU!a55DD+d3D`9A`M-&'Je1F(q
+5`GNI+(fKql8PZ`MhY*HQYmSMT-I"'iJQdeTBmE,QDMpp-qr"(LL0B()@!%cVjLT
+SJ6arXK)Ua8q@N4P&BN&&SQEILV@3!*lb$&&1`lU"KElJ3"pf+*JBcf+PLNh#f2)
+4mVS3N3PQX*Q3!"9q["Apkkb%K`b1ac"#i%Pj)'!+!@ZU+iVHZN6HI1U+6!MqrDF
+S$ppR04L)cQd,CIfieHQkAd,XDi45b!@TMNA,%5%fL","e&EYEdVR+lM$T,&hfJb
+BXb`&eRlfABpfe#TDHS,Q5f2*X*`8mXSB'!*fVDlrT)A'@pElQ[!c%b$C)jXk5Fh
+pH,,bC+0Ee68CH-kPI-[4,[hjk1V5F15VJ+$BR(dQQiq3!+F9BbM%ki[FdCFNLEf
++cZleHr4Ah&M[[c#@8*R`*HV("bL5!B4ZaITX[F%3NB2F$d9QiV(JbrDLpRbE'0Y
+0)Gf'@UH)J"q)DJQ8DU8BiXL5cMDMrb+!#"fcl$Mh4"6l&#q,%+h!3&9GI9f-,Ha
+AkHKK+CG@V$)Z#f"%GhrGhqmpXGSFGZr(+i[D$i-&,i-mEN1kBrV'dXce#HDN3hV
+f!H(3''*M)5HK"[10M!ZBTrYN#rI3P-'i,9SI#0bBBq+`NTS9B!hHYFa-E3GljY&
+QffJ'Cij8iHXUG$R`VQ)[eGVSNp'3!!5!VdK`&kMpLVR-aL'TEMd8[&rlTY+U8X3
+I[M,')c,HKmYpG*akq'I,"X"(cUb(G6Ef'jDFeM-N0EQY&D)kh%+D+LU4CbN3'%3
+G94+,6$L-&ZHRR,4p3NZq!)49XCNJp6+Ti&F5!04J6ad,ajfNPA5)Xq1bPdE-)16
+L!$S4k6+j1mhM"[`Xf!C$VeA'dBq9D1j$YR#Xea[-Jik9@XDLlCbrS0%#ZRYI6h$
+Ta4%1@e5i[8,2fhPA"hfMhl2Gd,DT`GQMq2FY'3N8,'Xr`,K4Uph-aUFj$-&"8G4
+D'%RdSEP6jB30eS*KZmSj-f9%Iq'TNh62FBE$BpHM$TDZI-#PN!3"!!"%!"#i)pU
+VZ#2DU`!!!5J!!$Uf!*!$cJ!8Rim!!qmY!!!C2`#3"!m!3Np"Ae4ME&0SC@aXFbl
+2J#jiE@`!!6Ff9%9B9%0A588"!2q3"!#3#S!!N!N"1J#3!cF!N!32!%,"e3Yp9Ii
+)G@q1M&+eZVY+UcfdQBlbjJ*TIXpAm28Bq"(rbr9bq+0NK'C*Ni'aAdAGKmN8l!"
+#`G82Y@aZ1`rdha9`9fYTim6JNY'qNmj+0Vl*J+I1)Hhri*Yrq@Ip1MP@,j-S`VF
+LR9Tem31SREKcSfPH[U&9rGDk0*FI80-*$Q2cbR`CLB&J#[iJ@k@kiBTEKEI8&*'
+j'L9Fb'#8'!Xf+iBpCB2[LT%N@ER%qQ90FY#+kIpHq)*i95#YZm@E&Le)fEae92#
+QQ-cT*M'+&!bQVZA1Mm$$Ph[PH)CD$-aq#!P22I3!fYGB`,UN*lHiIQpLI#f`[N1
+H4'6RD#,KR5VP`'r#&)hYG`5lXkUmNU3!IPV98d,FQB4*j2fVPSEL&Q6a`qT5FZ0
+Q,DZ,H2R2mLR'aPN9`0HTe%cf,M"Cia98)PrV#idI%UpN83Fc'pcSXCZ$EeZea,-
+CSU#`KbCrlGjqD&M96$KN@@+G8FCY992!AdSjNbil-98"@S@lrXT2+`*(b`Ep`"p
+kaN4jd,i@SB+8D[M"pGELVBXp0R$JDDq-QH1GLUep0+EH'R-$A(-%6%S949&0@!`
+Ce"@"8*(qTCG&CVU'@Kh8#$P29kbm#,'[2c5NQ%L#ZQ+p5cdap9iE`PKhm,BPjHa
+D%RNbA18kh#Jc%-@Ia",5@il@5`Z)@IGI%N%Kq2qdAaHIVFBbGMEFja#!-KD#0JG
+03P-%+AJ[UV4l`D*ZiArUcC*aYRmS(*Zj(feJ(Kc+ZYUEj9ZhH-cE!qjCqSVF+eq
+ZXPMXI!)B9,IpidKmNJme%4qZG-P"L1P3j`H5!L(fT,q"hUDTrGc(bB,Uc&U5bLk
+I+K6G#Kd1[6%qEPi&%N)Ql&fdENQPPa6V&[i`U,UQIYEeCi@jL&+Zajdr%Sk8*8i
+NL0d"YJpGJ$$0[PLUC-UhL0(kHTd*3PL,3GCCAQ1e-[`dcdG,)mVqdPBN0ZNCZ0E
+pMUfmVB9(%SX)dr-k-f2['fN3@8a"[rFENHcAi26[9i-aNB4Mi@H-qcl6XTSZhA'
+-ee9[r#TjDeCV[BhEhDE5,CI"BEibVl#ca)(5c*Q0pIRqHfmc`XN[@&aTT%$qV+6
+[%#dKF6DYbeL3!)8!R!#[U5J&NPq4rm(mcQlPVIi&9(+ZKKrLX5praRhS'r%Kdf+
+h,'c+I&Zl$D1)2F5XFG2md%bS95FiH$[8($S@2J@hK)Y6!V+DmCZf'JBLKkL#cpe
+60d$Jl4%GHplhZ)&l8&PM-AY@#J06UX6&B4VV*Fc8#%-RX13-0b9-cZ,%[J-S1d'
+P$@Tp16(#0h@RifCZC5k+pkKE+5fljY&"f*K))'i$d)dM%RQ'L5V,jR4TMib8[lR
+k-UEp5!*Q2U3#imcR4Zhi2%6GfJ$%PeqaMNQhV&62V["Y%P1$d"Z+@T!!E&i9kar
+iq1TS"ZD!+PGX6B)$-jkEjHE3[c*P(bJr&$-)J%*r@YHRC!Teb0c"pPia-ShI`iL
+6b2jZNHHSl!VK&J#e5P)0RINS5YpAVENU%pERFp3#+DNI%VIM6VGbpHKcaDBP-q2
+BDm6M,#!C56kc+240m0f21U#&Uc,R1qIS!U$`i%!lGFeRF+FdD9e1Nl"aBd*G9jH
+Bj*hDQ4#GhYIZ[C8ImdU$i428ZQQAkqZ#eJVGiLMQSh43%TLE1)IK$3FPMVaDcp!
+)j+@3!)rkGdrT`m&*"'8@jEhV51Kr9P2--C!!VmeI$Yr5c2#Y4m+1bbUf,!`h'qZ
+hrYjPFU`#*F1&%14+,aCljIkLAZk-C96k+UNjGI`bp8L#q,`d19J)#,CrGEQ(m8P
+MM0E@d1eZCD8PU(0Y2mp6+$IR)%C901e*LakJjHRP!@4(JFJ%i(RNAFT"KMJia$X
+XeY,l8V8r@IR('ZBYVEAVkha+1%9Q)V1aJc'U-2Xl&bCh1QC+)1H!98(-8S4lNbd
+#16@QD-8,AbJj9mTdcH5ITLHA"llAfhJ%,LH"3AP&)K8Bc)$91Lmd,@Ef)4fb)k8
+$P)DK'R23Tc52,29D%VaBi&,U+mPP!L@X4&hTT3jC4Cp0q2BI8!-0`B0q1icjhmJ
+VJLPPH3MYSqrY&@NZmhXb`e1)pj2)DejlN[PpE5*JG'@P@fCqH5eQT2QNAh*)Zbj
+90'Mq&#C'!mHC3)dHSQhIP[d3GP9,CG45LXPlG"aG4Jd8b4`iP%%RTNZm%@,H'Pm
+E[32bL(HP9#T8qmV-%ET3"2,K*rP9%546%Aibk(!CSQG1SGG,c-9TEZSB9@,TSQ6
+GaB8@DH`(`2E%IKKeBr&U5p1&dcBH#41)MdIIPSU#DNa`RZT#jB-%%[J*(qdVFX$
+fSm#3!,$ajf!X0B'RaX(-8mjFD1%chlPQ#R!SVef[)`8)*H*p4XpH3E$PC9KUCGf
+(K#G8Y#NVaC6iP`EK!G"ePLSrl)`L'P6rT9QL4pXC%Tc(4@'$BhYDRB[Gf5T'+$i
++h)fUM4I32G*,C16#V!a1fPN9%h86MTU"[-QYr2#+Fr4JVYH*Q@KVXL6pERXPmGh
+5$'im'N8,Llkr2IEHUE%AUhm28-5i&MSqZZ8,qmC05pdqbbeJml6jU*298-f8#bY
+NXSf1mZ-PQ18YAS%RD#U0rY`Se9K6JZQHc)`8rq[0%i"MJ4llc`eEXDVH8Z6mJ%h
+#9k5BC(dc&Z&CQ"iYQP1MJ)853@UQII#SjpE4D+apPqL2%D#V,rN++rd`"94DZc2
+(+j@4#p4`AKA[YN')(9[S"Uq$rdPHLXDiUU9L'9r8R(4F`9qiSb))2XaA2)M'"!J
+3a#8BmSGEqUr(b`8&Y0F0NGUGcef+Sf1j!P2LdfJXA99l#Gq"A4[q,KFP*1PqKJM
+THlJI4*AMa5D-'TK45"EGGjCQ8`@L)d4i##93&Ie8*rXJj94X)l5QpfcKmKepbeU
+0Q4iZ0%*`&N%d9SS+)R(bmD%$fVZ1!+K@I@XL([`"%ab#%#Ea6q9Kjlbj4M*5)MI
+GXPRZPh$3()*l%$m,faC2X#G3iRP9JeaK(%'PVAAiDef$hQ#dC+Ckj&Pa%4VScfM
+6&VQr8PUC1SD6hL3$@FUUMmql[8V!@VT2BJal1XF8PVLK4cVGYM2h6q24Bihl$NI
+aI%krCFbEQcB#(9aSLDeF*)cINa!*R3rEeb)mR1**M)eYEdh+rVdJ*SfchkhZBLe
+dIaUmjUZNGr8DmrNG968mCIGHfd1fr%P`abNfP4ZqTh0[%`DjHD[fN!!0Dj+RJ8A
+X0r+abdG26ck0j[4BUeII(a[QPX%62lebN!!F89&860hN$Ti"Xr2+1U(mlpZMM61
+Sd#ACRXcfb)L@FAH40KJbL641m)lbP%(@)K$cmaYaNf44L#&%8U#EX@rUc&p1AF(
+X'[6pPUY5Ai$9b"[[lU(DUDBp61Zl@,GEYBq8)p[#b!p&cGK968VB,8G-M-6)0VV
+*6VbQj%f[1X3GM3d3,218JlhR3GSJ$eQL9ha5p+r&JAG!L0V+`@%9I[LR@R5ME'J
+*@9XUrPC)8$C2m5B*cRF#6dQ#HS+,ZX!H)r$NDcA3E3j4"1FT'00,eh$YQ@LX8Ra
+"U@`U+QPII[*Shjhl)K!BlY(`Jp)jfF&(b"NZf(#Z0A,j32V1Tmf`j"jH3$aa6CL
+UCkH+Er#,fFp'F0)"NM8,IK%rHFkDr6"3Z"R)G'-S11rYTKV2U+&(39M!TYbGr@$
+rJ*Lid%dH-@f%L2(6YPY4SX&NXXd5TY$km'+iaF45(S26[#&$8G$0mY1h$ci2%VS
+eAJB-R)ZdR!Z6kB&e0jkACl0Y62Uf-hQ,G,GD(kRAmSNmPacZk2!3&KTr3&-"2("
+)E)eceCiX3BZJ(T,"(b[)F'9mT9CNYUQJ`L9S(X'eU@#rp)lKRpT9q1#h#ZQK'-i
+emrq&LEj1bFhddeK9LGPL4)8E&P!1GCqBXZHIV$8PXq0X')E+$LZm*hF*Y*d&1H%
+`f[&NV+Zlq5$6RB(,Q+iBF'$SqphQ&2A1dEYY,8Z8T*LC8Ufl[fA"rIMpUh!IDB2
+#f#cj$`jh9q)44fQD5AjQMkXr9rG#3+fpAqTp6L*8H)mSBr`,M0cRlpjG@2VI"R8
+l0YT6!AXmiLcBYN@U5Nr#4e0N-9N(RL`lSfSP0TDLS+PZkr&r,Sk'"6Iqr#bB(0-
+(JK8Z1f5fB5@acMp41ZCk*$6#2Db2f"9ITZlm9Q''Z4l9mGL)'Mmh)Ie`)T(fX2-
+T9[1q4(e,f5&K(kpKf%,ahM`J,k0fQ5*`Dr")eGIfr,ecE`#EAV&c@9Q)b6ZYlXE
+J[rVB$'4K"eZrf52Z)0m',DK$S3-a)+mMH$jTrMIQG`9eTL!BYE*PjN3I%6PmlhH
+`AmaCGr#C`-Fka&c4#Nb-2A2U2[%QbHh""fi@B`1p)dU2b1Sm+kr6rM"ZGA"TqBL
+d,JH@KCm9lP*K1pUAqd6"36aC1JUqGrl'DeZfLe6h")T5!Qf)0M088'QUrPd5k*S
+[HB',[#DIDDXjPPeF8PTF9M`8T`)NqXD"VhBE9ddQjp2*jApH8p#-eqa@34,Yr(-
+p%8MiZ$L'kQ3Lijq+fI8&%!R%'q9L"(KU-pm[D[N(Tjb-ifJLMm3-Lr,#SEaLl8$
+E9qXea"i(&`Gj8qjY2'-[Ca)$dJl%6G)CCBd'-6K$4Eb*3h5!9!H22%@NXQR3aD4
+@0@F5%&YU@6'JHbQrR)CVZR+!6q-rm8`-KF6'S5i-LlR*"5-A(J)lQYYphL%9ch'
+S3fD9#0LTEX"q(9VcM2Bh9!AN5M-8Jej8QZ1XD,&LMR(R[4mj[C[Z1BHdr2`T"Uq
+UB!9SA1UR%DLpU$*PiP0ZX```YXFj&lll3EAPliK`PV'U`[Qr%UNmP&3$aNrrM5q
+CFd(q)PK*DLbaL8X6l"J9jY1m4+PTY%@X!0qL58``Sf@G#qURVe$D6Lm,Y3F)+r&
+lh@@%[DX2E%BC'3(5'T6p35MK(Yq+"@4934N2%PC%YEQmLF)N#Fm6LXEA+6`[1ak
+U'5H*C2Xe*iCf3T3-5+ZB(a88BB0r#j)SLCQ6ilYEe"#cUe2DkYpfb5[@Qm3R9`2
+Pi'3-&I(@F-j',K3%4SpNdV'f@J%qCj5HP2(ki&J#154G6#c$58rBNE'A'ir(+!%
+D2*YVZ3-pT14ZZE58p&b3!)KLi21$+TifiaD#HiVm(VUmYRB+ipHLjV30fTm64,8
+42hX-mk,U6EHmHc,P)3GZPV2#$AJJ)6'fPrMHLjL1'Y$f"1q3!()CibdQEfV60qq
+UR,k3!%Z5!50IJ-,(XM)#e1r8LZAb12SV1$1F[HqhEpLDb5LD6JA(S(rCJ-YLLBD
+-355JeC1QKqUj%0[CJ%lilM9T[PcJU1*rU15VS3KbMd8Ui(++[4Fkqq"'V6Nqm*%
+$B6G3FIGVl1[IPF4!TXpI*$&`0c(P[*[bXG,[QTUKjbA4jA1@IIb4`i(e`S@&A&T
+lJ,`(5*5lmMLi'i@&Gq8KNbhkRC-dGj@&1rRNhr@bR%c(AFE!3Nf$0P$XcjeM+&0
+Im%K"QCpP,Fm@K![*aJEBZ6%iK*)m58!*#ePT5F)k3DBI-l&*bc$CfZJA'fENSeL
+4ecTJa4HE#"!&qGVlRPM8Q9F%PdmXAf4L3f$K6B@BMq0frIjc!L@-[,USjC&L8%E
+CIjkQ(3KE4Ld%hel&qhhaJ"Z-'%U59fHHhH6*82UZDh5S9eNi9Z6)*)`"HUcE,*9
+Ga*D`@3G#NfL8V-*@+&a*TTp-D#h%,U%*@lik`,%eQrSrGA,M'*[*@'j[,TVmMPZ
+kX$#e!Ehp$*Jr2*UPcM#$8`%9Um&CELbXEr4e$j!!qrLP*0FEXXTNrke)'Ch-i#B
+88K$bZ14J#M$X-3UU@1'mKl'd#SeIm6b'L44-YVDVB+"4,N,)IMmBpGdTd9Bb!&"
+i"2)fUT!!0M,1'5KIdQi,Xm`0TIj&p+fcb)mmP@p(KcC321+c""A+[3XUELphXmX
+Jqak[33LCFKJqbY*$3"")[*8!rGS[LmJA4#MdMfibjDGS5+JpYTa-I)2X-C5-Df4
+*0*Lqr""(SqEVTMZXe$kd-T8fa#``l#%e3jd-`XKq#*FZ-V'FRAM4J14#@JQeIQU
+N2Um!-A89qZTIlaXGaF2Nl[&-4AYd8jrHI9@ELKlp!fi6KBeC3P%1eRlqLSF-T$B
+D-RPZR@K96qN8Q,V%$ZA0"j@Fp9@AX%4@,jadRVm@lTBq0E4fT!!*j"X%Vbl(%6K
+6qq,k"GR4m$%04)Kc"HiAc'PMB4LM#NdAd%hXc6K$48VF1YjUp)-H*%BFVZfU'k5
+PaRk4MaMrHjL,aVKGrNR`MQ*kjrMfC*(krH-5Pcpa+UJpHE(e--'maqra1'aKL'H
+kHrc2dQ&P@#LiX,K1BNlfR4"%Y8(b3BbU(HSJ*HD!!QD(+Q'N5Y8lhdLUE#'H(&R
+V(FkR(mP"F%rYp[61+ja4L4Q!'GNH4BNqJi30!6$F%aqI*fLeY&kdVJf*%p*RR1h
+F,1&a-Z(0XR9d*PKU@e0XUGlA!R3PXlPf*%q&RT@(0R4*PdT+`aZF"f@1,FkH1KC
+qm62V+I"X18M9%"1mE5C&c,6kT"Qp[hjpZEVm-,I(3ADfC-IH-q-%G#8V3CjG@C'
+Y)k6#pG(RI03LFJ@J@%1@bdp1URBe`GMicj(@-[#2Z#DC3G@#55(Hj(YKiq6KB$c
+#QB3&i6'D9F"B*6'E&IP+jQ9$dLcJ&3APLQf(V+,2XB"pM3lal&QGYZZXAR"D*E1
+T'PLh'6Z#jY8NdHG[j('#X'83$aD8I4qK#)(QQ(pe!eQVk#`GSAl&h5kjPJc0fjM
+A5ZIZ8Zm%"$@5''JCMdq0E@rDZ8Z4qrT3XAV+&'H$'@+%[TJr-Ye'-@Q4DZ1B-E+
+TPQ2T!k&diPCGl%a60P3l@DGaj+VphhKi)Z4lX,aXXa3KE809,89q9-JNb9D@CHi
+,-Z%`(G-Fd!6NZVJ"8a+2Y''pkHB+IL',m'EaRIQj5*45T6CiVaC934A(Nl8"dK,
+'NR`a)E0@!Vrq`@ilT$IEehHd#@Q%*G2,QG"jG!iIHjI)LSRqGZqF!"f42pfl*Kj
+eQ%GS6V#%YVf$I0H961GiEPBBSUV"i*Lf2%l`jI82`N*A+PM#D%kr3(XNHI59-Ne
+6"G!fD45$49ccR,UBBN4SY!Ik@Smja)9e+cDe3J2(GP(HTBKi`B+m,hA*%b9Z+PK
+GajBD2F-80,,VAA"k0bEm1kNlcqlAqX,e'lI4GeNb59I4SVNRKLZ45k*&QrDjR6j
+0c1,Brq2MKK96)0C3K4"1Fh`IPJUX`ETf&j15q`!dddXGM3DhfdX$91k`%*fP!5H
+)SQ[R%X1)c)G2a"Y8#AVMdqSLT)V'RR6dm4`SUeI1[m#XKIV$rbF#q2IHHq9fm2K
+F3[Y##5#Q2!1p[@!Y-0h2@!--Kf8A9J&YL(peCRh9%fB#L6ES+BQLJ9QAS(0ZXqJ
+',S1rJU5P#F$T2'LPGF$%EY,1f)ke(13I6C!!P9MUT,l)Di5mA`QXAIMpBk'VUeB
+mB4!iQ*jF%MY4(YQrLU[1A$3MZB,XBHckI8&U"TQhRm6H[*!!C3%JPlL!K+lRC+-
+UR3kAGFL*NVrdDMG))M*6!1EKmUh%Z"J'#0dL$pKJ0R&YDbh$`9KYd$V#a$lK%DD
+B`J)+FSNHlqE8!Yh$*F"(AYHhJd23VAR6%($08lGYd[-KGJhhGjhhHi8BY&kpTdC
+0#8Sq*lYQ!VMIfB%imi2CU-#BIbr1if8IUQq$Ad,i2C&D-(9f3jBXpINS'HEmVNT
+%r!GHJNH1rdUJM5ma`SXiNU(*%(`RLIC%c(Trl(M2F5dbd88fXI6Pfc"K&ah&#VA
+idc`l41Z,PX%LGJ$lYJll@*L&2Z6Chfd541RX$B24hU0JkF+ETj3laib098JDJ#Y
+cjdeGZh5a,3)$8NDSJSf@rA$EU*lqh4%#XD0'iQV0fV+28%m'Z*iSNY19l1XL,[@
+1f'&bRaBkSFDAqMT(C8'&,I[U!@PK`Jq#pI'**'-H[VkURQZci'V[2IK30fAI96$
+!UlJD@ilf5mLQCYplY+QIidK`KKL$-N38`B8&k6*HJf`qZY!P6hh9A*IcTq6J'cI
+0V,H#18LeGRP-)[H)i*B5ZGD3!*UVjJ-f@lPc)H@-Kh5QEkJ80SQJ(6c"4CZb,Vp
+iY$bV4--q(C%j,B415BaLK,L!9qH$dQ0"%3iIUR#9"B3h-p3-5,L(D#5Tp*1"q*L
+1*FkbV&$1+!"+UJ2qfH$[d)jc)qJ#Xji`jS1MURahAmKqZ)ASc0U$YbjH3m+Dp[+
+T`m6M*G0ecdDHV1be,Kj6T2ALUbZ%q18r,r(pe2VKc+LHrqkc&5"%BIPQ0Qbl9-C
+DJT')H)q!*3i,$G%d#[0USBZ3!2ML@`kb"qmjfV('H1VXQ`BcHFYSjVQQBj9deXY
+Z4)@`Xfd%9K,l9ekbFMQ4Rf&%`N5R)35ZRIkJ2LmX3D(Rl05#,$+%AdZ0-Ud,Sr+
+3!2h0jaN"QMrrPjHRd%eYP-V9Ib%c%JYM-$Hr%qc&Pe03T%ZTU0KbN5*2+3R25'9
++(ibd&)2`S29`2"X*NUBXLY(qhXlYImiMj"mdDD5@RpjDGSDSU*KjX@EA(+S3+ip
+0NpQ'J6%4$Ib&aP$pPe8G!'3PA(jIaQ66$*aN8SY'!UXqq*61Urm1qTkp1i8H&%@
+J'#Rcd`3QqL&M0,'Qp"a!Sm1CkMAL%0fHNN!*,"lpBU-GGATi,QpK(9i)G6EH`T1
+@[3MM64[fFJrl"9TNFkLQ"BCLclU+EjHAfP[(ileC-2m@jM*ijGR0S-([3&0F&N#
+PN!3"!!""!)#dSDNkYddlJJ!!)-S!!&KP!*!$cJ!4DHS!!H2N!!!G5J#3"!m!9'0
+XBA"`E'9cBh*TF(3Zci!!!%#b68e3FN0A588"!2q3"!#3#S"`!*!'3X(8a&YX(BZ
+$5%@ZT,mNCf6blr3R4K@-8X(N[0HfNDAiZV*-ap+QN9efYEGm!FG90KipU1L)Pd*
+C6Xld!Lm6qF-2RE'qrTDBHN)AE"U@ZJ0kf%A0X,pbHiUQKSX#Q*%mb[GeKT3"5RT
+Q62b*c4RbI$#eJq`"VjP(A+Y&K$l$bk3BZ34LMMX#CFcjE([,SrLqMIp'3i"#3-A
+HUc%lX&b56Q-0L1R&AcGh9`D&GBdUUKCM@RKC-p4!rd`'@k5YdAq5Qb9iE5+8Ij!
+!0GCdeI1ee8U+i5l%iTC8$'@fkTpi44U6XE189L8ZKBL80Hp(4U%q@49@cMF4h*C
+T[)IRrl&800MZJVXNA1S+P0C"B2,bYSm#MPFaLLmP*6b,&e$BLV"!NchYAXRJ"F+
+DHLc[)q5AQI&`2V5Z6P1dD19-!fJ48c*#jILEAqem8!hS24JYh'l`C$!i3LA*ca$
+rNVj&Dq%#Y*K3eb$)@4'"YEjC@!qNb5YLTXNmRK-Pl9jeiLM6qEmE"29141@QPVh
++LKcIJ800f$CIV"R0rLdIUq#A6Trqh$KC(Gd(VfB`fP!!(cDhRApJNQb)qA3ZMTb
+p!PYlJ$YIl43J9eHmVdrclTa4Vqh[k6d[hG-09RG0fIr[C,qH'Sp)k+mHf2r-"J5
+3!)VU*I%[0@Qkq#BU-VFKmJS4lSk1FG,D518DY5phTS4l)RBa1%i+b!X$`hqJ[Lc
+5QdM",BMlaE%@F[[#rdXNi&iX*5)lALUU'1$-$R5@!-e2*[2PTAAb'M56c-IT3Gi
+Z(,*Ib03,VUea1X5+bR'UB')JKdB3#[F5N[D'5&B3`UGB+rC2h$(PLL@,pYXHi5T
+d0'$Kf&CVCRp&RJIerKD@ck`$ecXfR0)i-*AQ1@MFZM@iARUJQ@2aq9XIV`&+K,'
++VZk'[6V&@`6kDD4Y9p)%cVdQ#Abd9TS9a,E5IYXB-FNAHM#qNj&Urp5S)RbIYdc
+d%F*ia5G$[FFeSQ5@$,DNfC(fNGR(29a50UKJlh4A52MZiTHBF&NUr9C-%CB`ZfC
++*G"BmPU'Np""VE"Mlp-LfUF)ereP$8KNK-V945+$$YHib'9X`Pk"h'ZjCVB!V!d
+hMfB8%,`#YQ5+Qpk##45I3a@l-Z@[8[+N#[%VH2PYT)f)#Alidb6MMH*52URH3pl
+Re&*L)(-$K9PcaNr4dS88p%-*-J)aMD",DHSH89d-+HkB0ZbQmNl!#L2p+l"N6PU
+XT+(XlV5'2PX0fT@1IUQ*e9R*r'0+Y),T50e[fmF8!)@mFCVE$SPflD1Y'ZEhlJ#
+XKXJUiYL2R$XEcZMiC@301dCERNILXL$6G!(UHYSPVMkShdLeB'1a#pHI0`j'YI`
+iR0f1#BDJ$fj#9B'a)kI8VYF)ifKLBb,Q3k8K*85e1V!TZ4*Vm*V!RP#cmRYeaVK
+L*#'B1Tmb)[A-JI5a1%CpZ*M#Q8m$2@DkKC5XTRL5)NS-"fmikUEIl1$EXA0eHpJ
+[Ueab#NSqGC5E`eUEB(r$!!fARjjhZ&1@md2%MmMAK"CPFVmCjTY&'-,d[1B0(i9
+Fbr3*40'593!XEPVcm+XEUbTe!JVH')qRBpaFSrU92qa3J5Q+chDd9-m-&(5UrJe
+a12(G$XK9klc)i+G-MH#G21f@AAr5l#BmM8mc%4(EYCTHhI&9HEY41b&VbY6d1+@
++q0#Jd8NC`DDF+RXS9pT#AR)U2,9-6drC[3p,)CMmJ93GI`4"`Tq$!!Uim'qAQ'5
+LhabUMicV'h-@b!rJEbkf2I4-LbkFMKQE9!kG#pBmH-4"VA)f&S!lMSqm)Ik3!!*
+b6D3+b4kKLp0M9U6+!6!,Vq0@LHK*"9A4M+)del,',[Y,Y*,AfZ!*L,b-+C-'JKh
+3qqhQQh6-&pY[[@a0!bK#HBF!'kI,j8r-fmTP'lUi*B60B6h*1cKrmpM&(,qEiUq
+cVD9H5QG',KLB'Uk,Kp!S*pHiT"M+%$2Q0ErZlr0'K[Ri,DiSf2pqhJTQ@i@!D-I
+*Df&09%DXHH%!D1-8F9pAVSDqVTP@2XKZL9FZ&4c3hNXEmR82M(6DJpb45H6D#Y@
+LGV@PrSE(k)"0*)m[53&GSX-hJ`VG'D3#XJ2@bQ4#1[XV3cL`H)Gr$AcUYrir,`A
+e6Tl8X#G!$Y`YE5!kheTV&NG8"I3QLR-AUEh+Zqf+D%BUZTB@1k!3AR)`M65!lPj
+#,2i6H5(6ep$BJMd)mq5UC@l5q'*3`-ISi13[#,aK*k56"3N8"Y4IXY(jJ#K#BX,
+[4"qjRf"r!qHEcqpDNFRBmhiP#1RRMmN+L3*bc$Z8Y(Ca+&N@65!R$$Q)PRd`2UU
+MB28&r''2,Hh#i(mf+&IH&*p'h"K+HZR1BC-`YXC1j8Bm*f2NKPjDeJ+'%1Y`+E5
+kRZMD#'r(bGNPL5i2&6!S0`R5a6RIMR#"UGJYj3$r3l4,J46,CER`9iB,UI#@N!!
+DrM4c2)9*BSCiBZ['PIl#i4$NQhcKh9M%N!!TS95#S183KK+Jkdmm)L!#6[BI5ES
+0U"bLjJlm#@&fZELJ-54pTEM*C%[chPRerI&KT!DCjM9+Q(Tk'M2$r4NMd!2pMD*
+Bf68QQ-#j#6*e%6)LS5Te9$$fV[dKZ""KL$ZeT@eqLS4cS&D++(9qfaH%%iJqK8f
+CK6)`@mmrLcSJN!$dAd6e#p@b"RDBXk*Fd#lBLVEPTD*Q6HmqN!#R-QTl*LkZb-K
+@jA,-N`&r'R#Ue84Rr)a9&1Z#q2AF69Z%rU'Lc5(!5*HK6GU8MFUM*D*Z-Df'K*6
+bl-edI(`"*M2`Q0j'bJ9I-"q*rCCHkN-(h(P!cS!YNjBQ'GM2RYEBLQ9LkAPT9UC
+CUYaJ9'j1!GC1@CF*Gc3VY3jDrXeIHEBZ4jNrVSUPERekfcYQa+@X'chd*8HJrR`
+QI#YGNci%pcDef[`mL5e`E$8K+'@(!8e+b+8IeBpp!F@ZGcH%I,,!FU6eG%1QX@A
+TfJXr6h[rYmRK@MNkK*EkR&)d&PKX&#IZAUU`R9r*F2`k&)R%INX&1!m69*I(bRr
+)K4*$A@Jm"(Q"2Xhi[PHG&8(MG(#Gf!1%H)C`4%r3pDHN&GlM9Y&-bMlRrp@R*1!
+'*5N%YBqpF,EU`i9TE((r,m&$Q@1M-`Pi!BH)mY-pe1[0T5hT[bj81f&UDEr@cAE
+L`'LamGPb#jHSiCid%C@*-1fbk$*2Y`lTSJ-&V'+H+Eaq#)iQ-[YNFJ(EZDpNe1$
+D&J2BS&lY+#d`pD#d[V!pM3eYKFD&-GjE1c$b5H#FKB$LYbE@,A'$l959)JP[L&B
+Y!-I5ZqV,,2)3*!3fiUf14#)$-"E!Z3Lk#J!05VJKIITL6`1&fF'DIZ&XVcc+)N5
+hc-m6m!Fe'"V$D&GlI,#$jmY3Bj%T*Xqrjb9&c%@alC0Y"V[pP-B$`05c5q21ihQ
+#&+JC@jH[*)U(`#IHN5XPZhBiBFaZqkK8c1&Q-QCGBSR&9KjYV#D92`UA4d5R5,Q
+@*kVb*8h+Ce%9DBj0+6I-rE(A2lAaICe4r0dIQ-U5Lp9h,+B4T`j-(0#Gk'Ck(L@
+LVCT$V,k5jSpX&L`AD!bED9&ZE-"@ETF@G(X1Ac&Teep*kj6e&I[(fCJP!Ll)pi*
+Nb,h6J18UaaLlPS,Gm[XPDG42Yk2LR8Zj*9)9+pLMrVI2j%k25BhR$Tkl2V4cG8a
+%PFMF*`a(e,UIdbhlI#DLKjAHhVmXh9+NpML3!,[#@#!j-[f)38X2"1dp9j!!4XQ
+M&Q'-'#qjMQp+&U6N5b&'b`kIB0FALjDDXrVFr@d`YTFZCqPQII-a5hIa#CRXa`r
+R%&+&YPei!9pH+1[CdZ[NT0[!5BEJLHqPq0XfVD&+Yc1eh1N&Le)!r30qk#drfla
+%S[Z`9k`Kq`SYh`J,"d&pY8&@2ZNAXE['VKNRECm+dRr"l8qDYkmE@-c'&1m)f`&
++Brmqp"BLh$GqFT'Vl1ij$PbNjfjFMK,E9YR[P1UIN8%GJ`Xa8ZG%4iVd4jcD+SV
+"`CJb5H9f%FqMSDkde-0p*DAZmGb'&2qA5jcN!YY*p'"mp6Qhm"[a`Rd)"K$16EI
+eSL&Iq[*FKEH`q"8mZK0*U*i(dPk2`lhB"ACXSaq0@E[GLN49%3bjC"!MY3K![,S
+*`0(R(U)S!'N[lmmPMQ9[*Q6*!M1HhpP&rX2c4L"CCAe9$Bj,CXr&R`$e)!dQic#
+$[FXeR-*qR"Cr1a3N'#J[R)8SI01&DP%k&afpMhJFclFhdP$FPchhZ!iG6#h$ecB
+Fb$(p8d-UHp[rJAq(JIQB-+Nk1MP4*kH4rYG(V1fQC4eAl`"dM#MbcfGXL3T8"fF
+cGp)1Qq`VJc[+*$S1YH(Bmd*YJXmUPhp'!H#!S4I&mAVlIG3Kf-26(4$+riK")rX
+iID6A`&mBp$YT*ICQ8BbM0,MqemL-&DNY,XfMA6rGia2iZmUS*e[6d*kPer"rHY)
+-kPQbXbbPJqCd%N1P-bVVYZYjCXb(RR(Y2rV)&Yd3ZC81L#2G$"llC@+meT5(X#b
+XD)85bBq216R3L&pLh"amQiCEk[q('Lq+IpH#Ep@Jh!C6lKm)IYq'@G6XYk89#9U
+DV2TRLGlRj*jF8&,DqGZYSkQV14eL#e@H&+0rU-DMYih#8J6"`@YD0@B6q[[e8lk
+U+Gf%Z#PL4$cK%pZS8UB!A)dRjrY'fBLjZV`pPi$@B6N9$IJL3IQr5XA`e+2kKA*
+@$6[HHXQZ1((pD,SdlHdF8!#HGFa4mYrFkie'k[b"R[qe[hLG,p`QGXPMiFZqH*9
+ScXQj(8jDq+$ASH$N"a`'U'bJ*d01`e2Bk8`dNhmULK`QIpZr&i$LRd,h314Q8kL
+2E1ijhEm6aD%h(%Vc0i,dBf"630Q-ZiYaUARLb2RaIq"&qQqbT0@AKZrqHHICA#r
++'C*GZ@a`)DbmGHAa0i@[lYffGY*S-K,QlTPdXBqble6D!5,8A!8$PiJ$@e(e#"Y
+HUSa#A+U+F'6&61+D4Kdk1$VJac*'eqP&TpIJ*AF5%Umeq)EZ)&dpGkQHHhh0-MF
+(T@f0C6dJ'm0ISN'Fjf`k!cN'4%D2%eScB1r@a`VC3(QQX9BX8k5FfFD"`S&p@'[
+6TGXc*mQCSFpr[&0FflDRi#aKHfia-(60CLC&S9(eXq(N)m,&Gb!Z!EdZ12p9!(r
+LaZkJ#Z#0YmBIckc55q$SHdN1pNm"YVJ$*#U(h`k)bE$DU$63T'%*!%d@ILQj8%8
+Z,2X$'h,Bd%RHb2ZQqGHVTS3#hj!!*K@FY94XaKF+0e1XMZZqka2,'KlTZf*jih4
+K3p2Pp1`#NDm0f)5pVKecB45Q*ef&EP[K*p5YX*[)h6BAPGp%le"#F&D(P8,3'YT
+P&bRNGUqUjll0&,[MJ,pQhTQe[GI*U"KlhC*+41kER%0k3,G)ARPDb6iFL,iC8qp
+)ej@[S"lL@UCcDjmT4Y5I@q9,3bEQNCK"$ib4k03TUkq-N!$SAF2`A1l9HkA"mSa
+*DrIKX(Z3!'2e'FXLBY,JQ&,Tbj'&-E2Z3RaB)jS4qhfN&f,8CMM@FaZ"9)UeSUX
+89Eq"cVdU,[Kj[+2GdU'-cZ4PeZf8"$k[Q6L@fd5hpLV`Q4-I1qMi)lr0EjF@3dj
+F&G5c[r*,f&4ZqH$8%$mVZmp5aTaH")Dk'IYSL%2BPlb6(!NZD3F#%(jbp(Sa+cl
+DUF2YM,ZE0G6)dE52Cc[Ak%Pec!UMHb0TR#YVfV9%6Eb*&@H6)qNTf)9"D6Ekm1J
+(+ClQZ3TbMbE64qQVbkJd)i$h3c'Uj[BM(X33h3`68ASfA`I@@4jYGRCR$CQe!f@
+XRPl,6RMa5h@kP-V1c['ECiiEq+Z+d1EYQ3bJ+YPX%Ir$",qTK-('K**9ZZ!Le3!
+GFYSH$q,UK6JTJKH$dc9Rp23(HAqFp1Rh%!EV#!LR&3!,[arMT0V,iYK`TB5ZF6e
+N4@haI,UX"SG$e$Tm4Yl,i@bk28D`K`cAYpd11J6G,,!2J1iM,@8I`hX9T,,XJ0R
+R*eA+fUa6"+U[c9HiEpqHk`HNkhI'QYSj[HD'@Ajf6[Mf&R-!el)F+rfeZT*F+f"
+dE0iSU9@%IQ+%D-36(R(H(MdlJDE#eErhfS#($!F'[-@AQKZC-L4f6RZTk3*YQR@
+GP#$0ZbV%P1Ullqb,K!4V)+BadTa5La'KZN@j6@B@@EE6XX1e'mX'1@89J8K$J@1
+'Tp)Ud0he&-S$PK$CB)4dVISR&apED2KDQqM!d2Tc#8p%mK1Fh!&,,T%P*''m*AH
+,e6,kH4i,VNT+3hi5&qk`dSZS8G%HKB6QVCY0XjkK"PNr0ePkNJaDVUe4THZ-q[K
+F+LG@Q"3D8GDMZE2KQG8IJ*!!@@#jEfXrjf%A2MLmQGdCH(Yf)T[M5Urb+dZFGJ$
+CrirQ293T@VBDm)-b@AFGrIpC'$a9d@%+`4(EAp-*6aHHHc+3!)Ymq2I))(UUMHa
+!)8p3[EqB%HP@mGD+&q[)CiC',CKSfIcm'H95*6kKQr1idKUNjE8+U8ZL8H!qCZN
+,HBf5'")j%aP(,62V0Z![SZSAqk$dh&BNj89YUKMFPmKNf0rmN!""2hKKEbH13-L
+h!*a4I5$Xh00"+Cb3!+"KKXaaGdP5fSX@p-KiGPXiXKi,(L-%SSrfA4J!FVS$96*
+b5XQ+2[66[hGm'T!!b+51i-KC$lV$$)9'KXAdZ[+pHF#MmE`T!jcAQ([I'%V3Gr`
+C[',ISaiBDF0RT%SjMjqlj'ZQ+9T4K3EM-k`AH%3(2`JGPY-)(FiY%GTkZPVA!fP
+M9I[!a3@l6"C+0'S!!8Q%TF+MrNTJY9aL!%"5J5@iCBbchfL4&9e8mHd*RTl2@5E
+RbK8T#JZC'!d`#bF,m8iX64fcX'*SaXh"q1jSfa,2(b9(#"Lb)MHTmrK6V%[cNBC
+5m9!JQYFfaC1Hd63jdBbEFfafG!#eC@RViS2ZGrL%M5"'b"kF5I@)2ArFe`NJl!p
++YG2S(+"f+(KQMeL"q@bBNe0@p$fSa1TSqYdrN!#(',kH[YHh59I)c)T0#T1I4PN
+ePA4Q0Nfde6DYV4CpqdJl%hG%iG-)C5l8(i8'GP$KX8YkJ*)Kj6@6F'`9JMNq+cQ
+-f3mPRfpKPdVU6HQK`$jIc9VTrDGf+MNEmd5RrNR`Ld#MPVTLl9jY0%5B"q,YR(`
+-+U3*)VbjGpeEM,[q2K+Q6Ph`0-5cQ1q-Q"!KdABcUliN,CKYR51#@!kQXQ*kPF`
+DI+bUVT@'ARd`a@BYE'UG)-h2!q@DAS!3$-8hA-*cqEE!20H9CQSN&a!Mh-[)q!P
+98KdRMjJ%0eMVQP!%FAfE0S1iUJ9RV+SiF[6,ee3R3DDh&K+M`l9pe6!MH!6PI@D
+8ijfFM21e!G5HYFCa"%H%hH,CAceFe[AMUiJT+6HHj-9,TlIm[VmS"kJKp-9VjqS
+*Kim5mRpJ3M1#B9NXL+kN5jRCY0jjqN6U(6+TFT&8j'[341Y2)NVIB-A(DJG@+Ur
+EP@[p2NY2Yq+0A'IMYR5d8mI*dfM66c($iTASbJ'I@1E"2jih+V(X!![DY#8J94A
+@'l&9R#fMVi3S53V#5i`d&FL@rNMqVjHN*QkK)BZEZ@N4'k&aeSc[JYB6[XC6A2C
+AX$q526M6,K"qK8YK`2'80hkPlp6+1XT+FpS1HMc+IT@$XU[[ZRldpIh+*Z!efVA
+5a@C%Gr"(Kk80Ykj)mE4QQpJmQ1"k2dZUFFfZUAr@QLkr2P**6`ck1IT*H9De-r&
+3H8D1Ub(!m9)E34Ka(*4&!h%(IIIELDRZ-i6r%F1IcJARlj@5p%*,J2)JFaUJ6XJ
+!GDk-E5,@Z4eTD'3e9GMSZ9CrYLS&K9"'NFf69)AhGU"SpDTlEIC[rE(ai)6d5eI
+B%8$mGBBPX9)f6P$pEDL-E"$L'bN#&DSUNh[R'Yk5N!$mPCrF3Yc3HhQ%CaGfA@J
+%SXH2Sfr-cc"kjMeT3V!40-CX$NXjR3R)bkKQmTA3+rE&6HRT04%kJLJ!("R#TkH
+4)eEXb4jd49'4&4*m5c)d5diI5HlcDl%aQBcENkU)"Ip[VC`[@AAV4FSN3jjhAF+
+rFBJefaRA3D%Hl)F$kb3dZr"AmNDbHA*$RSlppT-k!9-(38APUEUm*UI80rGFhIr
+XG'VUVmce&fU%kP@*268,,JmYUkLHV+b3!1$V923%kGYp[mMHHAV)%Qc`&ejQeHQ
+CT!DlSI'4EG1D+9cFSc8p8cBaM9SM-PKHYFdk5i8)(al015UI!GF@H2`LXV9l+hR
+d0cjb"P@0[M'P8ZmmPR`E*R3$)@INar0C"!hC3Li6c)VaSGZe#l*jL'$d0Kh9b'r
+bj@[@$,b2jBFQCm6#l)[)NiCYC,cae,[khA+80I@P0*a%mU*-P&`J(2Pe3fq6(NH
+UB8XD5f+E+#6ZDGl'$2IVL@h+N!"Pm%eRE8U)cH3eTjNi8r8mC1"$3h8i!ADir%r
+@[G5*mp&1550p6+TFJAi`Nf%1a!bZXk[pCGq"0!"eE!QCpdJA4'rXmXHY64Za"GA
+2B%%GacV`Q1jLZQ!(eS'QQP,Ue'%hki`9UR5jRG11AJh$ZMbPBm'h`"4m!iVd#JK
+QRdmrl#35`ML9R*GSM(X6+UJhfEmVEhE(fUZ)$b83FYFlq#TJArR!&Z[$I[[%$&4
+-)H+IZRc[m$c+*5VMGiae`Y0T*MmNPJ--9HC!@@!U`hIA"Z'*)!mLQ30U@qVHI1-
+irlGFb[d4BYJ2#qJlb8%DYM&bUK-Eq1U+R,!6(jhNl2Dk``8`)A6Zce[SZL!#3Ca
+B(f"(ZF6[D9pTNTF[8MVjXI"kS"1C4r,9p3QJEcQM"NB9BRrJ[+p[Gem'pGjYfhA
+i6YA`j[%FpF$A0!ii[6)Q'9JP2U,UiH#lP&`&,KNC42pdVqZMC13R'+Jj!1MkK%&
+d2jGYf6HUJ%FcRILVZSXLM+4`JK6+pFj+ZbEEcYZ`Vif$![T)mEM[#`5B#AAhd,M
+j+DjZ`)CPC[S0j3iGU,"2Cj-Sm5Y6LkQ`amqPVlS&!pG*9T`&h!U&NCCA$4K4KhH
+@NX29bXkJSE3mbGfU&Y2e8305N!"&j'M$5RadSm%DV2LM8RaD9mk-0"DP'%h6SQf
+ki["G1TG#Uc#&#!pBe,prG"jJbd[`,bTCp%eped-UQHh$,,&*Q1p@jJe6"J&5e%R
+"4&4ilf0)(a$`DFMd9`fLb5dfZl1IUTX'6"9e@$KMpkS,YJB6adZ"%h`*[LJR4+`
+&AAh`6)i-XmMZdPR%PdAZjUCQ#'#FZM`i-#Q["D--Y#pibN,(00J0$4PcX9YIL5l
+)i5k'pAa2,c-k55$TVTAkc9&CmkHeLad0GmfS5@P$LNFRfIkql+rqZZiK4GdKS3a
+ZGTIJ)IUL84lbMHjQU'I+FD#,qM2eH0mIrmNL%*9iSRCRURa0X4$kj63N#H5[cpq
+,TCmiX4$!Um!BHhB)8Hj%&f#(31AF-%""c!M6NRhLKaZSCcYq#PkaEm"3E!M@kMA
+rR(!%@2DM9ZZeDVR60rp"fE46q+X,qeNMEN[@DP`![lhR)EHI4K)Ylq$D#1AJLID
+EC+Bc$C!!GH"5Sba3($Ck,8j4[K5NQ,6`1SKki))dGYBU!82k1(9TRFpD"XI$!)J
+5h(YG-9I59+`U0C(!-!V6IVBi#5plX6,F#ZJHZCY4bjk969Z[5m2,feeAQL5MNip
+IB$eeF%a%09k(MiQhiBmqYNjqjc1T%2lhcCEIXA)3je1b0*`!D%*!SI3,NaiESEj
+G(PbX81SGTAAKq6cR*ENBl*I4`C*FBfP[Xa299N(HVM%2HCI5Z1k**""CBPUA0a9
+6D3!)R+DYS,YH+pU`[N6kHV$rbUCYhqlc*93&+5Z`F8#cYYc-D9r1%l-FY#aHAfl
+GU4,TLQ6!b(j*KS(B"D(Si(926LqE8MfQ[Ql$$i@j`&'&8bU`4)0#LElHSHS2QR*
+KU"[VaGHAB)(ZlXmH)Rk$,&BIbLTeE,-+il,rXdcYMU)!&Ta2[A4(QU,PATFkQ8h
+3K4KhI4-f8(2S$$l53eXXBq0X`NA4K26frJK-Eq#"3YX,A40FRBiJ8$`JS%(Gl,*
+CFbfl)D[BMKT`I3'2m$+(FCViF@&h!)83TC!%!3!!43!3Z#2DSEJMfU%!!$Uf!!"
+[HJ#3!mi!&Ab"!!+N@`!!&U`!N!32!&4ME'&`F'aPFf0bDA"d,Xq!,RKYE!!!Fm&
+849K83eG*43%!rj!%!*!+J!#3"d,"e1,,,[4c1[kGP(l3CH2J[q1L`A0AZ$9CE,#
+R[UmT+,(r18[&%a"P%)!$6c69(Z(K%BL4mb(fq%,`eBFPQXC,P3SM-fbZ3@L5#Ir
+(IarMAb2EDf%%bddK@8Ce$CB[$Q6r'%1qUa1-80!c8LQR&D94cq"*I5jaLaBEB%L
+e2H3LG8,Gi!SMBpK8AI8CK$4U3%(iTJQ$+61E8ZF",TrZH[pVMZp[G[L-'e1H@$&
+2Ak2%Ar55l2Qcl*I`[V6)9$2`TEj"KdPBa"h9bRb4d`JMb-2NXU%KJS&r9N8fB94
+hli%5FpfTdFc,D2bEl8)%1!e206-C[i*%9KT,PbYl1'Zd0ZhEc(Ee+T0KGbhIceC
+0LBF)N!$Za!mUZeB5Z"m-[@fEimm)SH@I'#iKV$Z2HD@rYLh)`0J`r8f85eYbQii
+-Z!kJdeU"N8P6)8-2CZ$F['XkjiU0Ri)*26-@YqZ0MfMJ%9SI[!#0bHrT8GCVP9'
+kJ5C[+C00#LKGZG[TBKN24L@R4AEJ@BGJ+4+`m1Z$V!YD1BQK44QX(%*Bia[i"PP
+KYh%VM8KXr4'[*NF5Zb6"D98d53Db&pD[I'ICcpcK2+)h"rLM"UH%h3QdTdIK!F6
+Z'L6'cBFYIXaEA`2Ep5lXh2@r"P@LKhrJXRQdU5efMeV0JK-Iki&QhG2QXdJ3@K'
+j-apI4!&53F0eZ)bl1bAdSjI@p4,LIGf40YQK'%41NHaQ'&pMNp6ZI32QBS#PH%m
+N%rZ4a0hFN!#U(bIhZ0%2j&!QHhK0BR4++6V0aaF(q!rH",UD*$k!3G'iMbd#,PB
++PDPdM[0rYbfV@Jl#JX,rV[V'3Cp!pH@9SkX0FA6SaMRi&9J&Lrj&Bj9aM*9e!l9
+!RiZ!m&YD2EFMST%3@M-KRi0"NPKJYfeaBpmEN4U+)SRk-Y0+!JUErp#S1NSMD3e
+a!I!kQ3U$YQAX@fL0j1C0JmQ9bc8I&%'ZbJ!+GQT#@E6BQY2*VPpKPrr+R991hf0
+fB'i&4A[C`6iT$0)U066U`@d(b4IHc%2$pGcU-L'Y"VqhMAQ8jRaeY$Y$dJJ9+LJ
+R!K`K6mKSL5EkI[eB-i$X6!j)MJhe8ep5KQII9"TCI&qMQ4BRp"H,lmb`hK!ilES
+5-#qN+M#KUNSAQE5-!9"YTRiK4ZAqqA18HB4Yq'h`P2P6)G%I3X!5DDXlZ'+YA4Q
+G*'"Flkf*[-N1!$Zm4bCRj+8Z$NJFTcjI+c3am+m$3ThlEi@"4[I3P,er[H"!a90
+*fLF[A`XeFM3V5J,1qbZNaX'l,ScmF`ALZ6p2jZ'3!"*YD6T!#F'H%f3Z[r&jHb%
+r8BT'P8`Gf&",`6%*pqlc#cHedljTpaahE$@2V'@EI&AFk8B"HUb6'[6c6X[4pT8
+Qr8q[9ipS$(Q+h`3,c+NrX[413(em+SbLPBq`RQi*lY9f8m+'R`SHh0X%Dr%Jh"D
+ST4AMSF)R[XERYde["h9`hfLb)C0QM*Pc5HC18Ji9'20%)PIrG"!99aaaTjVq[K%
+mMY)Z'mcXrS3Z$l0UIhdL)+J5J+!`hSa[r`MPcq55*"1Ga@PScIiPXjJJ80f2`U(
+c%i!kFN*$3F*'`KS*SE6h"[`#-AEIM2BM%BhGPcB!iX-c81*pN36U4Y!-e40Icl(
+q2RrJG8$B1D3S!h*2FP$cAk&6%@0*%&jeS08hDpA0ePD65[Hqa)M'V+ha!V#*+k$
+jm,[S!dbL@ekj,)3XXNFfHLP-@N0"KZceKh,Ce(jaGUa%+e))hEa-KJ#66KQB"h#
+Zr#+NSjVLaeU5,8C0r2TBX2YU$@hZeN$kNT2pE6,&)lAej*GA69kK0pJ0BfJBYbk
+%da8``L`-*&i1hF2hDiNLQVRl%(46LB2l%-UINKZ'%BhHAA03YQKUT6afNB"Zk#P
+Td'TmjIT#`k*mp`@XEhXN`(E)bL3FTX9MF01`RA0iVJ"1m6LkA"QYlaD@62+9r#Q
+JC`6P)5SEG9ZQ,l3pf23`N6U6[1i(-P%2KQ(KAPUFd)Gf*"fMk4B5F@KCf0p52MF
+dZMR2TD25'h%DHK'YNAlL'(30SfCP8NDCi6PG$kPK5r1RG"[p2Y*4EVHfJKeIepE
+E-,K6A)aF0J$d@h8k0)+1'X$5a0IXkeId`)S,BrIQ[T8ik3k"URFBkVa88)'80MT
+KSZ0*4$kqB-Nd3aPMa34j%+pZ3$TY3bDk&ZG(0mIl[A'b3!(midmGFfVLPZfeJ1)
+T)5m8pVRLI,bqhK[m&6TqMm@2acE$UlAE05eI*"5cUMhFLf6k1JBMMR#4PX!9J1G
+bSeHS&"-6YB)33e2ja1f@9A%[*@83%D!#UkGc0&)$`h5q0Uef9A[QfG,2!bIc4(@
+-hh&`&i%#0H6K*q%3BjZ-cHZcfI'V@PdH"db*Y280fr'#)bZ%*bd0"hGp"*FLR+"
+$rZFQR'%T!-EIiE3YKAU(@&lB0l9Yi*e2(UI`*qC0&`f8KGE1m6Q,rfkZX#*-KE2
+Z5%NQpdUT$J!G*[j%'#'NL(JE[VSIcVc,9Q[bNbA!%@)"8&P@F`c#9HHk49#M&aF
+3S@G"K6pj$T1eUrEYH"m5U(%'9d")KhP2N!$fY$pCPKqJdR9`Q9Vlfje4`PQ94b4
+-cZM44pU)G+(ZK'@cVQ9cS#@*caPhmG(@HR&N[q1[ak,9Ck9+Aj6E1+P#%,THLDU
+N'+C9GpcJLS,jjhF*ZB2EU5C,Bk,B[cU5jI*Q80(p8Vr4E&CXRBI#XNl`6EFGXjL
+!"dIPXi6e2T-jPAKEh#AFPPpFpX,DaMrq![Q6-f!&d5V$cDMQNQpHPlfY3"'0M)f
+Z6A[kLp(*HX$Lf3YDV,iY@cRIiMGSplCh%3`VAMR*PcQaS1*Z8)pe(!q4e5*-Er0
+mNCZ*4)f9SNm2`HfZkjb8-5AJa-cr@4T5eYZDS4NciT!!5$+qfCbUHBcm!9ClFd(
+pEqDQV%2dPXM"HhQVfHB8bG'NH*8TK0[aSVm$"%`EaAb#YN948F&iQH8@##3BA)3
+$Uq8IiS!3'k*FG'cEAd#p@jjkp5Ba+GT5`Z%rb$!1frGBqP5cG[J"P#'i!cJ'LV#
+IIPp(ZTQcFi)eUZ'F*a1RbjSrbTSaKN8L!iIrGb5ab8(m9*4Rk9JD3(RS8(B2Qp%
+3C"bZkBB'FrE)(Ym!F4B#jU@af91CNEGJU`a3EMA`6`0Ze2lMN!!XcYGi2Uc+L%0
+"$'++&GjD!)eCNSXkQ`j&!Hddpi8+KThBI"HaD@[#46J*8CCZlFQRC!cQ2VXA3F9
+2dN)kD,cFcUB8,#-E!QTdk)`$,Mbm4H(@CS"PJke3QF00VZNA4b,mFG13!$)AYI$
+'(AjAach+,RTXPG3NPf5fZcJeIp9-1LKa3IeUh1c4GNND`h"-dfd`4f,J0f8qKTC
+Z%AJkrPSk(L9l+4mL"p3bBj!!6,2D9@Lh6dU*JfhH&lb*PYX%&JI%qCGYp5ZkS@p
+cl50m&NGV$PhA4J34GeYFd0jDL-Up"'3K@P%fNa,lHh$4@eVBLI-R(CT!8f*i31Z
+`YrCkQ1pISe(N2UpbYqE0fQr&PG`$RlXC$hdF!R,Xm5D9iIV@@Z'(rPZS(G"Y$V*
+43$1G"R(428eBPV0!A!41DVHTJK1aeFIr3chJN!!Z!$Tp56e''R1JFcdJG)'lkDX
+('1BlCqM'KKfF4[M3T0Al%RDTV3UaE'[F`%CG,Y5h4HdN[%q[r'8"SacGBRF-c!l
+YEUDebP+,D#Jf'+'Rlk%D+m1Vc9e&`@AHU6'AAG%cSG9!HIe*DDF@idi3q*pcGEa
+FLeYNVcYb$h9p$K!@[Z9l43-Tr5U9CbC3LXdafT`45-p*[plR+l-q(NE,XpUK9T'
+E%emjcC5Xq)(Xl1A[$G16'8mQ4X&TmXfmm48L@A2F`Lf8$*m3qj43ZZcV,KqX&AG
+P0*hHc3%KHSIXXNB8V@[6f9rKaRV$El8*i9AP+K2pJDcBa4U`U,Hr%K4ihcT-#3-
+kJF#CQ2rc!M*N"NNNrGQX$aXl-iGhVG)U&LM4HYCf*Y8%JD*h$)[-9,pcZ8,LZ2I
+XC4,9)YV,VA-$P&f0UaH')**XVMKZ10&cKjhch8ddm5lEPqk+S[4+F4&C[iR(Qif
+8IeCTr5+[hKB8ZalG$PdMl*M+"A@!X@03G,q!EqU-RmD#F`jXq)[c)6()CX+ZXNi
+r*mm3-ci`JZd`pIH1rBd0&m1m6hjb`1E$1A`Qc`l!j1K@(5[#,E'!kG+c`CGY@0Q
+BfrS@j5DL4imCKmDS"HifQYbVKIES)DFXb5"4NbiNTX&DmCmc(5,3@03+3)f%JJ+
+6+6XRerSN3(AdD`%"Db8mZr!$d"k!YI*PrQF%IBj[r*[+AYJ-(U&G-eC0TH*Nlm[
+[eXU,b(B3RVa[#E(r-QVhi,B3Ic-f@DkimHdJep4b'+im[c'Dl$''8A2AT51i'J@
+fPXIDQ)[U9B9m,8j1rLr0ePfeKR0'$$FT'TdYHJrqB(MFHH8dBiRK*A35+lCA+pL
+i%rkmEGUlBZ"GX#"RqB6hXi5LeAQpR*LhbESe,84XeCZ+(c0IV[aUEF&I"PbRalQ
+pD8$5YqIF9H`,VbF)aQr!Rbp*Ql@BE[idIG0ql6lDE'XmQ)*rYFQZPTj4X)"h1RF
+aE[MS,EmM%,c*kdbdD5jIUkb5TYHFf$Yii[q"bSJrBd3Y`CYRmH4#V()3ef%eF4k
+@5@pX-#3QqUqmqK&%XqX-Y(G&IaR'Q0R1"JGSI0+GDXAhK&e#KrQF@&eh1Ua$jC1
+`Q#L5#R`)E!9r"MSad1kD"QI'jAeXZ9U!3QH-j9m)8Hi"5*)#E%-cafUc6b63JG4
+E31eIDH6eRadA2dpqM("66M-CrKrVIrq3!%mQk'"M8%ZTTp(Cb10(L`m2$&462Tq
+621q!jXekMP&pS1+2f,m'PVdrCIE,db1X*)r2)DLqJ3R9R%r03!BAl6F@Y'0"Qi!
+6502FJSdECABYj,*SAr+G&f(XFj`qDMhUUr&h5l(crpr'R3Jp!!-d0UQAd)-e#25
+1J*F&i3d8R[J`D-pl-@2GKXMAKh!,A)B+&H3KeVYP`HYBA%'G,T4qkGSU9c01ED+
+PElc2@%lFE2LeE9#[SJC"r[Br1ia'pYBUbAr6(c[FBAE1S3dL4V%qM#G[5X[I3La
+4+A51qkV&,,$6[[PHPT4h'mPVc!D$V5S6KK!0Ydj6IDam2K@H'qqkd-*cHj&#ELe
+m`r4''d6900i+8F1'&X8M6*3I$9!R+qUm,rPJVqc[9X[0ZaSK@32rhMM45#FIf-&
+jpMhG!2'b43)@V'h#0l,&XTGHAXh+)T["+S$QP5LaF`*kQZ'R1Nj1kR"*,@h"8rH
+c*J!LLf`NiL0eM14Sr9q`US4h4ZcHP0bPeYk(&8[,ReAGIlNj*9rIGblhqr+,(ja
+%`D-f08RpGKkr)2(14GhkeIcSiJ5N$#MYQR!mMm[hj%*Q+MCKiJiDQ0@e,-j2"LX
+8ea2idVq"1Fre$DSF0l&UqEb`656L%BDrfb`NBbIT@lMbJKq*j80$km'9P!I#f2b
+U@4SRMZ36E$!@Ra4'$,'821KIY&Ep*aS6lcGGF9B$,34b,0`6Ham1BAJQS9M9mGb
++Z)@@FA#mVYr63#)kS[[DdrBdD#YRYL"IpS+ah6F-!3a9"-6JC-CiEVG&BlZ0r$p
+SL02F'I@`UQ`GMdil$S)F)Vq!DD"+Y@i"j[-6aq1SBUN%4D9VE*K-e0SLLq0Lb3G
+)NBAj`HY"j$9Ak+8p$0M#fV,jST!!c8UBa"V*D-j"LR"P2JQE,*CAF`HC@e8DfCa
+@C4C2TScV4AeP*`Y*dmj3e0XNL#2*ZNqfFKIQ#rFekNpENdrh,"[%DVRXI,pidAU
+0k+Tk**2%&e6b#T1hCU-pr%Qp)`13!%@bIEqkK#r9)4ANFfe[q[jK3Zm([-DfbqV
+i8,D`+rNm"rGQS$jlFS0PC+*Zb3$l)G$8)4Q,mN`TEG1r30UIlp4pIUY'SR%KaAr
+6a4M5+`JJIpX6LcA$q1lC%$I2m&TA&fI5)8qLp%IB2L,Df(c9QXjmi-lKd#ND&S$
+)KL$lN[SERi@VkfPiA9GDM3m0d`H@5aiFlYKm[G'(f2Q)DFV90C!!erbdk((U8J8
++UENPG,ahMlK3URrAf0Thq6A`VLN-H'$JB94rM(C+LX[@)pZMFP,J@TJ4ke-FV*)
+jdYP[IAT6cl[L))a[3SQ1HH'5UlA51cHe4I#fQfLqm3dB$0*P1M+"N!"c89pV(6M
+"3*0)0PK'-[C,P&**R,q!IY[pa099D2jQRqJ")E1&h,rhkH494apLS5*E*!%jSkZ
+R1hGDZ,AP993rH@H[&3qRDKC@XB4+[d1SPpYEEa3Q-LHp%CpphJAhkhlP`Jdl%lG
+RqC!!"FP@UFkN9$%adj!!1'LX,LUlS4fC*0qJjHN(K#Ufp"i,Rq95B,&-5MI%pqp
+%GB@*+Xi!38'DXl4940TA'5Mh+EbG*fVfVmP'c!YcC9["P4X$m6&TfMN4bD66T%$
+5IIZA4H(bGPlI`&lGVQI`ClBI(il85K)#M5fTSq&(d1T11aK)Ne,irE`jK`a6+mU
+EIJD'P1IkLM[e!UURqB0)+5I*4$Ab9,`9h&9+&af`jl,0jbZYNPMB03dDA`ZZqM(
+ibH+%4Kf*h4eLFhG*J8I3CQeK+(U'&FJ%(TIJHdcGQcU)9"R6$A9$lh`Ydr'rFJ,
+L*XiF0UkjdP9(#DkaN!$ifbdhdM(GTB,U*'!Z'j88lKR"'1fEfR[mV,[35ZQk1Kd
+,Ref58-N(Nf[0)3AVU(lkhME00Cr$UQQ!LVXYha#2(mpZ)Kd!)bfj4cRk@MiKiGI
+9T##RL!8*80!%diJr@0BVN!#1%@)NjXQ5fiAhkG!r5h1i6"XXY5"+3N@EGZIcl!b
+9"4jj'C3P53!j2rF%iPVQM-k,b`Y#M$`r9KdJVAKXijXBTX6TBmL9-DAmYmhT33L
+hJY$CV5FBF&kliieM#'"lA%XTbjmErDa3Y21k,k82+$&(ZYP#d1Q!YDYabY4`P@f
+,Pdlq*IcA`Z04Zqm5Z-"r+jAcCarNDmq-V1HlcRX,qKSBrqT,m@%U9A0r23qDCZ#
+kPiRFF6A2+R[eA432VF"IqTUB+b4Yp%GS9,MH('I9ZYC`))H(SB"2mAAf$@TP4ZP
+[rJqrVcVHKNXqq'p"NAA2R)%q9X4QCZTead(e!ZQh*N0(HkkHC,VhpAC'5fU$)Ka
+mL$[d`,qkHP2e$D[8L-Ub*`&0Cff4d9p+LF'5VJhjG&8#R*3SjB&*fNLajEf(L-j
+`244fB&j2TbRC(HU4k+!MEY$KjaQY8@`Ml`MSbH3RUdC+fL*9L`(,jI9iAlL49,C
+N-mN9,SmQS`#lI2mB2B[M9K@XFHlIX9*hD)M[GLV15L,2elIH)T&PMTAIHLNdSpK
+SGBCeld),!U,1Zf5,dD-i+0Cdmm5+6pQL,qV1Im&Im$5V39+[ZNkd#em)Pa-3*%4
+d%@42EBbp)XK(Jm%,mGQ-Hh0!KVi)G'8,)j!!bae8SA-j&B,690p@V$+H-"K8m8G
+0RjZ`+RHGkfFX5'`"`c8!"Y3q8FB&1VXD"iJ*GpVqA`[C&#2!!63CQ,FX-QqcE8,
+rAkEqlkc9Jb$m`6p-@Ih%pIB@me#a$G(eQc%fY8**PGaCT#,1l6C%NI5QEZK'Uq[
+FF@e+IC!!('%rJ,)iS--HJ-jR1`"'(TPe*3`&2G8NfQh5qAB@FKkm)36K[LRc"1q
+N)9"l6C53!-%YHf$2-&QM2[S93[&kf-(*Q3T#8%0$VrHD`#-peL$Z8F@Y""b)SFB
+VJ18L6bU,6GmP(k3`h#d'pKV#Q'J45*r(fYHGd+4FXK2R-Bk!TC!%!3!!2`#!Y+'
+MYVJMIH)!!&KP!!#i)!#3!mi!$i!l!!9UH3!!5%-!N!32!&4ME%aTBR*KFQPPFbl
+2J!!!3,*069"b3eG*43%!rj!%!*!+J(!!N!C#`G6"DVkE#E,5Nl9qmI))CVU"cJC
+!ChD)!ci,F&BKe1BZp)I`)@hrrZ&aaLU)@hM1i!hNjXd&QJ,0iATRd3Q("p-9`qP
+K$`[4l$i4%*KJl*JrVYpUia%06r5qAQKXd$I[Y5b5HajdjFj`'kqBa@U10X@l!BA
+KBS'r[UP6G1E$MTjI-ApG!cQJer(SK`B!8"(b8%E1mH'XMl2q8eC0QiNTp[PP,@V
+G)pA(Zm0B0`#CA$+T9I`VBJ%D,0UPB2FrbQe)jjZ09`#S9d5A!))-eI30Gi2EI%5
+IG*aVj)m6`HeLY,Ia+5fA9`lBeH-mALb@)HHB$94Nb!Bb1a8jMbrB[THQYh+VR9b
+)N!$)FmZNU$PIl8jG$Z4S,dR,HIi#"JKm@$RIR`-@&'9p*2pL$Dhl4rRr`S3TEpf
+UHZ!0@Xi-J-SY9Q0Zb4A'$T'-(D-9X"S,DH"!jqHX@5&"Dhl`#UH)JY"fSP+c&LL
+[h0C3QEh*0kdHH%E-*dd6G%XK(Y$,V189!m'9bTc+RDdT3JpQQ&EQ5U6FkV9-i)!
+40L`Bl"H-T0c$"C0#('N*i*k-!S+k#jj6rIf1!h[lGYUXkZlPYHjm3,CMA!KQ)BZ
+DR%e2JE"GB%Qd*8Nri%$!Z!"3cREfN!$+!ZR,cpL[aabB540H&jCE"aXZ`NeDDkl
+IZhBC6!Z44GIJ&HCh-!GYNTYpQ,*i-ASK@E$Td"R6Q$MBZRk8,Jpm&)IL5+MM,4(
+'e-CrK60%2$2,NeD-kDB!pJ8q&LrXh[kVai9`%Xi9jSHM[2E(a$e"50qBe!&8RI!
+"`Nr$DI)eD9Xp&0&Ulj0XSJa0G"bkBL,@Y#6e[TI`pI4p[RH5e68lm1bRmXi1rU'
+@i0d-1-UN8TS3'$`Q0h!Vhk5ETh[l+mUf`0B45ZeXSr2Y`4EY)'c1U&jAPI-G5kI
+MNk3hqBM5G$CVr4iFa332eY+Ak,H2B(53!'k#RZGlq#$I4Rf"eMl2-l*#93PEq+D
+%0#$U8QHQ`qI[2A@KZ'#@YJL)"+!fKD3Im5k"09XU@0[J+VJAcC-,JF'jZbXG*iQ
+8lR+(#%GXT&9AN5L3!$NCAMe4Nb9H(c5bd3Nmj13!LkZF1bMrkmSZBHAjVGm(ZT0
+05@1QX&81D2mNRA4H(j`kb`IPMLCT,3c80&C8B8BaFBLXh1`YphC`,VT$[XR&*J(
+2A&G-J"1(Q)D3!)[,A`NGCDKP"Bajla,Sm6HQL@HhYp@Sk&E!!`daj1BlKTEE6,(
+X$KIErC%Z!TE0A&F)I,U-Kk#%pTI!B@KR(K6,S`jf(4f")AeK"eiaV9*-'"3BURe
+ILK1F8QCe4r2Yk6pIfqJcG1ii,XQC)`lN*9*iPCIpF2S41Q[fE'ZKAQaZpbfN3-R
+[9K(q1L+'H!0(!pH`3&6,qh%S0[TQ[Id2iA)ZS'C1P6LI9$SqI"K![hC9FMkN-&0
+j#eL,HaSb'I6IU*[9C#,0'#j'4DceZVprRT6I3bae%Rdl,$,+c[RUDleE1)&GM$J
+2[aE6mH&4c'km&FAL)1C&TZN$(k0S1JETJSFQDSe'p&65QUIMmj%r!0SCqq`3Nj'
+[8'#6k0Tj"N*Pd&ca')rii(V+iM%-*V%mf)Td%C4h,kEjG&L%%kVF`)A6qMCAbY4
+kSTDcb,[V[lpF%lAYA*%C3+2*d%TH%Bi6GNbBkHP'a'[j*m(&`UTGiHSPFSj-i0r
+53&BV%pcqdCIMC2H`hEik19Kiq9XGN5Y34+P&8m#e2qPCEl654SI#i8USJbXq#*5
+*NdV)clpV`2GH`r0(h1B$9L[EIHjrYB@FXP'cEp0daVYb13de3L8A4VF*@MI5Ue$
+8pMR!$MZfF'GNqNU5IhVd#FfSHG+hV)P"h9fIKMC+5QBhZQ#`4e%jqAK(Tmc0FU+
+*#1c1bYQ+8T(j9)$$MI9X0TF[PD+I+[M5&&0SMA$IXXqqV9PUmkH3!!@LG&kSPAJ
+96F+L*0,4KAH-MbDqceS@)C41H"d'p&dehYE0h"UdiT8)BLlR,"G)&+pE"CEYc+m
+QQ)JhTb$5p#)M$AdA"%qj1&2GbYZD"["rrZK+-h4`Xc%N*$b'ck$L30Z`VHe'4+R
+G2)hK$5"dHN,3IU*")-5QV"A0@G46%`hkMZ!Zl95`'P+JV32rlbN8'klNi$e1%3I
+SLLY1,e'42Cab%`qLqi%4L1Y6dKpU1`Z(VrC,k50G9XlKpZ)A"X-+A1Q,1N4%hTG
+5#aq'e&jU)62X'2"N%HL9Ne%JSGd!%M@'A8BmFp4`U,%"dPi6a2cjiVM[XC&ER%L
+TSh-kQD0TCJL`bd"d'fM,k5$J,!d5EZrAk8F'q&4KJF*-D+*S#MjCLDaAPHZ[k'a
+JGpGTGPXE,SB-LM$c`6BC6R,Q$-0emmL,KZ,U-T5K!rV8Ie4qcdrA,KF1V,hN@lE
+#03lR&l$J8L(cN!$5NeSYlFR(3l0[d[0KF(jRqCRPbMHp%&60$l)40a-2'*VfRAT
+fM&3&lSUBbV"lN3ANd0MlVf'jd&R&iV2FpqUY"Ue*RleU`N',318S0RMRjCTAh`"
+h3Jp$+jVVK0)jkr)CQ[cUL"C9*pCECMa"KXm4DPC4k1RK@jCD9+LLck!Q0VQI25I
+13*A+hT`AH@9Hha9pj'1b6Z@k+$K,FllG@$'""+YK[QMI0%&!"YV"C@K!X@SqfjM
+5I*[48G"*55hJ,'X#KDS"kV&jJ0Fc%l$lPR&BhVL((D1!+[Z,Hm3ERrq*HC!!G[X
+b'R(EZ[4#FCI+1E%CINll(dl5&5f@c!M#F+QX!B)55)mp8d6`1&,e,236Y#Y6Dai
+"c4ci&VQY[QiRk2'cG#dPZMHP[(2QfY"meUG4qHY3GDQ2*rm'ImPiM9EKNp10`fJ
+#k[9&p8lbZXf[I68`TQfVMP2@4&p%&#h,+jcZUQlQZ)DqelcNfUjT5MP[QQ%k9+V
+4@22@eCI$LjM,6+k@-@NVh6q2GLiU4R@HiM@$+arb2&JU6HK(jMA2832%L'8V$!e
+daCTYM'@HSb*`1UJa89'cPqLk4-0q+FYQ85Ta(VaCEFlMSmNBQRPf%'YGSV`i6d0
+E'A5S$54fF@*'ZUF$qQq,1!8NccD[Nd'X&aL[%$PPQ&DXTFLL[$BcqG[m@NJDPp#
+Z+T%5V`(a'%eklQR2S`T$-%BC4kl*HFe*(('q0hCALS&-$!b3!#pcd#5e)bF-5ce
+92F&Z)Mmb,l)-Z2b9f@l$ZMh"f005MZDUYMVqd@%[LS'NI,51#Ve%`Ml!DIl!0ld
+SSF8G1)pJ!18!A!cfFp8X2c%rV[S40C4UP11lXUjSaYlHj2V!RTF2aiCJSR&H0YK
+[X3lTK@IkI0BkT`AA3X&*21AqU$lE+463'9F4[CHTPZa%UG-NDSXNABb"kiCP*i#
+4JF#A6jR%lL%qUMAAH8YB#UNM'NBk3Q9FI2S%8i3DYrQb5VH[@P")N91%eARe6V[
+fH4"GEHZEITjVlb'I0ZRU+'p#jl)U'P`E&@qYc'HV0P3LbUh95$abq2FPPXfQ4@i
+D'B6)`iH$*[Jlb1SlVU1R@diB%rGqmH#iSX@6V-+'Pc`*j@3'0X(A#cimGfqYiR#
+56PUaQ00%j&e04eeP8K6(Zj2lKZ1`iMqQm&Thl(H+L8F$*BYH)EqrU0dGAcRH-2i
+!cei'qjbD`"IdLX@NNDTT$3l$krX**4(hpP(q@jfN`,Fe@G)hJdqFRI@&D,D6'),
+9ZmqBZP`QYp2M4kH9PceeFIra'Sa#+E"YUY1kPmYf&M'GGcp8d&caP!)[2le)PUV
+Se"0G+2I,[!b+%1ZcUXSS@RXKccm,38MG*F+X66H8`eYr(AKT2c(*cZH-j!Dj9'*
+ALm4ZEMf6)N*%PCJB1YVqMc#+ADbj!L+j'9Ia-9$Iq"K[3kdJ%T(')FLkZR8P["8
+FHHZVE1j5*TQIA5GAIE6Ndi3cEj!!Mlrd#Y"G`#**$+X-"J'mTU4Lp+pEFr"MJDk
+IZPKFNH5GpAeGQrEU#GeS1Lr#Y()VTA'AQcKi6bL#RdIKf5MLY&f&23p8A*!!KKL
+55*&S&"R+1D3"BbhcNK4%AUeF-R1QB01RbLSHSR&l1Nj1G$+C-,H'DRNd*XbfD@[
+&5!-'mA%XDaCMb42D-qJpPiQmYc59kR3mJr-JYE%fT8mdc0mZMLm('Qbh@PN%rSd
+HFR5mbJ"hacT9jf'IEe(84kYDp@!,4%LYTQU$5FPU'(RcmS,l#D1qSH[V(*GYDaP
+jrfX,cBaRL"m3ejD+6SZX'1KI4DFEcKkGk1M(IAilUC,'5+6E5ke[6icCZFV%6Vd
+9,rq862-%R$!F&C0UA1BCh*ZqqD2q8`0VC@RMbJ1hScjU('1rR,Qf["YYM)Y@44H
+RPNerF8ZbGc("X3h3rL9X(P!&Z!M-&Z)89fZa'fG#8B!QmV!L*bKm2(YajdGNpe!
+P[UFBmp,L8KUZ(-Ul0N(('p!hp4EEVDD5ER+a@5YF(5JD@0H)&GC*AaqMJUAi'EI
+Tl"1ccR@[6[65%m5G)RTJMcL(PU@66K"&6*9Z6r`6#Z9q+4MSUQh9((d6"FFVl$'
+M+D%FePZG3&([Ja*M)RMdHY&SdP!VY(pipGF'YKlKhe!-)(jP@2c,bK+,,i6KcMk
+U!NckPVH6L!keY$(5!Z,kG,qG+8@)6#f8S@$f&`VjP!0HR%DE&8RRe)KE![9jjjm
+b,R&#@2Hf$@rmmMkXjF"VC6eAqPeN1`@Pd+rfi2ia@#pZ#L)P!BD6Mi)KKljX$A2
+k%eL[,KMA(H$T(phpf["+V6%&-Lbd(Q*QGrDB0QC#qqNGeBQBCa2MVb%15%&P580
+S"5MDl(E3,Q`JdG5XjNS@pK)IJ6@),1f",dfSI+MlFAM(@[IP!b'GKJl@#%%q$S-
+kU*BM[`6+6b2@ae%VpD3U4)KB89@8R4qVVZl39k!Mi8Qi`i8$r!(0NdqB%[pdLUZ
+%0RQ5T5`V(F53!+8MIE#"K%HVq)4Sb&)X$i4S*pLeFIUcbU2-kV%TVDZQ'&Kj*f!
+92$%)SQEm3*b[XCZAPceX[m*ZLF9F3HU1I1@r(!4$Dd`CAY5@4S3YJMYji&q!NIJ
+SjTNcVP5J&L(`NV[FH`DLGjZhDb)Zc,KXAd0%Zp3+eFdb''9#[2-B(9AB2ScU,`V
+SP"cPJ,ilbXBpBVX&j)c90P($SN$%`a0"I4dTZjr53b`$-3aJ,Y3+C3`5-"GZ@13
++UVEP28(Z*RDFMBq#A"KQa3Z4rZS'F+3%*#1+$53'%3)d9l6lirmAejHhKi+TQTd
+U#--26ZrJ6dDU!Z8(!NL+91k[&pp(8mD4fdeEleV-B&rTpp(Ed(2L(PT!Q3G'#hq
+RN!$YmNZYL0*VNAPjhD1&fkF[m%"b`ia5hH5pV'bSK#KE2jKQ1E1JPHQfPQikFKb
+X4"5hY$TSeNR-hUI,PllFP'"6A#CZD&0j5)(UJ03h'[H$a6K&Lk)"PLB9IAH,3&j
+X$HZ+Y,&"l'3bmK'"4,iReiqjNEV"I%F9a-0p9*S2[XHGkL5kQm%,VN8@%Xi@B8V
+9hcj0"Q!m,%A0VS65dCF`L"HpE)MTFii($kLV`,*jUBYi[V*8G3i0Q",VqJHrTU@
+r$$AMpJSGYqZajd&8+'F!f8m@,-"1j4N6`83&"Hb4`[pb+Z)B)9[)BVjcD8U&h)1
+&L3+%Y*pd1BfEZ116($3L`*E%ZGXk3Zc9G+,Kk&B@Mcc$YYihl%)!k2*VcI%c3G`
+(*'UP8fjH#i*m)'p1!!fFU8@m6mkc"fqlZiB0[U0'@3C)8RX2MJ4d[#Pd6iI'h3M
++m`"!3b9Z+M0H#D"&qLcBa2,+0iBCb*2(f(ZEDL#a96jlLEL'61Lb&3Q`N62+!1d
+VZTVhCYHd!h(T"2Zc9l&6IbVq'pAq8J*cl9*G@c`-8[!9B2Uhdj5ZMj,B*[IY[SX
+k6,KdG[)r[r`l6C!!I!(b8J4P-ScPaTkCj0Qa!YAf!QR3M[&-203(R4UE5[5d)(#
+2cZ"AkZEKpP#Jb*j+,!Ek#TQ*+ai1jVGFaflI(UX`P8MBJe)FE,`0KpV5e3U&-YN
+HMUb`TbJp`'ecfYJM2XXHRkkNIJc$DT0(YViMS'V4*d,3[3A2Nf*J8cBNUVVPGe1
+BRkb#"-k)I(Q$F%RA1DC#@6&lLkcCeCd4mBFI0XmiIQN#[[00[@f"Yp6&V"1Pl0I
+m$b[5%*KTkqAa@cqeJEGDr($jQS*ViT!!CYZLFJ*Vc**4Y5G`jPeSrAFiaLdf1&Q
+jMhIPTZc"S`r8'%H[)Zjf1BV,6ASb$XC6LS2laVH(m@U46E38mN#r(-$qmh6Che(
+4[TZ(d2l0mDDi94pTBA9b,C91)hAeTGc%AIC@0Hl!r@#c2mI**f$(-F$h&pi`U8[
+(Hh3ci&jP"cqB1@ITN!$k03abp*S3jAb&P&iY$*&%RS[HD88*ZRTc&'`LKH-[e,b
+@e@rHX4bZ'K!-i8L)$Sm#@3JL(Tf6GYD$4XM"!(@NE!md5KR[qB06XdU&%iSrAD$
+jG4p,*Ci3KG#YT[q4VrZ#ICNJkDL2#VZjHAJ@A*jY#qrK%8V12MZ+4a1T8mSUGXE
+GJhbUS@"(3B"98H2D"JamVb4PLA-EMHCh*,VVa,(&HB1U*KebV%@pS@LZ+mGSQ"Z
+$04+U8l#!)0+*Jff$(&"SEJFT-8Z61R4RDL,c#c-aq5cddM&%qNDYS!iF8)@TPMV
+D5'AH3IrNI29%l3L3!+B4"-H!Pf+fLh0%r)-&e@h*U2kj!ZHSb%k5deqDhTbDBU0
+!hA3)Lj81f9D5idi3f[f8@ML*FkR1$mN9S'K5BM(KQfhhcI-J4*!!a+)$R2KT*df
+@V[$MCdYe+ECjYM`P+mrmP4N0`b36U%#4+`p$6d)IPfXa@k-,+B64'#q),%TQpbe
+p0VCeGX@4mmEK%ULlp%LR9@ZhhTC@aKUrE%KN,kTHI'&mfhl#&a82EUlMK-R"N!"
+&U35VS9L6%c8j88Ab%UmH0A$$IP[fb4[k$$MF!"rfb5jh08*MeeeVlA43!Ddk@Nj
+D0l%8a`RU#)jAN`8"BKRhm!+4C+Cp$pLYNX#$*H)Y`!NlJJ@8rah9KYLY3#Dp@B0
+$&*pF@+bSMHA'qq@T[N*l)"RPm'EZ0K&A#rA5SQAqBCrIEdLS"!0-8E2adGj*bXI
+&Br#IY`BFik2T'r"l,IKGc0P)k(daC%'Hk-#AVY,065qmpT95Qb*RpIJ[$mjqJCD
+SKL"[fNHT*kBeZEIVlj3M(9%&mqJr9"d$c&qeYG$FBM`eA*bG$RM!S8C6ZT@(V-$
+8DfrQS4jELcKmEH,*Cb&R5KQj0lT!MNM,5G6aSB$fpY&fBF9@j'3(Z&aPkjMqMNB
+RLScmT&*p8R$ah6#9G`%NQB)emi9"`pJ`JRABib$VD&QNc%Xb1L2PN53P"G+!(5[
+N425&*8Jd%q"`B9JQHlTFrJlCZfGQpRm-UACcM"jjbAm&a`l!%jkqT&d+Ep,CpG)
+89@d95+i4"$,6BHN[Ki*ib$@CT'qK("")9EQQ2N@`l2(!%[4Xh$fSGJ!8STH(ECE
+(9)3NdEQ8+(jN$LmKLI"IjdbjGbVEc,XL5Y#3!2r*q4!ZBlKA[(Bp%%LdedQBrJH
+DJX#YEb6TE0N)D8ad"rH*4JaUbABG2aZ'UKbSrJ&@lhdlBG03GfX$Gf*iX0bZ-)D
+9Qm8$FKj1)X4CXR['XXBdmDU$8"V4aZ2G&3cdA'EIcHJNLUElKSl,j6mf%A#HT%T
+m+8UiI0BX!j`Z42VHV'Xb&QkNJLKI!3,p2l5p+4rY"D,jKPYB8HC&G@D%TiSBjYf
+fS#pN%[P8h92I8iY%@p8kkGM'a#PCQIk9TTM#l('50CAK#!T$UR#T-XMaNmaiG#S
+PV$VQd5ip5cR&8ZLFhC4+bH+K-V)4VGe'U*j1EC[KZqGITZ4kRb@TmRKLhB0bb@`
+1)PL(0(+E6,3%XR-eA%$645&H(Z5-XXF'akDfp'D*6ckh[84*jm$Aq(cCeDeV(aG
+8q%0#MV6K5e,4+(V*Y(VbNMrl#MBp)bk(iX%8P+N,8F,EU0Mmm68fja(cqE(@LP(
+%fGiF3GPC2d#*U'U3!1l&c*)qYb3E$$ZI0A["""kjSA[c6HlkLU,$Q1D@R"YQ%G2
+6"VV'i3ArTCHNC0Rd(Lm*EKRmGm[#e6Qkrib26Z@Nri'NZ@+M(lEU1#AIQPNiI`0
+RA"`B%)k+a+pdh)$3c$8K4J&JDNJLeC+ljTlR8LX"DD$,5I1Cp9p`ZE,*(@%[m,`
+3($Q)[qa#jcX),&cBr8$SEf4AdfmH+(VMecF9QRLYRQQYd'(9BUT"1ULS8XSJ1+#
+&QHD+j4ajMj!!Z-@j1ZQ`pULD*2bkj#3ZRi0YNkSk@jhmaJ2HU*ZBqAB1NVQ*aHK
+(4D-HV&D@ZS`"GD"E#fCB$058#LH$0[N(h15qJl56[*ei-2GZUd%BD1PE0Y[q[CU
+lV4`dY1"%@dklFRZ+h9PM"3aVZEFeS'Rd`Ar80m@"m-A5BH#S2#!640!kVQIj(Zm
+X),Mr62jrB6[G3-l4*64IAjfdU,R$Rd!5X%ZjfS!qTGJlcQ"&YLT+&Z)ed`V91+q
+AfNE1lpQL9&RK9l8"i@Rr%IjB)(HBf[4GTG%,DkpPfMS-+r"3$Iql!kNLPF%0P'k
+0$-%8lKe5a80`)N2&GLqK$D61P9lV(A-*&a5%l9H&@Y4b*!&eSZ,mTSLi5,&M#&N
+kRaG!RHLbBqLrJfjIch"PGd,BI@R`[3pEDL)[q0U@C(-'fE9DkVpK2`G[#*[1@B8
+(IRGB'p1ViDkm2e0l1I""*PU!UX*mj!D0J5MHH(@*fIb!CQB#ph#5(D3ri-,6"(b
+ElT%PlMb)Br"kb-d``)V5QXVpj8+U6AP+kQR*!!,Yi3UDIr8f"",-$bFZ$bq08+&
+ph!B#)'36e'CFL@VQMXU[$8N[T$f$l@6ei*HYU03c@m)V5ZFF2PS5GX1jGd-EZ(h
+ar8%9k%+93)lIE9C'HC+bAVdm6$Nj&p&9Zk!NR*XSM!LI'R1P19+E%GA'E`LXjV'
+&mcBNpmcSJ)@LprS$GX'0e*3U-UMK"cMeTR`)CH1DmmNJcF52SU'&ilFrHTAASAG
+I@GbYd5Plr)N4VX`Ma+S39drp*-QP12d*H+JA,A5+6)C)jpNkUp,G%V1d$QqA,d5
+Ip,$%5YGNlekNrKDD`F%Y*VX[Am0-FBU6Xpe0kc,+YY$b95FXI8!QDhFYGfflMLD
+p1%j`qDjqChDFXDQhM,V0(bcZI0AAkTU8fd4h8G'A`J8*`ER)GXZ&)--0YG[Q)f+
+b`%M9iQL1&&J,#eQ#jbSif*1AUm',,Z$UU'pXT[JA4kk**Zj+pfXr(FZGXZdY%mJ
+'h$QDq3Al,bSTqL[[ML(X#aU2a5)`a@rI#bDVT@G*MCFm,PMIU,He#j`0eAAi+HP
+)5dc5qCfXpMkr0hI(B8NE[j(lBcjp(H)U`+mbS&Tj*V*N0@9G6l'p(qP'PiMGfM`
+8VQ%%3DH@,Q66R(ZcG'`Y[!6IrREZm4JH0m&Xd8&i0*!!kkcN!f&p"j13!'l!-Cq
+"0bb#9AGqTR5Ri)Y3pUqSCG+ZldH"$m42PNa`&$*@m1r$f"'9mH4P(Mf+!YI%dT+
+rdBFp3X1&b-i#LJ$f8lIFbC!!!'[S8#03'$hPfk6U-F"H"QTP2DjiJ)hFQL&%r#6
+LPcei9r$Z%6iY8`cBHe1&#Q)V$emSXH0ma9"flNh8HeEdkcH1[EDm%%5SKb#0QLi
+F*UFF6-1(0QJj*fb&8,V)k95K0`(0AAm0+C,-Yh"DQB#`ZK1*,fG6*@'Z5&fPS9f
+MKj5@$91!J-(,U(0h31M&+Jm"9R,pE-rJ2mi0AJMqll6Y-bhK+LiaCFY+*c'b4T3
+qZdrZmMI@p5N)SdU-qM"&q,Ph@5!$Sm5Y%3VBDeLS'Rpe3*GKX9QIp+rc%Q`6JZ,
+"j+4EddJ&SK%,#&b"Pd1`cfq5!iVES8R#A6HFK)Rr(&JVip6Y)V,4mF%3hP4H8$L
+R[G4BHMB-3jejYa31`3&2UKFAj*,$6#T(QYr"B,S4-hVKLf@%PQ*'RU6Lp"i4`AQ
++-`kH[b('f8X+j+0'1EpX6Zc#`$&r-*VIRH9bMLZYBKShH2DfRCU"A4&`%X!lHrf
+k@E1-(*U+D@4+i&lVA6BXQ5mZ(aZrcM`UFUp$,``AUF3p9XrqM340fSq3!,D)`%,
+jL+M'1SYNp&&2`8mNp*J"f46!r)fQMI*rXTM(Se5KRe4((*Q!#X%Q8PlV#2BZa9K
+e4@)MPbCXp*mB#CTY`DZHPZMBFPH3!"S@N!#`I-h&bFVH3G'h'!HM0ccBQdYKK@`
+l@RpPpXK5BZh%$8Um1'2)!S(UMHh99%5K#qRAJq[K-caeHl(a)QcX'J(F*makXL[
+hZAViEDkBN9r[JkX)(fiMml+9!M&9+BcEdB0Xef)EPJ`3ka,`QrUP%3pGY6#ZMIi
+Xmj4hNb#pAD1R6*5KG2Al[N@IMSPr"EBDU)ZC#iqpFEr`Id8Li55Z0NGPqlKSGk#
+jJ60qehcLUmQA5SEe$&X6IQNSdVAF%-iP%X&eNVf!5U9KNATBaqqN2NdD+fQ[ie%
+0(4jXLLJY`,RDRTa*`dN"E4eUD8AcZI`iBp!3`rKjN!$ELZd4P#8L8bKehrpA,rS
+aN!!&4KAe$!jiL1L46MFJ489ic2F'%kRQdJ-NCS,U"-&lJ+$%r82j*@JM!9CZ88(
+"9f`Bkb"Ym(J'%2Z-%d8HHbdh1%Pb*f29iCUkqTqVe8k(G2XVpMkV$QBEMfIq$lp
+D"-1B(Bi$5jhfLVip+0kCc`SQjQBcDbE`i`F1Tr`U%S6LiR5P8,02cihjm3fQ@KS
+HY'1!ZkcBDRP`*4jVa53NeqABk22C(+C!mKh%NlJFTm#YR-2jh@@B4d3A"6FC[BR
+Z&E&+Vr`Pr(fNf8XZ9cPNI@'qPNTJJh!QEC!!V,33(*X)j,AYkMpDUUiIll$!XA*
+Rae'+"NVpk``CCNeCVLJm&6#SMVk6l",mGkKm%DP!eENL,#D(AB2Q)"VjbX6@`I4
+80[Q0MB1(V2Hi'BkhbCm&kr4De%0lGDcS#EefJ$8$IK&DmR+MQ$"!kR@+cIkV%B3
+@%D(+0j!!NQ#RQp6)Y)$RcC6-ZR8C8eihNq$1JXDD9hpam"EqC"XbJeY[pC%+M&q
+H0GK[b&9CBJicVXr9jGe91(Y5AMhNNR*BM8fl&8H[-J2mK$[@kp`TEBL[TeX2Z6Q
+,4R%9eE$L,U(&RZ1FGmab8-@@R+8!8+bD%%KGqL4a(5IT+'ja!X8iM1b`$5pQr`)
+H4Nb"r(!bllL43YTbD#U6&P9jR%a2(%bR(6ZJEdJBaIIdU1C5"$2Lij2hA0Ij&La
+BLXaZQ9hq*3*@''3GCM%F)-"i$EAlpT%RI["J#4'&i0bDArB+VPRY9FYjf(R3aM(
+lH(b1h,6-A--@mEHYcTl6Q-!'Z5h6,[MGM,TKfdN%HT%!Dq,B'pPrM&9c)Uk3!#V
+H9lVeq2,J%c)'!!MEXK89@98[+XLbD9p#r6hfA2*&9hPfPB562bC"N`B2Q3AT2*V
+TA*2aELJZ%@1dlqU*l*V)phQ%K)cFp90HDf,h+%D*1U2(C%S2SphfbK'*$d&qrR0
+c5JYIl)B$X1@NSc&'iBeQ4pj[DhP6%0,a30B-2f)08[[bZU2&kJ#qCP#BT"F*89b
+iP2#Ah'C2KpT(p&rGF+Nh0dTabGiVU!,m3INq)H*5(R'H0aQ2m+j5eLIm&S()G$c
+hYH!TQaMSa14!X-5,&0N+Uqb8#YG5UTDJ[URe9HNh[lm8VdH*m#ViPS5(6jG&A)6
+#IU8@(*-QD*Lk6CNmD$lR9+l+P1@a[2NQDDU8eGkqZ83L*$,*VG,KR[FHC5rEXGq
+I1P(Zc4YHYk*5a-IriB2*da)UK#TFpV(ZKSpQRb@m8D#3!&&3lf+#Rbe-K`VQbJ9
+%)+QkYrCkm#5%X,mJ2EA,Vm360c!5BC-kLaKI8Cj8q([%"kX9!ia6Z[Y,&i2`E22
+*BYUaRjf@Lp#eMTCB8U8N$`Sc%lpl)GZ6$`(%8*+S#bj25br-BfiN4bGdj&fM*N(
+`20hIk(2EIG[Ni%2#YGQeX,iTcL,S3`ID[+fSlCmqSjJ-+*DHf5R-231A"VkXUcq
+BX%NY*B0T8r"Q+q3E1fe0rXL*@%!%X'*[Pr6&#@crIih'QN4EZ3[3Pjb'G'S)*T[
+p@Rd'Q+"feEqM)6ekl&QRN[IRda2*Nl44AqTQ%HXDrHP2hm9peP)D%&m$P9Z-XJj
+6hm%!j*!!G03`0E$5NjMZM`K"jCCm4Rq5@EJUfTlCHB8K@SVTfDI6--SF1Y6Fijm
+DaD8&@`lp!mf`4`kEB1*Yec'V@13jlKajMY"&hl$T"L((@"6C#`#BTCkE+-NKk1%
+jbJCU1&QDeeG0"`K!,"K14PDdapX*Z240*$-i60cAF3BY26fqF(LJ1EGk&EL0$B`
+3'06`SP4"FA(4AX8dk)p@#84h'AC!rcT`IGmGeUb["%"$(kQ(1(8lQ5&-22mHfL%
+KZK#9r1JCf@"TiP&))KT%j!$p-'qf)kDQCHFJlSH&)`@%NBT,UVdIZ%"m2%erIJd
+-Np[NKPVbPK-4E)rL$BNEm@!'X*URM@6FPZB"Ur`C9C1T`MAPQ@QkZ5)h(6fpDR#
+'i3#4TTNHahbfP3Qjd`&S2I6L-6BG9!0Fpbaa51pUB3m2e1Vq6e29aUi"Q1mc(f%
+*3+-D59!hT2CZ1'I#GVrVf*DFNpT%T6b9Nq6LS"`304lk(AhLjM0Y1#%5%-e8Y1(
+ke9$J%$dFQmBV)-lG1dCfYGm02Zb@l[!4#@XL&,bV`b*qRaX9+Krk2frA2Q$,50V
+XGG5DDLj*""%1$`1[F4pL&jT3d-'p`)!&HFa!$*!!4li%BFeIZCfGa0GI"BQP516
+m!Z`-[`pNb,MmI8#dHjhq'H+i+P)QR"3%3*k4[H[pq6`Lm*!!1,bh4B"`+@#`[ST
+f3YCmGS0RLKCV"3%lENL#)QCBRbiR5hh9FVA)*EpF*6Sr%2NID4HGSJA-RCiZ-N,
+V6"G))+$0RXlPZ3'-cTMk(05fqQ%A9*mjGBdA2K2'")`[T"m`r6Q$UVXXISiqb5M
+B6ZPdEDpm%4@VB5X5@)pUZUqbJYd!'3#AAj(kI#FbGDr8%0V@McfCPF(@1+ATJ*Z
+hYZ0M$3mi98qkXb,RrY[AS*2DN505JU(Z4Z,p!-46Q'FaQC3S`Aj*Xd,cYhY[eBN
+9N8j99#NEeI$QMNR(,Tj1@X8NN!#amA8ljKd',V6q!#$KDi)6qX#m*hTM8(bPi0G
+)pBY[KF4ZmI[F+HQ![))e%MR+Sq4Ml1SHa64G(FLJFPc'aX[,bH'G@E@)P`IM3`k
+FKP4I92@rB*6`iqiYq#'Tr218MZEl'6!*rGUJ[ZQ#bXU9MEhT)kL5iH5ciZ&$N!$
+k408Ee!SDMX5RXeKdjm6hieHYMEqdRHIGiY)4FM"brFaUJk#f9m(DaS#JXT6-e4,
+992%'p29DcCD)0l82J5b*A&cNZ*`2pk4p0j!!FIJ0GrRq)9iFRYX)I-Dj"1Q3!&U
+i16MjL,%,rqQjVqC9ZCDLBhRhM!(FZp0(QAiI0rS*J`I120AClSF*J($,LG#h8[Z
+GBh5cZ9c9mLimNcca+G9UF"3#bGRd,XIL1e3*S$a6hfpR1-IqpJT&@49@',!P8Fe
+R,ZQe0BQ5PY!HJ4%pr6A)GT%8Ff5qqF1PQmN)rI1aI)1+*PrDlAQee'r*TSMehr-
+ZQ4&2G5"d-G`VkMmEQeX2'pL2,N$UXNLj9"5FeR&2IrJ[m6`)qq4+)KNAGe1lReM
+aIpS9e``Brh2'"1e`KIN+KBQ%DKSE@p%3XIipkNpLI8IE#GGd5K1aq%rj04kU-'4
+cDUSlp"6qde-1B[ac@[25U)K2I!)&mV[c,6CR[@%TImR"NbJEprDRZ#I-[2KlIAm
+Kq'"r`5IGP%ekVM!1b+`hPqaLp2@,mZ)8E0jH(qGBJ%R%&@6)3Dqpa(MEC(8P[cK
+bR5j#1(GYj"PN+P)C*$1#Jfa&`fT0L`c&H,3`!S,,'&4$GKkZjk)1L,FDN!#&CM&
+Hr!0VIKrNpN)GAZek9HcT-ML"Iiq)jq49-Q+4qI5!R6e`mFMR2F*@#-DF'MK`GMU
+%cdm`%rdmCmreGNZT9N8%%6@fRi"bb'f*kVJmR'#'23fR[qaJ0jK,6&22+0ReiiN
+2(fh)PM2&-L&IFGc4q0E6XRf'rUmkj)ECM5Jer59'0*B'LQ0C(``2DPQ19*3F*GM
+fjU8S59SFJRIdP'DeS2)6l9e3chpZ$)*M+([DX5iLH5%1dS!Z'`4%%#!PZI(,Y@Y
+R8VSG(KVl5TAmMP'TpeL)3"`dd9(diHY'("1Xmjlp2qmdMN0V"%Uc4Re0YG-FbF4
+TqQUI1HB-kF[GSr%9hU8fNCIVEBX(!2hVqM5&FJmX@d(6XN)rl8``qeXTRjY2Ue3
+J0(-pJ#'h"+iMMh"YS),EYV,VCYlXQ&aC8r15TaR@BKY+0MM"$A*r#BqbRr("RRT
+C*Ifj8)5bSi$CGGLYLID$!ehP$+$j3U2Y-5'YJe[jYa)Hd'i%jTY(35FR&EZDVl0
+q$,SkhpF-@LTF206ce+#l)4abqT!!$APBRBiE'(5b"l$mj'FG"QN!VqH(5GmJpC2
+#cQ@qRH@&V2XU+#ZXDBB&[T2"5Hi+[dTV@Y`jAS$AaKYLB)b)I1rJZT@lLAZ"LY-
+$irR!85[9CrP1dbLCfd3&Pkq&N!$X&2kqCd#+(5qad`m9$jqbp90qe"@"l2A`Sb-
+ic&1h,Z#SfDemlb5`@(jMbjYqJQ"IVPa#&A)IUV,HPT[3+C),!#qhG!r*+ZfMDY[
+C9p0`8&$V3%d!2`pT6BrL"@!Ij6"9[pL9XQRPA9(h-[30p8"b)Qr(1Em"Q[i[$,Z
+r#ZmH$8'[@,&FP*mDQD*YIi3Fp(9MaVk'8J649iL!fX9i&IeGpjU,#$PdcMf4`pS
+jfH*4hEQ4SU@[,YK2K1i0EJqU%UqC)G,8p,$MG+Ql%M$IKF&R6'US&0KFC,E2Eh(
+XcZi"hQ1jE!(&Urr"l"$D8Y[,c44mb8Zp,6Val"ZMdBQq`SXA0K'eaarC"phrpB3
+Md%Tq6`R+bE`mKcV)[T)&#MTV*aPZrf1V)QK5#05Fq$@%iaTKjUXp%#$U%hmaD38
+RCCHe+[@5rS&RU'+Tqq0B88LGaCXml20MpZbF,pbFp[H-)a%QFa)pX5T&)FBlHHA
+`2M,P6!k`+-BUBllRpN(h((kc9i2RLVC,DbXCKZ4AHr,8ZD!339P4rZZH(Qa)$BQ
+3!)k,M9C3had6T0Ifj"jj[C'8B(B[li`bfq1UX+6+SqL5Br!%3+'*9drZ1f06!Br
+M&rR6hbUe69,%`()k5+9G0$DTA3&3J#EE)QZ'8"K%a+6lUiV`0E5-aNLGCJHS`9H
+2J)E*6'2)p25@h*mfKIdU,UEhia$S2S-T3$k$RNCS&m-![F&6f30Jf'q[XH"Md0D
+D"!@Nma,%mPXh8L09YpM#9CFTc[YipBUk#&Ch*hC`)NC("-00#XU,dZ2bh)frIGK
+`-I3%[Pl@ZBh[0hTp)Z"PK-bNM-#a,@j6[ff2r0`EC[Pm5+%(q3XcUS15ZBBek0B
+m9+Xf,Aq4&fVIr12-R1C00M!-m'KN(NB3&(MV8[eQ"f34Z`ZME'imH20M*+REk3k
+p`plm2@Zld03+qaJQ9S9Y`!KEl',dGM8'c1f0S*YKaYJm"JdIJEVBk14jPR%,N!$
+!K3-IMprE(eU4eQj2`&CMc'E@Y+Lc[U"F'GAG1jE#afU!-i2`RCC8(NCe!VmjU(m
+r2Lj[TAXX+1i9"-aJBP)S%0(KG4XRTj(-EQ58q4kcU+'NKXZBD29$R5#*G#cDq+$
+1Iqicb4TI)iBH3-(rq`BcYQ2+&I),k*fR@GDjRPIEYRP[N!"5b[IMfFG8iCDl@@9
++q@B*iX14b"*023(L4H#+G`cM`H6RU(5kHY9a-iMMZ93'2d*+c"$C-4X"ehp0aPL
+eS`MHqJCh,H+YbqHXm+YGKib2JU3"-[AA)GFKb)VpV5$(!X+)L,!kqpH-'+QdLkh
+rY),hET200,EHSHAJD4hK#BB#Q0"U%&jkRUa@Dp@2rqXj+ZfiDbE+j)U2Q8SbFJ+
+4M3Nr0ZH&$q*qLB(`Q3p6@a"eE#hP90CBMfkhYH11h'I5pfA(emrTQLp"KCcf-jP
+"qN3381Gj-+T!&q2&'V-5`YkS)9E1&jDMFl*A6&f%J[-XrdqlP$f@%MZ2`d6XNG@
+becPX`6UI4re[iD&M(bdA$XF%Lm'aN!"aZ2dX&&h-P!JIQD-eQ`5,,pHDr`l29-T
+ai!*N(-3RLM5Jk8JQ[PLB08@V9Sc5q5k0-,,%SU5S1ammr(6-E1mbkVcY+)j)QU5
+aKH%CQk&QiDLmbFq,FrN4q"GEF$p9,ar5kU#YUU*p"`QX+T,E(S'!,(SRi%[PKT2
+j%IjUReAd`pd+391IfZ6#ZY(6ia#ATc8hmQbhGQ6h@#GcF+[)r!cikBZH!)[q5Rj
+,K5#hF!*`'LmXLE*F$XH9Hm&9F54ITd%mSU5XaBV@($(,!9QJDTB!b$DTl+-`[*2
+6QAAUBBKPl2JaME3jFB*Vm9#eA&E%f-NI&+UDhbHki6qpcIG0hk1Xcq#2ZU$UPL5
+EfacmYUd6HX-mZfh5%@l8`Er`Fli-i8&ND4(cKXT*6m2fGY39,12-TK2DG5ZQ$-h
+N[)4NK#(M6U&adUZ2JbkqERSJQHre6P$KFKepGHID,l$#TUfdZKFe+(CIrR&ee-5
+6F9$$RdTCBk5A-J)4p$JTQA2L'-4&4Y9U5CP2`F$FJ!qS-l&jeLK4"'8hM9`jKA@
+&aMCZ@Ll9f$m"UYmpFc$L!%T2YG)$+i[NB5Z&21!AFQrI`DlDS(+$A,F1MQ1mEIH
+(DT2+X@TFl6XY*)rj@C38'VD3!&kPekIEkFXLd@F0Q8Q'm%[KUKZ2l[*60H4CKJ!
+lNpAKXJ,$P,iS0FaR9#Q`S#'C52qEbkJ91&Pr81-m"HU@G*rP%A"D3&5`Y"2TFm(
+%V0,N(aP+CJR"XZKP8CkPEXqP`DK&iT5(Q9Nh([p@*iPq%kSdDU4SbNIME[I!bZX
+-MBi&BDlkNZ+$KLT)+DXi(SfXA)mUephpYDPKA8eJ0155,E[ch06$m&0TCX'PCrb
+c&%(H##a69*h`T93MpGNNHU*8i'A0#IfFG4dSG6,Kr1$JJ+rDSUrA*&M!#cD0k2M
+PK5ibSq2ZRV)MQ9CZDR(j4-EDjUMa`UJNETkF@dT4M2,"p0le(6PTmdZ@Mhp0`d1
+4HJE"61icJ2j`a$2RrahmA3rCilK)30kMerT&Y,Vfkb6%,dFT6mpcA#!%TZ6`fQZ
+,rk5G2eP(cQCCjYF6!4dDlQII9%m[j2BZcj'kHXi''k,*HE,((a"b6jKZB++UPqQ
+KkaqP3ViTd+Jq,EX#PLHkNpeGID&cjQ`J&iFJ)T2qpA[LQQ9ZMZ(bV3Kc%E-ViPX
+CqTDGhl!&F0DVb9pNiTp"-@9#R5#FIE`h+MI6(4i`GP%P+cb-GTc#!qfie%GVa!*
+RkNGC'd%cJ-pdNN[$XKp'MC-!,Q*qbdk[)$lDmBAi&k9#rKM+lbXMjU(NP1QHc9`
+LflPq2R8P64qqiLb-,R,,#PlELJZZ@jY3aPf9S@alc!h34qlq%#$l'bR*l1UG6rl
+**$$BrL%&hhSDC@YG#edZAMHLSXCjq,K&V3)k!'B%+@qlN!#K'JV%IJfA*T,$(dr
+,Krr[VEMp@32&*9[I'0*(9%lM-!Ab%J-$,C*CI`@8fK&r'-##qL'rphGj!J&U%iG
+dchLBCAI,Uj(aXc3-BD#J!ad#S5YcT5Ki`8#YeU[SXRaBYFd-"rQ!!lBB,BX%DdM
+ZqQ,pEB(!0X4Pd8kB[TqB(mr-p!1DC,a5Vh@NkLQPR0fI9@[Dq8K`i-CL#AN+6CF
+#(09jKJirZX)@GPqkpY3rD936arkcN!#MM$Z@Aj!!4QG`GlDUMe6'p0K"kYDI5*V
+JETD*Me#I+lMlbmfU2E)p"JjI-S"hM16SIYbGBHHj`Fd8MAJd2ia#V$$H&4''1`e
+"Xf'a)LTD`QaPl'%4GD#LMUH6%@i'h%3redUr&PdQLe6lkSY6k5Nf%@b9-e)mJ1Y
+J#+bPFrYATmA+U3%bYVAE9)hD#j(J%SAh42DfC4[-+&lX#``VYZ3NdMI!)T,Xk[S
+c5JQB)Rd6"5AIbJ"mq`5PM$e16pVMD5*iAZ4A)$LVBj'Epm1@PB%$m!-3Pk@TUXm
+1)d'"MSTE&RX(,D(c"Z%IK-Iq3+#M`@,(GDa6URT8"Nhc*Gr0ePH[Ac@k,1bj@`p
+l#1&pFKf@'ACe`D'H)D*9M5"GACUMqcq)-qX6PfifDb&53E!fcq'48ShU9#%KQl5
+`-mB!p*%Cf)J(lRUr1-&Bkc4$#I$0DGd*%aDE'61[UF2RC[BS+CL[P6R-Th,HZIT
+B8`ZHEHAH(U(3RF!eP'Vk[TVk2I8i+dqdR+BMXPqr&Zhi[NLKAi&A6!%MLcZm(FL
+R5daHBYI!'$3bY8EQ-kc1MdAlIBRTXemGZP)4XDbE(2NjaL4m-"b2hhTplj+EJrj
+Fq'$4fKY8aZFQfApXVZS"jUT18+AD4V`YcmHD+8GCRcJ02%Hb1+!Zf&6[GSXp`'@
+5mUQ-+B&`j#$1%`ccdGA5&ZAlD!MckkKh-")QH!D9icA$*hQqjRJ[@#Q5QaQJD8l
+1r(B5V9Dj[$)iipi!pB!)0CGL+i[4N4qNX3(Vac6NM0m+BPf3!2T0MmGd2(&8"2Q
+I!,Ch3ZV0[jYfDPaGKE&`HP(I%&E)H05V+b-B0N!Uk'ISPiEL%i"96&-plb!"*PZ
+LGA#$NV%`EfB!VCPbGYa)qV16aqhDEe"m*j61h8fq-pR-$pmmca#5RYX4%1G!4S,
+"flf&N!"kcQ1*jiB"@P0qR@S@5r4%mZ!rK3bjX&Z#Yf1-Nl54mh3J$kdJC$8lRKJ
+@`#YGViM)EUdqaq[RJ$3ZiM5db`C1cZY0-#m+`!T!b&['YZ5d54(U(jN)Dmp`p-B
+3IKF&F[QFD%B8PhB&Z-BTXrT0(fk-I$'$&!eEZ4-q(8FM[LHqmVim08",#*Q#$dD
+&+cVXpDSZXKd,Hc[KT`*FccH'IdB4r*`m)F3%c6j'U*hBBQYbTR[Y,Q4%Hk)I+Id
+&+YLZBVNm9)aCP4TMeC[LM$Y#CNGicH4E"Ck',Y-*-QL%E6)GIpJK44&Cq!RYJ1+
+qlXhF8H8B@8')Lk9m0eMDR3ZVZd&D2Ib8R#VLRBfP05BkVqEU4)EM9"BkArpkI44
+aUPchKNPFD2b`a@P"$&hL!Kf&"MS095(GL%PhP9Br@GNQei5jI#RlYmH8QHGamMS
+1[GAbUabTeLVQ5Af)J5ledG"!RR$S6,Tra$&))d(j1kp)hpfLr!q2J1,XJh6C'i2
+V&J)Q1-Z'%2MQFD#cckr`K5`N8V`0Zr&3'A"m5Bh`F9ArpjbTr@+"+Hm[BLm$[UR
+f,FTBA(jmJ9IM66XNeEKNVhZmIN'mdJ-`)ed69ik-6d'mhJ'Fm9[rd)df)*3DE#e
+fF!kr*,R*IprMAJ%hBP[Je@lCI6T'X!Zi5N$!JMFBjBj*[q1LSHL3!(@Yk-QiYf6
+q1r0&kM%`c#4B@1T8E"cRj)DmhbciII#mhML2NCIL3$1HjF$2MRXaGL(kb1HINrD
+"Vqf(pVl4JR@ATq+X2R4!0jZhKS$%Rd,Y%c-%fD$k5P-3$+F8,%hhBRU@6m9MUFp
+L1Fr&e#LqG-cXeE`Mf%3)faZcTNe"%c2(qaL(`9I(e6jYr!(NIV$fdA`M2`iiV%[
+F)3HSD,fSZA,9Y*lq1'Y%N!$J89*4"qdc'+,*4,[ahIlS6S1r5JmAT3QG23@Fa5C
+rDE0bBjZ&CEfCA646Y+4B2$H3!*[$J8`BU@LUbahmE@aUf4#MpcEK9rQ!&158`44
+SDiU0-(Pp4[k*Ga)VjUK*IGH#aRQmM#Lkr'N!N93A)81j@CQ6aILj0i@1[9C+TYe
+Ler1bPMqRaL@Y0q)p9-3,9h"9,T91U!SC`BG+VpF#ZNQ1D4-)H29GB#IXQI9Xa"2
+ifjp`j"jU*-4J)VUVPb-ZS#*-*[)8m4-&0IX*2ZmZS,825apmak[aklkfcAJ(ka1
+I&6d*"m,#L'801jkHHVfZ#h3A,*,rURY*e0-'4)Sj%["#"E*Kh"UIFR'UP+Mf(a2
+$P#aA%25HIkM3[NTjECqK1625#[(mR($GLq4*SK+'8rY(rr(9XdZ@mbPa)eElh1l
+!,"AG))i#MUKTdR"EiA6KHa5VLq'SGl@i+iYH`0H@UFFG-Dd#0%5d+2XD8YQ+51'
+@[jcT0KAA`[&UEhG+)"@I%1F`VF1DHhPpEV*A4FPLD#r$qQ*2[Dci8S0aT`lA0`E
+6eB5c*@R3P@$'RLZ3!+58GXFc5FJ-a8-G)0epE9BMqbTm!Z"PKL-BMKC8-K%YM@D
+FLG*P0JV5J)A2ee`K09@a0@*QZdY1T(Sq,`4J@4Pm+[+dYae`SSF&IIENqdkJ'94
+q(d(V*5e!Ca6PT2ampXQ2VFABCZ3a4JBHkILm)-kdC-D")V+AMGpa"kEeqXp@-6E
+,(fI9C'#d!ep*Z4K!ZMcXK"QM"PJ3iqpSqh&G#ZU2L!kmY0U&aj3EpCM)d3$S1Xe
+$YM1Q-c`&e[cR,5flBLafEYGM14P5B1B*V`R-,0[Nl$2NkjP%G'(EH5LCDpeT"Em
+JI!,FVek%EaUI'RCThBX5!fir-LY!EX#e`Vc#K`pL-aI8$@LMe8HhpVXC95hCNmT
+9DfVQUfrVjh-93emC6+3QBiC*#DaS`qN&lHS5!Vp'AeP)!39fZZGar)C-Q5+5pc1
+`ZE)kZ#QK6`aeTlM2G2Dp-[4R4ZA#'(Dp4#*ZhaI*$D`86%I'3($j[kDNL!)[G#$
+L!"k&T*'ZN!#mS2@d0fMRKS0F*JbNIp@@0f,L10qq(0DJI%pN9)rH)I"cr8QB2#D
+,BQ4,0F,pjX3,S9QX5J[H6UGYIY3XXp9+aVpe9pUd3(BDT"Q'`eqPpIPPIb+$b!'
+0Sbhm5hP+%N[H@[0dbY00Yb"H,@[$$RBlAJKH340Lp8N+d41PprMbSiF1JAeKQi-
+23B5IGF9#DHfd9(Bm+4NY4K3@K+E4j&%N'lIHIX&&5CMLJcedEE-,$qbABlS3pD&
+dAX(kTVSeD9(9r0A@K3kM05eBc@%!&QfCZH62f#dN["Yc0!D!0-F#HrPe+q6E`Ir
+9+@8d@c5-SEmf90a9XQV6A-$*0FEB3Ve$E6e9"IX-4iF*@FD(Q5qE!6SL"qiemDK
+p(*2hSp9)T'a,XP58F@KV'hiJUAZH4l8"qANVB)GP!(H4Ded6LeF52G-LF-2(-+*
+b16ilA08&EdAKr9Ca8209"IdNQ#R(ZZPSf%'*3XYTE@,-Ud-PGk8b%GK!8j[jK%"
+`@aT(LeZebHCd@hJr&r#Gi2KNL,Q95Fq(KjpAV`XF,mH$IpLk[HC*T&VPl+ZlZ,X
+%Pm0Gp+ZP'+Vhfq"ZR-BT#0M-r-mLUQ6U6GI`J0q1YEr"98Sh#ec`jP[m4@jLPAS
+@Z4UYNdmQENFJ*0hXLd2JGG+9Z-hqZ`me$&&'6(QlZl814Xh2*m0hRk#,Mp-0fXB
+3(e313hkK&ECTTELpS3D@+TJqCQ061)NhU(Z@lRh[aV'bDjZ0)b,lpaKTl134F9L
+i-R61"6AU5ZR-pY!cb4cGR49J[VABEXr5)TbUDQFdK-kqCrhh1BBR#5&&pI%4mCY
+fpir@b@jYP9@j#&ZE5mM11,Ri8%BBb2Tmj1PqN!$l95K4+ISFf8d(5cQ'6HZeZPD
+'3YMr8lrkb6[kL6A$MZ6KC('*%PE,0D5mE#4m(9&i!hX*h",96%Tp))BZPF"9mMi
+rTj!!M`QdFR@$q-a(e28j%eUqNREC`Sf`*EXF$Ch4hh`1maTJ&$b46S9[d!$%L0Z
+68`Ep8FMSYF-Aqb[EHXMc8d![([ic`0!cJPeX%`,"IbZXLA%UD[#-FLhU%++81(H
+ji"'q!$+2A8pQ!,iK,3lVlPXZ2V9d"Yk-(1IR3Z1*fC!!L'hD+,a28,LcpH0Bp8H
+lN3m6CA&,*$3IQA1Z+U4K*@RYIiN@X8TV$bkBhmeRKF[Lrh)S8#!TXk+d`6iS'S9
+LKRFA+T3T['eYY9dl,BIj(PliYB9+9fYA1`+JBQTV2aG"2S%(BUL6jDf+09,PiV`
+)CG3@'Pa[*Qq6'q+Gkm$U+XfF$1mIUa+dXH8(k`Jp[l6d!Bmqeip,TjH$m%frDk5
+XN!#3!)%ZMYPJAJYi9ppp+XE$JBUJ)M`+c)2PLN4-#cC`@,aL*LVMK,',4i@A`1G
+(H+9l52T`IHVRkC%B+[!rAXAjlJ5DK3h-3Ak*rS1S!8@EpKcX!VaKA#NC2J4Y`H0
+0qTA"dQ-UZHP+8@DlheR5D)JPqr%cL,%(D!)UhYM,D88Ge8p2pDS+CG[4dB+qLZD
+I5qApE2i6eeTDCE'3!2JBBdiqEU&I`E)UYa4mEAS"Z@j3SRGh1liVSc-+@kK-kQ&
+Fci@B4jTC5Im0NPrl3TU+*ReRmiN+i8PpPkr!$pF+&p4,IjJNEI43Jp%c3ki+4N(
+N&#P"JDXJQTbVMX81BK8r!UpH1A'cXGQMU*a8HS,RZM*LZ1R`Z(KA1JR%ikTX)NI
+kr924YMH$3a3%8`D"HhUR%eq9"A)$cr"-HY10Dj!!2d@'R!JYT&f@i90ApT(+&R*
+mJ,MH%D93&&8D1I1hFFRX1SP+pC&l3&N+%jdB%S*l)-,BeBF"A$ID!K3"UPkG0N5
+V%RT"*T3"P(*cUMA)b9ZkRBd`Q-,!bX68i("$0lX*E&V6XVh1aE%XkYreE6EZ0pP
+rPKAQS`[)iCCI4,E6'%)a9cMXdS'LJ5F&(%h%HLCUM3%PNP9aAIHr%'q@@+k-142
+8qH%r16Iek"lMNlYqNaRa%TrUhS@&-"@XF(i`K!F+&`6$X-ZkQL8`U4$S(+HURpl
+f@rrr[iHGH5eY(e,4Zq('N!"UN!"M`dRXpTc9NPk1)-Kr-!JS!j!!N!#+!J4J'qp
+%VI8X3i-)AZrf%E14jN@YT),Z$$l3KXp83GP+&NHZ8jEi5iKaJE0RY$+N$2VDd)@
+@[FN,N!"UY8%[9$-mYX$qT%"p$c$3'c#@ZPk68VCDI*9USNM`2i5EPq,AiM)X`eE
+`b%3[3`l3JK"5m(DJ9)%"qMLD,LUD`bRX*Xh%9I#%9i'F4%'jNK6[G0a*q'4"#M'
+Me93qXbcpmKS,IC!!)-r+0ZBd[PFR(9$MY+EY6+,`YrRTfKkk"[`ij2QCp5-BVQf
+bBq2ib%%df@MaKdQjI$%XVmdaIDQ0m,'6B'mS`qb1Y"I-,,$L[2f9[*i8aV@a1T1
++L[Teh"TmM!'V"U0ePPBfPIKe@"fB0lld(%*`9-LeU(raFe,*m1k&kimLQ[QC+bm
+fa5*l8*efKPrE+,NR8pi$*)q5"3SF[0`PrbGeBc[pU#lr'f-YPff5QhhhKE*ZHM,
+,QheI53C+HYe'@4pjEQ-JP5r5eNC1&Y@fl[T!*-pNqMd1EbD+D3mQqCS-$c@MD3D
+DHJhDM&-1k,VM)(YI@fY2Z[cL*0930Ife"eXHdDmE-r"8DXSE+rPIm0,[,SH25&0
+MES!pDp+c0Qr&@QBKpbpYSH-30Bkh@(8*ZIXLp#K'6fNZGZrZ9M$F(TR"`HcL1"*
+F3,T`D9QV+Q!GU--Pc6k(6Z9rZ1dF,'$LcK%PFf-&iiji9HR!a#Q@N!"JAD+dI&A
+FTL%[`6acjHVNF#@0#lZr8aU+QdHZf[B!0(8KFq6m!MRR-NFSINIbfi#rNBY%#Vc
+'rPLiCU!TA@#(cbNq"cdS)1M02Rld6CHABmLp9@+P*HE6+!*l*("k9X59+Zh`$DZ
+b)m3)`J(0Cac2re9RG92k9-jaE%`8$@Bj"XZ2VS)P*dpHNdcm4MP6%pdUqdpNTfc
+H%hjFd@F21Xh`[NkqDFTiIJ8(b&#M'l*BP'ND`9qApffIkG!R[bEaTAVr(hXeqKP
+V$c$5Fk4FGYbpM4BqCi*!drKEA'%iSQU25c9G9YaaY)Far0A@XlS2dAA-lCc2m#q
+&,iQ1aa-T[(*SKARAC'MXRDb0U%`-jPk"lXGaee%P)j*B3'G8KQa'@[-3h*q9QIi
+rZijj"0-,K!(pkrcYHae*&IpY88qH6!fUE[ak@BG"[)`K'R@'&i&"p8+pG)[(mkH
+HVP*[pl$3RB3d3E'TYcH5@a-U5[hU"!eYdS4LCT5eU[!Z+l+IrC[*NXN6UifZ!c4
+(N45E(r9i0RaJa"cM5['XM8d38TA881EN%ES'd*U3!,&YG&c5PcLLk(SX`J*#`IB
+$0)1a(,de1d0T*DbVeplc51(l&'0H'YNpmMTGFGD(a$a'!U1#jdefD$Ya)CH'FJm
+)BDI4FV-[mKk%U"aGJA)r`9e1ZJ-aQ0(k`f-Y[[`P#+'-lTQhi$hEEb!mQ,AEmj2
+q`'J+qe1i8*RL#E2V)("haTk-b`2qQ@!k%ISBG%V%@G(*6j2K(A%5)5b*#64"I5Q
+Rea2Y&NRG8Z9[`"V2X%6h$&!Ae$LPJX8ajQ8SQDmF+C&Yq*p!Z3H8V4LcQN'dfPq
+bETN(59$A*hJ$9MeBN!"H*XN*BXfADfc06D3)Z!J[,a"i,rVTEjS!%-@L(TV$PI(
+!Ak3'$EpCYEUdXC3VQB@e$d+"Te*E2SGMk8K'$DcD`dLTQBRVVm0DJGrl"S[T"1%
+Y(r[5(k'HS`XH1`fFQ#8Z!HPpiGP($h2D2Q#i+%cKaM[*r6G'@)ISerblHf[S6[A
+KTCPLJXMh&Gj)cY&330DS`EqALD0S%[Qfk6pUS"j+L!mZY`*,LqemL!#0!cZ,V,G
+$`UhdRRYi!,ckZ,@#XS,jYqb``YI-heY8(!1h+6DL'fJLCZq+0K!`49fJp3,mqEr
+S`GIRjZ$lP2immCRa53A-H`KcETrLEP'0fKG!-hZpa5B5'[e)Y!jqUal5(kK-ded
+i+$MkQ%MU3!,d[1bB1IF9[GCkUk*6hhJ!TC!%!3!!3`!3Z#2D-lJMfM-!!'pk!!$
+EZJ#3!mi!%m$%!!XHZ3!!)VN!N!32!&4ME%aTBR*KFQPPFbl2J#jiE@`!!I$H9%9
+B9%0A588"!2q3"!#3#S!!N!N"QJ#3!f`!N!32!%,"e3rPe#b3!&*+4D!8p3I+K-V
+9ll6TRV"@)qCMmGmb`r!)he``jaX+iPR!9dI@RL1XBF339QP"'4Tem)R%C'AQBad
+afIKSZ*-Ce"$r%I8VX,9jm'2#',&JFR%kAYmA8%$A8J-kfqQNeDhA"!"#`G5P#m!
+qrDbCHA8Cm*d0@T(k1j!!IY%QFJZ&,5r``@Q,bZf95FVFdd`hY[a*(1[+`Yd`&qh
+1h`1Z-Q24eF8Ei'&ZR8IqEDINldPDbA(ikJDKpi4YYiS9lQh$Rfp6rKbi)`lC9iF
+V3TX#4)1ei49&1,)8"+Z*#Hj496lJXQ',$hQ@-Zraip[TA6M2P4'C"0D)1G[I2Nf
+BXi2iZ'ap3HmrJ%m0RP#B!Yl*mPbZBDRb-ER`UDRdb3rG5EmX[Lb(,BRRVB0Q"5V
+VaX["ZS%rR*Bc#N,3G(`8fPp6Mc#dR,m+0[djK&$5jCXm!"Maj8fjf61m`f(Je[U
+",%@qAGbCVmQmm##G*b"RK2QY1RZYa$KQ3i@ZLFJp'UbF*fqA&3pQqk[iCVp"83p
+@f""CIG*KNi1R9VLXAKrqF%))D#P'QYq(h(eKGCdL-4,R[&l%D9#pm3cHY,YhjZU
+FXN*Tk6'rQF*$Q,'BZcjfY#PX5N2+UGLb)kM1#`Bh4`e**`1(TUB%qXHGQ-!*F6P
+!h*)GIhb*S4`8j-bD2cke8UR)6"DSfi(keqrCpJVZrBmbbQ-FV6qFk'TZ`EacG!l
+)CJPUTcD[himj-%V99V@3!169mB5DafX4@EEdIa!1c*5[M"`1k+eFYNFN"2A($,A
+SGcq$ff[*K9PFf'1B-6NS*F+0b03j2iVV!H*1kHEr`LPP&Y9mIYFV40@`#pBPHaa
+2rbbf)[$)m94jM6JkThp)#fPidpj3JlJLG"QfABCVdb)E%ELc1QrYaFkT%lU3!%2
+l-Q%,0@l*deL`D)l6q`&3Ta8*qS,(@i)X!6J,D",)UJF(2eAX9mZV`kmKR8AJHS[
+lHN6ANYKmqMEmBEXEEA@B(GZ1pD"c5NhHLQc*cBV(5i86X%B$ARB)E5ak#&-!Dr1
+6plGj`leY(aaeCmf!$*1)`*JFDP$9k2Y&2)`)f@YQZ3ea,aN5`bGNIELK(&0Rp6C
+%AA6()@DD(d1e16K(#0-1r&jJ9QVDZ[5G"*&%h3YHP#Cja&IYamGa%Cmp(#$-0ZJ
+$"%YFBqr&DIMr[`EDQ5*%D*5c&%qb+NKJNDmN'Vq1mS(04cE$5N!idD6@mMKZRpp
+,0ecC6VhiD$J*Qj!!0FNbrA-&-JH,f0di8Q)0j3DaTIYJ$j!!Me6Y40%m+LPZ!E`
+&8d2#T&Gh&C5qDd`"9J9CQZXf4$P&Hp!3#(S@ffZ[[eC(@&8LSUGE9K""FAc)d5,
+BC1rVFb,V512[+r(-#P3bYBYjI3+mH%de+M3Yce1X,i+eU5`hm,,qLA$Ep8GFQE-
+&2D(P&SMF!H)PGTZiHDM2C'cbA$Mh&qSMB9qJP*8&Jp06'`VDm-eEiFBmUHY9MEF
+CDi`Xdj4+445L3iRbdBfBl-mE2"i)IM9i&MqIPiS'SKaR$#A3(01Qb*jlZCji+mF
+T02S9d@MkV`H*b`!1"$@fNEI4Scd2YF"6a1Bb+Si+#cm`G9$S&,qXKF'c4KFp)"M
+I`edfk8QP5)$)4!qT$UDd)"qZ+681)2NQ%efjb[13!+iZf`AG8i``Tr108Lb0GEU
+akY'Hqpc5"3A6B!$X@`&KTCJ$G'@R6*P@[&*,%2qVXC!!&kB(rE$%&'HmDh)p#Lp
+h`FZbCeR-98CR+N@PGHGlDP3$P+X2E8khRkIlB*PLe9bV9IV1ek$-%-V,c'+#9GF
+ec3)ST&KN#p@d1NY6p!NMXQZI`dJ!AmA(`pFf*N1e%YI-kG)[CePRiZjR6GTR$2X
+'$c,$P!%P#0L*@Ia%Lc*Zql2,H35$i-Rrf)+aRr4F6`C0&h2E!m#qUZL2(8q+X&`
+DrM&0Gi"5qqhf*`QXCmp`b,`0[-MEmhbBVe%ff4VLVN#"m&E6P(q,JFDK`HJrLK6
+E6am$Sdlq!r"k5hDibSNFjXl5Dqpe,,c[3PTT%r#IhZ%Nme8lF0P@d3k`5B5H+)4
+(c8Ikra$ebS*3CZ`+P#dpBSPMPEMa&e)*RTlG6FN99'K-PXQZ#Y-GR1Q6UFVRP9@
+bm2*hZTHA&k#R$eBVUET0jQrdm%T,5K@020hme!I42J-DJm`iEj,6bNI-JLMeBE'
+H,4IFYGa1%(lRK@Xb$J%N3I,P1cf1iJRQ#6SlL9k4!Sm6Lk*,fPjP0TK(mGj)P(l
+Q9+5Y@[9b3ZmRq!N)i(5$JD0U#2A+JDVPTJLh'p2lPTdA2$,b+PiXLqFe&fcP&F0
+i$!EDHH%l[586'iPebb-X[(fiIf+b'Jm+fa"2@XIEk*0A4(TEUU`4cUaT@#*IZC'
+d4J8RKdV&%3&I'!$HH51UZLmkK)Pa,lNID1T6S0jb4H)KYJUJ#h#p[emBhFX,0Z&
+e!0JZA$QF%VFX1VD@K#P@hBH1BeI0dBmaF$bbe(J5Y+iZHqa42IjY+VD5Mb0dS2'
+m9a#[04YF2cX)lperp-%ea&j&bm3LffL8T(!&Ba)eq&",N!#5+Qh+8I6+IB063+$
+BeARhqphqM2,'e&P%E"!++&j0X""Z[L(RiUG1JFJJ'&0p3UY'BK+%iPAdrh1)`(&
+JX)Yh$8k)"XX"63ND+q9I8r!YbY)T!D$'bJT*S4lFmlIT%h-0,p[C(jm8EK-6U91
+eLHarG5I3)E)8dU(aXcr-D-T-(CHVaZ,#AhU6hlM2errk!D#(VhMXP#,a2'!#Mp5
+5$EZCXd)hHm#SfD6Ph2UHR$FYqRKS9X9hQ3Pq6Mi9KX&Ed91`UK5((d*K*ND,9Gl
+NQMddr))k8[,R!ZG#+&G!-aZ8X(d#3fNKL0Z59S#L,NE9P3QQMX"N8%F6p'#E(GK
+kK8QEDLpBr@f`rQd0-+*I'l[4PC-T0l95l@-ai[*$PTZ`Z+9BUmS[k!Bj,a466#P
+Z!4Z0-'Sm`Z9`)TQ9D(qpUH2(E5'qrP!PiN6ZBY6&FG0r*)r+hpVZdc3l5a8YPV!
+!#k$Qq,l&jb`H8Z)M[YpDem$,lA(Z,(ISZ8i*U0ppqUNd1(Z5hT+Z&Y'c%ibTiAR
+BZe"mcAK%P@SXQ&HUlYkKdL%EZqrTqi2[&YM`IpGrE@kb0aE,aB[)m9NZB0@fMST
+h3A$A[P19IVa420&T0Jhc9$(ZpEb19SHPP)8PV%QTUa"ki#MPQk$k"FYf2rMVf*P
+"aJAa,1RU2lC4CD0k05qI03rI"T+83eAZKqqVa![HJr%bX500jSZ@+l-mUGdh2i0
+ZAU6A,CGJJ[EG&8,S&)Nc0EmSpB13!(qHBd,H3Di#ZrHP`k[cJ%-ri6A2JDcZ2H5
+Q(S8&8p`08FSK`,Al,aZFdj!!p18hr9$ZMkZqNXmB[i,1K+5mj$)JM#TT"`6REG$
+eek9&+3b+RD5m0EH2SN4@ri6&9%VBj3I&dL*KiTF'meH1QGi9C(e#S)lG!m@Y,ZL
+rUFh#M[Hm2*-J'Mi29`5`*DRbYcFEMr"e&,-"p!!PA,R#LjrdbK-c@9Zr9-5S"4!
+%XcR3CQmcc)@5#cc[%25Cb-dY#82kKI$%P,X5aj,,NAGE)TbPBpKNM8BR+Y$5$26
+X6`Q'Ndb&M-C&l0,iZ(drQ+[8T6k!Sm-jj,!HX(Iehp2YYe#q+Nrd6DHhXG$-"LJ
+J#l8US*lYSAm(3k@#M5HY`R&ba9XKraqi,f`5b5mii%1D"rfN0FJX%-0`&'eUr4e
+C$9M&h[Jh4ak,,(f-Zp96S13Ah')IDC[&f$ZTQd#`c*hkbN%)'+9m$DpZ)*b3!"1
+VYU#-[Gm#G-5MF0N%DZT&%1lDML)-4@hYm@lHh4ZC5D+9Sf!#2-fl*KL(,1`p'SA
+rAM5+D+(bHlk!Hab'P&[eM%TqETiq4ZmpZ`GP!9VM-UZ[[dAeP2,P@**J&$'F!@K
+#Hpq"%!X4Hcm*`F&aPV00*l,C+[LeCShA+k!V1$1rmpNb"j-K)+i96m3,*)Bh!Qb
+j+`CK!E-pqM5H-#(5e*!!h8(jjaGYQfAeA-0FCKGJef-SUBGh@1Bc[d8*aKY#5Xb
+6R%&)k*cY4qZ#[%SjP4RC$JA6G4MmZ98a2e8X#CXD'lk(RLDDJGpS("XZBlA5iKI
+VB+GhZXGIb+"T(f0r)0Dp"5(Je)!!iGkLLDTLQH$i9Aa6`8Yf!4bqc2X*5%cXq)&
+$`3KkA!"8J)-)AjIG0,)f3#H`fpmc6AV0iLpfIR4Xhp3`MR`2"UZ8E`D2UI6e3mG
+4d@rf"5mTB9b`&0+%9F9)4!UN4KGRL14(QFM-KIr&cj%E1r9`*J`-rGG2dGp0ZAG
+!-$,&IJRk4[qGFAaU6d'm9lH!XMXdX0rV+'PZVe91hlX-cFc+0#SPR@p93kl#G(q
+K85p*G0!p&r09VLSMUQK%1cTb"aCN'"[k)6qkK8"+Jhl'2$+*`N2Mr)-GbfQ"T,Q
+L,C,B&ZJXlKKUl+3k`@m1APC+$jI"9U"Yb&0$'(YDKa$P00H85Df@2$VhVqmD4a$
+9AL+SB)l`YB9TqkVRX4Y["iIM-bI0`@KPrEN@kMJSbbL@jA#EIZq"@Hr9`M5"FF)
+jQU*3e9*N3944*M%`22aqV(&%d8"R#1dh'%D3!-SjkFP6jd"KeKe!q!N(0+D"0UU
+KDVkYcm1D3ad4iHAj0(@Z%fZaU3Ll5JZ*2b`H5eA'8b3TDPaQLa66kUA1N[U,f!p
+V&,lm(*DK%#6KAABY,(-rN!!&!eh!69(HiDUiM9"Sj8l&N!"LZqVV51`iQ,'3!!b
+Z`H&"+V8&6(fDr-+dm9N4X'H!j50GG10XG*`h&bIZ%6Q`R,kfLH6Via0-"NHK0"T
+$m9JqqCN-+`-k#6pF"1-5TA8Qq"#B(RjQ,i31&Q$M5M*KIA8Aa9Kpd#$@B-NZH05
+LH(,RXfD-E2Pce#Pj0#V"d(!$kjlKPqXfTEqFUlafK*N$j*[9S8eP@a@cMC[[D+(
+JadiBVdHi@G4F4lB*H``j12'YcUK*Nf6UD'EGc2a+YI'Y'9cQF*c*1C4F(pYMB+3
+c%Q*SV)65[%e@2pEfrI3G88HT1+346-Da#JM%,NF+[8C[P+2EcT0m@%pReb[H+-J
+82TUFZ2eY-UGC5G[*-S*pkcqJejD#X&MP"[0(AZdqBb"b2EP`D+efrV0b+$0l88k
+#dQeSBU2FFHN!P2iDYMT0V)Rj0Ymq"ar`PaUS*3!hDJF5)TI&b,(&Fb4M+pA!UpP
+0dqDfFr,*9'Yb(-,$SqAkRQMA)YS4$8k&HmSI(AAaC4Q,J@!f@'$*lXC@T,5S&*4
+X#*3&%UXJNEe,@!ijReLiJSYf(U0eTChhKC-Nqj5lafbaNbi80iMHmTjL6!ZLd)Q
+DN!!@LS5%Y,S-H1l%eG)KHS$ec8iFifTBD!IYLVGZ(3LJ(!Ql`j!!B@fSd+d[3"`
+LVph$0ZpDpREMkD*KN`,S*#DV9&j234,c0kjiKd!@1ZeT6"#j&m2X&!I`K4k1a$L
+GLEHPTTfMrK1l`E(F4G)!QR,c#-`)Dbrr6+G*Y&4IpHC#)rBYES##VR!UAfSUdLD
+RMbik!'38%9mH%cck9J)[hR4VS30YHE4YTQDBeKp[-H6[piBei8@HQXY3UVe%+cV
++akqehS'[*1`lX0!Q%BL!-e*VQ+,$33YQ-l%d9Y,H&+c41I9Jfm5'dVm$BR'UUmb
+pdMHrAk84RaqKp"M0)BPPp0+qh58pZ[1P$ce2X`reEmL+BSm`(2l$+aRifS*-UX)
+3IIT`r4@2X2p#Ybp"q#lMZE02GcIC,bJp2M)FZ+CAdU&DCm9K"H`B&,kicQ!4H5@
+p4lP(HG%258%pFJ')-1$Z#*JIXAFd2m09Sk4k-A6-Y5%aq[bePKb#aLXE,9%pYAp
+)8i[)Bjq+,58a*pm,e,`Vlm@$'q2L%99XK5eSTGKLFQdUNlB'Aik2YjqA56cc4$J
+[!Sb,T%8%9QH5&1(ffd`V$BZB6c[,4K8bj@P(Z`0fUB0C2Z&el[$*[`EP&S(%PC9
+PCG(hTrb#P9RXkBEb2dr'T5dU$R#9Z"1b&$*!G3iP05k0PeS*@r'U+SF*k)GZL8#
+*2B[aX-+fjN"[Vr)Yh*f(mMh"[`J!UFRq15E6XjZLT$M1V(%@GZ#99MH+VPmPU6q
+l*Q%8AiGFLJHGU0`8TMmGIpe*qPZ[j[8KYBCjL$3pFG@(KZ'R6cRX&m+LT58aiNA
+HZ5)JK&*0q(5$(G(cI,"CR5SUHE343GU*U)+p`rE"LFYZ+Va6raZQ!T!!$0MVAJL
+XKFY25CDLk9JpTS49iMdKNAEqUl&ec8DL6M6R!%+Fr-P+HNIld$fbqr)!HVfiiZ1
+#3Ab'f32MD@U&P`,ILGh0""XE(DK+`aQ+pSp(U"!Fj1$0AeqSG"hDEUZQ!#HJ&K%
+Q"3104cEdQh28hD'JkFB[TcTp,K"YJBQh2PHH`NQ+2qGRb+9a@30MAEf"*#'HMHM
+!UbKDS0JdGAq#pSTp'+!Y6fCAh)+jbeVV1-C!FBD&lALUCq,l-AVkeDqj0M+Rf60
+H2GPp)E*JFp(Jp+9amRKDRGpIdL%i`1lbqpc&#3F-2aEXX6l)RUP1j2"Kb!Yi4(E
+AGEGLcr4C,#2YZ$0$P@BrAGTZ&&5MI51-fV(2`Ra8*,3)d""jG2ceq0R89iRHF%f
+Y5@f9SHr!!HCT[5YV3JmBXeX)K5PURafr9abCipRE9Yl%EF)X4Ta8S9BZ8kjPZI3
+[e[5,P@4Ee3mBm)5r$!IGB#irUSKbqF3d2$c922()rb3ZfP[AYhaR8r9qLPU9P0'
+B@83#Vl3PTiRIT%"Ui)G8+d#r&m`&$8)J(*KL0JF+d@V8-`Ikb$88B[Q['0rJP`r
+6$'!6AZr'6""JYJN@0YfXA`,D0''qCYY#4ETZfXhPCPcf+Kd[0#aDlc4"4mLBRS-
+R[ie%8l1k#JC%rLXF,Bd*lfV&h&Jp%X0af[r&,V2RkCCDNqHKB$+4(Dl4a4-'AYN
+&(NX(()(F)I#S[+4NpHSAD,l,)0*-c3*8e$BQ2,*P'JM6qA#'Ff@p-BprdN3kMP1
+5e5jlHRBa"&(aXmB+F3(%`$fFBZ95d,pahhQpKiIEE8&d3&D9kd9peqRLdr`Z5XM
+@`2bF'h8SHABABf2iXffB()@`kkYm$S``SP")i$PFGkN9!fZRCjEPfPj`Yif'FJi
+fF'T*cdCR$pY$DVY@jSl38k*S-Zh5KjPd#LF,DPkJQJ)UDA9b30P2Zh-#1A'l"TK
+QUdGqUHQU$3k6Rj1--'EHdJV6qQGb#RV-Kb%CLFB'XQ*5GVc+KHAe&a'!cm)UmKA
+1(hH,Z1$Z!U9dh8SZ5[%*8MV5V9BFY!8UBd%K&bYY)V6,!2dQY#93B)0'2RHP#,$
+`3,bCEJrNl2`9ZZ-2mYe"e2[3AB4Vh39pbYXjVKar9Ca3()*``F33C6Ikkh3VP%a
+$1)5d"FKi+Qa$PqCdEPAF3dG+SIRHA05%PfAE!1"EhX3h2'$EN[XJBLVY*f1"PS9
+(8f#9CV2h1Nd-4(Z$%AE(+'$)6)Jjm,i@@RBEPf83(Q3SQ'hKUM-*qh0d6N[DQEQ
+*d%1HR4bCm(pQB#jYNMfl)PDIl1$H8a#S9PNKH1L"3bDfVciY80`Jb3p$LFlZHUR
+m)ddCKG+#QVqV8H0JJBCe62#DXQFp#bhh4QZaISZ5dkZ"%'MfbRTUXJ2KA"Vcq39
+F0(*c6&b251[CLpP'M%hmH#5j@(@kPRj#*4$4P+#H"q25LIL2m!eb-1F3AV+HmK*
+pBpkk,k``)6UCGd(rkKGK(1dN"KUj&eV0+JiIEC[$LHp[F6NKp'!pBlp"`!2kLmr
+C8A#Q%fbSQNYT-&X`J`)(G`I!3l023Q6[qNE,kaAPmqM$qL2"FZ8`AE[ZE,A*!Um
+r8(61E(&CjaTD$fA*CX'*9j0)KLqMH,,LeJ$GXRbR!@eU-QL%-L+@RF)MZlBhBL`
+AVKd0(RpX(hh5!SS-d"dF*SY')p3mTNcLXIJph3$"qPL+fCP2@b-k26154%[Ya'P
+[+H,Fb$Yl$@Xb2`CVZECSLhA&3MhUJZF0jSRXGpS48-*c!lJ)d'TATY'6kqL+2Xb
+r*Si#DK!0lMfdeX2[+!AX1(rPSB1-M6SA"`'Rc6P%`hXJ*adilX(L!NA1NI+$-&F
+-'JX#EQ%MepTp#HF18EaqQm*6L1SVhLaSb$@NX@V'YN2LiKZqApl00UjdhCeIPT&
+q**0NT"TMd"IX+&CA9D,'lJAXTikPK3*HF'+*MS*UL#CSZ9FH!,BMcCj#GlRR9NA
+'Tkc&+4$XqMjLEh,*PTCD@DT%(M18i"[&-Q*T'EP54(fFr[`c&aq1$+I1"eHm6H!
+-D6hA`l%m4#5lhZp3KSc1qD#3!(RYLPb2Er'X(#IqE8!#&J*0!$"q36hTXSAK3YC
+A[&3cK[+PaZkFTC-eB)-r%Q*MrlV#l&'V-q"VqC1m`$(L6j9+([hSSZiC&l4JmE'
+Q#ieI$Ej4&Gqq1%RX`L`@[H1+Mq#1[J6&ckRZQJBDHk1+U(Ap34Y2BiF%-H&-e1I
+I#96cMD@3!!8&)3JM%!C6*-!$3ISDqUbih#l!M9%Xa""b`ahHH"j'LC9L'EpH@5a
+M'@c-3Uq14,bGr)4N-e3R9-*XCA"Vl9Eaa`3Z$)m9+6fBC"+c"LGE5A550J-Kh"8
+b'DkB4eKK9q4h6pSBr-Ih1+Yc@$@#rEpi'F)`+,Qqq"LJHF##9d3kRRdUPqNQ)D5
+KNb"&@fkERd3B&&(!##)`T8pV!+S+aXhdRGi)r3(Rk#+$X8`[qkZTmjZEZ,S(4j'
+!+E+#kDjMq$@4YCS8"2pr*U%+Y2D0E@'C)TiIAp)1$pRL+*aAFI+#5d,VXA"+RQY
+X+!5qiJMe*[0l"!Yd,c2[QENLib#d2T`HGJEpR8pmZYHcB)P8!16FJV8[PRKr%f(
+)GBl(5bbEPTH96p-K`"[c[2-IMde,D+`p&A2'-88K$0CBFN"Q'*fPE1b')"DMe$F
+HG9[2ljm'@319$5+T-Z'*hFKpBYB[0VJVh3UG-h2QIeGB&9I(4H`))MPc2`NL@m5
+NEb&bmrhM#c[LJ-Z[mX'p5q$-B8@+SS86h6KL`12Jl)(RB@PPf4@8Ke%Vq[@IF#&
+,a*9f@hiqeYPD(YAh%Dl(iHe`)MKX4%BPiUr#B99b8J""DUrH`q"6V-[mB3MMrkD
+1)qYZCj'#(Q62Xjk,K0D![8DMc8@!FK(HXbIJH(U0,'jF9hZGpmHUJM&CEShHS40
+8!Z(@KVe`HH6T-RP,abU(Z*&10`rf4!$V!`ZH"hGcCT92V$,Ni4h("m'$PcK%#14
+#kDm8UBV0*"D,05&[hDe84$QaATTU"S&[G[f5@0klE#Z`@Q1h2Q"crXp&-MbDdcG
+1&jl@1dD!lYT)l6+@R20N(2aM(BHlV3Sjc-,XVTHZ!EP9`FM31Hf4F(KBNl9@AB8
+4ZZFLl[YkIl"HaHja0GVh(FpX6%f`,*pf0b#C+Sp%FU33Qj!!``a,)q8"P"ArNVB
+XL&*le998f&Fc*jEhFE%iB9ekNk'*R'L9T1T%m#1lGrM(@UKrPA04eCIMm5[@64M
+LM8lH3XP1)E1h-&EGE!18,-&C%QZ`R'&Cl8TUCTY-eZ#-m46DEdLPLd*))bc3-pl
+S-GHSDfP4[cqM9qj&l&Xk&GVL3bLKh`hp%`4JaIA-qCaU'eNUKlqGUS-QFYCVjUI
+qX2T,!$50U2J'49*1AmmBMM+8&8E,[ahl*C2-ZGV5%RcH+*GE3e80h6N[(VTlVAr
+[ID9UjK-S6LUKKELRHk2(5bM#*eYm'Q81D$@KHD8f)'S*K)@2Jf52iiFhTfR"5UD
+RHE9+!6MVC`jf0RrSR+pH3"Y8b"4[IedY$T2eeL00-BQ-$,Pq6UATh0i8%[IFirQ
+[d#50b"Uh5K`Al,Dh5+Rk4CI"S@j5[,DI$%`91cDpZS3'5*b(d#P8rbPYCjTFVJ+
+e[!bcQ6VDbGj-2Mf@X8@5$JGfK8H49ILN$lD@mS*@K8b&B-+Y8Iqj)RTYa$J+SdX
+,XMm[14!5PEUTDGK2c6(DEk5X#Zqa-MVhAJf(lhFA@E0C+lAPrBNBiqX(IqHVBmq
+ST4JAEfR&!6Kbd&fdGp+FkkVaUR%d+jZQdLlHGZCLPbT"AR,V"HdQ'%+XYj98'4k
+pjJ#3!*4V-kk2i#$ifYh`LLjI8lP@lD8Y4@JPdj8@0RS$E*@kN!#NG"fIZGQp5NV
+k@`a'1'6@dQ%p9R[%#)Gi`4Nlk%"eF3AMLb19C(9V8X2a5jN@*9fTe`5&--&UR!M
+i8m90#c*HRI#1LRUqiS@N5Xe)[PN+3AqjkBd-@VUEj5fDSr&`,kj&br4TM,pkG2Q
+kj+ZTZ6)rRiI[fV&I,dr["qTm#!UJjm@KL,m-BjZ*,%eVmdhXBUSE1mp5TeLI2S-
+HFElSNl#5LJ1[RZE3e![%)A#2[M,K!D$X-JJp!'$CXK0(&m`B5GXdHe@&3IN3-HH
+@5C!!f4,JaIX!`1LC@%R8U$Xf`!Idc*-#`*@P(XfGFH4)AQEHh)5!(B98[L'l+f5
+II%H*rYqPXc6K90ELAGQ@KM2,'c)XFHJ[@(Tj9K2+l4)Z1(dDd2b4`4ek'"kE#r`
+&rjR66%CQr[C9M'Rk99%*[CZpB(0#V8@&%PaHe,@5[Qr2*N*l3$2mJ$`eVe5N!+C
+A@33HD#edF%dq4cE9!adq'P0amh-6[8Q![$3I2@2BcdCi9KhMEQ"E4HEU$Y$,0`T
+[Ym$5!%TK3`C*40fk(CM@IL4GpUph2I@!pSd&eGdr4+&refYEJEjKeVMKh#0-,"9
+'2*D[jQ"N'Gai'I)'[ChdcGj1L(K%PdZl60D4'XR)"29USRQABR8PHa1dUcLZcVB
+JDq8Q'M&*#jFEbHB-m4-jGc)3NaUEGIGAKKMjSfR,MBaf)G(K3Q0NRb6NSV"'8cD
+Qi)1l9p%MfiVEHR*(QL$F-A1*L-qj**%Je9Mi1L@aS,&R'UCqDmq6VD[aIQK2)3G
+1ir6"SVb*9+Q9TZR4FfSIIq)U4ZmqXT5C"dc4m&QD)ch%e2'(')M1FMp&PET'S6c
+!KE&UhSdMB8V`lDNqk#PM6cdL"8*8$*%T8eTRL-pQ3cLH5DU3!(#6M!"Q+d9YMm$
+N`q54ZFh9JNFH2%RI$Fp4$d-U#BTd)2CX1P-pmZ#TL366L**4lQTGKM@NF3#3!)m
+*DG3-R'FD'G9'AD4T5H4ai02S#!8EJLr#FLd&VZjpHB)T#el4a@P[C)5FL+51F@(
+JTfR[h*G#iXl!jLrGr1fr"*r$KIB*"@SBF"&PEI8H3h#kr,E`NB!fC['IJKhT`HL
+eYlEr6*Xr1@C(6ARhSKP[[dIY',rX4'$M)&a20eP*V@&'i-4Q"KffD@$H11fmkC`
+@&fjM'XMBG9rC'FELD2aRXCZf("&(ZF94"aEqDJZTm'1Pc9BkiQF$j,LUMmae&YQ
+*Maa+1`0Z`aV9LGHD5IN@D&X2-Z5@L01SkdDP3HD0XR"dHjE$KM*RDYV&EeJfe$c
+m0[S+d4ZB[5XX*SV4e+'Mh'lE4"[HZ68@4l5aqiXEG@Nj3`4aXljP1#p3Qk%MLH0
+C-C4[,EcVA[Lk@q8H2rNPi5m!pAQDc'amhS&(-Pr12Jf1SCG8&[2SC&'(c-0cbX2
+U#rPbp`SBNSBqGBD49F[QC@3ZF@LH9HC*Gh-Q9JHq%%remL)l&p-hQE[UUZi$f@-
+JI2"92iF[pKU9HXEbEIi3+)[`@QKa+(&Qkq!N9m@J!YA2qhJ$%6Dr1&#dZRG1h5e
+4Irk'jC@BYEb,D9`p1!m&GJL5e1hHDkAk[jNM[['V!RV9b1kcVL'HNLUSJC*TeT)
+2P%Y$5+VqJ[EFG-S1HLYFN4KEKML+bPZD1K5@)@@$j,mf&Q*`VMLRY0$mb*E8*3X
+GD0I+([b%'qaZ,l,KRr$mEpfhRekXLES3!LmN(Teq*,FhHHCj$ETl*[ZDr-C-c$-
+RQrf+l+R8-9DC9Q"pG%+0a[&4r@$QFGr-Fre21'A5)AeB)'eYl)J"Y[FhU&`&8@Y
+JEr5""*N5LYN%@"CL+k#V4VrihV@R$##mNf1PXHc"T3%&Um@HK"%c8dpCVJhYcl6
+42H"A*p9%AI0k0@Jr*iC!BJ)@EB'``k*h1A5`EJ#PN!3"!!!m!)#dSF5TYeNKK!!
+!Z#!!!3jV!*!$cJ!-@R8!""l(!!!b83#3"!m!9'0X8fKPE'ac,Xq!!!"!XNe08(*
+$9dP&!3$rN!3!N!U!F!#3"N,"e4rahBGB+p$IhcA8XarlKIRL%&4V![@Lk23Nd9Q
+!5FZ3!$XPbE!!pd8Sd3U[HaGHml,03e2dMF!h#`P+6FYj+IYU6IiVf@,5S@,-fm`
+#lX%3eS#-pX(1G5$44qR`L%l,CrK*Gi,($q8G10YMFVJDD5+p@+md"k`235Mr,bH
+U4h6C92Bm,-jhCm)@5bQ25h$JQQk8H@V3TR1"KmVGNb3hee(N&AF30#d-4`NBA$b
+5Q6H9Y!RlFJScXX+0aMKY91pSaYLa!LmK@2)XYkNipNidb1i2lZ(VqaUGJjUc0Hl
+Qq&UDic9T%%J+8miTCbN!TXc1#-K(k-GYZGia`EQE@3U(&`,C$GJ#RJQb9[r9R*R
+BI1XF-TUc6-Nm(B63YpG$N!$R&(m,8I8aI!#GlNAm9G"68@CTMX*qIb*BD&8Nme#
+kFF$`VUC8C-9h"PV(QA$h`Rfb")lEFI&F4`RU,$6aK1rH3JrLVBekVd,36EQj1p)
+S48T'X5N`qjYJSj6RrIY!Ja(p353F#$T*4Fa%`kGI4X)ZX)%YMLQT$Z81RH%1ZA(
+ZNLFU-mjp9m%UpY2+K+Xir5NQdbr)p#qdkKQaj4![dU1k+2#hMIS#4@RBj2Tl+%A
+cL!SreFj`HlGZdEUH'V!PINpZi`hjiS'H`F*3dH`*iRlC1A@C,riSMYZXpX'pHfQ
+53C@kpiaMk56a%'c$@md2%cLk5!)#IrdeSFP+[e8EFraa@V!L-pI*lalb&M*F#N,
++4PAhRfh)BFiK+qepj5ZIJ%5qL`eG&e10p,J9qA@%%,lB5F9qH2UD8P6C'Cm+@Td
+P2RP*lmb%T)2'4Y@'++d@V4Gj'H53!%@11CCHdI(h,Fq5hEf1kNHH1lKR**&+1[-
+iBBqHS!NZZ(HYH1Ge#mLrMpliYcDXUPe@N!!bH'KN!ZGkacb-2[XRV@[*rp@8md,
+0BCB(`FiP5V(%Dk0@TqMC4'5NV+`$dm3!Y["89CZVJDa[!KEV4D(kDV(GjQA+T0V
+pc2#Q)*fbYAc&@ScArE5maffabS0G,1cbbPP#C!UbT&pNECASY,L50P!iQS06N!"
+FU9P($KY221+0R'!+Y3CTr8qReM-6Efmi))ZY4qF(eG"l6Se@iaedE"@q6h-VSiK
+i@Daq9JAQm5H)@508pVhI8B(2Ik3-BVd*p6!jJMBk*Y"VJ`j1M%`i&VmKcG#hFIq
+%h+p*4909a,Z[a2pPKkmmTHVCiAFEYSh(@QReLRDBGU)0J+1p1*+"klCUPPf,))j
+8%cUlmR!eI0*ejNeQ&Vrk&9(3F$QY0'13!0lK05YrNia6(eU&6P+p2EiR(GJZ#Mk
++4D)[5N"5h9B0iQ[Z'ZmIkR`[-QB'3mdQVA(G,fI[1Yb&RI22Zapm8dM-J1T(J!V
+T*3"[5i#Kb5kR%YQ*$ieH$T`erkVf$Af5*CjX&LFeVT4@$QhPi+ek`GbmVZ'HY5A
+#L!)h@(ZrcH(h0#fK8k"bqiX1rGT%j2p4!"EKM26[Sffl&)(VI#Rh!cpaETHX+P(
+!U*&ZD(N"iBr!J6LL%Pk"J&-VSV)#@JeDf,`5&cQH'l[6D`m`SMk"!%4Qqm(U[V"
+-CG'9Ak$b%Z+J9@8Hf6FR25J))Q'Cmp15&dPUB2XMrYT,jp(S,,L$+9(*EaD%YH[
+$jV[3TAlkG1C!DU&PV'*VKC60P,`rPR9M+RM1-DVaH)0mlCePa+9$9b+(E98*JQ5
+N*P0i,Jl@PiK%5kI&-(@2m,"c,N$,Q"fI6++,$-c+4ReY+ReT0ql"rU,-JM92`hU
+IAjJAk!qlCPMCMIc4,mTj2#[Ca,`r2'[N!PMrl"lX$9H@kU`YPl%Qq5c1641j0ra
+X$(U)H"*"NXdh%XcdFqC8G6!aV"9KT!R$HP-$,,cHicc0fSKN&N)rR#5H4GI(#i!
+kfV`!L`Srq)FLfJ'ql4+T(VZSi+#rZRGE#-&kqN-SUHjFUP6I(%K"0#"`r''@Kq0
+k&VlFC@-jP6YbKUd,#el'$`3Vh*RRlM+9KKRLX@+[56#P2hT6i+QN6)j8i!I'bAq
+85&qF#U601dC*T([*pb',ZlfL(*PJ4h%M(hRG*MFLR#dYV$UQPX3KfGYfZi1mrrD
+pk9)Sk0[H`S+qb#I3%aMFZT!!LZq&(r[Ka*@,j0RRL)ai8-2F4T8XZKQ'Jh`Lqr3
+&NLR*JE3S$1j4"#T@-4KYjeZ'd$'ch"[2M(-['$Hq+Yh%3H8,kV16FNK$ZB$%!r'
+C4ph99C-B'ckLT,FZDied6DbQ'+[P0Aamk9`fVS(c'TEI3dVKpXd[[rdSC3Lr9lE
+VZkcAES&Z'-ErHR@$C++9VlC8*5!0`hqhY"iQm(rZ3eIjYl)`"YMNP#82rlD2)GA
+'RArRJpV"(jqHGD*R'pFIMFFchJGQ3-L'D11QE9Hl96S'&YIRk&R0dB`dQm$8[K%
+9*RQEKPAB2QaL4MN[#$+CMVYraPeFpcND,mQ8*(fM43[cbQ!0h,pK-8Q4bpUkb`H
+(U-Q4*A4$i3`M[-TCm&e'T,cZkIqpJCk+l#GP486S8@jZ`Jf,cTLDKi"c'$K%`)D
+YTRKr(X8TdQkVKL55d%XhVk)bF#1$4i3FKLbm"Iep,*X1F3$BhUi!h3R!PK0edQj
+P3P""0`2kj$A#)Redi[cQ9KjQHPp@kS&QdPBeprmqXNq8khcZL81)L`0h(fRe0(P
+fi0F4`J#Ql9'm2`0C)R#pAi@l0E##lE"+KFTY2S,Kc(#!j['5ZcDPZA,l6S9hE@q
+X(90@I1T"Y"hliIDp-9bhdf$HKpjpj6hRlBkhD862q0TiGDQ&,50l"!VpIdPF'Lr
+KC%JfL@B`&!hDU2BGfl&KV6(D4Y&QXq1F[FRG!0@A(Le1[iF1iM*l5&8[!LKpGSl
+e2-I(H+hCRAdM-`Li`)d6fE[eHlF-Lh26Nr3V#+"!X)365C8Flq,UZ&Zj[KJ$jH`
+YMPA)E[c'bVdRXh!Vmk%LI$RZ)(hTPd*KRQ3h*H5&8,1-*`F!@8h$p9c9JB+6Y9%
+Yp(c#3H91V["NLik48`bXXdlmhX8%ia4"#K-kfj!!bMh3qU-MrC`8S@@,lhDd9Zc
+MT&*Im6'VIakTEN#Ne@45SIhcmGHcBpGUd!1*LkkFB$05T5,6Z'X-f`-,3@HP*L(
+qF#Kf3Ylf,K!@Md*+Q4Lh#q!"%DPNjG+r+a1G'DXBe'-*kNdf,-,6-%J6NY$K2-M
+PhJEMk14MNc(-pXS'rDVhV[FRaF,N*j!!X#JiR(,M5%H(b@-2*R$9TL)$pkpCYhK
+a1!5jITb"!@@e%8leR%"S$`D3!'98Rq!8ET05c-B%-A4LrbQTB0c!ZXB@qEd62e&
+@f`6Y%(9%F3Y'j0pc(H"h@1"fQDe%1033"dAH'GMiNl[0r`qe4LZai%L%i8I1*,&
+%UebiBI0Mmfrj@A(de`2)!6pG8JLhUf@1E9Ah))GJf1*VhZ'kMjc0Im-CpJbN$KD
+!lF5l1!G!Z"pM1VF@b-p,[hYGapeRe2&kfmQl[LKI`2a&ji9"Mac!+9kAeI`f8q*
+"dVX8TBNXViXeSP&#B90C,@'q"Am$dCa(K)k#Rc'+L#+BA2DHGIA3@-)Zk%Mfqck
+K*heGTpm$djDSjIQXi9"2piHM!$U2jDh[0*jAQD!`MH8`Q%lA0bSC98$SVV#L"Q(
+0)N9F+)#Am2c"1Llh1*'d(EK9H+KeE)!#0PJ+*eV-TX&@QBKN,'EI%[!-56iCj9H
+LXC*bCLR8al+e)5HeB9`$HSPSlI`NkFbXL+a[a"QDp3VVmIbrkV$I4b)+&"U5$('
+MC9lEU"PYcL)SJA+aPXL14*ImXQN"G2Df9US0V2ep-ALId*ep2M2Re-pd2!bDXq&
+!bLhcQ`"8YJklT$J)fc(f4V9)GDBG)&-C#c`j$r#XaA+ibmT20hkI2XeAp,,GGKk
+$"(`Jp49L,!6%SVra*h"[XX4#)5,-eT8$Z0UF&kPa2jpKBU"P@4-,X*YUCi1K-j4
+iV2C'+kRa(BHEATD'9`j4J1(!*TJ@@`-3BFNAG0P9T@h$l(K*ZEZ&VkJA3EbQBXU
+@6r@4K6%1&J#&mf%UT*V3#!cl&+i'qU*'a,Q%RaDL5epl3jDikca&1$G%1Mq!TDA
+!Kk1NAE(AVEb9ePp)G6fc%e,B-@L46M5(9SP5bHAJ"pK54H,+mhq4jaU9*3K9mG"
+Dh"qFl9-'cbM&(+rcFP,CGm2%F-aA)d5&[LqGI1rM6HK3'TP4@rEF@`Q`M5lcm",
+K65A88)iSrT*,$4-VHe*F"`@Q%9,GRA9P+)rb+#AjC"2f5SefL!ddQT'T@-r2bTa
+ckcFpLdjmp3hL)$Z3!*@(!r1UmZeaeUKDe5@DQiLT@M)MI4"QNRLTQJB)JhPZmAk
+Kr(!E0B0il6c)1F9rb1c3Si-ii,T5%Hhq)r`BI[A*D@@3!&ab'VIrpMLcXTXaVA4
+VILGS28Vi852K'$6NCGZ*HNH,-#GkqCKklb)lqR*CdHa9QHBV3K-,35HC2BD!5,m
+XQ6UC-TF"+Cl)3,K*qA@lh!H*&fZ$X,$k-+Jm(T48qibR10J&p9V@EZD4M0p%P$C
+Qm'lXSS!BA8NALSNc2L+`3Z"I8#1!4#U#bVc`kJ'h"JkQ'5"MUdCl-p`[cU1FT'f
+kCQK-I'9'!3Z'Q+$LUJc98Q*ej-5'46+N6ZUNkTS%qdGZ-K`-3M#AUiRA1Z*IQi'
+DF)YU6H`0T0N,SD8B,6bA*mGd06E$VDS**X0#UF@*+ee++!Krm6Y[f#Z$&9Zfa2E
+,h,j`5Im5%%Kq20bXD,3i#JPi@EUZ*mGfIF1r-"El)DSCKF(Lr$Yh'-1H'QcNrVe
+%$A@IGK5ePlm4M838cB(h"B@"lKjJ&bfG+d#`)XaRZ5V)FQD1@(f)EMpXrK)IXLP
+,(i+iLC4V3PAk,S1Nek1'SLZ"a50&MH,')K)"RC0))AmkKrV*A*`I)ZQqqL-c*bS
+8cXEIHm5GBiNlE0-$j!Q*X5JrEZRP#q4)`p@SAIL(@N!*pIeALcH!bN6fQF"SJZE
+&(jV0L$Lfl&K*hrKFkkd@#KEE&h*R%ZP(5(-`UIYC2$%(E61M[GR5JcjFFYF1IbK
+`5m`VRYVj+1RidY[N!K`9FYLPMXT&RbBfaR)B0IF-cl*CB!Zem&iK+$k$@DK90)L
+Nj%Y'4P4AKK,,*QAQNX9Aj#HT9-Ferr"1V[hCI"+eNSq@d,I8IHHe&C)K4@U3!-U
+N&fV6Vec0F)L12RqXUbT,N!$-)BR)6eL93+iDUV#PFB4k0D1*(&!C`!ZVXUk@412
+V)B[BaF$D(K"fcFle#Z(ieFMG@UC(`5eLY8X#PXiVHcEj31RA"EGm(T`rDqCmN3V
+emFJFBSV-QIUE85#BmHN+Sjh(q+iKZB+CMJYcQN"+"-QpSj8'fZHCf*VqeR0AN!!
+eCQQelEK-%!3jL8lB5'A`LQG#(Kj%iF36Y)alI`6C@86d4#CXbYbj,JBiphCPD`@
+PN32a4rfPRE9[JUklPfl8iB28cV'YdI-T,($4iaeCIAJc$m#'Ck&LeLZK6U5GH59
+)IHPcNi![li$),b"E4B9M0mi5&V!L$AS%YLKm@#l[*,Eek!%rGG)0kh9"0TSbA$H
+6$K#j$ZCSDLhfmM4E2m0DpE9NZ`EPUL6INbQU'NpBR8!4J0@'*BeG&R@&8#@P-aG
+l#EH0[,l'E(B(TG3PHm0lR[dI6LC1fef)[NSd2Gb+1h4&'dYMBZ!JVbpKD+UQ,X3
+VLbGP"FHDKpKp8#V`KeD[YM13!110bfa$b(1cFP@BU)1`F#U2#l61%VRNiqV@qSB
+EVK0IGr09KD`5`+d#Up[qpILfQ#cUK)d5HXc`1F'(2Pj1(0UC0'p@Y8jjL,JFL(e
+F,(a4A,pSDNERlU8!mBYAHF`0IeaK%G)"(b8`[-1VY!'!i`A5&JrMYB!TkJIGp6a
+l@PkU#'KM(RJK8JZb#6eJ-C%aPhSl#1qQ(b08V"IS"rSD&M[,GMEAlNH`m*J%0T4
+2Gj)IdK`0"R2R1cjhk40K`Ifa5!4CpAKrAc@d+!b&$kEB*jP4l6LLR*-$hR8fSkI
+&2R`3T)YNL!EAT`!-dlSFJ$,F*)G3DXR3a4Y3i4ThiD`AZTNHDm!+C*XVqhfU)Li
+f(,e"R1X5ZR5c3E'q,JprX)GJJ,[E5Y&R8`[2`e4j9@B9b`8h240BNI#51&d8irV
+aUH%&CQBBP!)'9e&pUU,%[A1aG,!H,GJZdK0#[qZh[HF9CVP1(MAR0qJ[9"T4j2X
+lTGf9Gm)L+IN-X8Q[V%$@##"k'+CP%ErX[dZ$p%bh#aB,!qE0U%TVGrIfPh*4)Ne
+9BZB,e4ii!CNERVfF&R@Y%Da6B6-!E'Zfb`NNG3MM$*N$TAHHXef-`#968krV$Dd
+`Q3M-ljBfK8U'Qi)TXk-#q%cV%BBq3[qIr&C1k#J6e,(`8+*NaV-J3HIj$2JQ5r%
+A5(&3h5MCTBp6*9X,m*X,Gi@)+`8b3ii`A1Z[%%CfA0mZ5I[`R4KlVVmqNml)XN#
+$ch+ek!qERfMa8-4Lp'ThG&5LcZE13!jIp9HFE$L'cGmi0`'m9)JqYK$eq-ZBD,D
+Y$Ge*($E,2bhTS)+Y@f,AAVD4pJ+Q&!%YXEUUc6%6P(8pHR#8V%XAE1qQPe$+,De
+8cL-h#@,eXArmMF`N2Fda!qjf4I3PiU)(F&0RNXAkHFE4@XK#E9*N5ZrkhUA-05[
+(B%0B!"*r"69"EK!H0'KiFKmlp!(A#"05(pZ,j5$Imerh"$+R6"TE-eDNKc)aS-'
+i8@IT&A$E+hK1Y##FcL1p`&1prXf8i#UCadUq,rfRHNJm'UCVNCXqiPGMRU#jiF%
+M'3Jij'MfV9QS5PAl'RC@[NdGZLSN[`qFai5%"$)F9"C`[3Pl&4H2mQTidL!"F,)
+3+PT0600$Sef"aP#JajXk`-[A)J5QUXLYpMh-5b0'A`l(#"HXX1k$qGd))N",N4q
+rFhb(fUQI9keJ!cJ(4lCTPe"%P#f3!#$pD`3%G,DcA*[K+UkLpb3qiQ6(6&%2i+e
+)Hc1@'0K(I3f`C6jlS02J1-cAbS3ENFFpE0aDTd+'qTT@FcR@H@CM`!H,$LpMAJ(
+YK@6VRaG6#DlC+fFILd"lDR9bQ@-Diq@cEqRmC$M54MN'0BV659C)ef)f$kRkGKe
+fd#T4Dr2`(rI6JThNfEdmV$d#,pZaSf2Z&($UD19S*R0elBHf'clS$9l0HfH&DGH
+i8bRF2MAi)c,TipfDV!()2$@55BCXNe$ERJC2L)1,mBDLF+4d`ZeU++B2K#ZZ,dp
+&BlkYN@Z0*qiSVNeEl`801*LGlM0[Lqa9Ba$q*HK4B+ZHQ@-1'lHFY5H`RMFVaVZ
+9JNSp5'Qde-1M@N@1)Td[phq19ciilB@pi`THjN+0%)1Si8!3H6+$45%6X"3&q6[
+H(TSe3FqTaAl1)V*fkR@CPL%Y3l*mRVCGB1i`JU368BGLL)@*X61+Na5k)DaZFdC
+UJ%bJ@emq,)!HG@cka8D-dISlM`A4q1Gk5@mRCKD3!##6GAA4%rR,4j`QjFrep[G
+UULd+M0G3pG)P5,DrqkF`dZII#+'qp1RmDlc-8q,2N`0)Sqa*'GB8AYP8EPbfC&U
+l@@d2&rY6XPZh9TC+bcTfCQ&0Bh%5b@-!A%LIY`ecd)ia%aMq9+0-+diR0jca#P[
+I9cTL9jFSRc2mblpYmiZP4ZpDMQqF6Y1C2UI8FMNXAA-$aBU&@X+V+QhiEH9E)`@
+M-Zrk+Z6eC`)-@HVTkUi-5qfVb&M0@abk'UFAQ*A*2'0452-4RCHiA6hi5d9,%k0
+TA3AbQD0i`"hS*eUfQrkSXm66%ep8C%U&jEq5$4,FNY&kjHp$0@QEVi1X@jYR!86
+dJ$IM0$c!1LrPhd6[`YB(B'0-(AZ0F"0IB"kY'L"qD[Y4E'leQZ,BqNT`&q+VBVT
+4H@a@DDheFX!j#U(%pe-I*R8![%H%1KVkDK2B8bLcH8XS+KlViPhcI`FJS1LH(5M
+RV9e4RNSB@!`U+*DX1G'Qi`4TJIdU*ZE&Vb(5QZhH`6[j8T1IH8DG!ZND42"`)N9
+ScDIG8+1aGLU+0C4,c`'5p#!,(J&KlYAa,YUlGQR6Bb+0H[l+fPS-03Xr!NRRF&N
+G26KCNG[Z$MRDerdV,hT6FY+J`%Q`X3Q00SV1qVMU+`IP"RaNrZ@N),RbiZjFRT8
+T2l&Q6bAN5#Zi@d)la2fQ6hIEV8pX0VDJP-6-K[C"!mH`G#P3iYDAXV#0$4p1CDq
+bQfmS9Q"m3!jGG(GN%Z*[,ipf2R5Z+Y)UGiT`RhUJTm+*@j1U+M@PU`iFTCI9ZDb
+RReIGSq8pG0&Id3`KT%i%0*jf4H1F0+[,*"8k526RKb1il3US1QNi!8lk9QE,'-m
+iZ`f*QFl'FI@D'CT[)FpRfQ&Lh02(*$rP3eK(TA)hc2U'F9$HK4iiN6e$N!!h9K6
+S"-9p0Xf(ijNLe1!X34@-G'$4"DUiBa&#Hr9mIC5#YC&4lMPK$pSe*B)PkI9@2F$
+VG!X'Tlbj$#D5m$B#022Z)%hP)'0B(i`1PQD)rTj"0caF',")#F6qk+famXP"#`I
+6+QV3*6%QmjZ%(Z80Sh#4'Tcf!G`M$r6ShJITQh'3!&4(mq4R%"k!b`AarQA0QNU
+dV-Kpib)YCkFF6ZI[lhTcaUIfDj9LqT!!`&YKP"f'52d6G-,R([Qd[XYXV'G5jdc
+%A#Ii$m4BD1(Hc!4&IMZJB%eNSX*emM%(0q-(DZ(mF+B"S&jFP@!QdT1"'M*iE"X
++4lcb-I(fMhZmm%G[NF3*H[&aD1AbH`12C4q(ij&#aGCXVmM2h(mfkQ5i`kK5qDl
+rTk$U-lQN+6bNhQGU1T`SE$-BHANT#6)`IJNKT4GjhRPC-D0bAr1lBrbr1A$j-bX
+&T5E$QJ*Xb%P@mVI#3M"5k0&)*3pX9MSSErNP%TJ*,a%I-a&h4QiTL&Yd3F)&CG$
+36KC8rf5RHbC0"ThN6c8dq(LQk5r8193Mj#,k6ErQ$S1cCSl1%+k"Ml0jQBGVh&F
+Ir@&)eET$F53ZVY`baI8GINe+JYqY"r!V5BBPUkB2E`-CN!"FGiX+#[Q!3TZ8YI"
+%0&"[5UaYklda!q$d5K93fXSc,0*G6drc#2kLAeF21UQ(IbHMM3hJr+fm@*a1UiF
+r6k8%GL$iE"Rl4leU#bNQfQQ5L0,H-A)('6T*c6&0H[Rj$bm)[,MVF--L[&T0AFR
+%Di[`4f`k-kTcd6M#e12P+bh[k,1@C&Yi,rbIbcVqq0H&!GA`KDei$K`jSc"`bdm
++r%Nk-RcA&ND1SJ,(Bc#!mpQ5-*UkEG-VFID#0qa!iQmV'bf+[VcKSFbG,"Imj4P
+%M-J9Q@NbZ0RVS,+K)TVB&Y82QFpU4p+E+"T$+,ElJl5fAC1*eYI*DEUB1)*8[rb
+IH3V4$8hZ1A,IlKaj%E,fEV6@rdT"83MU[a'Xl"9ArBrU@9X,ha`R8&8b*A(5Re1
+5FZ(``rXkETN5FC9)4YcMB#&EDFCPrBBTjd93!meK+rBD*0ShUqA4Vq5*J0&L4*F
+A@!Y-NUTjH'UFPc5qj'Pej8l1B4#m-6fRpqbkMDBM"(QdD+cN`[ZdXUe5[bIl!2Q
+`Kr&TVp)KIm2Fe2$pb5Pc'4`kaRr-Jq6A`UM6+d8bL8[cUq4*!3+(6(X,d'Z6H9+
+)(D6[i2i[%pcb+A8V$%`L'+NeMThlPCURkp!L-',DE*!!Hmrc@%1aBEPTK#ph`mY
+@qfArdjL6G"$m'*%SP9@KaMMF+-Tb1Mem-'-JqCI2k"lUL#!ij(jDK@(@+c-QjfF
+E%,iE4j80)2Tj8pYHF)9"2P4MYTQJRGJ9U1KZK#P-Fq"XBREIh-)KIG3mkH'k"Cl
+kl95miX8[86hTEA0Xp,MS#AkJ8`Gcc)SQ%H-RqiSc#ZFYm"JI*mdFDFbB*Yr#m61
+EZTH$!TTr3'FCQq0`0ISD@SS)HiBQ-I-&+db--hZEH@$`2AUUajrUa3IcaPqcRGa
+ldYkK'*j3r#hkP'Qj6J-SLCldU&V3iXJ0C3J)hZ6DZHThKc!bcRHqL5#!chIZ@1Y
+DpDQ[m#Z(jFBIah8r6bqlB%b4!H!2FZTNQbX3%!-*K(e0'YJ"H&"kmZke-b9hlZa
+C@)M"J$1-Cq`E@BPj8`GEC6lN2l6P3HrE`pbrrTbEV4AAeP*81L&c3fK&DV&DIN$
+9DEK(i6laMC6$16XQX)qA)eXmQS0fJbE#8rJpKX)J4J5MC!X%@4l$)`r2Ef,QbhP
+j8`J"peC+0hkEi0-NRUmNITU5)Bj#99h',[9c5Ph+8TChYVJ6'8&#*h&+5hh@IPc
+ST9hHRc3'ZLpC'`k[TDKHQjr3$qGl#P"iKXjVj'6ZqPLjM"iSLmZ0a&,@J#9#BT5
+920ldJH-bV9N''9J'MF&NZElcICC[ejfkDa2[4TcAhaj3Xk!k6A,5j,r+cqAKXN%
+d(DMlQhLGr'd"CSd@5[['E!Mjlp0,eEeIAI*(Pji-3e5*arp(U[V#40IA2jQ'qdl
+P'a0bG-b9j)iLpGXmbF38ZH-j``8D"IHb1pG0b#qCNA3KI[E@DZf%65N4K3fY1!#
+U$(eKZJQEq93R!(dB&#GHk(("MBheh!65LJD4+PCpQDJDLHQQp$9M(8,`h2fbPlc
+jCZ`AeeqILF5'&)Q6T`QY3d$5eqB-59`r-&,mK`3kreH3!0aq6%E!ENq4L39JY)!
+95&jamjpUG9MXf(9[%eq&'%K[@H#fNhY-p2B#Jq)XAUIk4S"$q`Fp-fRJF*U`UK[
+5[&&!j+M88#R!N`Hf4bTP0q,H!)8Q5*4",a%rIGGi"09)VCeT(I59T5a$#m$RU,T
+Faa55NlB!"RYX&Tm-ljcT#,+B8Gf"&[+))-)SEMDGLNqaNVGk('455(mYFlfBSE5
+DUlReGF91jA6C38CmY!#FV$5AicX&3,6`kTIU*,!D[m"hE0MTLm(jIqj'M8hUBqQ
+L@Q'TK%SJjqf4TSVQZkDDIejYG,+eK0QTjKMFk6kd*)KYrkTL6CS,HlrM4b2A66(
+MbccZ!NM8fqc%BDkCEipJFDThHVXfU2Zkh$#l'q8UrC!!kDL20SaR42UVU1Um8E-
+pSmA*"Lb&EUS'"Ji*2'A8eAQ5AE0Y)RK"VX@C0@20-2$(VYD)P2++&rFJH!EpdNq
+A5q9B+$(SHPQ(lZ24qE(#jkb0,VI8i'S-FKEDdL(U))!*IJYcj!cidK!#QYqI8pF
+"aYri8H'Rk#BIm%jbi04D,$SV5!lb6DB[f%YYk%%`Di`TK6)ii8V@-ZKYBT,0d'`
+3drT5jUdH1ke*cDVqmb`iX@aG&JA"Ze'H!8XehU2TT)febbP,r-plpfM,%1[&@UP
+V'NbSAQfIbe(*YjD3!&rqYCf0a2J9q(%$rRNKklIAkPc6MK&U6&QE0GX9jX`E[@3
+mmFlfl4`M0$0LbjV$cjGJAq1YmF(%PUGjp$c6DebNXk)piDK&3rir42Sl8+$m5Cd
+ZXI#60LDeQc9+K6#JkY1'XXQ1cj!!cbEc&!UbH',1Qd8iHad#I#6D%"ENe$%([%X
+1&)-jGYGjTXI`RR@Jp9[J-q2qkIRNaA8Sd'1[[iXp-0If%!3h&R3G,R$TUrVeUq%
+UUKB+@U53!$(II'GZh98DMD%`rNfY[(c4@B##T-kI1$pqXM[,I`E)#A4!$'(fC3p
+-Np(@+0KXY@l9cI$$9PUQ2r2"3`H1K"NDAG0"C'1EmB*SQ)V1fhrcHNC15T&H)fp
+T*S0MB5l)R`6cT@4b)cb`[B2(b'M)K#kH#rYUl1&$El)U'&ZPG3jC'18Tb9)4+,q
+X$GPhBkhJM'aSRj+*JMmarN$lS"5@bBA0$B5)4k@PYFC@HJY6MC9H!Vl)b&E(T9R
+Bp9C9a3M#BchjZD"28,MQ"PMT3q-6(RhK@pdlmAeD(ApU3-',1rD[kSKXAL5)1(6
+&AK`m!%*MU4m"p3-ikJNYFda#!-8XK1eI[feQJ2M%M6#STbm6P-I-f'X5PX0IC['
+cEY2H&T*+pk8D3FLeQaR5HNcaLeR3#b5XXqcPF1QPM4h@LMXdehMA-#NK'+h'G8K
+DHQ&b@qA*lq3A*jIdD`ijVZ,(lB4&ic%f)H"8kH0ENFqRC6PCmF&Zl4R0haV5$--
+H%r[ram'e(Le-YFR9CiT*f#hH%0d@mZ-Hbd)M8P-QPhl,,1UbCNeAhjNqhi,hccN
+&9m$(b!L!9eVUURl"D$Mb6e`&*+[F3IMD3$-F"'p%*X"1*f#$94amVe%rhZ'd$C!
+!mm)JAhGGJY`1Q%UCY&djR2CYqXmM9iBekcRA1kQ5UU(+[RMfEC-HbamB8%SqAp#
+(qPcZHS$fbA(eEXmRkMjSCTq&6'hkT4$MDkZXphU(9[Q&TEJ&0Ce'E+%)cmJF)B,
+LN!$RYQqM)kc&FMKJeVT$FNGY"hV*HCKqjqIb+PYh(,$8+ZQX$GIVqTPPffqMm9b
+PYGa48A!*8*f&$%4MdkCr(f21*Gi+RSSrLqmIY8Mfqd80b[NDD&cik)T4[XFh)B@
+2[f(3Z"Cd!hS8$8RaMckX#0@'Q@&)a1XVXX#aMUmFEr4&BC6%Xjj3Z[%a2**jlS0
+lpZr`J``"E-`#q!TTf#0$p!*h-%YjfLY0,GZCIiMejlI&H(HdmlJlCdH(8mc*eG(
+b")dE"Je,@*62*l&BY`Jaf("Sj62b`A!QPi*I4!JH)@iqA!-qP#IkNB`Qqf1RP8h
+0fe,RN8p#[Q'Tk3Zc&kPGVPF$%f,UjilTP*ZMqlBaAST%p23'3G+kSj!!*T(,0Y#
+Q"22m`T@eUFe'Fj%6Yq6D#PF,c@a20PGLN[8@Uk5M2Ek-8`VXC'cd%"aC!J5Cm$4
+RAZ1L8Pchr-ZqP[j,,63H9+l"YNU5lZcM41`D%`[T@KaX3L4cQ3CSL[JXF4`N"6h
+cY6j+VA!)r0$L3XbTPAdFG$dAD%RFbb@SH0Ade2'd**!!'A&"H!'[45QY&al4U6C
+-IE'%&,,jmPT*N!$D!Kaj0&)VJ@IccKLMmS-K!,Zr%@+AFIKj1CTZDE0K#iZ&-!f
+,5S+#k4[IMBE+5pNq$SQd!HA4`(N9jL92*HiH93E"dKjJEQr[FjC4r(BfrY1EQ-d
+0CcB!42YiCRlr&B-V!eSRL"6&C39db!%e30AMeGKmHKHFZa$6&k2KdU1i5-B%Pb$
+m&l*6r%f*a%l4@&$,mc3*br``)DTKV*Cc(NNmq4Y@r+T4P"S5Z1'hX2IQCH,-#$p
+d-5dT5[lD8bTQJ&0`65&B[Z955!M34b5Lh"5cPYG4&MK+18YXSc'jL%`3V9ca)r%
++a`*1!fBIa1[l2RTEfa11mQdI19Q6VL2lfP9(Dh3r-KJASp&UV#iQMe50(b@!N4J
+44EIp%KMR!RIPNdL3!(DGI8LQRDMrAYBH8!RfJc3'4&*bP,)Nj(j"$QjK,Z8PfKF
+`HBH5Se8rTdVh-LPb3b(G+c#)P2KKX[NV#$C'`lY1TfcGl0hBikPF0&$-JZ#dl)i
+%m@*[[JiI[`UFRC[m@1ErZE"LPh#&VXjMADD)-TB+ZKL51EXc-ikXFq63U-J+"$T
+AS[`#kqpQNhq&*4k5+GTPb9)X4E3#+b68XVTjj)TTJ*h-khLf-Zad@QYT9fef2@,
+Q`Z0m"K82)&AX`TE`"c6[4pr9mCFi##jF5E@)f3-9S*'c#q!G2&6T1ibB(+GI)iB
+V9S$brq6G3kZTT0[0A!j[e"QEE[QRD+RC98e+',[T*6p+LA(NSISHe+-Z$FcYV`R
+,,94804ekXAh#j&kqKeej-Xqm5*m9dF`pqQSDj2lfI)%'5cRkYYU(1YCTc9qT*S[
+&UXEjBVJ8X`3af0DFX8VL!m&qmh%%V9bLjhf`6DGK-CSKR8SI63M+,[N,1C[EBI[
+kVKJ6cc)hkVPq'Ri+h4D"%qX&`l39il'V(khMKG5)5$Kkd)KRlRfV2e0NQ`6QjRh
+#q9#D`C*bZj50EU#r(&X+e@r!@4[&dkRr`%[J3@H9hekU@LSh9+96+rND@&Yd(8a
+%LY`9M[h-4dD0dG"('RiiL%QC'6*N5A9pMZEPf#$`,@RK,JeJAAXha9RL+SK,'Yr
+L'SSRjRSjN928)Q#@m$Z(hdrPE+)b*6YKLe5R""JJ,IV"T`j-V63,5m*ebTBE,RU
+QDi!Ni4TDS)FN!6XT@*bI4221N@lCbpXM+Qf2cPAmZMVIcmHT&r9D(%&G8+VM3r)
+R$crrcN2-%GK*)6MU8E6qfGS'%CjC@MYTAcpIM)BM9V%3#f!'$'p)j`(ScN)j,2X
+ijV[Z#DkFdSLhDiPR9CLQDhK5+TEL'G8a[lEQAXbrAaaX44I6HjX[J%j8F"ZI,Bd
+e50qID)Z3!2,UN!"0GprIDR4#6$Ii4U[bXj4Q19-JBVAieU[cGUkB&Pl,0rbFH+'
+$6Rcm19f2$(R`4HjreH5lF[cTJj,+X%BrP-GA*53&1qSBBD3$5$kIUZH$i-iYC2F
+*#2(J'TJNGm5cp!`ET1"ISKXlj+$,Nr%Z1qCbqjSA95$GFqXYBqi+$AcHHKpVZED
+L9-VaHAT%F+(AXZ+9b%`Dm4!eG9fDM2j1`I(Tq(5"ID3&4IJ8+a6VpG$cY8Dkf0S
+"`Y-6BjEAjIaTAf#r9Jk'mhZ46'SB35j%R$plNVXqJTkqj6p+9ea[p!VaJ+24r'f
+ZH$klFi[pdSbA#91PC,YD,9-0K'B5&K6d'$M*THrYS"J0CX+Q@pK)j@3F6-,[d6D
+X6jJeSZ&6"U@jhHFjL0eq+CFPaT6$15pQZlNUpL)IJ[e20l-m[r,Srec+ZQZGKU8
+0K1#V"@XppqXEF8Vl6ra"KS#%Q3F01"NS6&ET5&kSUlm61bVdEDbb()-SNIcjdh1
+hVV'%9!'!HRG9CGLcf4$GK5(qe$)@J$[rF1El(A%9L%eMmliC!a26bfrEMXA-e*E
+kTp"jJFG`%G!8V'T"J8V$HqTVeN,MSNqdp$N`dqdLYrDLK&#YXhr`cp",-Pecqb3
+)V6cFLq3R#E6*Rk#6fK9ZmjheaBa*imi+&CTb6Z6Td)C5AfIDf!mY!V#Sq8K+RDh
+Na'9@K8Bb4V3@[FI1#M%p1XmKIP["I%`R5G(V2!HI*%Q1mTl)(mj[e1%kp!A$9iZ
+G2phNh%X3'QJIX-Z*mK,hA1jCi%4hK&ZVVJGYqrjREU1PAq`Z[l(!SBTlYE-Fm$D
+rB1KTRc&k#'bmH4kYJMdjd!j*(1bER06HT'qh#L1GEM2f0)P`pS9cpbDSNcb$&ji
+r"m)SJRlMX,LDICMhmH()qT!!JleHPf0l5jfL&bS**jZ&-&e929H*)NYN3#bpd6%
+4[e0-kBc(e+-f&DM2"%fEe`BKfN`'jLKdX#1PG#[bGlhH2QNQE!BF9hl)Va$`)I`
+`1XdMfiI``P4qbj0(eT4&"r9,%PFT'5cpM@!flYJ#,3'ALmTm`cH(@LT99MGc*h&
+%5FFBf5d%[fM6-GL'U9eGlLhYl3@f5Tp'0H-#SclZC5-b[UR8mSXEJdbVU4Vdq3h
+&+c*1)3f9b8pUhGB[ZRQf9S(f8%em-j2SLK9"T%0)CX0aSjT@"LC35hE&akl"`im
+PFAC6X)!rcrkRNP*ZYC!!A`3L+3SAj@0'RHCI)(1S$*PhdP%-0@)kZY1cJ)be*Qp
+dS@LeTSrKRT+"95ML-jjfH4`G1lPXSbmZP#+BU45S9d5,BQ5$EN1JiDJA!6CjRHl
+l1FqBrQ"rC82RMShpNlZFT9!!i-U5[RrFC#5$hMG"EfJ(SCbS++VP,Ipa5$PT![N
+YXEDaU2@c)ffYZP'AbQc-M61Mq*MNXGPm&&%5N94rD%e`([#[N`0&F*V'*!DXcRK
+bejfI(&#C3!mr"qi3qh9(RiSK"M)2EJX)&FrG($Q5AV0Ik(Cl'#F*BSQVh&,E"6F
+AC`krI#R1-bkqk[d,G&DE6l0M5HECR+UBb%Ue&1R[e,KH2Fq+0cVb+"Z0hNLJk[2
+khNPQF*4k!c-8+,5m3QUk4N[JfB#blJ0S9Em$fZ92ApN`&AdTF`!(K+F'RaZLI'`
+Ri1abBQQX@)8)@5Fj!P9JZbbR"6R`J-JZNSh!BiHG1mpMk,-4DR5BeV,&TCJ"ITl
+bU9fYQS8k3-"$"2GlRYNSPVdr!TmJ,CUF&`J&dTX)M9-Bf+4c9G(D*VjQaHIcdEY
+rC2b"Gd2jEaIRH#&$FY2J5%L8k82ZMIHQ[VEDjZe4Yh1!,dAc1aCLPFrBd)HU0e!
+40rp&V'0$QG0&raGf$i#@Z5Ib$6(aA'PXN!$4C#ke-jT@ELmlXY$IpI0bSIm$24,
++khIdqU`kFKdl-1XZF$N[,3d!H5J5Dk`Q%5GKKY@m!MmR(0[c!YFPK3C"KE*6-Y%
+%6K9!$)#8bc6r`*8LQ5FT1')%C2R@PH)M#,V-Bj!!D@%)(9A9DJbd9Q,GMS[aKaC
+5%$,2U!-H$EA+)D36KQ8RT4RlHNiJ"-4032rXSE$m#J-*hM-E@1")--dpGrB'S9k
+3!&m*d&J)0jAd(aa[MaBY-0-`PXYUjPirHa)h'6$#-MH8kAXURDPJ+A%Fj'!J@G&
+&Sm0Ye2&,#,dZ(IVFr#k,YiTFIS6!IVr[GC-9lhG[-[-J-3""@"qZkSKb)Y&FI`I
+(@cUQ4CR'Q`,,PKC%mi@&Me!h982),[3`%(qLSCGD)LE0(!Gf@9KAUr0I#K"0efK
+KK85A1rLS[NUk+0IC4pdTVCN`43'8'ZR[+GlZVm)4(q(ef2U-JRHQ[b%IANlN64J
+L)0`YPAMTSUEB5(&d$P)kKKV#rVcD+RS8A$[5IBA3,qKe'KYH%e*M"bZS5G68CL[
+AYB63`kNQTZ63-#-VVQ)[+LNIGM&*rDRKr$40N[VbGqZ0*A6*+0HMTTa*i8Bm2bC
+GSqL,K-Ze2D0!#ehLq9"p*SSXq0fVHdIA%Nmj52&Ce5i,aqElj#kePMf,P%ChFq#
+Er%Rf9F8P%hkU+@!eHXTr9fB)ejZ&IT&"R(Z#Z!!ThdTf"&D@lEaKpSbS`46,M#-
+KB9*kIG+pFRV"-2jGLXBA#af"Zf(Pafa(2Ff4@Y4GP+P,AVcc%qDqjhkkC@i[MR+
+&85i1T`)[bD!6R6RNMljLE",Gjd2Z&'A'C)A0f53b)f5XC*8@"BMGKFpTE9YSjRd
+)*!%d"Lk'*1SpJJR8pE+2,P@9!L3'KS!a+2Ahr%GPkrV()l!cRkTKd+Vq1kf*3G(
+0V4CeHKZA&S``0Rc(BqZHNUUNpMDcN!$e,T!!X)4-i6YRXrF4-aM#*#8"bCB@a0P
+P`!p6-@VdbqrV&1@-)E(C-lN4Fj&T'bcR[krEMHUNRS&'fLCZrRa28Ca!b+FXrDc
+b"lb&Gj@P9MRm6`m[HK5!H%8Gb6V&20UGH2XqiSXjl9pa-S!Y0F@'cacIe'+Y0TY
+84kkJ9#9S%dM+jl%FjDq&C9fYPfpV9'2EX3RLN!#PN!3"!!"!!"#i)pUlZ#2DZ`!
+!flS!!5[l!*!$cJ!3+2m!"U'Z!!!Fj`#3"!m!9'0X8fKPE'ac,Xq!,RKYE!!"0cC
+849K83eG*43%!rj!%!*!+J!#3#3%k!*!$0`#3"!m!3X(9#he9rJKeEik-8V@kZdU
+V2E5CM[,Q9SeqceI`p4Mi%Ir,pA,iSf5%B1aAJE&LF@'3!1AE"6"#`G654D@ifia
+X9r5,'ZbL6H2M69`9C80S#5('%+Q3!+GI@2k2@'Bm`XqY16I"JB[%c3$6aH0SQDI
+e-5JDF0rb,B*1&m9Me-8F35ZpjDl`(&e$24+i'EL5V#q$pF8*QSdXH'*bm&`!-#J
+DEjb61bcPR+2ZI[e*DX#f$0XTcKTVM&A+dp$Hhm(rk"BFYjl'IrRqUr0i'+l"(B6
+II*&kU6ZGZAc!`!2B(Y+9q2Y"JmF)FTPBCL)PG1dec,jNjFmeK8MR"qcHT3-9#kH
+V9,@"0f2h@i!KSAK+&VSA+CVbkfhmq)3T6%e9YT(2$G@IkhUM0-&R$*[D9@J,ZlR
+"-Bj$XeNBE[2UrkBdR4UZaSq9lh-TiVfUUclI5V3r1Cc1-J3V[$'8"K@CZA$*PF&
+r"%6eDHP22F#*GaC#04lpV[HK,9m,2Eef0Fb"HRkmq,%Ka5$m+dGbFqYCR(E1ISX
+HTdQ3!,(SPL!8rRcc)FaRF@aR!PPalk6IMl6RKJcpYBePZ`2h)8p,iMX',[DVI9S
+@+6MHHE(mRTTmVESc,MPZ6"i"Z3VrpTPpJN@XZ3XRN!!hA4ME-f&h-A-8i1aiaHB
+8BRdbC!5Dj6aE@XMdiSljN3aM+m3FKpPe0CK35Q&F3-5kIhD4%&p@T0h%3TqGpRY
+P003!Hil3lf6c-Gl$TPc$%9@J+C!!3&MMZ98V3`eS,TPrj#JbrQ39Nk#PjGFXN!!
+r+aE55!V)X"4V2*mM,EfQeJ,`Cd&BUR&M(1@lACQP`'j"[TbAUD(&*ql6,5FT'AD
+Y52kE&8&ICbJ6Af&rPGBJUjXq9CBKk""iPA$8!mV-&T16U$,Kr$*G`SdC55-4F2S
+`6ca8ErJe*hH`bHc2Q2S"fpmfdhmM0bfhF4iPN!"T5Kj$iXkVb3!6-9A+De'`dC!
+!cKcT5e(k"Upe%MmrflHQ$50f"lR%DFLk*j9q%QC09*!!HGa3&TT#U`$!91jfmqh
+XDMP[-N`&KD58Sf[iX2kjD1a3Zj',AmJ&D#!PB,eSJ2dJ`QdYlbhldX+$m@q5Ali
+EfHMiFrfG(NrL!TFY,PCHj6rbU,G)BBB8fRF)K[64YSV+eBKjrQA3F'Aq8d*@DVR
+B[hcH-EmmAmKjp%DDFM#*D"`6[*@EqFi'kPcb399EKiS$i8qLkVAXP6'0,85P5*d
+ff6(fp1*fqcYci%fjR!*Q%Z@%MfaIr-V,LA+q0+l3I+BDa2,FF`J'bIcN!,)iYi%
+6B([1Mrp%D`1UB+@hqdE%LA1)*@+$&lEG6VAM8-hR#I,h+ID4fhf$M!Nl$9#d-M4
+G,lB9aI1j1,'YT*p#YU1rc2#[%d@aa3P$0IS5S1Q1)JY&VK5e'J3PeK5)d6r[f2T
+`YG3q6fPk4#mYL(rUM)ji$L4M4SVE8mfaqfB&ci,C5"Cb5[[`DI-d$iPYfipS0[-
+RElMD)'8'RSXC+2Zp`-YP@jS2UKqYMTq&a!cLLR&NLk!)@9XLj,05@#3Rmk+dUfD
+R$5NY)iYAK0IeM"Ud@AM+H5FHPRVP9)f,R'#%)!'L0@[dY!I[GY[I#!CQY!MSS*H
+X2UEHLIH!0+(a)!'$4(NapQERC6j26AZ-h0#R54%6V+aV%S*PX2EC0aTVh),jc+q
+dp$S66!iid(P8P1!GZp9-X&kZ6h3@VFpH)Pre9"qCqYc@(E6R8*ErbFcYI2TrR,I
+0pp%'GfJ[#ricAV@bbH-p1)Kk+RVX4I[!$BqfSD%QiZ0N8AC9hG[@mlqYeHX($r3
+c+A1@-DLfP'kHU(#prTJj8E'kP&$d%iBbHLAb$XI&+-$dIYFVdd)Hp"N''!r"QT5
+iA56*DU`#+j4,iSa8QN#frGjU"rakZRmTDG@rRF$N%Cm)Xe)0['U'bmYkL5N%ET'
+r3,ceMAM-3VcK)R)+qYJ)"jT#`CEl,%3-21hcp3aTbBGH3q#PCp0q%51U'-bR!lD
+fP8Pp,SLr)-F11D!13L$rI)VqfAr"$jZ(FSi6RAf1m1pM0,a"p9*1hmAkj(6l,9A
+m2da9E$qQr+JqL`ei$F$-`-RffMjV@Ib@D8bdQ*ZZe0'&*6"HrDNqf,@pq(VldR)
+MepmBAipq6QY2("5P(6[h-AR0,ibdBB8e,D([i00PZ86m-2e%C0[MHJDIhJpB1MT
+jh-%`d&X99MY9m&pl1`DKBqi**FpHmH-J!,#VR9C1RH#BVIXIPBKrpMalA)GfXmI
+'d2G#,KEdTEAJ%+6C8QbQcU&*%HQe-iil'NA0HF3PUhC'3SS8N!"U-[EjcSE+Il5
+AKmH(Z92Vh0q['@(''CfFRCT5ff2NhkKd0-kGG`T`$Z8')i9TBi@(`p@%(X$K`@$
+U3l[L+m(C"CqC'9&L$de3mG08S+B!Xb8hpqPkBk9Ebl9Z2i2cH$mVMG`U66h*N6b
+YIh#3!*8c8jbhm%$`5AqYr1@%q9&EK2`Y6d@2!T'&1%(dEE$fUNdX))3Vq89I!+F
+KJQ3LiB&i)N6Z&+(rql%iXSiqGFAjPpM'UAbF`6h@h6X"ql(apHfU`r,Dce+mf'm
+lT0&M-mG+3%!IhR#@Pb+GmQT8mGqF4De644T-TMDL4icPilF8r`VUpA-cZq3UBf`
+k,kEB31+MTr2`8,fi'dcffFMDff(SQId,eJ&C*'LkPM'@A#h(r3l)N6c[YKEJCMV
+X8"pi6c&SH",)`3k*jZK20KhH-dfL61a9(Tm`B%qH2bp,P+C1&+b12GpAk#F%MN0
+aE[d5-PGM8a6*Qm#if%0`arc1hArp+)FGAEH*Q%[-VFYq)SSESJmV'4)bHT&I*IE
+,MkVfLPlbh@(ZT8Eeq#Ybe%6YTMYjDhTIqh[HA+X@YY9h(MC2[dqJ8jPUDFE6DK"
+TH!a3L"'"!%4bG!JIikQV3SD'-E)dEXRrpF32H92lm10dYAGaflQ#4a'mq5X#SUN
+G9[FY'KebhrpQQ4NqA&kYjF'ZKKX[JF$9N!$aUU6a'"13!)Ym)efA"U!ahaL6T3(
+$`j[b#9)qk!4kqc,p,&)bJ`@,YNY8b'SH,Xh[fL1%6q5jj"XZe*ZFelm-NpGYUB2
+IhG2@QPC`ENVl63F8`h+UCP0Lf*!!LlDcYfCJpD@Qief9l&-,+)0'!cddj4$i&28
++Xi))0afkpLP4j0b8B$&9GDNG%bEF34R'cMI1'l,T(`Y@JrpS`*a@SUj(I2`PJll
+"V'C3X2Erk3X2k"NlSk8FHF2pfpDqUe8JN!#((S3DdD8+iJ1ShCcJ#V'L"#5d!T[
+4mrT-0l25c@[fA9*dYYR#hAF-2a!$K%AKc1lEk"(R-K$4mqXfhJr'PDjFr$i8,%8
+15dNr[,[BGKL'P,*Ne-BILYmEU"SI4+"IH5YI8MTp[6U$`mX&QEj[4"+GMC8p6(A
+SRlBNpb`dL6ZV5Ehd8FiNTKQCc80,KUVX@qN`@qeSY&,q2,q0p1TP$j,Fp4Y0,6i
+d'[mjGljlPMEiY0lZRp"l&+NX+AQGmZ%URUC2jFX,4R+26`+YY$5+@eS[+h4J[*U
+,FhSaGKHAZ'-80a2T'XejS`Zf3QPMSE3jp+2Afp3+QeUVdQXPEIF8'!NachfCFQf
+PEL[,r26JiEf$c)k3!2pr6EKIPa8I6V'6Idp8@XHA6K@YR12l6"`BT!649jTL4VA
+j$9D(YpKFEjb-1e5CrY#5q45N&T0lq#KjGRh#Z$6m#`FAAbE'1c%Gc'9k"%'k[JR
+2QhM2X&i-B@iEfJM[%qMQ6pCKCpIMY6ClD%D"@-YD(VI`hX$Y9$aQ2$Y!'#Q)cip
+bkUJRHTD$(VPk[h*chS%($3QiFD9+#,Mi3$+3!$VUbZ4%!aIc6bbS'`jYRHr@kjZ
+9`*ilfbI`GXF)m9K#l,3-dd%edPNBadcM(Re5apE@)hmdC,IaIQaN-9`0*1Yrf-(
+c!4HlCIQ+R@a4PQB()ifI%bT"Pp*q'IYM4iIma)kC'm&MCNQ,i,GNfba#ZXIFj%a
+r@E0)BIq*f-llHSD"TVCl2[dFh"f8qYdN)eM'N!!jhDN6JA02'Y!q5BJi5"!Nj,h
+0@d%%)J`p1DDlJ,++jhee&DE9`YYp$88B@H'YUJJ,%5DT*`('kNZEU6T3a"B#X,a
+A"Eh8@cI-`dl&)QQQN8Z&F5LlJR!-[L[QUa"cKd$UDrN6Tc*QPIjVEQdkEN4V!Ea
+RIEV03IHS0$9TK[ke`#,+0`[I5EG45#%0Ge85SJrT""KZd*9mV&(ZB@DdXcHZ3`6
++K"48#qL,eKZJP6BJq")d*5bcl6AQDSjD3aPZe[+jMI+TS-N(#0dFhUj3Z,K+"i(
+2DbK(Q@Nb##ZDEHTdG*-XCX81Lk[X!1eYXcVhRcZ6Hk$8*`&'C%F@6`jfA9,YB2+
+YbKc+(fCh'I0'k#eL#l8lAp9`#+1b3PXi$!Vdh5kC6iJYQQlkX3jG4UqNNb!!S4e
+M2iXXke#3!--QUJ9`jR31EFcYqVBL!%B`5F@kFRqpY)HHU9G`%E#$fb(,4J$jDV6
+qScbYrIP!lP&6Zf$p(%k,`Nd*3U1"N4'IXLeIcJaFl)ZY&4Z(DVf,mr4-+`Pi-le
+&C*!!2!T4QN,jN!!iY,)"F@-$#fUBGd`'9LpYa+ZpXJ-Ql'SJm#bkcR$Q%i850#Q
+#XZ#e+Hmpl6%B0S!cJ,&2DTj"T4[(qabZ5RV&!(Cp29Q!#kT`(eZJim$MHR5pUcR
+VF)H)J'[U"&'4a%#QG)"mr$NfriHT*ADB0YA'qAQ1DT1)3IEfT(3Khc8NJ-TX`X,
+4DEF*qSrRQ)CD#X4P"&IFmZAMDBi4*e1HR)S,+U%TM0#JaLV0lA%6p2-e+H`5i`R
+km1Q46'2)"jBHH3%@p"[N'"AYk`qq2K8i%f-K"q8*d(d)M@SS$Y2cLEhdc6#[!&m
+X6Y`S8D[1CeZeT3"eq!S+iDf"8#Lk&BfdqMC3[1(KPjhAKX2H1iRe445ZAfd8KJ9
+3+KI``ldH#T2U4%Rk3FU6e6Xf6Tq3!-h2Q)UPj5095'p[$9EGlb4T)3UdD8r+EC(
+ViH0$Cjlj4)F&X[)aYTHZP3QTj',fPc661'1BANE8"@'d85cCC#,[)"pVY3`RF0,
+eH5haH!`Ir$MANkmHJ$*h%FNJVGl!60@b08`+QdN4HAP((R14'r!eBq5-+bae-fq
+R8jJ&#!EAqfhCE%$E3SL$6cB5ECKV(lm)31$,GH[I"Qr&@2FKI6V1kcXpV1Xc9-f
+JP'[Yd(B@dUN+,8UX'VR&9&',Mbe!jEphkI&b)b2[Dab"&f9P*bPXZA2*QJ8G'e`
+)8j!!L!AC-jCJ'm8dV%i0lq[@R"HBeENT)N8r[6(`&@'["#IA4SJ1%3VeKHcZJaF
+!%LfdI0@5)E(cLEiJU2Uql+(IM9*,GNqEb4hEXEe["Yc4iH*h5H6Z@!*P0q[6GP+
+DMNf0A2NHi!M#h18A`bc%f5(IJT5E3TIf@@,rRh"iadAHLBKJfZ3BHKGa($#kETU
+A8bUCPcqhVeL9$@PhjQXeN[*YVl&#Ce+1DLD*aih@c4hk5Mcl1ClATlEYh(18ki#
+8,+)piH8i#MGf!)%edCjGX5p)PmY`#)0Cr,5GJlEUCV4rjJ3U'YBC42rd+T,'GMT
+1Hb*a"f&DGf'mG8-@K&@+PJi0I11[Bqj!#lpIDNSK*(NBbSCU`J"bE`F+8Sj%ALm
+'dfpb,BGj[+#TT6CBTfhq#"hD-Z@3!#Jpk#HQ8Z"@bFVr&5d+E$@)`)'JV#UF3-P
+!`a!Z64Pr1rF9Sc[)F%)QLS+Y'U[+q`QhqKPH'%J25TEML*'Q1Vbh)L8L#Xh*qmY
+)PL9hh5@J1"`40lQVb$h2,0GCXh+h6k99-'Kq0bEi2N21U+I+#*lDK4+k"X%pZl9
+K2HpXlV(BiDLK1[*cS&MC6I3"IF4!dBBl9QhVHQ0lbRQVd[@&6#T*YqLqDB[rRh'
+!P"%88aRGIZA54X`df)+2L)fklq#C0cYjPF'b"*YD64Gq[62L53Q8"Nih8U+J!2Q
+RTA0`!b5"rJT$q$J-(YSETLTUcPr&k1C`3qB$5HdMV&9)$Uc#m(d@Si1D`k3C#Jk
+KNEKSABDeL[a#aRiB+FYJ6!JJIP8JqaK*HVqeVc[5G"6bl,2+j8Tr9*U"X,+%ep4
+%A1,@l31CDC!!EPbbA0)rE44r#BG)0Vq)@lF"Ri10*@6!@Z&A80Umlp@fVi-'@(`
+TjM0IN[qF#)jcNb)"r$@TUXaHKld8[3$+@2eFf!,'D`RdFVT2RkEFEK!6%TCU,R$
+SR6YLQaL5T3a*IUFk5Z"k3CAH60AeLGbYT(HHLV#bX1H#!Ukk+r4!CNF(-3h*$#L
+ZQ*12M#fYYrEklYXV"p+,qbE"lk`0ZFdAX6+U-L9l2,hE!(3lP)M#M10il*Lb,`1
+XLR)M&L0ZUT`8,jHcCPN68VJr1RmPQX5Xr2%Y)CrqMDJHc#'fh8k`Na#mEIP1DQp
+$Xcldp!jU#$d308ha[lXGM!TYUk[0@&TFKR)AFfRm68&Zie0E,h8RdClK$+DUSI`
+re*-3QZkY&N2Y[')H`rdG5ZG20XF$39!qVpAGqdRkQ!Mm4+M2RFT0#(d&,b-jBZK
+A4V1%,B58c$p%Z"E2hC`PD%-KcXAJ-jr`X0+G+Hr9M$-b#IC`1(aN6cL50L65F$9
+rB&X2UU5ilijcqZ*p-bJHajSMH&lmmEFZ!mSIMeChiXIPPaKIi$hhMm,[4FeEDVK
+qZ5X5XR+4GQc)Ife4S@+jD"Q@cjHl*S`#@rl+NcE`@LBFPG99,8A5rj@E!@G5""I
+"2M[HIeM$CB91D,6*CM%j(!BcQa$'K%DkQ,NFN3-)P!NPe4@1A6P"6X[ijmkl90E
+lIM+LpX29Rbec2iXFb,IqLB+9jUf!K1(qpE!0UZl@*['2%,-JX"LSM5Mkp-M`3GN
+p!CU'*L+1"0&-,6ce#BX@c2f[rq6c!"Z)A5c%rm&',[U46d#EL+&GcJreil$Jpcp
+CShSf'KRb!T%hZN5D,qVPX#5@1m9EAR98HNJG&C61kJi9i6cDDdk3!!)'6YdQY&S
+bHG3$I9ic9m!G[l,eB8krA`9d2JA5,-[2'SV$f$ET3NrV#UZLDNqG1iRDX'jf%Iq
+Y(fYG,Ge$%DpZD5I1F1fX[`R(1I$G`)JPCFq$qlK2G"!%&GU+5pI!GSjkF[T)9+9
+5J8l5j#BDNRYE$6N0lF!mH2+lf)qQ[f,+1T(0@-a`T(kJm42j(I`)bZR"E,fQDGl
+,+(RKma0fJL@mV0BQZrF38&R6CQPmI"M9,NS0PYah3ZCc!6QPM3P5Vf6H+jY34KT
+[3R9ZU840XbGaq-Z9lF!JrYIf"&D3!0mR#mmHd5kaUK0'BNUm1XQKQBVET$H[)!k
+ba[d8AhlSmR6SGjihUaG+DZS)4PV$0+!5(b`Q,BL3!([)McDU#5N)@JF$+`f'Zr3
+Qcj[rH4+DfJ46I"A*LHKT8-P+Q+K5CJh*h5!952j4H&r@YMD,Y[V2)1bRq115T@Q
+LIjDHkiJkF&R4ej5Tel%k5$dmVS`d6HbCP$1bcGHqYpHr4DD8(FA5K9CE&4,&&EK
+'Y[GD,A[E1cI-K!FH()J9c'mX2[80Ie33!#0h11RISBAb4b4hN!#Clia2IT8[AjF
+j9-l&3#8bIrCa0ff@-0"i-+5FmT*f,lcPeUDCF1h*X`Qq3GDkd!LF!bq@LD8I$9"
+r+dVP249[hJGkVS#8Zq!+%`r(P$8*Jfji1%q'Tm"!l9A2Ubd%pN'b95i4r@5M1#K
+KcJL6#3"dXfAqKYD`kcZaMXNQ"I*J,eH(AqJ48Da$,KVQ"q0D(B*#3D%#`rY"Pe!
++"fqJNSC[rA9@*!b(),Fh+qQF3)cdNM5"I4I524Zm`(&C26m*&9+)`j3RmS-a-r*
+cX2+E4,1fa2&T%#f''!X4T@qK4aa%ATkkjHK(r#h%SGZ&I"'KQiL2,amGqE*jeXD
+F,8cpB!@2*AV$rSm)Z!'Ffk(&JpA!cQ[RUZ@!kYpBcM((qebQH0*CLhZ"IIJCC5@
+cRB$B(JN4#q8"B0%leNqJ5TDqRm9eD0mK4G@heZ,rilAYGT!!r[[Gcb`jE''bTZk
+Jh'Va@MPdU$m4mKJ("#ESe%j*V(4&[80A901F,16,J%me&2Q[*cpfh6aaU[(6%l-
+dhQmqh+H)L-ZPK+-*GJ+FqA"M'fFE6Rk-3VjUYl19AE#0*br*rl6'a1[ILC1EM+0
+GB4R&*),P`RZeb[*)l%MamM+$-9V8Ji%2N!$kkUA$FH!(2C!!R4S*A)E)NEDMH-r
+%`eSX(DLHKSiYiN2drN9m#`MY*@`qUlKmQ[@(T9@TFpa,%9PI3+I6ZY%!&95K9l%
+p8dI6b0)bJT0B-@0%$$pGcS%rb0LmSLF*&Jd4ih12iG!-2TD(e))fm(j@iq2kh$U
+Ud*X!'05,c$fMYF6%p0E+6el[+Y5[f@k(@'HMC8hZe6kb'h%R'4I+Ma3"Y`Qb#1d
+c0FjiP'!jiK'6U26,eE$(jTcV%A1$VP08rG!PH,'SY9iPEP0iU@&*`AVbV"m23C@
+H4#'Ir5pKe`EC3[@*PBF"d8+[6@`#e,I#@)9p@c3e!Il5c9q3!!SI3NK)+LlS3dR
+H9ld*%F-+jZH[)$#Q6`"Sl+')AXQkLSrCpeA`HKdJiib-F39-X5-$RdZ!6N$30r$
+-rj[jQHji$'fS'L%%$R!9h[aqNC4cYi0c6f2j0c'"%ci0&-V,-jZIDAcbFd93j,T
+4C4e(*fpqh&(UEMi&j&Q`Q%YA4++LrL28r[X3@+L!mITGUNQ,(q+p9B4*0EFG0UT
+#cmpAIAi+1+6!TbhQK2B+DA9@e*F8U-NH0KK0+qrM)+63`9iE"`jF1V@B!$NN4`d
+cPi*fS)hkJ2C3LK[ekqT@S5ccdGNU!HVH!JV)PTkLG3d16h&$5D(arqFL-)XkFUh
+6RT[baRX!iU-YGdhIB&9-hJ*b53("kDXk22HUaPDqJmACT,0aDJGHLa4G53#"#k*
+p!X+KFPX3i$e'AKhCDK!+5fNhUQ@,Ia@CbC52iFJ-**b!f#K0TjL(08dP*h)Rje,
+9A+h+,R'5clXRSl(mMrk$`SQkBFadqI-cYELV'#aAAi("CZr1Km8l"Yf1KC@Pbcd
+3DYij9eXH)1("()@*Alaqh)6c%dc&q3&$j%C,HNJ1[PU@SdPEEpZI#CK(#CGNB9H
+XpQ#cJIfS@E81LRPI+2Yk25Gh8"UIB6`DSQDY'B%[[LDF4J-c@pRN(Z5iYHlSm4&
+M#853!)ZkqfpijTZjm'N4!3GEih4ihYQT0f(8U$KqE8Q4G2Y4,BkFa#43TB-#A),
+LX)i6aaqdVKVe8G#)SV$R49THCa&hYqBpeRJ99aUIbMh-ZUkbY0Bc928jfe+1`dc
+rJ5Q&M6eiAJ8jipp0Kmh60e`S@PXc(q@,EkqZ9GNbV9--Ue"jT)k%P0"0QMJqH@3
+I`+CefFG[2elb(9*PHD-LfX'23pJVFUS9fiU4S5p+Xpb'h$Lj%",)E*ETbrr$'PT
+GCKrZm9G!C!fJ"@-JJ,6591Xc&#RYL$X"%K-BFj94KfHl2SDq+[L2eCqRPGPR,6J
+*l0TjfUL&aCp2,SUr8MdJR,HEI4+HMY8dQk(#B0khqfEli"6BS)HmYQ!2'i8"1h-
+YEX%"C9JppQjh8mUjj#&Qcb&PR[,'#2r,&I12"9!mCqLcH''idlcU9e0fID`CAFR
+pEF""k!DpXkUm"D"[TKahSk336-[TGElFkT1H9,UQ9dQBAU*khdLJ41#`+*Q*JpY
+LZj8aFj!!Y)FXif0FZ$+E(m8YiDQ'f-28!Ji-)!3rflhmZ8S4I9!(2l$(h*[4k)d
+4%XCIfcZ5i3`*aFr5KEhX)RECrEkI4GqR)3Zq8$5M#(%#K6G$cMVq5Y1bUF$b6aA
+T%l!kpi6(IIG+$-ARqi5LCqeX')HJ#qMj6j&bDSK8'K+lZp!k+'B4Dh%`b-6hkX5
+hX$*!QVYcTS)AcJ-Xc11jE!6@dEMTlhBF%EKL`%r,f!9IY`dTH`a&YM@&Udd*C1C
+$fE2Y9-UjTl0%%TD%-8M-5hcj-F+4JN!1##'264%8!+@3"!%!!$!!3!#3#3%1D`#
+3"mi!N!0"rj!%!*!+TC!%!3!!03!!Y[&1mlEa6[-!N!21!!%Y%J#3!h)!"3lX!*!
+15@0[EJd!!4)YD@0[ENe"3e0!!*!2J!#3#3(Q!*!$J!#3"!m!3X(8iHr%)(JHNZX
+l)T0$PMe1&X9%h,U"-`j,RCS+U(NFRSIR`'$MA4ifZ1eNp(bc"k[8Tf29`V5Ebi-
+dlUp1aif&(6j6c4PRTLP1eK5a-h2EPVY&cfClKmZkIGS2aXQ*%PIPjC5M%Hph@9&
+a(ZfDKkIUBkh$)JJi(L3&)ZG6@!#PN!3"!!!`!%!!N!N",#X!N!Gb!!#dN!$rN!3
+!N!ULN!!!!!%!!!'MLJ!"SSS!!!9,!*$c$!!J!!J!SJ%F!)"993#3!``!+!!S!+i
+"6J#e998!N!--!#!!#!#L!4`!JP99!*!$$!"L!*)!m!'B!)9993#3!``!4J#Q!,S
+"eJ#'998!N!--!#J!+!"e!6`!Ke99!*!$$J!S!#J!`J'N!)K995J+!*!$$!!S!#J
+!P!%5!J"993#3!``!+!!S!)d"&`)"998!N!--!#J!+!#f!4`%!999!*!$@J!"!*!
+&A3"`!(%!V!3#6dX!N!G+!&8"%iJk8fpbFRNZ)#"*ER0dB@aXBA4TEfiJBf&Z)'p
+ZE(NJBQ8JF'9bCQpbE@9N)'pZ)%K'8b"fEfaeE@9c,J#3!eS!!3#3"9d!F!"a!+`
+%!Np,!*!(5J"9!41)1P4SC5"QD@aP)0*H-0-JE@&j)'*P)'4KE@&RC@3Z)#"3E'9
+KFf8JGA0P)'Pd)(GTG'JJBf&eG'P[ELi!N!05!!%!N!9Y!'B!J3#L"!*25`#3"33
+!5!"R!31)-P0[FR*j,#"LGA3JB5"NDA0V)(*PE'&dC@3JCA*bEh)J+&i`+5"SBA-
+JEf0MGA*bC@3Z!*!$I8&%3e)$!!"q$9-+Ni3"Sfd!l!Yb!l5b-LXVieY0hP[[D[H
+QELEAJ$%!3!-!N!1kY3b!!!PT+[lJ!985,2Y+b&X1iq9cZS94MV)rcirrVL!j0k`
+Dq"(+KM9jKQ+MCf[`V&ir"HlX#m#`U3BL1%aA2VhVbkfM'32&(&P,'cJ,!*!$6!!
+#!*!&-3"R!%8!V33%8A9TG!#3"3S!8!!F!4#)'P9Z8h4eCQCTEQFJGf&c)(0eBf0
+PFh0QG@`K!*!&#!!1!#J!,U!#!!%!N!28384$8J-!!4)08`UE*!!lLSL+&Fm@d(1
+X4'`3p5`rIcrXejfrjql1$+GBf'%P+PL&999LjEra",'U"3ZbC6Y1)2Q3!"m"9#5
+BqM@mKDIGaGRG6G,)HT+pI4mZ3pc&PmHP#aEjM6KA6jAe#b3m5Sk53ElSG,A`G'S
+9QL)q"HC1abaeLk9cJ@A[I"3FZ$A+c+Ce3%m()3a-9j4CR+h"Zf9c)KIFIJai(r!
+m3+*2iaUXL26-$cGj+&$EM-KaUkHFa@0E8ER-cGETJDZ80pr*q`cTre6rb@d!N!4
+Z!!%!N!9S!(S!I!#f"!*25`#3"dJ!AJ%PL%j6EfeP)'PdC@ec)(GPFQ8JFfYTF("
+PC#"LC@0KGA0P)(4SCANJBA*P)'j[G#"cGA"`Eh*dC@3JBRNJG'KTFb"cC@aQ,@9
+iG(*KBh4[FLi!N!1T384$8J-!!,B08`UM!J,[j!5Gr91a$mmfHp2E9(6Bajb+k03
+*LRTfFql'k6J3$a8lE'G9#9C9N!-KhQd6UrS"#j)2B)QrqC!!!Al+C$IA*4T0h,,
+0C$41)9c$S80X0Nh%l40&LQIS0$'"1Rme"P-qaQ1QT*,p22dS82pVc)-l2TG!Iei
+&[QEeiPFKRRa,frhZGP$pLG-c6DU+j6&M59JZp!+6*N%5EamGV!)!N!-k!!%!N!9
+3!&N!C!#6"!*25`#3"3-!4!")!1L)'94SDA-JBA*MD'PfC5"TFb"NB@eKCf9N,L!
+!N!4)!!%!N!9(!&S!@`#8"!*25`#3"3)!43!a!1L)*eP[G5"SBACP)'9ZG'9bC@3
+JB@iJD@jMEh*bC@0d)("KFh0hEh*N,J#3"#J!!3#3"DS!K!#q!0`%#%0[ER4TER9
+P!*!&"!!%!+)"BX!#!qJ!N!0m!!%!N!9T!'-!I3#I"!*25`#3"cd!B!$cL&a8D'9
+bC5"TFb"ZEh3JC@j[G@GS)(*[EfdJEfiJdPi`db"dEb"MEfjdD@jeC5"9EP0dG@C
+QD@jR,L!J3@iJB@4NDA4TEfjKE#"H-5"LHA4PFb"KFQ8JEQ9PC'9N,J#3!ai!EJ#
+'!0i"j!!&!*!)!38'8h4KG(9c!*!''!!d!"3!r!&k!!%"!!%!N!8$k!#3!j3!!!%
+I384$8J-!"1B08`VN)J$IGJ11FDG1aI+XhN5ajMb`KrLXhP3XTk#)Ge0Rp62"!"d
+')Xj5G&B21kcbrprhRKcHfHed@!),S+0`'6QD'hf-e6-0EE0JA0JYVCTKMLqC4BD
+'lHI%rAFk&h,ZT!UE+blcrR5$XU%CY3&X,KdXDS#*9HPJ06Ki%J%%4j'$aiQ$Lac
+80FqpJqd)X1(#V")%h"U$B,1dq1`PRHQNP#Lmm&%MhQUjjlm1[0)NHb-$5U,$+hX
+*C!STdVjIpHXJf$AMJATqk-M-MAJli["V5jR)&)*,#QKAa55e-8raq6Fp!b1H-Bc
+[G-40$Ldme)!l'AmdjamkrMTV)lN-NRH5S0Q(&[jUb4G0pRc!Ah1RGIC')T3DMaB
+!!!F+384$8J-!$#J1A3ZXJL3qkJcIlqii#D&+Ke!DU9(K"%G!H9m(C[1JfB+%&8p
+N1&D8a9jY2,15NYUHE9KV1r(lkN0S,@5Y3J9V6Lk3!)3*Hi[IEhAm2XAeqmM#S&Q
+eT-lX,V86@a55-#r*XU4,K4$5pcZplm6LfR2Vp`F0jqFd-3%N0#-e(dEN$U81T2p
+Ub-pQ#-'`@@PihV`qI-'pjd8RLm)IBIebRc`+GJ`A2SQ9L4kZJf(%Ki5*VD(+++J
+iJ(KI*!L$-i6RJBMj%"Nl8-TZX#ZTIBcBlM$p%iP6Rlpp[)(p[2VZF,crpQH$ikl
+L2p[!0f(&9(QT2YqjNVeT*-pR6bI2K*@I,SDba8$G!'bC21$jKIJR0ihTKH,TKfI
+'!mcHfQh&j`f`,dKaB5E1mjd,%'aq)4Z*jC),+Ar)9b3$Jkf@qrR[cF3cPIATH#J
+bR,XaXMLik5Tr8bYLC46q"Ael&k+"C[I#"GZ0$dVBebMX4XC2jR%5'B3rL8[E(JV
+icPi$,iS4kXh`-m@V!Qj4VaQ&0c&()JhM%r'jCe8ZjY92Rj`CFTrN2KlHEH!EPj,
+MZ@)f9CDH+hEiTDeIR%r+[YVcfk8NpmZjEFX%I&6"VhJSqdSP["kj&S,-8"q$@hF
+lBJDqY'mm1IR$qG"UHHkj'8cVrDQ+IZU(8IJ2r+`9X&j(B4F5)P5mR*i%J3j#-[I
+S!Ke%SY!0Uq"LXTMRC6'h+)[kMf34jf3K+&588$L%#LRFTZT&UP5Pf`02Xq6d+c&
+C4[ZF[#bC[qBB@8U[jj+bA(kpjl%XDpk*lM)`2ki`-+8rG"Lmb1a`'!50rN3`q#!
+he5SIaJ[hrX5$@Z[`iXKI9Zl`5KXQ`c"*KXNc6+SZf3Dr`9YX&JBq,H,iZ,!,elX
+ee+GlXAa$MkVGC%f"T8I8PkC42fLe%MV,KqS+VNa[B%P[1H!S&5jI@,ZJ0KaG-b2
+TERM4K(bSPGJqL-%1fYE-M91k@m"*3&Bfi2X@YjEZT3J1QVkL![(3ed!b4qe`$N"
+`QL*UQpdF3bfdiT(4$1iC3,"LM'iV364RaNi2iGC+dhq6$j%`!`lI%Dm1d4cTqeI
+dJf@e5Dc)M)LN2DTPe)hD2YLD3f%01I++KlAi[L4ZHA0H[3qE9@qmSGZ%rZ&%Y32
+9Ah[-dRZ#A%bCT+TF[bkE+VPid8'PRJCMVrr+36c)[N!hp"D"$ZC6SR-ajP5(UD1
+#Srmr'"hLem1#8fA[AIR(b4fMd*Ulpcr3#[S$MSdVKIiDdY4fD"6)TbKXB05T[[6
+pc25K$`8IcSSJ9#eGjIkb6qhVqj4bp@,!+Ab0p0iTlF`FG5,VRGTaJ'J@Rj[9MJf
+V3!i!FAq$hT(CD38,fJD!CimeQd(*"%i2DEIGVcL4Sk$&k5BM,TrU&DPfNAS0TpK
+l&Zh2lXZ3!*&TbdZ$GVILk[[+Cr""B06H3[-$Gid6'FUFe4b1$IGCYRQXU8d%bl4
+0a"+-P*,$T29Q$H1S#A(5mGC($JcjNmKbd,k#1UI#h4RE+2SiVp#F8U!JIRp,rIY
+)DeGDL'&83"i$p&i6,+a`1r3(fS0K+SEKRZ3L!9lL)*B)!F#)rlQVjd$`pqi0RQp
+XY&@pYrVNk85Irrh[M[qHrBjVrderGGk6cAbck@*X[5*13r1q1RcA*r(AY'c)Q&a
+50kA)b(ETcGab10R#2bU'XLNQNC!!JpI92ER&p8MDSSMMNK34ILGadH5hd4EHcS3
+HC4M,2P2`GPqGP+L8*,m1j`!2G%KF,RNDJPmUKYS9CREH&0cfZ+k@Eqbaj91VBdq
+6rDUr*a,[PG+G(H2qS1G5+C5SMZBED%SB&0VJ,%j62X2L6Z[Z$dVq'44'F4e3rYU
+LJ[-me"T9J829KkaerSDL$)`VXIrCdFZcN!"TZ#A1de%Y8Z*-EUE1dB#*1lE,NrP
+R,ZC(qHd6E9H292IX,&qq)8rXQ'mG0F'TBQ-`'-U'0bZ0I0fldUeC)pFB($(0mYM
+#MjS2bLmArF&Jl6B4IR*,dRjZj2c")G18Mbhb'4BS'bV1cY1i#FPI5GQ!DIUhaYA
+"UlBK+ErTQSd''jLfK25XF6Xh*!9-C3%qf%MK,m3U-M!)K,fk%TkBK&2brJZdA!"
+'E1f`4+rVE-pq%&fdrE"-3)#i`R5j*Y1f-B*N'$,XS6dfZQ''F-Z(*q,F4ir[4U+
+Gr`1)iAJSBjSKL8*IMe6rHppArie+Gb2BZ8Qf+l@fJlHjUXbHLI@hl5BUN!$pc,J
+d'qhDFE1TIC-BPF@@5VlR@LJNK,1'9*eaLB1,Aa'&8ZNr!CA6DN)ViC4-AD+8`[#
+"#%FTlJFYPBQFIc(%k%*98ZVB@2@VpFN46eGTXP!p4KUi4pA(qEEmFUJT["bc*Xf
+"AJB*T)e!-4UU4"bk0YZ"#V2#JX&#@U%EkXVA2hjV)KEh[3!!!E9"4%05!`!#b!e
+9#j5La1aK"%pReGh9)B3UDfd*$*Ld(%PN`13%U$)jQ8J'!5,ISD3P(j-1*6FFH89
+q*XQCr'eJ`6EH6TpTGi@%56)6f530b#IEXf2Z,82mj(Z1VVPMNi+EBlfXU"!$l3c
+i%Lp1N!!m8H53!1ai1[jprBcY`1#e3A#i[$`q(XH3!(Cdp2`FU,0B$5dZZjD$j!q
+rA0lJBYTbDI!m1FqF&ca[H@Y+QLp4erP&b0b@U#3HJ2Vrr0lbcQQNH+&'MC)kqK6
+`ec9Z1Z2T1Lha1Z$H*fQXlZHZki&[&YbUTmmb*DPlkrZZK!rURDDm9"'9%[kG1*j
+6[@R1UKP8hmmJ,Pl[iH@LC)-'+SShpBbB-p32UAVkpLLF8Nl5&[!0f9E$bq-lhJl
+FT+Tq8F+d2Dm'e[MrUc4&)[-RAYp`U+Tlk'k!,'B@$N@Xe`fED[H!5S[L%M*5IP,
+*a!HF9h89CN*F*[55Jl8T-$XVQN%ef6PIQ!X'`cDK&**3Q@cfkN&Cf@C&LH%X1S@
+1%ilU&29$c81F@AbHjM@&!SDq&R@'X%)VM"[r`)*S3B0P#d85Yaq4Z#rf[!r14`!
+!!E9"4%05!`!#p!e9#pbb`+d2"#FRY(fFYXSYA1K9e1X5RpXqUZ,qI8AV$SS,G6[
+'T3i3Pq29Uq'iApffE4qJ&5%[hdYbX9&af`F,kc%+A#4PY&f[r*I5qN+[D-[p#I8
+P$A1d2aZ8eN,f[I&"VQU3!'U('"FcA9bIAV`I3"Ue`D,Pq[VKBEZYAEB4'cDRM5r
+#2jfRVprmaie5iqHDh5GcCR`6r@[mMj+l@J@QB"Y`9!%T2J*B'A3!6LE+,LC1QE+
+8-&SVe!+P$Um3U!A(#CJ9k4A$83%$KDQHMhj%jXBb&`NVADe#far6`F+R*%,5pUq
++rhVVC%V-b4S"k4*C[hadMbkXb!Krkr%ZUc%RU@9hAq+E(drLFq%L6G8r*frLF[[
+dHdMRE2(A*4lI%R,1Gj94Lqr3HdDZP)X6Ia[kkhIq2-C(H+*S@fD(Ah[[8&c[IEb
+mKi*QQI"!D-((5&*ShIYK&j-dA&4a%dke*lAH,h8)LP3&jJl&YqJJQ"Ti3c*VCf4
+JfY@3!#MQ+4"5RUG`%Gf3!"SFCM'HZaEKJ+I)QUQ$H5N@j-iqSi5X5#(['arhL'e
+hL&QCN!$fA1ha&!)!!!'+384$8J-!!V3093ZF&-Ae83$I*(P*'YHDE1qe@Dh!Idk
+GbP6IkAY@IKAB#V`+E!8![PD0YV@jZ@rZNRAA#J`6f4%$14$09`ERpmcaNaqj2hG
+2l%TfFfar'bK(iZPCq2Tpp3,NLk)cNXpm(Iqqr4eAC+m0)VI2X9Nb0[HH+Hc6,md
+l0#SpEeUab'PfiGccV3UT2UPTm8[1A%pU&"kKqRrqk2Q8T$)m+&9UP)9HXVlEkLS
+$VQ@45GHXZjIS90Z`,!ekA,J@Te[-*E4TDmXN(m@6&,Y*K-3NrblFca4A-4-a3+d
+0!&BlJeH,B3S,*!4hDDb&Fe,[j@M"Z9L*IP4[j%9S(m!HJq4)d,Vb-9',D"1U))[
+fK3p[J)R"ES9dUSE(@$cNrd2(6ZiJ@,9'+XJSGT!!!)e9adG8C!Mf"cdX-bdCZ8m
+)c)TlmT%U%#b,A)T6N!#BGA"a3$U0f8#KH!m,D0Z-er3+fSNkMY,#E4kf%!UBjfU
+9!3H94f(GrJmB9-d@((SB8VMqM-6Vq,9VGM3#!!!%-d&%3e)$!!Ch$9803b)5%HC
+HEK"N,4P%D[*%*!X3@DZQ*LHh2BZ-i(ERb%Qh-e2bQAph[qrELM`EhmbhY8#5eFl
+XbH4*f,ilNa'5j9ENLDc)laq42j1IbEcCeRB454B6XMFYb5)S31)(rdjCKT&84$L
+S#cYiiLGf)5c5J1e3aD%@GK*H(mq1D3bR6lpC+R)6)mRY[@4[%r6@hmf'R%[)+8F
+IZEr5&V,ejRAjaL3*5bPTf0kN&a@6NPGC,a$mi-RK`KFHI%V$*QM4BN6+hFfqTX2
+b,*5j55k)jb(*(2h&i)XDJqim&Fee*9$cG*JIMZ6*i#SGjViNe#Xq)@+3!*h[`af
+,NK")heX@$ED[(5XhPA-`LA1fRcbNbSE0RBqrZ,m'l)YVm[NQUD!A@)"Ck2@aqND
+T+'b%UlJKdF4%D4j'8D8QKLJRXm5(8JQR40@4X8N6+L,JmB-'82KL!,85ECR3J#8
+d%@TbLdfC`eLTT"qR$+aeU)[Di0J#T6DMFe4B`aLflrdNJ-)Z!m3jBTLiESAmcl%
+RFHbLl9fAJNh,JDRU`pD$+ZFdM(GdeX@!G"Z$#pDfYBXaSNc2)HBbh"2bA1lEQ20
+L2d(0f,[Q&#I)A'ZQ2(KBb@@qIDUNT-rSkShVZbh3b(2j4EE#Hi"%aD`5%YXK48J
+Pi!JpjfESS#*')G-lpU&Zma9#N6ZP%AF+hP-PhjBJ16hDlDNc*qDmR%1jlK@TB-c
+EfPh+FK[jplG1#3aZ,GrmP`rLNbG@J3Mpl)N"@`NmD#E1Ye,'NV,SJ&0-'N"4lGD
+H(L15jV)kGQArf*KLjXEBBNT+ilSFVqIQ2L6S6,2!-qdr5A,SM5rZ8%e+qrrFIEa
+)TAK+(ePf3"KU9mH96KeiJM&J8-CCH2(UplHlTpQ8&pIV!mfS&!eYS22Y"H59K,,
+GX(5'$iDUN!!D1!1%4[Dm+R'd+EK+q$Ll6eBP[SHY1Jm&+*f0f9@c1LPl$U`!LB0
+EA#,N"l-#h9`&eEjM4RfXIVf`GZf$Y!rlJeGII3NEUUX[JA!5-Xp,Z*!!K9k#PFa
+lib#6LH[)jR!53fYB8Y@+#cA4e!fZkRA5eL(bC5reTB0Nq+`1N!#ULm1*SfpKL@K
+A(V8&MK(J'6fDpK)ZJ-$X$'lTUd'pQXb1L-Hl60lqhlJ2YkIbbBfVNkBAI5lbXT2
+6-1CCQI@i%dADZX@J'V("P$45$f-VG@mlh@!+D@pipZKGMr,CUC9ZcXXMqF'dI'X
+XGU%XA8IkajQ+#fPh$2Aj@FVRjqVrINKT#[0r9hl1a'Bar[EhjGLF9@FZ6fPZ&[U
+Q90aX9RVbi))fT0[hNY60m9Pip++5qIc2PqqBK`c8pE9GaLXRlhFHm(""&mY9YB2
+CTqfiUkZ$G385RX(1bd[ERX3qk'4JZaVPpDGj!R%'T["3[!PH+Gc$PhJ`"hHqIVA
+3@F0Eeq31!*!$$!Y9EP0dG@CQ)'&c1J#3!`J()'C[E'4PFJ#3!c`!"33JEfBJ"b"
+TG'9YFbi%8h4[F"Y*G'9YFb"bC@eKD@jTEQFJG'mJ9@j6G(9QCMS,9@j6G(9QCQP
+ZCcS!N!-Y384$8J-!!$!05`0EE!ZhDJ#3"DJ"@qfr"JB$m"(EmRm)@%,*M`E@'c'
+A%`#3!`B!N!80!*!$2`B"J!#3!`8f,M!Z-6)f,M!Z-5`J3fp`HA*TCfKd)+NJ-6N
+j-#db-$!a)%&XB@4ND@iJ8hPcG'9YFb`J5@jM,J#3!b)'!B!!N!-&0Li`,M%98h4
+eCQC*G#"%C@aeH'@U)$BZ-#ia!*!$$!!S!#J!I`&`"+p993#3!b!IU5!a16N`,6N
+i)%&XB@4ND@iJ8hPcG'9YFb`J5@jM,J#3!c4"9A-b!*!$!8P$6L-!!`#3!i!!!3#
+"!!)!JJ!$!)0'8N9'!!-!N!1!!!%!J3!#!))!!`#$!*!$('&eFh3!N!-"5801)`#
+3"B4'8N9'!*!&K!#3!aF!N!83!8S!!!%!!'3!!!%5!*!)R8&%3e)$!!#S$9X+@N!
+#GrJF9R9RkF3q91`3He-hGAEBSBqh'hZkhCY[Kl-IE&K9BP8P@&9L2BBG9J8*U#Q
+Qq![JiFY6!'CTr+CUIJ,Z--20MlZSKSY&HKKK,qfj,(1Q,"9-Mmrf5(RXk-@X00L
+!E*!!DjS5jK4TL&dh"9[h4!G&YT63ABX`ZFQ#C6*"-HNekEYI%LZAU+5p`$mR$b*
+V!*!$Rd&%3e)$!!#U$9-+R!)#lpEP$+#qS*Ea@aQI@CQPV4E2bMUh0hHehUhEXm9
+[R!'!!3"S!'"NFeNC!!-*U#QQq!X8kF1E,U4q(UI(l#YZT(50Qkh9NT084ZTSlpY
+69H@-`L5-qh0p3'iE[*J9S`[#TA#'fNJ1Lp%f64eF0J!,&AB`dPq682G6"-FSJiV
+4Xp(IN!!QGReLkGYZmL[kiaM*q`i!N!0-!!)!N!8)!$3!'J%EL"Y3E'9KFf8JD@j
+cCA*d)'4TFfXJAM!JGfPdD$S!N!B,!!X!+`!VS!)%5`#3"4d!0!!Y!4L)!Pia!*!
+$1J!"!*!&0J#(!%S!`33#6dX!N!8#!%8!,`%rL"PH-#"KF("PBA*c)(4[)'*P)'4
+KE@&RC@3Z5`#3!aJ!2!"!!,3"Q!!"!3#3"`%(!!!S#J#3!aJ!2!"!!,3"Q!!"!3#
+3"`%)!!!S#J#3!a8!9!"N!)X"KJ!"!3#3"`4,!*!%"d&38%`!N!B(8f9R-J!"!*!
+%"e0PCc-!!Rm!N!-(8f9R6J!$r`#3!`G"8&"-!*!&!3#3!i!!(rp!!#!#)!!L"*!
+!!#B*b!!L%q3!)L!#!#*!!3!JKq#!)3r`3#)F-#!N'Im3+"U+#$)bLL3Q-[)b6M3
+'15CPp$)5C43N#'Im#!4``"!#2q!J!3'!3!#'`)!!3!%!!#!#!!!6j!!!#FJ!!!5
+3!!!!!L!!!!&!!*!$J!#3"i!!(rr!!$rri!!rrr!!2rri!$rrr!!rrri!2rrr!$r
+rri!rrrr!2rrri$rrrr!rrrri2rrrr$rrrrjrrj!$2rrrrKrrrr`2rrri"rrrm!2
+rrq!"rrr!!2rrJ!"rr`!!2ri!!"rm!!!2q!!!"r!!!!2J!!!"`!#3!i!!N!F"!!I
+rrJ!)!)-!#B%#J!T#!N!)K!)J#3J#%![3!rJ))!!)#%!!#!L!!!J*!!!)#J!!#!`
+!!!J)!!!)#!(i#!J$r!J)"``)#!Crb!J'S)J)$+#)#!`"L!J0!BJ)'Ad)#"P(#!J
+Cr`J)($!)#!ri#!J!B!J)!E!)#!!!#!J!!!J2rrri"rrq!!rrr`!2rrq!$rrr`!r
+rrq!2rrr`$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!r
rrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!r
-rrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!!!!3!(rri!#!#$!!Z"!S!)3J*!#B3#)!K
-)!K!,N!!$q!JJ!!J)3!!)#)!!#!N!!!J+!!!)$!!!#!J!!!J)!IJ)#!2m#!J($!J
-)"Rr)#!DJL!J-S)J)$!')#!d"L!JCI3J)'8F)#"Rr#!JF-!J)$rJ)#!"J#!J"X!J
-)!!!)#!!!#!rrrrJ(rri!$rrr!!rrri!2rrr!$rrri!rrrr!2rrri$rrrq!rrrrJ
+rrrJ2rrri$rrrq!rrrrJ!!!%!"rrq!!J!J`!,J3+!#%)#3!Q%!L!)5!)3#j!!!rJ
+))!!)#%!!#!L!!!J*!!!)#J!!#!`!!!J)!!!)#!(i#!J$r!J)"``)#!Crb!J'S)J
+)$+#)#!`"L!J0!BJ)'Ad)#"P(#!JCr`J)($!)#!ri#!J!B!J)!E!)#!!!#!J!!!J
+2rrri"rrq!!rrr`!2rrq!$rrr`!rrrq!2rrr`$rrrq!rrrrJ2rrri$rrrq!rrrrJ
2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ
-2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!!!!3!
-(rri!#!#$!!Z"!S!+3J*!#N3#)!T)!K!+8!2i##!!#!K!!!J)J!!)#3!!#!S!!!J
--!!!)#!!!#!J"q!J)!r`)#!F-#!J'ImJ)"U#)#!bJL!J-!BJ)$3')#"Pp#!JC4`J
-)'Im)#"``#!J2q!J)!'!)#!'`#!J!!!J)!!!)$rrrq!IrrJ!2rrm!$rrrJ!rrrm!
-2rrrJ$rrrm!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ
+2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ!!!%!"rrq!!J!J`!
+,J3+!#N)#3!T%!L!+5!)3#P!$q!JJ!!J)3!!)#)!!#!N!!!J+!!!)$!!!#!J!!!J
+)!IJ)#!2m#!J($!J)"Rr)#!DJL!J-S)J)$!')#!d"L!JCI3J)'8F)#"Rr#!JF-!J
+)$rJ)#!"J#!J"X!J)!!!)#!!!#!rrrrJ(rri!$rrr!!rrri!2rrr!$rrri!rrrr!
2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ
-2rrri$rrrq!rrrrJ2rrri!!!"!*!$J!!!!8!!!!)J!!!%N!!!!!R)!!!6j!!!)!)
-!!%!"!!#(i)!"$r"!!K``)!3Cra!)'SS)%M++*#BbmM*10!Bj*QAd-K*P&#3)Cr`
-)"($!%!)ri#!"!B"!!)E!J!"!!3!!)!)!!"2N!!!*b!!!"*!!!!!#)!!!!8!!N!1
-!!*!(J!!!!F!!!!2J!!!(m!!!$rJ!!"rm!!!rrJ!!Irm!!2rrJ!(rrm!$rrrJ"rr
-rm!rrrrJIrrrm2rrrrRrrN!-rrrrq(rrrr!rrrrJ(rrr`!rrri!(rrm!!rrq!!(r
-r!!!rrJ!!(r`!!!ri!!!(m!!!!q!!!!(!!*!$J!#3#!G"8&"-!*!'"e0PCc)!!3#
-3"!G6C@Fc!!*r!*!$"e0PCdi!!rm!N!-(39"36!#3"KaKGA0d!*!$!8P$6L-!N!@
-%4P*&4J#3"B3!N!-d399c-J#3!`&*3diM!!-!N!1!!!%!J3!#!))!!`#$4P*&4J!
-$!*!$J!!"!)%!!J##!!-!J`#3!b!IU5!a16N`,6Ni)%&XB@4ND@iJ8hPcG'9YFb`
-J5@jM,J#3"eG"4%05!`!"!3e6!Yc@"T2hdNE0440Y!,6j0bkmfddECX*X[UX,hi6
-GX0[NhAE9eA9K!!NiTBMrG!Ak'M5Q0Klla*eVf8k#LE$6%2V!XqJ!D*!!aElq",i
-'!!!%!*!4J3#3(S%!r`#3()%!9#[r!*!DJ3"8re3Vr`#3')%!92q3!e3Vr`#3&S%
-!92q3"93Vr`#3&)%!pID3!e6fN!3Vr`#3%S%!pID3"2MfN!8Vr`#3%)%!pIEfJC!
-'9[IfpL[r!*!1J3$ep[Eprj!'r&EfN!-Vr`#3$)%!pIEf9[prpj!%JIrhpT!%+rm
-!N!U"!2AfN!2mrIG@Ij!&Uj!$IrEf+rm!N!L"!&6fN!6rIrCr+Rm!N!089(p@+rC
-8+rm!N!D"!&6rpT!$9[riphmUI`#3!e48UrFVp[p8+rm!N!5"!&6rrrD3!rcppeC
-8+P53"AqVprEfrrp8+rm!!)%!92q3!e6ip[prpRmUN!989(prprK8rj!$92Mr!!$
-r+e6rrrEf9[rhphmUJC!%V&5V9[D3!rrr92Mr!*!%rbY8rrEfr2hf9UXUJID3!i&
-rrrIfN!2r92Mr!*!'rbY8p[EprIG@Uk[rN!CrprD3!e6ir`#3#2mVp[C@rRrhN!6
-rJIH3"2D3!rIir`#3#[mVp[C@rIq3"S(fN!Ahq2m!N!cr+rD3"[q"pj!$pT!$prM
-r!*!1rb[fN!2rrrMrrrMfN!2hq2m!N"$r+rD3!rIhq2H3!rEhq2m!N",r+rD3"&6
-fN!2hq2m!N"6r+e6rN!98q2m!N"Er+e6rN!08q2m!N"Mr+e6r92Mr!*!DrbY8q2m
-!N"crq2m!N"lr!*!a3Ej"4%05!`#)P""9$@99%3!K9Hj'RckIP9+A1THPQ3[p@HH
-XJkd919ilR0"ecjZZ,P[Y"Nk#VV#Y"GcclQX-A$KHA-'"#b!1j!a($*R6`fd),X3
-[m6M2QjaRL1F40-C6ipFJAjmh-ES33mJFfrVqqr`qEAmG!b'AerIr14e@0K)4!J'
-3""%"N!-43Ji!A32IQ[Ej"hUL-`Km2d5"rJbZdI4iYUQE[`3Tm6XAhiZ&e28rqjH
-mNSQ(K@lSkfQ#6r`iVi51%R'3!"ppNiMDBVVe&PPM2LpJ(+*"mm&3LHU40Ie0Ta2
-I!E(6NmKV1Sd&"12cP@QJ+GX')Y9EJeDr$H6H,`GrpKGRmP13!#bEXSf"1qIEaTU
-h[$@iaYbd'mYIm@8%bjemf8Q[*dT#jjHGTGF6*F&@[Y`*SR$2XV1Gr`B3[)iqlT-
-J)#BF!mrN18-Q*db"*XqIq-$d9ZHrJBj8$b*c9I013I3G00mrlfl2%H2BSK"2V[a
-Qr(XLJ*m3IS+Y18,qdhm2IfTqeKB%XFVLV!J0LIqCqZ[NN!"M++XipJ#IGMNVq'*
-Ia'@Zre0pE#iIbXiNQ114SC&2Ba+$fJQ#RIM'!GA82c-"bfc"+$+J6QE-GGQH%Vl
-1l5")aN45M)YY`T4rCDT3TH)rIjhk+cA-f04IfF3j$*[aXfAd#Ne&V[$T8Iedj)V
-%bPk-l4X6hfMqFD3[fLH#H8,PN@r2lqBNJi0@pqIGL4`4AIQImFqaqFqaqFp&X11
-(k5,@e[)$GB"[2AT(3"d`@mceeeYLZT9(L*@rFMQMYKmqBGlUiUmUp-GEIrM%PDe
-(j4`8,PBaG9H$6N`HFKc+EC!!qr1l1q*%0'hYYpjL69*@L-TL(@Jkc3ET@%K,bNj
-T*8+Ta0chAIBL3ZcDBCmeU4edkBrm4iR3f818(5LU1JkJXC(AY0Z",GUp@%D3!-Q
-BE2[,'f+d'b4Jr)GXZ4,jimk$3im+-C9HAbM8cpIjYh3HK-S#%2[#D,IjrSdE6ld
-Y2$!)Mcc3&(-QCGFq%-%lDdBrd"3Rlp8(*jUN!'8I"PX@-MqJFJ0Vl#C(elVC6Ur
-XUXk3!0qXrNM1PM@b[rS8b2jq'c(081e*Q1rD,,#CSSebGZ)lIp`X[#!lKa,q@25
-H[Ce!m)r0)U6jkFYc9-mi%*3SNq61qEJX3iP5fer+bKaGJ3&RU&R&Yd(&F5QbFT,
-BJ$pkMJ6C$d4"`"Hq[*5,FpMPSG@fiFhr)"DKJN',eRi%H8ePa*Uh#2'5&M&XV3-
-&8hmBJZH9#,CQpr`'&F("MV5eAJUqL*41(T!!Ye"%5B'E)JT"'T%IQeS6D6,Z'e1
-TV-L!N!#4!G&CFk+l0Dr*+#IY6e*dQqqhLI43jrD%L#AE!S,)fp(1Jkh#E(VrXrD
-!HHLpqZZ(c#D6UIkcZ8HPPf&(*V4(!LD6f@3IRi@QRYRPp&Nqf`3KYL!Yj*!!a,5
-*[c5EfJ-ThlMqk&f@KQFc[6A24N)[raKECdbGMkT8*4iL`eQ$P+dBX#'Uae4&&M'
-aa5qU"kT6cAR0KjYbQiUXL"b9LM)SQPZDEFeh)j2M[jSdeE1UCmPMaT5F9'6)&0k
-j1&%h5pM(UB+HY$Kpq!R&r'5FcA0L845jkTK2'QUc$1CEJf[bQMjX["HIDBdR1aG
-rZaJN[+MT,6$@)C0`ciPZBf!#i(Cec9-!YKY2I*UVqRVMT$aQ2b2,qNXG,V[I'+S
-('8qILIHTUc%#TYb-P&8b[5b2R8R2X)Fa"5Sar9hRiZ+06qeG+aV(q'IT8hY9UXE
-$TVc'[UIfLQLMUA2aVXe!r$Pc@NKJ-3F(c-JDbPY5KjqUcKNrZ-B@0beZRR[iZG#
-8,GlRHXV9I,dTVrNQ)SRJCbj8r%AR$2-e!hXRqU$NqDC&UNI`8if+HE2U4E"8dmq
-q-9Y&mkm03lqkqGGJDac)Dbj9,F*N)reSfGL3!0MB%#3*[d%%$Eemq!*q[Y#bIS'
-Ipl5XmpR3hrcV8r9pBPMB"TUIT!`9LiA!&@GSIq"8Yh*ML+VVejLE(cG1VA%eEm@
-f2h3%l5d6$cGrBE69aU$JBFFLeH010CN"-ZkRc'NLp-CIJXK+ACF#a4QbNRCC+4X
-*3"G3++%XAh0HifMcaeDH05Q5c8p6&U*))ZTf96q9X0!,9202'l*F$-6r,MK*c)m
-X4C!!RSH#a!'5QR2%pUUjITZ`V4&HFhh0XEDpILTGIA12a6E4UalpUpF5BZ02k9r
-T6qq`E$eL`f5Vf(L&rT9HZGkb&5$R(DrC!V2S3-KFVh0KiF2"bp[%aU[dVr6UcCD
-YafcZbJFI1AVcj8fSUZIfr6fUeEmI&#'EEfi["Vj`JMePK!+)DHXq#fAiQkYEN6f
-()YP4r9&lT!Y)cTpFLL[Rh5C#B`00(jVIfc(30-hmfI*MBelcHmZ2E3YSd6Lbp9K
-+mZBMK`HDlMCr(fac`IEDBEIjqmYIk`PXr)$qPAl`q*'YVmdk"P6kj-J03!bIXd#
-YE'i[Rr"aC2T(fq6)2TeSDDiHb1ECpiA9$XS1Skbli4S!GJ10NdkG,N,CeL)*iY9
-!I8PmQdMZfbD3!$d0%M)b5#R#'QqAXf1kpKE''#4'H3JjIdQ)$f0Yr[rPl(BcYYd
-Khfj3%,)NNi654&YNY,*kb-$-+&LX,848PKd`eb3+B1e"Dj!!MU!UQG&UTL@Kd(a
-X9T`ZX3AEiq8bAe8`[hBGc#F9c)G@CeBp3`EHG%CKjXr`c14F9A(car5aMUN+9B9
-0c5KiJb,Bp%eT8UL&ZUN"L`$!d'rUK9('+*'-@mRF35i'10l5,Tkf109'rh5,A8D
-e@8'C0mlKRpmR3RBHr2CjLG#YfUrTMZ8EJp04A"[GB'k$Se*)bM*Y&bQh)%[&4kr
-YQkcVpRNCQS@%D[2(&2@b*US$0Ia@*jVS3QfVNX3@ZSb"%pdaRRdEp5M93eQAD#K
-AQ2p"$NET'[G*QqfTN!!%8(D++2lTk'G0T2(m'P5JM9Pb8Q14A@XdMFBe!0XEdf2
-Ym4ia!X80Bc&P68*p&A,HiQ%dCR4L&-fjaF8k4,ID-E$N8AY#$MSpRdY9N6T@J8,
-%L*rcB*)eh36+0cV$)K"439&#6-5-+XYR+&,8j%E%La6D"Pb#TKki0$Q80mc"`(A
-@+-6'0&FQKqMkV2YJU(l$iA'C-Uj"dNrLF!81Z0%mAIcSq9Q#60-q5ch3I(1+'P'
-NYJidPe,60H#I*D$%m92G8+UEXQaq8@@,+iBMXq+f)$+P&0RMFClj$NHPj*l!hX"
-6JmdhVHPV,ReU#!Ac`dY+8$$2j8Aa@Pi8#c&2HqhT$P`,T#MEIVV$FU,EZ9FDLP*
-8BL9mX2K4)l+$[$3"0ipLMSaKiV)YcT9Ilk!YUCe()i0ld%*3l3eMQeRTf1kPF@5
-Qj1pcdp%p)M)ifSe$CPZCZ4i!5V&#JAaVT-!d`4#Yi)LD'++$P4!GD%b`5cVCTGU
-T9cIDiPe#3TH3!,9j`jd-aX95TNDUYNPPY922,@iZYEI-b'Yqh"iP!)"8f[a&p5q
-XAN,qd65+,+H(,X+959YFqF+q@AQ"P8c!r`T-#0R4MA!dJN'*6E,$q%TY6''+kb4
-'Q*ZDf16EUcpkC9,)+2!3`#U+AmN@VEm!)Q*!%[$+AZ2aJeQL#i)5*+Kp09'mQ*e
-#F2%daGZcjAA1VR)%9h2"ZH*(@X'%+"-,jJiiThbT&%qQhDV2V1VKJCXUp3!82YB
-re2QmPCQVDMp9p64p)69VNhBkKZNJQql56MX`lC@QcaK%E-+dQddE4+c%Y)p0'd4
-3"QD9)A!3H,[rCUNa$l*P)CBI[$8)%Q-KJ(ebij!!Df1ca,iK-F8"N!"d!1kl#ak
-JkPFCE'A(8'N"XTl9,4&,EFpH!I!VLTm@%2L'*dS,(S"Sf6J&!NNV`#""!-mXiI6
-CJM&!(A*2`@BU9YA#$QF"6(AK5#'1m1-JMYP-ZDTaIR#YiQ!,J%"CC3&"Ta9A%@L
-i!!GUHA9l'4YYIbHlS-54@e!#0p'Ya-,%,S#iC5$'e82NCH1lY6&Fm3NQUP$dp+L
-UT1-&+HDd!"TFqkEM5"djQNQ&#hc2!NdMlf3A&G+bqCZ1h+*#bPJ#-6-0lQ4MTXk
-qYUCE`&$d$VP[(3"j29"8P#F#VXrCDf4,(B#M@MB%lq@ZK-1S,2DL'BP2UfBJSUU
-+0T*j#,rGSh0S,YZf%EMe4&e+mSl,GeL3!&@q-qD4(CSk)XbMmDCr@AH(46H"V4A
-Em#2lRkL$`*hF[E!%"*'[k2V"51mJTNX)K'K#d5iRRHRYNBjAiG+QfJqRQbjF&4Z
-KCQ6$EF*VMh)(00AK6C[m-ArqPFM3p,kFV3i`1pY*(#'jVi`*QYTA"[8Be"FLTFa
-BT,)i@q#UjmU+iZ+kK1Ej3aNSb2)AU8SLK#C3"+'aZ!'99ij3hFX9d3%aHjZr"!0
-PB"pSb#dUbK&&j14CClKJHmQqRU,#jRRF841LUjqhp458K)%r343iU2lfX@UVFdE
-dLePaK4Rl*8FPU`5)4%h[aMQC),P&cF$XNLH*U'4D9!LRJE5!j*B)-NmJ6iJV"(M
-[mcCpJd"mS&9#6SRmCBbl)jEX#cC9Y'CENf!X-ZF@f[#cUENTZSM!-9@*[4eQmCU
-U+-q2a5998BikQZXHa%3&&ML5kq11L&i!4Sl)N!$KLZQZR1T)Ri6+FbkSl)!*&6N
-f1V#NcMU`T-UFYPC0fk!U(f3m&cCpNk(U'HefmZ$PEM!YAR+9Q'j!-dbBhN"$626
-K`#JBeI6#e#3b!&`1,,PU(9JmM'Qr`m8V,[q"J$&MM@[*eA*H4qh#hF'Q2&b-,[!
-5`)j6('##Fk46*T!!&DpG$[%Q'NbIZTBm5S$)#6eL(SFE4-M,TlVT1)c8CFllGc3
-4NkJBM4NA&rple4T-,,Nbi#Vd'TJ)A)2B'894j9EY`VY!)5LhN!!UeH@G-pDqASN
-Yl5Qm@,),Ri@0D9'%db8,R49SU'TL`R[#U&VM!JU,(kfC+&kV(J+BJ!+ZDkfDLMK
-clRB["cmY3(%D$F(Ba5[D-H(Pdmra+RAaSfSflHE6Y@cDRbED[B4Lp$`!eY0FK3Q
-JGKlS8P3BL4'$df#f(!J3!`*bd`("Ab#Uk89d3(LAP'Lk8`H"fX#5NMFY"-`3H@+
-SY2$[MGlU(J4LEq%QU,+1M"""-qN3QQjl#kDZ5P1&a66Pp(i1!45`*dFMmVka8)#
-D$-5#CJ+Z`J8pKCY5iXXYdP804c6G18PM[!E6L%T#GC1dY@+0TPXK52#Q4f6SiFB
-$2&Y!e2E!FCj8dS*$T*`pq$Q+J`dF2"UfFc,bNNG4a0qd"UqA($$R)M##Q4#C+#h
-F4-!DSZbSRP43k-G29#)9G1f0jTRkQSXJDXSjc%NP82[AG**3!)dLC$'U'Q"1@@C
-#XcI01%N1fkhC01`mQ$G)`hBUe04b4+HqCP&KG,+U,GIP,B5,)+V%bAf%#-b()Up
-G*hE(pLUMc3&6ccQ(+UeflU+L&qE5F8YEVK#&d@Z3!-e4X!c6cee,bp-)'#ke!+$
-[!KP[LJP)bqmQ!k8,i-V@8h#&JSp,f*1FL-PI++r+rFVa,+U3!%A2SCK+A5TlDl"
-Skk(VV%)#k-T+p9&MHJYNU8ZN%Lm+ZQH'$5S*j$Tkl6&5-B,e(K3R4`RmjX%kD8q
-%[CLaXj1QPB%SB10&d&&LdNFTJYU*m+!@5*+DH!&3E!8J@V`&PmLpTB@M*kkJQ5A
-%HijHTmmdm2BV-@iB!&83hB6NfkpSZM(`*+#q1k!q9(5"e43iSN56U@JZ98+a&@e
--&lkaVqd2hjM6cma3BqdTD,$f&-dXjiSjC,"@,fd+SQe`!+H'9BXqLR5#4a*DLhc
-,a+6,afD+0aX+*j!!mBTXF5TN81biZ!#*`2GDji`Y(i,!*`cZJ0aCPS18aN"l4m"
-Arkc6(qd3UZ!KZm2Sae$Yk3MP4EfS[*ILilC[`ZZb8*CcQp'QCDkbVc4kLAQi)r#
-pD"$-&ILilI5k,($DMZb@Ya--L51G-rj3HU*E8J@2M)6Ne!c`N6GGj6M-+54h@dA
-e*ClC(1fFkdJ,AEdYB4X609m1*XaB!,$mj4bRQV+j!2b[VDlC"r)*$ZH!q!bc6TK
-M[Z#Vkj!!hJ9$p9EAT-Z8$`*diBj24!J*HKEGXeG9"2GPDNU[GCSF!&jbjAX)[!r
-aUfch8-)L$0BPcV9L%"+Kf,MT!Mm5!M1U,8al-Hh$)LK#H1Q0GSP3`*UE9(F&V"(
-AUbj4aS99q,Z%Geh#kAZ9K2UMDIY8SDXRTH&DG9GS*E)B[VF$"Ab$r1D2NDNkFFq
-%5$Uk3KG[ml4d"ECM$pq)J[KJ6`,aQemp,mV%,IHNKG5L`T%@h*AAKkXVF(c-j!5
-CZ9$Z[L%YQ5mm4RpYc0jk`hRih3hAPYP(hMJ[6J[E'hYl)rfhLh&M!+pppj`(IE%
-##MiJpbIJP(hiNrZU1ZmLNk"#9FU'SfAeBTi49`%AbbL)YM#94&fX(GPUXfaMpld
--9m[Sl2P1Rf1qXb@fDkK%b(qFLma&BV0`Y`%eZ3aS2ZLF#rC)V(4rCXSC90ka[11
-Tjl()122l-rZaU#150KE,lFD$F!i3#rkI$*N@QfmlQB&&B14iHYCY@*MbmSJKN!#
-4FMb2&R9C@0&#X2pJ6%F6L'+M0hT"(%35X*ESKG"q!,lHL#[Q8hG&IhQ#-Y0M)0P
-d"8jMZCXUB)Sb$"b)4'r!kZaLNEC*lRi'KHAAhVApX-FFGF8pcZ'SDjr(UFDRbeQ
-"U5ki6)KB"Dj0'Q%1aL#C-N3*+D*cak9'8#YAjC,J@i05KI9#RGf()b,Qiqk$P&%
-q66)'-C``YhLFSZL1fF+qkq+2C6pHcZE'l#[cZ[eVi6,-c@-ic$cmC"i!MFV!AL@
-CBKk4D,UL2i[L4QF8Rf#HGp)P)9J88b*'M61j+q"rS3j*R6j!)"eZqN#1JfhTljD
-0M'!B4DBK9+2fQ&hU(cLX5%KAJBr2kAea,+DZ(SY&TH'b-4`C5`,&1%a&(pc4J*`
-QGlq"*U"SZB'Da3$ma!Kq2J8B1@iFUBj&ADTTpP#e)%2Ed53m-,3@jTU5e![!86q
-5`m!T!T0i13SMI2Qc@%McQIB#[j!!Ek!'Y`H#SQqm,&T0jm8fA0,M#0LpeD&BU$T
-)SZPeSJR14IFQT#X36&6eA%55SqJA`p@r!'X&XCciJ$-dF)B@cU#@YP$YY`rML[(
-UU,eLD$1FDdS46"D*D28Yle#L-8Pm"6mq,9`m2lkfdKA5*U2Bj+hdLJFk++KF&Sq
-#T@FePJVKiBcEZ&*kU[ZNJ*ZJJ%[4k89'V4rNrP)%C56HJ&R%Hp!-3f)cS9E([1V
-0)S$LYF5NCZbDjXGJ!0j%(BTP2mr33l(#!,MRb4@NZCU8DVT9MMX6P)PSmm"phHm
-FRZdk#8H-b3QR6qfjUckf5kf1Z+Tlp%8)%,lE'S4ENeVe1"VDGpG1c4)J*d6K[,q
-9*`C"4T+0SS`hb"6QG$F19DJHI`I-UUdBq&@&A-![9M1F+QX3E-1UH@"V8Eh!$hk
-&aZb#(p(Khh#RM@SFVM+1%0Q!VXAeMr"V2GTVe4XQV$CjAD*35BYhb+PZ(T&"39K
-iJDZ"Lq-L8',CGG`*84+*-X$Z'D#,Q[L'Ak4$r08Y5(cJa58M)**jf$8Y#S5R1-*
-UIN98p4AIV%qr@DMi"BlLX"C&+4PEe6YdD"irp!+rdS$FfYA9[!VfL3eL0kh'I[F
-la,+9)YJBUSeTJhqhhS$i*VGbC6h!)i%ENl'-E9*Y)dGe5MK%L45N6@mZGp-2)D%
-UC3-N3BLV!!Qc4Cr`,ZVbLEaC9-6H15JPpfSDN4*HPA`K*IILT%Xhb'IViT3Y-@+
-,NpNL!G#F[5VP+dUUL!E@#l2LpLJ4(fLi26%V$QFNIh4)p4-3PDqFNT,&PC*V**T
-H0i-jR61AkM-iT+`L93L[6K-lA3$@cCJ!)[+kkP0@*)@M#j[I(`2aY[RY@I(S)Y5
-Q)9@aIBSIJ6L@+'&f9ca@SCr%PRCe!4elD"B)L$Im*4Qcq@JV!$$6`S,J3d6ii!N
-iT%3RkM"PGB3Tke0*@BmZCmU+5JTTqK3JIEeH2DCh*H88cPFUTm3(e)G8Il+hD"R
-ISUCmi5HN02Z"F'9YEm"KHhR++VJ@VpS-bYS1!ACN1M6rE0AUfEi`A$f2AK1Z(JR
-`0TJV,aBj+DRNG6J#m!b-BmBGU@I58i58r*!!#Qdb4mR4,$,a`Udm5Gf),6!j!FF
-ap5rpI#)T6GLh'!-+8V%K%GcN8R@NGjBl1L3#@A4JE,p`p1CX5K1YNhpkIr3+-Jf
-*M&[$QqdmDdPZ&$iXTV"!SQBN%P0IB`'jVMG['S(UiiVQ3p4$f648S"m3)e0GlNe
-H4ep1*,T*p-M#2UKfei3LSX@5&QK[ZhCQj&+XeGEAkRpeL8T9*dCZ30k6@ac2M1*
-ci+62H`15iiR)T8JI+TCEGhM0Rmffj-c&pEj*8qiLZYKMdermHEFjlh@3!%!QqdF
-cNF93MkV%CeVmHNPX%e3km(S*A,X3m92hbR&lLc3P%H0q-4HJM9UD`X%518l(H,0
-paqM[ZH1DPYMZ`#YNCc(Q(hVNZ2EJ6$P1%3I(0BQ`9dY*$PPfP4V0UDRpd[&@kBL
-9CcQ@E)@B&PhFAY'qU'4ckk+5Kl!jN!#Rj#L)9#"$PY35)`K266`Lf[3'b9r4L`k
-@f40Y4q(8ZNK9[$m3FfMCm[jp)@Ic-MDEJUfe-P["ii`YD@"6"`d*'C(5%4XNm0i
-SSNIhi6pl0(U%,bJ4kXVSdG(Hr&'Dc-JjFja2*Ke(l6l(%53L$HLc!8a1kjJp*bY
-$#PCIHp'4r@Bp*C2hpj!!Fm[ZcqS$I3**3lRKAq`I1Q@Hf0dlf0rC0pMGeYFEi5k
-rA-MaV!YRQ*!!f+U%[-5%6,6e6daqCk*ciUaH$!8LJ&&HYR#cKBm[cNZ"c#M3U85
-5[DTJVcVCK)DbaSNdM+Jm,b)`!TZ8(5qL%j[&FM4pfSeZq8CUCYSZ8XA#QMkSH1V
-kKb+6Sa1485&'2%-TQFI6-qA8R&cl"HI"P12Tm(#@MjpC5QJ@@FZ`A9iJq,BKLDY
-hcl4Bb(5@XZFJ-0U$#SM!UGHi`'i0hpT9UU6JPP'5Z'C($9aU5e$C3e@U,b3!iad
-dDe@0))rPJM@E-MX1@bKa1JQ8a&hH$AAeN!0(*M@p3lcB89faPN&X4CMB@Llf%lV
-Z"'88,1$J9"-AI9N[qR$FILm$C@TTm3B+@K&#9(P9ME[V%b$`6aKR`qPmpfF@0"M
-f"')fFX8Y'X&Qfk@Y8c#&b%[iZ@+-0Mer1,klhY+MZJ4h`S!cY#I`cPR4dX-ViXF
-,U4$pk@$h+4K-IeX[4aeCmf8F+03M,dZ&NrT%hG"[4F6i$5Q+10SPHQ8MDc2lcHr
-hPDR,l$el!h5%6%0LfZH6Q)VZ)l9e)+["''Jij,c*FBL1r1JX9ACL)d-)P4hbSbF
-kpIE,Lh"Z1"@d-ISaC"kS%`2C%[!LE38")%,'2p6G1GKr9VZPqmch"kJ3pj1U#Pq
-(UPCDaiMqEB8E@+DGK&UMjLb"KKfT+kB$@4K*ekQDkja41JG4-QabSMSUP0M`iVl
-1'EYf(Bj$PG'f[kJYK!*)5(1[dZdDj1FSd&FY3kBF[ji5Lqi421K4`ZX@%%dd&2J
-3+G-FVr%A+aep6hq'TY18Sfrh6%I)@G%HII-IhJmH$99QHj-1$L0TUMU*aQYp!00
-qq!"9%*YT8-rih1#pR0(dPXhh@5(FI0,*@E'JSLG1bB8GV`(iqF)dD(+$XEl&,BP
-bfRLNYKL1B-2,F1b"NEJd5DjY3h$[P@qdAB5JQ@Sh06paB4G38$Yhm'Kr"K&qM#+
-m4pKP554ca5"KmdELA%`Th2SJ4K,"0j!!3&"j#"Q"8,kULG3%TYG42-$`%YH3!1%
-G#+MGGPm2("B,lX8@e0`i@L6"&A8pFDlDebJVieB3Y!E18SF4kQ*Q*!!ljm0)c[C
-fpNBQfLVE#NAA,KL,4erTla'1E8)MUGiqpXkNDYI!E35dF""S&i#9ph[LpK'j691
-A3&F*qU,V"d5BFTZf#Cq%b!mN405SI#hk!QdK&8!S,IS(2kq%JZ$0""5'0U1hr-*
-`13lhp3j1R'SET@1G%pr"dH'TrYcdc*6Fc(4C!k216-R-6Fdm``@U#3bf6-,P%Mr
-*Q*Ub3*&S)2S1%Gk5-DmTe`$JApEd4VicfMdi53X&3Q5XF$5F4S8HL$6#82KG'M,
-h$YhHhcRChbF&0lL!"F@i90$l6@6U&CrJq*[e+D(CY2JX2I##lmfC-d1m!"1aEF6
-#,aKR!4hZXVGNmDMd5bT%!KXTbM1Kb"B8&r@'3(pTX$Xbe'Y!30U`8c)-J'39,k+
-3!+KJ5&IS1dri10,EeMXa'AE35NPAr46PZqYjK4KeC)P1*cQ"G6E2-f'!50ASX[8
-EEqZ'J-&Z6@mRhhLaqIj[N!$C*%H!J'3kZqXGlMHTS*C-b+p'9UipY1H[21LK5Z(
-ZCA!c3l&5JHD$'i&'BiX6k2l-Nf0aJ&*[5d()q+F'+#,PaYQ[FA'jDVFf3[faQ)R
-F9Nk(Ll2bLN,kG-liPHL++em$#'JSlrU#1pMeGZAe3$IkGi1Lm`HpU-+h#EHYc1Y
-5IHMdIFm&9eNTBSiMBY!jKAU,AX&8BCYkcrCh5X'UK%F(LZb#"UVbpG9'dC8ICDZ
-f8l@S0kGM10MEfFH2&9&5*4iB66e&aGYH4DFG&J+XM5SCf9dk&aIUNDUlSYp#H&9
-2r-ek5YMP!0$"LdJ*26X[%"H*+9lF8Q)EC1`8&40`ER)4JF4FEa9bR%KeY6fF'4H
-qqCRMf0-cF5bk1k`)4Y5p#1@JQ8*A)E1JXhQq39PiI3b)3I%4$9h5*1Zb$DrPU&f
-,%LU9Y`L-r2A'MVM4fh!S4hU9J9H(CIIR&QafP+VG4!e(SYla%NFrmFP,@Al1HM)
-@f[DU2*9[X8T1B$lp&[CjQqF$)2C5Kba-56fNS-)RSIaLA1$Y3IBqSQ`F4C+qD*a
-#aFZ,aP'U`)3q+,1+%de!1AjRSUG1paZ6%mkc-Y[Z-,pJLLG3)L5QN!#9DZq*4eq
-M6GURV&0d%!639JNiP#el"#lfk#Y0A!cb6)hKB[-%A$&B88b!#,pq$bN1bZIJf%i
-H"FZNLaQSmc88a5MkB9C4A(CKT@8m$VD4F15NMQq3!!9fE`qpAXQC1hJbjCd5NXU
-YJ8AQ,"p9hL)6iqQ*@k0aRjU1RQ2Sp("8pR63"D%HYdc4pKU20VL8kPA"&,$4S!!
-pf+,8!)'b62fNZ&'eZ[i6FR#-@!i,+k(M*j!!eQ#f0,aVS9ka9%em205Yq4c8`[l
-1XpfR4V8UT3!e"IFJYHQX[)l!",[1m4)9+hECFHKT@RLX"($"YHUhJ`PdQ2AdNGR
-m"6IrXrD)V[I'2c+'pQea8L"3p"P3i9%p$1H4d'i5[c*KTQjZCVpm,`QRkL#k3fh
-ql*-MA+Mhm*MU,-5L1bj*&#G'kXJa19bN0$Rh-NcJ'3j))1X&"3JjT$mM05J#02'
-KB5*%%c--%d'DD$4-H'PL(KH1ETk3!'cXQH@ADij`FTAP(4j*(N8NA6V9UCNBZVf
-hFc6bZ9kChb"PUSNF8iibUm+9HAm*8fC9Q$,lp-UmrkB15CRq5XVdVe+CIP,QM("
-P$NU#H#0LG9@bb@hLjXY@(kN4jM9S-#m$mcXF-2GX-3$QP`FR*NF48TN@p*8pUB&
-AR5Bb+jIk9G0%bp4X9fkDIP!c-3DJIdm!%e-0Cr-L)#bie2I%i-i)pa`"iS83&9M
-m&j))qVb!0`jE1-XQibTBE2''E+TqN!"XlfaXQ56kDDRD*N#VAKm-V[C2ST(GLfU
-qZh2h"!2*898(rDbELLJ9,ccbfKd,HH5Y4-&2Lf%HH5LL(cK-N6Il@,DK+[G3B@2
-P$4XL#k"`VC8+$KDmk`fQFe8UhVicS6%SVNK[2Vbc$&4[KG3`5+cMKBA(ZJj94b'
-T,laUBSLf-%56U+B+&H"&PQR`J1#)Z9PPHpU4EGr0`6!A-VD'2h%p6Ff#,TVbSb%
-[IX%V54f4,ZP+HX%#9RX,YSbA%K!h1)lM1MFh(`5@QbbaqDb*8H%B$+pSl91X`15
-Gh8R0m*kiT"DY-8%YI`Ze-*hdpdiDi&K%cdidi8Q)'SN-4r9%4@6)l`H`,8Z[8'J
-A@lA03$H+G*T#mISmVTV50QkMN[TaNH%'IpPhMKZ0&h+GG"8c""5a1JX459+0ZHP
-5!Epe$-UMcBa4X5`"8XBhQMTd[h%XY+-#YJK,)+B$!bq-ZA-4XK@E1RV3"4G%64R
-p64eN%YX%#CI!Ih@pJT`aa-JCHS18'VNN#NdK5C3%*KP%m@V&0m!ER33#-d,'N!#
-@N!#KVl#MK$MN,%HP[A+e5VX(9G'SeFp!X"+JA+(I#*Ul(USH8@&03Cea"I,DLJ9
-A-Yb9))*M)5@!)J"!CHZ*aj*5d#Ne8M9*SJDd6@8'jNPBkaXB&HK!%T&,5kYDhm$
-(*Rbm8Gj"cIbB"'`SA!Irm%"imaq!4$P01Rj"#bl3m3YDV'U3!1RTTd*a89+XC"F
-0aeC+6FV+E($mf%3-KUENGrZ(9Y#5C0G'FHdi[cCU9@X0*FLZ8XGD*)+B*2jA965
-T9c2)F1@d$eFTH0d+"#p5#JD`X9VENBP0DX8QZC,mR!cLCQ)VQ0KNR)[pQTSQpH!
-qM)*"qdbB4kY`$dI4!%"*JYA#a`52-i9l+V2KNL*L-!#S2b@&-rL8A65&LeVj492
-m)Z8P8G(+,[(%+J'$dJ9IIi4HKJ'LPH'`pEYSC08AlC`HIY%(fSdB`$h@c+jaH[J
-eIPa$48'5LBl'+[40U'GQdi38N!!1p3raeK)6S0B')l99L5)bmCQJ+4D-&1L9A+8
-AKL,cirkKX"*c[93`[QS92&S4VS+&r*,95[reZfaUeCF9bq'AIFc9EDKr@E)6'lV
-!S%3a&G6!h#r5a!(K1*YM(hmekK2rFp+2K0e$NDTB"-1j'He`k!J4Q,DfI3S*11a
-45[Jp@M8kG%!9Xd@Z4+T',id1aBJYb0N%CkZ3!"+)lklD6BaqBYapDII3p,0j"(D
-fb&8f0c+c&!P'9YV'&%JG%2Z&c4hTE4M-%[i&(M4re9i[GpVPLC!!rZHNm+ITNb'
-"FPF4'!pd",S#Ji(4`-Q!-E!RF$N`,p!8Q"ji2h"(B'1J0&!B5SBmSIE3TT!!+D3
-*h4[+#Kd)eB@q#VdBQKfU$pd4fKJU$48'Nm(aB%H`+cJB(!hDJqR"Sm'&`GTJ3h"
-QF'j`Dh#R0q49Ha2H6Gj"lkMAlNhh([A@H"GiArI1m-laAZ[Gl0hPpVY(h$Vh,,I
-C[GZGi8ja@paAhBqi&lRVhAHiRh6[m[Pp`ckGEjD[clIEGpjh`(ICYm$Ai*[TQq[
-EkYYCjLZE+NZ8fFS1Pl@9R5ilAlDrV+TXH9PefHbbqV*TC6HAh9Hfbarb9rK(r1h
-q(Il$ISGrYrrN9+(i"ra8M6iE%f9f0Mc%KrPXq"SI1YM`Th`iaSBAqE#($ErL3jN
-0(q($&MDmN`qpE&K03pmZ0UcP`meXq#)IhX5'Ar,Kh@ciVhci"4ZqaBF0E0M-Kl9
-Xf-5(#pQ`N3q2XH%52NaM`m9mH)i0AqI$%fbiL!mlfI"Y2R5aiFriF!FErT)2@pP
-`0Km1Xq%,I1KR`qNdG*H`iIrQ`iIBF!BI2Xk'rmD(FpR`2rK`*KYq`SF[B,N92aC
-5kQkD)J838`0R@-L'A-AZBfc)PHT1Bd1Z4[FjKDKD,LUI-8J)k`hJ0h`iaPjb"EP
-lf*!!4i&ECU+UY+)U'!0AK&Z`)BmLlc1-rDIk,AJhXUZ1FBBlf(!q(ll2f1[`Xi#
-ccfELH(4iAe5)Hj%c,&G-r5ZIXV!Mh*Lm+@c))m+ESEMJ+'H2++BZmLQABZS$2N8
-+q!NTM`Z4&3a,1)0H!G`-[AS&m-J1NJ+QkC8AI**YGaNIAXZ'cr(K((E`(rP`"K[
-bJ"9mR3fjq3BA+&#B4bJ%,f2j(Rk@FiBp#UA8FBBXaC&MI1Sd%mN$5l#0$EN4"Jm
-VM'8CCpr''(M!$UjNL(1&"09Xq#`IKYM`EfNBfSRP2qX4#ch!KLrai6@+DekLDd,
-[+DB@mLPP!(L%6p8UTVl&TfS88r2je"l&e(rbU5b'eXrjeIFbKZrLj`TRD'--A2Q
-K``a4(M%K'f-r3NE2f8N"Ib$ceaYe++UimYpS+P#LQ*V"TcDcBa5C4rM8YBSTESk
-"paA(lZ46qJ$!83qmU'$J84pBVTML35CJ88`em+PFYVfMA%L-$Dr`BB30Mr"K(aY
-HiX0CE&M(KcSfr*J24pM`+Kp'fI!$'SSL0Vc-Ke[BN!"(1dH0KJ[jm(UQJLp*qB5
-Xd"H!h'6%#f`iM`qAXH%hqA!q'riR(k+,'[%q+bMfB[&2V)JaXJ&99aP-Q963jl-
-A92#dX3'*FV%"AEQ*(5"$d,%Ahm*JR!d)%68E8$AURASrmQcNNJ5Fj)P[fcNimb`
-Pl#@ATE#%dj58+N5*N!#mGNU%b!'BQ4b!ZH@Nm,CTNe'2`h0L0(JqZ-"VN[i&Cr2
-&L,F("cY%J"qYjNIMk"6['Zh4k@+"-!Z0Q)BH1kH*h5*GR"HA4D0i%F16BLD5)4c
-!FTV)&FI%#6&(I),"FY(!*kH*qF0MiNj5,"De@"c&iX[B!AaHM+AMXbb@Ldp6l$`
-qcE'6q#b*RF$RpGKZI(i@dq$c3Xb"crq1pH(c(l($q(`5km+R2VB$RmpLfr#C'@[
-(jrXa'CmjX4&m2Sa0i9-BUm#R11E(jl%B[+c95%,T0LXf,B&lqdk+N!"1#qiY#m`
-&@2FkYP`(YqfD`-eLIZ$$`,@"RB'YJFf"dY"+84hb"8T##&LL+E3b8!2!,aTU%3f
-KP4KD4,ei$UUi4X`9'`2ca@C4,,B!K23(21Kc5!lS`'3,Z!"-QJ2j!8hJZ8"ei(`
-J"U!bM3[i!XM#!6``$iXM&$La1)S&+C'##5Qa#JY5ib%X8V!iKX8j,&l$JY4BKm9
-T,(j+J41,+eL3!"S[B@(#!Pd-"TCLm6%@T-DV@(4Jm3%@#5aU+("LF4',&Lb@Bj(
-%iL8X3PJX4'5@B2'h@$b$a9GBh)I&GbP`BM%ILjZ`3*HEiJiXjQ(a)4EIT-#*a50
-Bc-$L@eM-aQ)"&SeBr!D,@LcH`S)8X!J,8X$Ec)LqB%EdMpb)rSNEdGhFL2k&'p'
-eh)LZi8Ed"$HL"lJ4hFq0D$-hSYpb)lU2'p'[Z4%pa)hSB@j%TGb)rX#0k&IFL*l
-K4[3eEN3lp8B8p#,Kb-rJeZj6MiQ[5blVS5d+`eVZV+!1"[MJ&5HDpcJqMB[k#4G
-eSej8D!C%,@HLhQHLPLP%(A-Q)-V-"lIb35Yqf[(6JamNY(,+-4Y%lZ,Eq$EIaU0
-m'b9m'p[j0JVij8AmFTAfmX1i[*PGrZrXmJj-@YMN[l(*BIj"JNeNDD1i#AQ(@j!
-!I'BV%MK9SkYUS2VB*Bjb#)QmJS5Uj58Nd1UBT)H2G(a1ReQ6KXrS+ITi*JdI-df
-*'Mk`d8GFTQ0LkmX@cYccXS@rp%XIVS`2UGXh@JCA1M2iBL-jUI'$,dS(4"@1TqN
-(H0AfXZ9l&QF+&r"rRI[j`Z2X`DZPB$T-%lFm!@Bbm(USUTSCkVmb3feNKVUB'@S
-$-p6Cc&"rb3ae1M28Rh0$IBiEkJaZU2r!$I@IZD'qa`heapa3jh*$[BXEkKhF82r
-)$I9kEUKriSEkhcb+Eq*4I$12i[r,ShJMMq+Y2)Vr&irL*eN8Rd!drF'ZU4a*d@H
-&H2fSFaYI(('ZT-@ArqK-dU+f'TRH(JMC`XAqPBYpR)[p#a2ViadK#8AA*8K-car
-")T%+3#B3+hNh&P&lP,Nh8I)%'h9h)KdT1%E1Rkh-%B3bHJE1`39prM[Ri)lq#"*
-demU1fV*CP1&lEI5FU3mGYIQ-dkJB3GFpIHLiai6N-4hLX-l#&chY&NVUMXl0(d&
-LH$KH&ab$!pJbkQJk*&502&(kE"Tk"AFb2eBGJ[#dD+jj69()RR,GKh&06j'hVFF
-[#ZECFJYU%rl4)qPVRfMQ5G1e)TeH*0&[4`,'BqCkUPM-DjcHrG0L,DrN&L`50Yf
-LJZRYL`TQNaUT1YHlU&*@T%HQa`P9)bF!b4QI48,0HEN*U2&DC!+3!(-SUEF)"*!
-!(c@Kql&BK4cmed3V%T!!bF%lXC!!(IU%D3`dN!"FaTV`+SN%b'V6ZjbiJfj[H')
-U2#DM9G&C3p6[3E3K%pc[[$I"ZQf)H9[HT`l[d&P--,&fTX@q"3kZKekYbKI'H2d
-KqdkmfS%Z*,ebk,'k+SXF-VY-,LckGIdhrV-ZqX[h-kENQH(rIRChjN-J80X-"L1
-2j5Lkkd*d*+Q,-(SJMEkM,@h(6jZPlLU3!$LeG3+G[lhUDUh$`-m(4e[Vd(e60!F
-GVP$RL0qZbqq@(HM@"4ePmBRcqGfa)QR$hmV1cNM2cRjjachSi1Z'HdiHcmM16%[
-00**riq"qUI0@l9@H$48rAbRqlm)N#dQBP1#%NTp`pY49XUGe([c2"mmI,iGTL,J
-idil1J`Z86*8fa6R&kJTXkIcG&"Lq4EVVH&C@6LUl4N+UTBpB`e(AXJj*DYChH!)
-N9Nimr*2@eMTNa5$KkhB0SA+L1mG23`N9C8G+G)J6)SRC,"hPRC(id6&%Gf9@5Ib
-d"9VaYJd3Vj11AUIidGpCr1KeLrqAKr6L#m4kL-HV`Q,T'1qS"4dTj+p)p(iQHNC
-"G,e%cbJi,"d,&dS&"K,lI53DRCl%4f+C(+KT&VA26iKDZ4p1K5ZI0iX&Ub(3!9'
-LYBiqB'V&JpQQT'f@A,0LC1"iV#G",bkC5iHPC*jk-66%G9155bm81m+c9TY%,9X
-XSm@Yj*VA5%Y#MaeD`!p4eh%@L4fCY,LQm$b5ha44`FXQDr&`U`9iI09)*cSdJlY
-UNB,Cb+Xjmr0JNkjLD0qREkJj1U#NT+04e0Up*Jcia"5kJe`3D43,IU44U5BEH40
-T2TK'l0a35MEQ8a,a'L-p6'@RqC`@V8*pKe[i88%)8*T&+"8b*U0ML*ccNFcN4ZH
-Jj%iVPZAMmA&)[1N`DhL'lq)5**AIAXHFlKq#@9SdB%'QF!6+jae@5Sb2&U25@%N
-2DQ&GJ,&U(dlL'A*Q5NT1LR`K9qj05aqmN!#9fCpV2*JqQBkAH8ZA%S[Z)b(H3#Q
-`G+QfA(VMM9l$ZVpE-G*Qe$$e)8Q1fUE[XUqGh"q3!"#JA&AZS+lIfcY%lA5`C2'
-1i%QjLGZT8N(@2Mjh3G'dZ#JTHKPAG!ZkQ&[(PEfCG6@a(0dG),%[G6!JMT)JKH*
-,p"d2@YFTe&kb!V8r4*Qe61epA1fl&'VIaGfI$@V29kKpPelYX[3302m'+$cer2'
-8MQhbQ3X(-V262pSJjDX++9Q3!*4"*P0hb$9`j4l(`qjQ5JNEYTIQ5mK59b&'RR!
-+L+efaDNcQ5P+b5a,5-d69fNcNpCKmkjf$L3k4eT[id8$3"d1V%5Y3CiS#KRXFP#
-[!!P3BQ,SH&Hl-+UQ8aFV(6mD8UQBN!#9*)3#"R8jT4Fc61El,*P[Q%#!)@'C@`D
-8d,N$)F&8iGHVSZ3j548P6c*9Y1K9)623GRh8`5lfKfeL"cT`iLL[GQNIZp6i0lR
-8%!88N!#BXUBqlqE1q3U9YmGKqQU1S"4*-EV+S$3)5L1R3%PPmTX*6H)#XJ%[+V[
-,Sm*E2m%l[Z9*KJcGjQQVJRCd,1JPTbKdM4XeRq-GF)p6*8#AVU"+UR5"SBS5J`k
-4hffA"X2jh5K3ND3H`%cSiTc`lKKjN8+2A[A+P"JqJ%FlqT9Gr['XiLEK*cIPmUV
-2Re6VUdmaFYh9*`lei0$*eMT5KZaJ(Bfh5L+qI[Nk0U`A-X*958@9Ile"M4QL48+
-h%T!!)@A2Ca&D8MA+A!2p$,QNS4"Q+TmK6NGJTPEUc,D'$*&9aBU-BG&",bSIecI
-rC,rk4MXHdUKm)@Z83b2Fia`HHiPbdUU'`%e--"VrqJB"KP1a+!G5&dXJU[kBi3&
-l*##r,Rc6US8V8&5&DAQiNK69d'D&DQ"Bj9r-,QJ2QeMmlIQ'aeF+E9*(rM#Tq@5
-Z6RpN#44aHf`3lV0TP%`'R6`qd'SQJaMSTSS'"N[UYr(UD59RiP1&#bR!8XFbhcB
-bK0+S)6JZ`KU#84b"%J2(U$')kLR+#ccDFY+`AIk!6fhAZ+d[@9m&`eId`,2q8Ti
-SjcB#*TN+1U8!Ji++"9i@F0X"b%AP&KkFef#6(GaX$["Z9R9KL%P"f,)LNbAhLYD
-D&88(SMKB[iJRqr2[2V,F)JF86&%bjjBD*AM+NdPMdbPb`j&-Efe2$&e%1T1*Y5h
-A6&VX*BN*Z6r-*-p,P4S[T0GT8B-+9FG))@G,q3X+,N`KUX2P+d3ec"9#fapAGSj
-)#'N(%26E1KkSp+CGSVq@NSDU@JbA%ZL"4&%E+6$S,bqD@IlP4I2SFR2H6li[482
-49M*[UA2jpZ`rIc%FMVCSU)bfQ+j%@m4@B%+E'0V[-q0T+3pYI66[U&'UFDj&UFB
-rUe&a*YrE5+,i%0!XfER0-2Mk[BE"eeC@,[,RUX1+I)"d8T(rKhRAU9ab[TY')U6
-L@9%!QDqVU'D&XD',fM595Z'ZYVK%T`@Qd,5"mp494A(H&4BBG&j[dS)0KK@TdX9
-PkXV&G1%AUdfp[YV822f8e)Qc%[3U-CGAeFj0eeHek#CY[DZp4mHPSkY(1"jBS$B
-8b4)"XTfk+@fCAT84D[HL`kSCfapT&hL-ZRIkSIcZM!J9`qhRb196$KU-GAZASVK
-E*aRXpU[DJ,41B[ZfjT8Ki586MQRdKA4XF2UK9*0Z0C%P$bK%XZ*cqjK@*!ZBZiV
-d)T8*h282Q99@0P*h@3d!JM*p!),3M'49$#r1YKpY9e3b8L@arD61,%G45E6`LJ-
-A8N96XSXB#CKbd'2'"kPc4`Vm*6BC(3+LmF+,$5Vb`AbjI6Q[U'4qe6VTXUrI9dj
-9GEZb5T!!*@3"FSdU3#jPmBdQA,r5c)%%J3BY"**)"U6D'#B1REj80VqLDa@ZB,`
-l-A*2KaYB)%diMZ@-@j--R29dAU31c*bK+mpHqfbNkVPMH8r+F#AcTPAZYS"AG'Y
-`B%DJ4#Gd!+TEfcUQfYdcUM6G*p&ek,A,TeHP&ZZ#mjGc9R4a,,',p[EN9kMiRhb
-@QTm')&S13RfHm+i,T-HJpJ"Fl5KVki&,Eh5E@pH"VUDKp[R(5$N05(L988&Jr9G
-)b04@CJ2ap+Y$FXXTG*rif1*YlZR(6UkmpPP%NjGG&HfmQ2$L-6hS8)k-2(8VM#U
-+4jZV$3mc03$+h)M819%*p!$b#8hhrX"lMB,qH)(SeMS8j@3HDMQX)h0pKff8H!2
-'9a9qIEX!dF-[0AcXJe*LeLdqeP3qcj[+KBUQ-LGe+*V+'BUQFU'fU4b8b"-6$pm
-iLQiSE1Jh#@TkV2PCS+S"JXrK"eh5THP*j4HSj5cEdBD@-h-ccXJ(Fc26M*QTkCN
-C@ErI8*)&+l+J%1Vb%-TdmD'kl4b'ILZ[SLDTLJS$ZhM9j8Id460mY%6(TceDm-0
-!XKhQK(XG&ArjBF9I1#"U%,Y2DY)45D)kV)KB*&8GIr-VT+-mbk#&AkF21[l1LbF
-U&lPrYQX9'hYZa9G3pfSdV+p40Yr+Qjaiq(UASB)0UqBI,YQS''a@$+k4M[jT,2b
-SSH)ZILKFe(DK'2J9!ip#E$%*L'ZVld"22RpXIQ!@,F+VG#6Ii#Vm"C&iGi#)e@V
-R#IG4B1r!NEi6hAKUqMhiS@%&Ef3N%'M1)@JPH0"#iJY4cB*5Kjk8)+Rj3XkCl*2
-(cf6+pZ-AXN"`)N*6DPEQmC69!`5Id"pBZT5G#!m3(!bk[M5miIZVE9+&rX$#p3'
-$(TK$)XTVT2l+AVQCL53i1l346SQ8m4!i*1$h(l@S!q@pQ+Pi`36FS`Aqq4BS5Z)
-`8p8L20Da%!mD$b0q-c,bMR#8$D!ADe#dVJEB1%!m$2'QE3SR@@cE0bB,l@3Rl`T
-e"MTiFe(Q(FLE5)U%!M5%)V!DA@hQVNKPP%A*(hc(0fF,fa`5T@QlT@(G2&"$i9S
-b-'+)Nr*Q&+($&8-3d3G@8`[)V!'HT4!LJ%',kM2F[$6DL6YNIhih*fT,%c0j`jf
-MVChm3QVf6RdLU&ZCqB5)rQ9K)AA++UV#*MGMdULF+QU4!NI4$UimRMaCqr+F4#S
-S1Ra#HfA"9Vj*2FZ8G,aJ*dHN`J#DN!!T'KV5P3SaG&)C4Kb#ZYj8&#AUmJTZ,F&
-QHp2US1Z+#MN1V#!21*aN4Jp*eT)SHAFKQR,*%%T5a4qb9N5U-*!!5"3N[(%$#Fm
-S9LpbYiF9ZC%QhNQ0IcA6RN,41-)b&-Xe8MSfLH0fkY6'6k5j969HU%*mSNj2%,f
-VAX'X*0V@Vc))DJ(MbN3R42fl,0((BPADUK$C%16#,f&NSB`9NldF0ACrC2(2MmV
-dSej0TCi0)M31'jMc9m5XIiJ%-Lf3!094B@hK'5#5Dd!dM%"3LG5U*8`V!I52K"G
-UZ"#Q!UkDm!Bj2k`Z2k+)R2I3i*0e+b#Xk6GA8EjC86@k[CLUd8+rBU"@$)55F*!
-!U#RAG$GFdBX,G#Y@Y,jj,@CTQpH'$4G*64J`,#l`Dl60l`*Aj5TY4@LUdPH98EU
-H9kZ[qfUH#(4+bL,N$DlG'ZU8[jLjqY"4)NbUf84d"B'Q-N'i[)KJMb2!jQl@%LA
-eei$BUqNfA++UV8b3!+KmHAPJS3%Ke3(&&KAAU"D&AA2hDNFA&mLV,",d@h[jPh-
-9e@JK5m4F5*8l1p5L80R5X!$eFS)+erj9&QND6GhUL"5p@2kf`T9AC+p8e6#e&he
-BcRDl9U$!UA+feX&HGLQf0PbT'(5Y,UbJG!@4F@mBfUlV3NqTI'A9[&Tf%BM[#BA
-6QIcb'fh#UlZBZ24Z[r#fCqX-i&581T6(G@%&@9KNM2e2*H+BV&ke-C3Ab9*#Dri
-J,dNPZY8$fBUL2c`59ad!bJpii8&)pIi+#+JH1YjDm`TB+5YJ4@68$51ldKpmScb
-JQNeGr,e#RG98ZX5kVPfIM66jaJ@1"$lb5mT($T@*(UQ"J%iS@hN(eKf"QijZ2E6
-0r89$PXMd*Yba8+YE$Y8F!H(r56NJGBPQL*C@1Rj"S+YY'r`*(k0+68H%"*diUL!
-)Fa9+V,TE&iPA296GU6F5qqiE,#0K*#diRC4AU'l@9m%Sd2G222br2L4AQ0pZ3iA
-Fq[-j)(TZ&KSXKQN5JfS-Q'Y@`@B8p%RR$K`b%A%6VmGPhJ4RcDYaBY[H"*!!ZC,
-leZS1A[U+h[,r+RfklS'VeTN,UGP%&MPjd*lpS0k[E"0j&@5RTabrN!"q"Y2C"XH
-bX-eXIAqp0e1Xhmc@rd1E55eh-kRDc4K!)b#fHq,KadT"N!$edN*6PeqAL#6UfL2
-dq+',rr5Z@5`P02"!E%`!E3rBVY+IPi3reFE"(B*SLh01G'mSXMPRZ#I(G5Sq$0R
-6Z(irA8q,F'6cPHJQT#N&`P''F24h4IM#li)`P,YaTU6FM62A4lNEcrmjPEY"KJ$
-PEY4)bYfS@9rPFS6rE-TG$i6ek#ESFTCK`UpPB'+PDrQPpi4Gq[IXdT`c'hMKBeI
-rTKHZ4b'M[p$djbNZ1%*rTd4Sd`d53T,1ekHi#%IVce%JV`pDUeD@fNVG%(BHI#3
-M*r["#aQCZAT*ADRT[cGQJR&S-&ASRB%mA@`$IFL-#V@2$Um41cc"&2HF)`k[ACk
-eKTceLD3Z#qV#QC'KZ$NA2CGIMMRVZq@e('DEZ'H$LVCCCc*cde0q(qD'V5IhM8X
-AEFHI8P&CP4``NC3hjXa-Kirala#T3rpIAV[#,I0VShLD'@A4)I,3853qDq(5M3M
--23j([`I,LF%(+3VT)@qcV1LbD5J!d!C*$Y6m$d2!3l"+X`ihq)AYKrK6YZ+5U25
-FV*`(-e2+Nl9+89[+%AA3D&bK+&idH2QMELXii%TrU)"a@#+j4Y1%*cM(S[B5-(`
-#)RAFFFeLJp`,CmS4+CR2$6CTLSM-Qr+1RlRY`8T&N!!mmI!6ipbChDFJ2C86Y,k
-V$&RDLbJ+b"dI3AHTV(lCFYIE)"M!LIh!U(,kFqf,rbUArEmDbQIIHk)bX[FAVJq
-bPRH9f1ki*rYXCQjQ#U`U05FM-h9r1M"(f9P1J8aAY2jCVNJ0[i,!D[bK(A$L!J!
-m61Dr3RFD)K63&DqXb)T6%EfDS96mRkT*CFA@+SbHq&06bd0NDVd3HAi&TD%"$id
-8T)")P2im"'41@T!!!%9&38%GR(Mi[LaU"Z$b`+U$9#SVAPFXkYIPL#S[51P&SB[
-bJaBGq2+1Tf9RCHBkdmpR'dU6X+M5&f(&",`-d%-iLRY,9E`$6LK-6Bmhj3ijH$`
-!$jK0XTSD@!`!kF%Peh9"C1L#T+p6@3be06Kf21["ilmrNjfEJkl#pkm51qP31`k
-KhpbF$232YNTqBa$X!f!rQ([Qr!9lqLS`Zk""(%Ci0#)J6XP[`d$`CdpJiH&LGP!
-KNlY+#AaR%@i-6&DjSZk"U*b$k4XS5e41r($r94j)eHXEA"H%*9[D9%iJA5p6HG#
-JhTHlHpi'X))r"Z)L(KH)2bI#+rq`S5l,1r(I-Hr%(c#%H9b(B6aBVQ')p61-"cI
---"lF%-0iX"c$U"`&QmpTSk$`Ea!&LS)B!!!`!d&%3e)$!&D`$e8,,#N!+Qec[jG
-h@9G%A&BL)U)9%G(8M((-'%IIppepbI2,b%c06%(1,4J"`S*QTXqlZ`)LRXh8'M1
-RF4c(DFbDaM'RS(%FTm`m[aV(2$HH1b8cN!-MT19qRJ9F2(I6I2r[ZVl[ZmlcAGF
-&'ab""%%3"%'3!%L+C%3VeYA9r@Ep8rTj4l$i&@M"-f#1`jb'k3V$B8*K,X0dJZP
-lX-ec+UE*63K"8H6*hDGbXi0(@j,U0%2kK5(Mmp@lkQ3M%$f1re)YTPmRYG-mdLb
-M0RSCIdmp3"mRcG'+T$ck)1P6EE6d@f0-Y*R29'FB*G'2m6qSMp"h5BZdE#QGPL3
-Yd"kAPKU24QIaa@ST68pk3hYDqV2a9(3CIdfGBRLM$r+TDJ&05jUYQD6"aZRS&qV
-i2HUrkHkNJ9UPG)D'*0f[h5NpB2`cqL`IT"kPQU5l003$id6d-@j93icbk$raSHT
-YG%G5X(CFDU#8T)He2G*$a[24qrK`GB4a+[SjIUpkNKj-'URYPqBD1G&lq6IUEKU
-@0%UVPh*TIY*#lC!!0-mi('hKN@SR)c`kUSirSbE6[j)kDcZNCZU6p(GYXr4()bJ
-kJGqZCP#rT,pUldKr-r+M-rP2DRpMBr6Vr(GU%rdPUDr@+1fLRNNrehk8AMAHMVl
-!HkZI'cHMEr![e@rT0dRGYB[5*iBl1TEr9pe#rdKkAdZ6)UK(dSGDM25$X5QkPIG
-58qPbdUelY-qN!FCAd5[j1E@EX5*k&Ap#rCkH61UL,CGH0VC&Im6rSqkNCj-kD0Z
-PVG3qk4AY6DQMm9EdDYj9$6@14'rJep@eG#8T6&XMVD1V5CHd,k4VaYI4khQEkL*
-RdRP0Pa+0qk,MH,aU0j4S"lGC9-QQ*A(0)YR3p$#8rJE*0)i1d10dJQj3R9%Reif
-V1e$hH0f*1M*lDJ[c!NA'Q1*PmZKa"e4lmBc4ZVEDV'X56,3jML2Z'UGVc`GdVE4
-BefTKXQ!HJ4N0T!NG#cV(`93#-f1-bcjk4Uh,E[!mPch!4l[XXV!(1*!!ii6eF#`
-KF)AX9$!I%(DFX'2BhKQeZZD"C+03Ya6UfMKCef52VTQ,*52k$Vl-mXI%P8%a34&
-T33Q@2dVfVpbaPZEi$@j,3r+H&bbhfHmmLH!mEP%cSL`*jjSb,9rp'1-1HLGQ[f9
-$C[+TrCC'LeYV,EFmGhL,l958B'TVbScj-HB8XVcRQ,#`$HlRPZ9Pdl,l-S)XQI%
-@06E'hC5Tr+p!RGV*qBdE0bd'pqMF8#f'a@-a*,Z(d&0%G'JHXKM-@MbUc51ZqJS
-Hc@2Sh+0D22%'#Da(e3`2j!Y1b-%3M+Laj-%!aXQiG#"aRGM$$8I&FJVhX"eL-B8
-E,VB8dd#a3CUKBKAZFGJp6#"R#U*RKl5UC6MMUMlQH$'Y9NXrchSH&k3QHMKbF8j
-Fi9aeSNmQeh8,0j&!@VJU"P`BX0KK9@jb*6)'-R%e[S,4`EQV3J!h+6D"9VR&TCQ
-iNPLahH63J!TP,'+hHTkYB&,Y1&GXJN89+cK#fC)3Ee'iKH&F6LB%DkYFU%69kL@
-b!CKGGVq'Z,BIaV6hbe"iSF9X+A6CcB9N-8YFZ"V@86@"8I&[0e-KmP*,S3dp)(Q
-K3qc5a8EX9bf&NQBZ9*d3B5Dfh9iSHLS1a4kc)PJj*)&$%C)Nj-aLT0S+Ui4,BTQ
-iUR8Va)!&qhLeHPAm6!UL*YCK&L*9SCTr498Sb!X9aQ8afrbDJ95Lm#fD-%SE)a!
-q8@N`!JmS!MNe4P)`F-d9,mijJc!8&NJVk'H`8RCJJhVH,d#FqrZL609i*KFLVQK
-8)B('5cf#&C6VIRDffbQ1aq[Pp'rQ@X@UGU(GGBY4TDh39,9C+JUc3KZrI*5fJG3
-,SpS983P!CS-N44-Bb5``kV9#k)-"JB-8Xf)c#aB3#cQG+R+l@a)lmCY#0X"Z-Pa
-F8Ca-[-)9KqBA*pC4l!cTAkG0UC!!cpC401b1&lZ!mc-+P"fb9E'bSTaRbl"m9SA
-Fke9EQIS-(FVf#`HLf[(+i)!b&SXNqUJpV%Z5DVI!9Ja!MH[Si)d"&P9--VRLr82
-8$X%QfF4!#B8-BXCPNCJXa5kKCNJ5Yc#V#,'1mibR#Lq@J!iQS3d@FrSAB4JQ3f1
-Xm*!!5S93PdhX9e!cE@!9H-ldU0,*8E'D)l3#Ji3QHLa8k#&cS6l!6+)$i#rd@$#
-`L)(`S+,%#Mf+6E#+UJFfp3SlCP[K@1hBSYUa4@L*J30e)C6*%I)Ff1k`#CN!CE-
-JfL@a%M1-(f9ehLp11(6')U3*'4AU++L9(K5[Kid9b,R2b8BZ*d-jl%)2Qa#+#U[
-'3jL*6"*c8Kji3Sp*BTl3"$J")H$U*C0($4-(j!(H!hIRB4X%a6dUSb%1&#IM8+q
-c(F+B&$3,lR1bNCm*'BIJ8[`4KH84CH"`XKe#e(Qa2-(PBJX6lprZJ'T-*dHSAa'
-UBNJ%QYK4I)@+b+$Bb[$aINj&V)2-46jmUN#l(qmNprG9IM)1IimQQViV1DM9M@m
-)KqQ`cd$IjBjVbJMDN!$C'Z[qbKd4&2@1HX9R4!ADV+X1Qq"4dHrXZ$3"Zq"SVr"
-5a,i1BeB[G+*pF-DXk8"I3(ma6,#ZIIp*J9E6!)1AU*VMUVBU"CdM-+Q#`FY(UYU
-10KJh$$+V&IeMh!Q@mY#J+T@KaRY((GGD*!P+[,IHBEbh(*dG-*PBjk`kB19m*5V
-jpFd4qE'C#HZEd2$-$)T3%kZli'c[Z+3Q0lTM-cGASB@Xfb'V(cVGaF"iEbE'mHM
-2KTQVDmXAUApjDl8VbKd&8VL$)Rb*-5P+d-*Kc2%@D(0ba-#BFaVbDM$'Lq5FpC!
-!Ge(9hJT@%prUN4U4[cNLb"*cDq*Lf0BjMGKQKqQ'VHQUYM9DI@,VNI(DI"(VpLR
-)&N2XqX"aDb*m1*N"dC(S$")$if2#Z%H"pV%C*N[A[ST@Y6HKjjYR#ja$)eQ"a'I
-NEfj+hKPNLG$b'5P"riq2JRmGc&CGfpC(G@l2C,b*'8'CQpf0JYQHc`Lmh[Ki+rJ
-M`1Z%k3Vq#&AERURD$V-YcKe4#6ZM,"Rfr16$qN53!+Tp8U$iH*(MZLp!I$`F5`a
-%"l5H$6HqSk[U6%kEU2+#GlDP`$QlNTfhjFHkGqBhlib)bY`Fa%3CXiq"*3k59X0
-Nk&VbBM9aHfC9J3h3di)bh8GM-f1D0QIL25JM2h2c-3LHl64QGcC#,)k*TH'U'K%
-6P0Q8A29eca)6#ZSi+JDhmL1B9&G66'Z81lQ4!HEX5'0f#$5C9D"0+i3T-N+J8-J
-ZQ(#B4L1NG@*,D3VHSei*LJK+m!@TPZ!eECYMSQ!hVG&K6'Y&abi'aV5V'+1b6ZX
-'dpm)`EH2N!$,"HG$ZSjYh8YLhCF%bQNMaJ+8dfSFaK42J6DP4!b-+6PB'ppITZb
-(NBb3!,jBZbG-G-%c)EdHl'Qc61LA@UCNLV[DL8d*0DC`jTkQ)$e6%Y""HUBJ260
-mA41%qlLQ+IfCDpS)30fi&DDji&C)T*!!q&+Tie0G9DY1,61Q&V&9TfCKe4(S`"p
--2@k%",GFY8BUd)D@q&HGHYbrkNbBAM$GB@l(1HVP8&2"Xd-RiQpD*RYUHf0U(iF
-a&38ep5HBhXC3V$2dH-'!SG+,F"K6KaY6Jl(rY3*Y1X40Vc@'3UfKJ,UKi3AAKND
-fA'hkIQ2kF@0SSc'dpHU',mCAaNNVkr6`PT9eHU[$Q!iiRQiA!f-kbQ8kI2PdP-[
-drXE3d1UUQpL8(l0c4e4-%'TaFe464Qb%)#lErbikLf"'kGVV(94RIJREF6iM2cN
-+A`l+RFe4b8&Z`@deh[$Uer+[6T!!f$IUM6I1'N0R'd-""N-M&6j#i5X8(Uc`AbM
-m2`Tr9Z%r+Abr`[qUm2F8RX1`II$kTr!5KIpFiFmSh+l`@)8rc,Lr9hLc`MFU2&l
-KQa5q@1&1*V%E#mq`m5k&rd2KPBa29[K#d3EQ"8`SfLXZKGY8mEVTB'GC#Kr-a)(
-lGB8IB(Y1-Y46#RmEE3Z&$m(l)C0lJDda6q(h+Vb0(53UI+h#rkl`q3VIS[!3KIG
-N,I`4E"c0dV0(%DpcZjR'AS9(XT@Q+IbL`[-8IPhKhc*"lCL+53Tr3H&r8rKaTNU
-M`Kp4H*V#Ie6i#B9rTr"I-Y3CTKa@6DjDVjB0VM"&XIN*KEqLm$mVr*,#PbTmS-,
-raA4UBk5rMHRd)91S31&&,,8+5bF+Sjh#cbRm,BA2C%Y+6)-%KAr##L"Ei4d8EPA
-i6S8(&(j8i5UMb(5&peGi9jCJP1AMM1jp@GUQ+,b6`JH`ihZCVU$qJi`klbVm)CD
-'KpNDKeLDda@q9q'V&,j%i@MbI+c`'`Vr4Z'pf@,$fImCTNS$)`d5Xje"c$T'eUX
-+Ame+#i[GBRTJl9HV3'3$Sq#2,*&h-pB[&,j5i5mceLf-q[XBiF!k@q%G&Iie9'I
-&%`jC$(TL@6R0B8`@*RS9+im(&&k[m1F9(UE`,eN#)-+Qm,-+(k68289FLVCd#Sm
-dA8kGIETAkf"ck*'C$AdE8dUkVTja[1HZB)r6e5lRpS5jT9f@6crlLAY3EG[k@I[
-lCBc-HRREiU2G,pB8fT9hFc[[Q1mpYh*+CBq)JAPKDclBehrMm1cf@aH9pli3%SL
-2QecIThP8@EF9Vjej2fe)dG9eFdlpP$NL[F2f*FFq[ePR063ekI!c8I-+ERdflB8
-I0Ydcj[U'hqlj5p2$Mh9mk`qhrIc(1iV2klrHqmHJEjjqm[Xhr[RIf!H@AI[k[C0
-rIHI"4rrcdG,IrqEEZf5EiaH(rT@mm1#!VkEqqm1BZdGI@I[TmlplrD&(ARRcZcq
-pq[E3FBRhrA,hhcF2HqU*9AqqmapElMp`kBZ2RrYErVf22lYc`BN[EjLZ+8hZPfJ
-8,dUBH)kj#-jS%AcCSM!a-"Ce`aLqE&%(Q"l'd-'UYRN(A,IN@1RiGk@[$k)*(0+
-Lb,&NM)Y'31D3!),%lr+B%#ckAEUaD!4H"C!!,haA9Y&"GVPS$MV),VmlBRb(E'a
-SX+T&e--8`@3,*iGF"YYVc!ARDd`9qG4h&ih[l%D0CG*-#6RKjCV859SYAI-M3+Q
-[ma1#-QKV8%6q&a%*34&X,-4pi*LdR41I2jjKNF2iEMik0@*J,$CMM(aUX3NQakM
-"eC8D0,TV4,iFU@V00pA,cFI',[$D*!SXEMB@TcQ-aH[4[`N6CY4FRN6SqHCM%fQ
-q6%4D1f2aG+0QCV@%Dj!!i(pjB'de`62)@&TSe!aqBX+A#TphMUAeaP)dj*H@S3r
-D,R8CGp&DhjH5T3R'dNcMVY5*YHA1953r,LV'r5Zd(*IfQdK"q"[M5bG$'8$+d[P
-LB#`&G#hYJ[k3!!*Y5Cja9d8$mbl@`%5R%DfpeTI3l+Z-r#frJQC,YSe9Xb8SZ58
-SY5ARa-"BdJ&M&rTpB(SEGqfUd)aAD"CDF#QNpHZSC*q@am4H%jB-E0Rd@&$S-"E
-N&9aE81VEC"%(aJ),cP!,&TbY'"X,MN!*%'S"@N%,-SblaVp5K&Be6-4HTl(JR((
-A6)Grr@l!ifd$"5`Um0(NaUL)r4CfG%N-GVSMSTVF-Hc!FUa+CepjLbXNRDZ3!*3
-Iml1NB"GHD4EJl5I5)JE)b0"(IPPV,1L2,P)8H86A,Qi6(5mZ9QMfFi*$GhjEkkY
-drSY6fVq'fEq'fBKdSiYLLZbYDfrh%Kd[$eDGpSY-3XH@p0ML&eJKrTb[q)UcDUS
-m1Ci!,fUER`ccm1Bp,kkD$20@#M*%SU8iEbX-2K5m6D,M*d1#i!!C@ZLDrk[S@Nd
--XC,CQ0FHh5N`D*CH@#ikIQ+XBd+kqPI`,l!MY[PR8hTq`*KIVQ[IMLc3V2$T9N#
-L&5l0'UTUq5K1+qUV&9A#L[TU4E@`iYA0ZJX[lEembl8C[[l&,9IZ-1DM$Xj(-Fl
-[VQXriMh#'Pfa,TbJ&Fl35MlV$SE"5j-edVqZG3D6rXU%kAaaT13,*@-K8RX6E`9
-@N!$8LQc"#P@XH2@ciJh*#Z#fiJZA&CA8LTc+#RGUlBTP*GrLUdVYLbbqK8Mc3U4
-jiIX`lq*b+li"@B2&kPjZpL)I['Y`eG*HhZ$P&LmAZR6eGM"9[jY8[*PBF,8c15-
-S+S)16q#),)IYBhZGX4a@*ZEiR`AeQM)h@j,cm8dP)MECR4p4EXQd(,1m%l9VCdc
-6KD#U6bH6VY,LDdIedZ1rb6"d44fEp(9TEXm+ph-VfIeMDe!9XBljhqV#',E+9Fe
-0-HB'-qLI1mYKc*eHS(d$p$HPZUCC98hVjZ9iRj@mr!K'kldm&E(3beHVfSd5,`r
-(9BpCAYjiRfdI1@LhFDM`0#k(R63hR0jVcZP8bA2-1H'98UkC'cGZf#HbqUJ%apJ
-5-HUL`hF,!h"4f+2F60Y4Pah'+!$1+2qAaNilla-j-@L@M*`r1FeG89(mS5R6AH@
-3!0SU'+T9''%-Sr%L*aGS`c!BKZpRYYShrAZkMNdQ&I"K$[pHBaJq%!a$NfAB4TK
-iAB[(Uhpm!NbfUTfI#r-qM"fQ4(8k8jMJfbG4ZKVH*lS)9J#!$d-p(6C)eqcp+r4
-Vra,E99m9"cQ-&(bq5)&M6GQKDk'9AYl9bcZT@Q)0c"bBpM!+$0c[U-q01UjUcJj
-H$MrPA1lPPe8YmkUUfBE!c&(2fc,rCm"l2Le)e!K,HCIUqL'%q2NXIVlla,YF+AY
-[GcQd22kCdAZrZ!4ES2AHri94Pq,PJq'DMBF[1M3[6PqY1(feaHNX"bk9IQCdVcM
-YlRXk21Y'DTe4+(Z+!q2-Br*'ebiV1Q!Um"iXIEVXUC,(XKr*HM6pFF[Kh%-jHqY
-h0qcCprcqNkHH1re#jEr2r[2-RFG[+rr6dGmI1b&&l8K1#'VHh0LdmI@-Gc,c@cG
-&a,KMdlEXq[(#QpXqfVicI1`-EermpZD0X&PYekjfDrpXBZMeX#[SAlTmkpb!,Np
-fHk*VarD[[2bI$XpfHUEc[flrBjqrpre,rpreqq[RArEkSFH(RrchrArdr(R[9l[
-rj[-[Sj2Hr8@lAdrqjFcIIK"kj4A,aiQcTdfC1[f0erjXQ9'hk,[&5jFXL*`hIq(
-FkjF6EedkeqA*!8pd(0cej3lrH@$)rF&hK!bYZFYD4rp6'UL+`kA(hAGN`jUeklp
-HpdAUCbZr@[lpLP@VhlTlUjm)BqABbSM!0E[0H6jqf+IIm&RS2c`UCIL$$iedMVM
-Rh[2[$4adGha,'[cdYjBdq1P[2M6iG0ClPMRMDI!(AaTm-fTBbX2$(aVji)Kl"pm
-cm1j",@J`bDq`qQHmL*qiGME4Re6RljfHb+mPEbHI(hq42em"i6irbHGA*p(BIe@
-lM3NN5lrbVf9UI"%J`B6+QLIKPmCb0&kM56IaX3LBN!"-RDZS06'k9IaFGD,-CC4
-N-38`hFY-BbL24P-Y,D-L62ib83(ZpML)ZmQHTM*kLNVS-FUQ4bL,(U9d6!fcd'(
-+T8183hZTRRC6!qfKII3mlDH6Z,[L146h#jLAqfrF4r42h*Yf*afRfkLFrS5ja,q
-RBjKBKS++SKf86!N84-fdQ4UTL6E5kj4"le!QjH0'Zdd836(NTPK+SbfdLhkN#r3
-QED12D$[Y4+Rr[`KiQbl5Yh36mpV#U+k0VY&9kNEYk9P+T&#k$Z`9mU-[d@@k4HG
-S!(@K*m(d"(@PMQ"pK9kQre!(E1P%ce"RqKIG6RqN2[4hkNYrSIld1qT(IkA2k8[
-U46p3$rU3!$kKrp,lp!rU56qRh[3UGDII-)CSc,kLGqNAe)jq6C2TPc56INXI3)m
-V@19Mr'E60*T#8fNk[8'[dCpT"Rk,k$YD6%YT#5fJ5*T(mfNKcBAQPj'#@p$k(00
-h!26Y5)1Kmm[3p6rd!!fKqbQBlU!3'NSeG"GCU8lj[`m#+QCA1-K&1XA4IA5%0Y!
-D@N[Vk@YD4ep3+Re'+qNV@NlId`TD4D[T,GVD!J6qA`5-"`(FG+@4R@cNT2-86m2
-S8rS'f&RN4cp-SbL&KY1$p"#0"0-)ZSIZ"HYl0*!!"Y(Gf2*5)2!6rHdP38!`4&2
-Ga%$J8qM`(Xh"Ed)3q!0q%`H"Ek$Y-1Ml-$3@qMi)IHm&#0`$EHq'[K-&!6,@m6Y
-8flMJG3MQ'K(bPV2!44LG`m)()Y4QX0"1"&-F#aG%1*JY`Q1$4FKfLT!!EN+`T'Y
-X8-N#fj!!(Xr#C"BL@CJV`Z0(@'$(MrGRB4B,)d5`P,+JX,#D"DX)KpH`d)@&%"&
-b%eL)CQ'*#(Xc4DM[)m,Z2"E1L0"J&Z&%*a'NXb+NcKEK+lEjUd%L,%pRB58,&eR
-SaF)L%Ei[BS&YrVk4K9!@2Q'"L9Le@)3hfl2!%[EQjb*XBkTX+fGK1`X4)Rc%52N
-4)mTf4[VYM(cE@H+hGfDKK`MKM#MKp5b`!JYRL3r[c3)MF6K60-V&`Q84GR4PJDQ
-9c!k5`ePiQB@I@'!N5'C-#5B@@#)6f)BJPZ`J4TUJ15``GB-Bk$6[&k&a[JK0TeP
-JfjTB!63aj6BbdQr-BS%aE@4-'fqb`)Tcih34-SkcN!$+!P-dJi&A"Q2+B)4qTeQ
-%r+-X-#$,pk-BD1EhC'%+#`aS@XYBB)4VCD$3bTC[hFS#+kV@[Lb`cDf-P+d-@$F
-a%QpbXm"8fF3)YiQ"a5C@Y*Z'La$"LLf#JA8%+lB)"XSa,0Na$&aL'$PL'2RF!4B
-B@Gd-V0fXXVPC*A5c",[lXF")idjKJ9AD@%E3@!X,$&"L@@*L'8M&XNS9biSfPUN
-BqaS,E(-D+q#d"KBBZG0fX,#,KA-XX%U5aXL4aUTPfK!4YM#PYl#NEQ&*hF)+D8X
-h&KMKYV"Nla,,m&d@i@NXZjKAf#@NDVYkb94E+&0rQ(D&XP&D+"FZKh%Ab[*0Q!r
-351pE+"F(B#S,j6&(#q8m$*DY+C5,qK6+*4d+j82E#ZAG10MG!fC%SGa`$!B#'VS
-8bR[+BF#`"m+I6i!"m[REBAV#c)5C!C05+1mR,"U3!1A#5&N1R*,PNM4ChKdYbmr
-hPqApdfAj4*JXUd@bV'6)XYjCPZq,Jh(,mK'6,'m!``CXA1Z&k5(,kl0J9X)XPZ@
-[JIbkQbar!8'THE,mfAiB#([VXLb(Mj!!jDKd'!L+kLl,1bl+FR+U,!H9`4b"!5+
-S6CDE&9RH$%&01'K&Cj09PL1JC%3cc%qb(0-H"XTZk3S$j5jdJ*NXbeRR22,TH)r
-m*jG(rRfj4ck"cSPq(YQeh52VPchb+S,"!G8@bj4G,-YZQ(E&XUFrc)KL19!+d`r
-QY@,C["AQ!Nb2BRR-l'+jGP5aA03"CNLaA&"B,"qF85`rA9mXPi3AbpPGLZ9(MX0
-!B&CHXCbZ`-b%'9iX2ei#FlPB2R`'jL)-0ZB@`C6$""I,Kl$3S4d`@1a3CjMHaA*
-1*FaUQ$DB2M!3PJ-&pqE#5$$BX"H(HaFAbrA,BAE"32(k16$cLqAG8'Jh&QT)+CE
-h4"6,*j'`NpK`mRdB,(U+B"B9bmp"NHFJr(3C$!5IKS)[R),T@5aAGLq@cd,aIiB
-@bfI#LZ8lSH$a"TK2LZAEc$")f'hlBD"%Z3N''mS(&mY(Qi[P%p(&XZ5#Z3N68L`
-V5+4b&3E%GZb$@3H$MDi!$)MSJR"A2-bjBMQZY9Lq,keB2J,PMX`YPMId,CEAG#Z
-@eqE!J-"VSF"k&0JA8$B9KCJ+iCqP&X[,)Ial,2jpHaJ3B3819m&3@8#Q5N!k`I3
--b)'iJ$`Z,5#E!IhQ9TLDJ$aQ)mcmJ*bh$bB$TJG-5%!H$FE4R`INfJ$-6CM*!AP
-C,Fa+Q0N"Z3M#$`"a!%*-%'BD%C!!#qB'C1pV!IRJQS$m9'T!cZSIN!!IE3[)k9-
-#XJ9#$Zf!53R)$GN"qIP5Q#%"qH64J(`+R4F'"q4+-0eT#XJU&(8FJjNCN!"Gkf%
-J3#q(k3`c-L$(V3kJ-X*J`j()J,`"'cEd#mKVHJINp8K3+K#Ir33c25"[KH*EV3(
-jc48"1H&-3'l1JpN1dbH!*`#J!5ZX&,U`G"d9eG1ir5iq$R0EF2%'Xd"j,6kLU0V
-+VCLd@AK86-IRim4X6DdedK8DQA@@mR*SA"NB#lcf&'k+ifZmL5Pdf*a$biT8@bQ
-C6bND0r!9"Pqkqr)m6)$1+iLr2j6#McH3!-8VAFmV!bGC625S)Q4%-QE9PYQH$VV
-iD9q-1*r*J8l`*Xj%)fiE&CGMGV0ICLKN6S#c#Cb&akqRTqV*9+R'Vk1F0A5i6)h
-I5Xql+Eh--E&dqT25AGMT(&qejkl("k9+Re'KepZK1d8YGp&6Q1fC6DZD+6H2(Ld
-6-h22P0!H%q%k2b6MXZR3[K$(0,Eh)d0FaK$TU'AdZfPhmB-1cFMefY[ji,$ZBPm
-@&`pTL5V`hF#dEHY(GEbr9NBPARSk@h9UjC4HJPBTT4p4E9Q8hU`kbbLGprBRE69
-E0Phd$+&Pfah"H(S4Ek-b[21i9#IrJ)T1UFiX+X,N&Fh2C,XM@1cY*26TiJhV4(8
-P1C4RSR((UJSH*rZmB5PdEdNF1dRh19R[E8XK5dNfQB[`aP@06aFESP+cUDb)$TV
-8@hP8j+8X%ceI5RY0H-&U8I#pr&[mRDd#,+UJiDES&(Jl42l2bq6ENC18LF$jP!P
-MD9%Q&4cM0rL8#3qT,T-59LBPV%bb@CQ8SN`kq*C*BA@CA"&PX[eQGC&-CN@5,BV
-%dE*)1JYeiVeKRImh,*)f&)QjN@UcD9`ZlPiG[p[-*P$9JPSAP6Cm0H+G9p$[q5J
-U,e)((+Ikj94C4)Ij9FTZS)-jG$L9ZD2"STkk4$@YUDLQ%$K%YGh!T(MFrYE9Djm
-p(PAJ1a5+p45Hk30[@mqIU91Yd#R+R2Dc&+rpQ9be)Pi[+CZ!bYPHRM*4I*JS%pa
-lA%6M[$k&9IQ5*q%P#C1F0)lpj$*1cKkKV'`U-"(ZfcY8kUUZ'!bdl9lE,",qFl6
-`Ri*XhEcfZD$ST2L`Z65XC$APPG#i)Tp9QVhA8kM1QB9,4B&M`S0!q-L#@c@$DAH
-p3Yib1T!!+cBG3'RkJ[*Fi9qAB,CGUMGd,X$ChJe2V2-Amq!AZAfTA@b(AT%0fbP
-[6AAL)iA#REfKN@6*UUF!GeE)9Dp(i$'Y@EQq1#eLK')[mFRQ)NDiVPVU+mPVHUQ
-e&rG3H,R3h&+NAD"!598plBLUE-((RcZckA3flFQQA(a)bUC5h$'TX"8`9q@bBZp
-,i`GY2S0@Rm&bRm&aRd&@Y5$G@544F8Q9e`l&iSG,0e*aGP81l%GGR""PDUa'e45
-F&bJYem)PV5KEYEPS6,Dr&('K954CG'X+VM-fEbB&XKeD"9+l)eJj[ipUc95X9LN
-9MPY!+JBiaJedZ'&'%0I[,6F0ekqAi*0XV@p0U"AYKbKmXbV1Uml+Eb%V2jbH5mY
-+bCY&HFGT@4CcZr1&dL(LYCK3aNHU-9V'*kKMTJP%PrUV([!QAh`*1VKKU%5+0fI
-j(Zcheccie63DYm1RKG-'3BUphLFP+lI'fE1U%8LiC8+%Uk0apKL9jG+M*F+plLQ
-PJlP89%)(c95QqJX$j#8'V[j03e0p!'dm$Y!fE6)Q(EEJr0@PRjj8qQQrp$-YTCp
-fK9P+d)aV3CX'I`Bb+IlR+66-'Gj!P@Bk@8,IiS&XCQV)SLB[0AMTd%ANJR5)pk8
-lDqR3$NV&U)3DDZPN,9A@1TLVQ-98&Ge2a(F8eZdT[U+`lY`#@`daaYN&YU'$'6+
-k`"CLqC@fG(r4LcLaTGVYr8U-[XHAF&aRFSQfp4JqLiTU'I%(#FAprZdDr0[%b)Q
-DF+KSUdqG&[@Z6N[I4iHmkQAiNE0dS*C+&AUXK%Tj9dC#kbLrB(6RLkp5j+qG9A9
-h[ZTXR1r6CRj113+``@epd%"Y1dfjkI4d,TP+k'PcPCTq2lHi'T!!aN-1i'8fjY*
-D[EJPqe,p"ASXTpT*iR'+eBc%h+3IS1iUF9AYkqD,PJU2mS(5qG&m#CQVmba`ISc
-Cp8Bl848M5ij5hQUI()dGBiDeS01`%S@+Mi01&GJ)88I2)fXfMIG'm%#iSlkUaZ,
-PTF4&HGi**-+4Va(,c5Z4+'rjT+HK,(20UK5jTmpT()qVpLi6FcV`FRQqq$cQ3dj
-9Cc5LG4-hJ8paa8H9mT6Uh'5)hqZ@m9l9Z'#4+Y`rPqEMDd*Q5)ADe[h5afi6jCY
-SiaP+A8%rPP&U%IhG4+RVDDfAi[*)VD@M*VV65j8PG,)Hp8p8bU1eiL#ZPYE@8ZS
-qHZ-B"9A5aPV+Vb@h(fVE!EVkLREcB[(9@26k!a8XHQN!qA$4Z`"8U1LG%eq64Dq
-$q*4-)1'XlAKr1L8FVKKPBP614VT@'#pk!N6I&9q6@EGrPFK-mIQC`@qI!QG0,jq
-kp[pAD1hr4k%f##eiNFca0EdUjK0TqFQ+jYf1QlT1UpTAh960LeYD[-d`p[[X,@B
-HJ4@c)F)F%dkM91#[6dq3!-@G%BU%@l)NTfLYPIM"GUlr&F%jGfcc1hb@XKc',I$
-+pC+L#9UYAMpiPdk!,r&H5a'lafZP(8c9YFr3[[SUS'S(-9rQ)'B@(6aANDLf&Ya
-UU1r'FcVU!ZV$I'aS2fPbRI0)0#QZF5r,UeXQI*mrRjU8(VIJ6mjQ8lD*LXj333Q
-0,N(,c5%iCM%fmHdKXfSNURHkejNb0N+e9"qdUTMY0H'"DV+9jV+UkX@XR#kU9SV
-j3Z0#GHh8,PA,bX!8Ida$R2keYVVXDfe9Ae9lp#KQLkISfQC-hFR0!4#ZIS[4m1"
-XPG(Ni#ISI1+(&@pl!5mk+LAZ%mD9("'@Tl1`NS@,,24LBC%)haHaF*D&4J6Yqe!
-GB-UkQ'jT@U&U+rUViZj9EG9L(6H#BV"2GEkeQZ1Z@GYE2AL8`rP@-)mU9*aEMh!
-$Gp*ZM4E4pZCCR0RI[)MR#EcCAYMqh)9,3*!!E(mc"2eYH@+4EH8kV[q)jEIeB@'
-i#"pPLm12MQ'a8PAl+%29$PK9qdF3SAhdVQlrD$B%IM3AcdRBVQJ(!"2EXhAlpNT
-)aAdEf,NGmje`Sk*fB,*Uhhi1c0XlBq[f(N#&UlDG1@"blNcPN@L)lZb1E6YRL@d
-l"q[fm(T`KLrARH%*20bMD1'pJCb-TbD%,q,K!38AP-3$'U)X3%9G&LJY+N5hlkL
-&P"d@)@@(5mH9*YCGM2A+9AYb'64)hSFYb5iZlQY2$YIYb@N#'bEXbm,q*'`da#3
-[&J4)-!N4#@Ge,F%&-EQU&P5NDd(T+ZiSdS,Qk2BJT0iH9!0YQl0dHr0qE'dqaTp
-cf*T[BJUBV6Q&Rh$B0ZrJKad-F*E03#2JUK$D1&RA'N'bCGe9He-@"$5GeV8QV&+
-l!ffDQi+RU3p3[B'+!mmJm'`dkrD0A86[G[5Q)bNEDlLP9V'phN&XH"hb4MHJY@h
-5R4RK()rFd$+FZMe$E-QiA8HcA,#p8kVEhcN+h$[`Bk04rc-hkPSQ!$C[Z'V2R)'
-66%"e(ZDPjD-KNSI#bMqUfr2MF*+r$EeQdEZJfr*C1[*l!MG&i%DKC`8e@N&RVE9
-HYlHka(#VX*N#C`HZVqMee(%Y5j!!Ga-$qNhP20aKhj5!XdeZhElTCG(VKGlRSJG
-&mZ,%*5faA%54MJYDBPG%QJ#HL-kL**d4Rl-#MCL2ia(L)#D,(F3FC`Fafh4R6#-
-QRbMf'!'!-3#Q')#Z-fDZU$afG`"BGlTZG`0dRHieIQ`'`0TY%8GGG+HlRm"UlZR
-J5K()B0dHD`ClV)@ailiKPce@*$Bf3U$Mr@J"6V'I#maVIN``0UHCG(YDJqJG4fm
-(H0*fLD&6GkE0%QTUD80dqaDKe4CSYH8)J'T,Z%MrPM!G9lCBYlIZh$+CijCqEFX
-)-I%@VJ[3q52Q$)l$%c8Z,!G0E@m6#le%Z,K0K'pV"I'q&Gi(RmC8,6"II,9%jed
-aVe3AAfF@1V3EZ0A$Jb-1Re-B,+DDkMDY'jFG0NaFaPEl1YeQlbp%fB4!Zdf8V`f
-e`6B%25GUlIN5(JlGcYYe@la`FTMDU0Y#+d8hY-[AcXI1m$U3!$2lFphfL"RH5FY
-DSpZb1[-kKrCS$ee,amh6T4Y9Cqi-2JpmKlE"Z8,ER"*GbeQ13Ar9ZGI$&cBSfZk
-MZQdhUbblHk!l3Y5c"RLVJf@U[F%0E4VJelei!@fBM-llURe21HLpCjZ`0iAY"+B
-plGCac"BeCDJff3db1H9f2!V2#I"dd'fHrX"S(Y`[G1"f95X'43i)HTAUYN!r!@Q
-"erK#m*T6GDIj!XI$9CcQ([a3VD+03Dj3"-p6LlRXbp"m+EUUfSTB05h#4-iLj#8
-&H($+-U6Vi!add,4i'RFEeGj8YC*`2)i+b0(`&GPG"*QcTr"$$YXMamAJ%6II$B,
-Pi9&@d'6d4NaH%+k@TeXiZ1cT-`%YkFah2ei#M2Bi2N2J`5V*+!j,AedlI!DlPQ1
-QJS!"jq%Ch#K8l,P&)%-Z*SrRSVD22SCC#m&#dd0EGIXK!Cq(,JJVUXkKhVSY4j5
-M,@He+2UF0KcPp-'L16-C@P3rqpjFS2G+31rG)G"lfrKQKlChX@kVAbi3pEZ%r2T
-qZV0q$UZKpB#f[$6-LZJLA-&ZiB4f)c21JbYXb16c(,D'&!#QE8m%#YLfCcK3fMj
-8kRe1ATHPD2X(klD6E8,bbIFj@Q%RJhAE+3DITd6@UMd(PreF215G9Qh2#6hYTq'
-ME+I4KR*STbrUfZP"UL92YEe`5QakJ@Rh3Np9'i0XYa)eD`amd&R-`Kd$Ara2e,!
-aI96Y6"Jkje6YcJ[SS0510qLfimbr(TqKfiq24"*Z-qZffjJHYiQm4#XhkEEb8)%
-Slmi3JhAY6ihBM`TlY&QJMZ*6URQNDMXfA!$bL@cGGZ+8+-36AA@E*$)m6@T%9`#
-m6HSXMU5"ZUDL5@VZVGU8VB*&ZDVE(#c[FJ9BU"GS&pSRCN#`#ilEG8k8[@X+FiJ
-ZNAATH!5''91-pFr4fD8kieTjH+RL[#q0Kq24(8H+4051S%6-+e6RKVim('@fBC!
-!EPXM()bf"ZfFY5)VYkeGai*E,,N@V5%c@NRVd@Baiakk,blUYLpB1bL9Y5P5SG)
-i9*!!cc#aI4aUjr*fD1dFCDfICKED#iIerAbKl)TXIJJUV-THab["hNF4hjc(+DV
-051'4$Ll(fH5HF#1f3*cB1NjN$6CcS3!@FbXEe!L#MYQ)QSZb'c0IGqD&L)D50MS
-06i9$&KJ)%h92GbjEbD2JFCE0aUHl-Mi-EDJ$YA`K8!GUG+GT"%-9c'8SlfZkGK!
-[``&-a5q&K`QJCT9KUR-!RjUI3U++RDU@MH@+YkV14clJ#e%"Xd!,$qEf2iVRGAM
-JFG1RS0-C6`F#!(QJh5'dPJkK@HI*!GaR#lrBJ'DRh+SkpjeP%Tj('db'H4iZT"!
-ZiL6F5#%JpC4!B0,i#`#TbT[Ll8Leh@N5%ZlXJ0IeH09jfck@)GlQpXI*V0U9)hm
-hFJ&plk*qfRkI)Ic[-EJ!!q9eSNB4hqh81!!BEJRq#FmR`-h"BDV0F8a84FG-%9c
-V4AEKQU,Ep*'L'lGDYaeKl[K)*)##Y@[Aj`V%HV3a[XB0Y)fUE9ffJ*TeZ)9k*F$
-L&'le9EA81!HZH"BfZr[@p-2[mS`CdXS+Xhc'M"XGDfTU"PP$V0D"6ZG8Uh@)X1L
-r)IV"mf$[(ALM&8`e9QX`3`krF6l8DMd(4(b`04M)N!$je[&r)6@I6R$mMIqNKTe
-'KJJKLd*B$,''Y'1pTG@)EaEAe$a3`e3B!K3dZhqZdaRLG!kXi"JiTH8B'qkZ%D,
-[UDQjafkh$kPC+)*!,I$h'11pLqhXEh$0r8jVc4$r%S1'3X*`Ch!&dphIER4#`0d
-e)l"pF%d&q[k4cZ#DJ8kVN`Ppf#PS&9)c,HbFe6NA%Thf%B`XGl`@HRQi'&FK8[a
-lr'SZB2[mbh`RYJd88U$m``*p$a3%i[l[a1JKG"qShVP3p,kT'-kYk!ak@$"&9Le
-A3Dc"GbbaAPKqde&9&#Mep"lRHi8pfI'16P,M!1Q#X1HNeekqjiG,mCFZa8Ykr+A
-ZGl#rpm2#`JB-[4b@q%ITR5Zhhp2aqX""Rl-JZ6[1NAD1l(M2b'($T+dX**r[fL8
-XV223i-X$VPdIf1&@fp9ZYhTh[A,pNl!`UAR+$e1Q5-N`S3p23IJGJR3Kc1Um+Ze
-%H$)86iVGpRE%AIp(rlfp9i"c66!$pprqZB,FRpl`eJMXM98hZLIpGXKVm4m-LVr
-4+IipK+XhRl"qE,eae@QpmF1hTdCDjpjB"H#imD(6H[-pqbclC2Xm+iSib@TGB,A
-1XIlDrZRPP(01P&pHHHa$9b6P!FR9mm-KG`qj@rV`0a@G[bFqmdV`S2k*9r&629H
-Z5j0l$T*5T4U8ceT45(mG)MdV"8PEZjbAVSNbq&CBQehDBRr@6[krfb5Z&UNjK0Q
-mmD'KciD'GR[Lh-[SGPhje`'*eb@(X1Y#TG43IrJ`Y&GScm6VV`,p9ZJRLCmN5Np
-m+Dhi33e)dk3Nb"XRCGV#L066E9IDK(`!!"`4384$8J-!,[%293eP44%!-@AZ3lp
-YEjBjAm,,$2Q'N!#6[)3jadbbiC%d4b8Z@4,R-T+a4!RFI-R8C"2*NMA'019kF$%
-aK'JKKKBXPd-$TDIaq3`X8+XHJ3'@`a8[0r*mV29i15)8T)MPYPb[f04prRl[Zf3
-*PR,[kAhq!4ZQ*q9"%!4!%!#L!4IRm4'G$LmqA-KF8)PNK!'qrQI6#bh1aZi@2YR
-Y$6j1PIakU[aLI1'41jh[rIf,p4#*3eUE'RPf1QaCD(,k902TFL3G1!DH1-f%9(b
-Z(jeRSipam@1B@&8)ca,l@K4#KqjM"FhS[%2lm&%YIL6%$lq[$HiadFdM1B##IR)
-i1IK19aFh(#8A*#XScD"+5+5F10cV-!jCIK@ZH*QhAMX5qZq#8!%jU8C[qH#CpDP
-@ERNR%&Ul0d5Z3pehHhXG'GH2l`fdq9BkPBelDLhcZErlar5hm8,hMmr[jp[lR(p
-fD)06rH5H+b($6`24R%"6fC39Ie99C-IPPpbp(M6hSfECJHp"9V$K`0h9cJVVU0'
-UF$Q,AT1KX&pTNN("C"PHVI&U['*&IV`q1a$+jEhEii)Tk$QM")IDp)RY9STGB@d
-6`m1-M$)#4rd11'bKN[8l`ME9AlpML+ZQihYmX8"-hG#NK0YpCP0qh0[iN4cK#8p
-#&[KR(U%T%Y@`LPKC1Im-4D(XhDC)lel2DR@$NUBQ'V++&4MAaR4SlZB4)5@9#Dh
-mXj'`48dJD@A9"T'mLkNQ`eBbP`3MNjTJ)"91(56-r0SESjcIEAS$)J@QmVT9'Cm
-hqXcK(RMVJmN+DMJ'TlaFUj[PJ$)R)'keH$9aHIQAIE&*DIMrH1'8RRA&NediCr@
-9qklNPUdZJ*YFU!r[k"qE&9,(fq,YKZ31ZYGbYI0C(cV#mRJU+I3jrk6e@U4P2If
-HD8cI#ZIh!Qce1E80DD`H*,%kker`QG80kK@6hC2`pSE0fX6Tc9a!d8X*51Y@(K[
-4A(C-bfSl%RdDDphP[G9+P)TIpXP)h,@VHe-4II$"CF5F-`5+2$4*2)+[)ZT&XLm
-XAKUZ"$krq0*)F9TpU6ijP0m'*kJ+CX,%@c*6`Dbfqkc)DPU2PCqa8USbUD61PU%
-a3("NT%HG2I*0$KaA5)dKYGVVL)p&2DD#!dX$S68&[AYArAUi3Ndp,iFF40!jKdG
-3+k)@0A9e5G@N-&)4&F)9eZhI&K4GLJB`f&Fmq0b+ja8fU1cFLUZ98S[AD(AQreA
-@kPe[3[pkm6&X6mA'RhVEI&C[Tqr`I4G88rh$Xr+4SUP)4V54PT&N"4))'9a'-G3
-bJP6!&kQf&f%f'U%%p3'&0U,NiQJ#9Y$&FcQZVG#e!pq%+`!mB53e(&1$J6C[+I4
-P+3*6rA12I!Jb%S3N[VC#14"ji0G$&DVI6)PU$R%PdF!5+K$*%q5QNe*JDQAcAP*
-%eApICR1D!6P6ECjUVe8effp(hM[be,$2T#k)YiCl`hX[Yh1N8pAeeB)%9+[M-LP
-8CfP%QQD*!5RC3-J$SYlfYNRT#%2&80ZX,%q-Z6"ie%mI!JqJ)j35$SCd``5AZlL
-B8U"da)Up4Q%Fb35@3"#)88"Lr$X$BerEmR`bb%JQ&"V!4*d*J5Q2GpFKQHH%N4J
-`mClqH*1k[pImR"B*T[*RR51C*T[((`C`mS*YGYiN'[`F,T4QB[SDkIe'5NeD#L2
-hpY@C-'3Rfdah[a,4lbE%33N-5F5E6!"+h*!!4N'+"F2rfPIRlLmHSL[Id3pa"BN
-pRX"209e+06SEBI4Y-!T)*-EKISCaf8E9Ai%Fh[d5*Z"GfNRDA!chFL3lHE$la`$
-'9QaNkijq@N`(M'6MPMSFV3@VXZ)M9+e*YB(e9'T`bfp@',F@)UddZ+9ZKA(,aC8
-ZA+I(e[K"'Jlfi@$bZ21$0$TSF'kTD8#([G#fj49em)1ddkM3"SX44*Q3!""Nq"a
-5JcYp-pkEH5KX"VTVYLhK&L5N!V`['JYEB6L189US0UD2m#`0D1lI3+$D@"p'%UY
-qNK61CjeBb)A&[5F@F[qMB*NDE,PNFHdIE,R4mXR6MT4JF6hY-"qCliFkq,@*-ik
-a`CBpP[pB2pM5E(QRlSfa#XYre,da(&cl"2dGHq,1JP9[M'HPr-eGU[8VK'2JY3&
--+jXl@)@IN6'lakaD!3E0a[V"'CEH,Umh8ES)U5hRRa3)2S0EHq0HVjA5ZYK816R
-SfY8fa"2RKpJf9e-#%B*KqGC1G5EUp@R%K4&DU0U4'8Z!IDQP'rp9RI&Cb'b89MZ
-6dGND9e1$cPCX@fDmXGZjXIN8+MGH2hV,a[IUrcpl9BZ!A%[*Za05S!0$YD4`[U,
-2HGYmNieeCl8PPF[rZ-6%QC'1B8%Qd,F(L+b*Qr1#Tq`EebcXfRMX9!FQ1DCEZp#
-bXCQQdFjj+JT9#LL$'mrN+Ui###e`fiVXDUZ`me[Yd@hkU6rGfj3NB%"m'ilSlYD
-f)pa8%5Hh'&ANeI+"IJaZU)U@91b'STJ'Ypb'3*Uj9U!aQ$4E#ZFS'1#3!)dmZ,A
-3hCpZ5H%S'F2K*pJNFK32kciTR&jX'a05P8LGF`dFE9mLiIN[A4KZI2mCBY2Rh1H
-Q)BB#,U&dRk8L6BcdH"G)k8EciNPf39QkB*3(pd[,)#kF-2'TIT!!&X"e&*0IZP,
-h@6J"0ddC,J-@`@CQQQTT!kRke(cHAAS6Sp0d5'S1J+`iC5Yph00[)&35%Lf&1Kd
-*LN)RPVmAYL36,5F4'&"!fi#Vc%+5AdC&rNIS+,EF&Xf"%GQ[dj'cJaLd4*(Z*%F
-m'Lmc$Xq0AL6@9F&LXlL`a5PUGT82Mh-b9"+`HBM5`ApmKS'K1Pj0V!N8Tqc1eQJ
-63dTlPH[!Y3q3!'J!%R*c[Xd-qI*GEdrekb9K,P+A5ilb4R5j"X2KR9(hHp)c*Q'
-q,iVQ'i&%VUpe&`hK(8dm-!66dS(1-pX%da*IfKC*,Q"N`X5!q)[kf`9d0*Q%q"K
-!J12NrXQLNcHcl6Z)ReeDh[)#$+T+,%$S,VKM$i,&Ye9B5'DVMTNY%D82CT(*krj
-D9cGkl'!@K,h&$q)UZUHlXh923A'bRUT%-ia)(N2S`DILp@*kCM%-XqMh0$8'G(q
-%-"b,qr'bH+3%UQ(+-rU'%NB@D+rI6"#qJ*UmA+T4!9"DY,)S0(2rbS3EG$@IHNf
-qMS%Vbhie'9Bd&NGMQ5Ar)GY%a059A8D#C`S!AS'3!)Y*2bdU1[2kKCpI1K#JT8f
-(,@Q,EH-35)fYTLk2NPSS,He&9cREPHfRT8Xh,IY`-ZBVmclZbimqq[0,(Q'J*YV
-Mdi44SAB1C)jd22kT1QH9BfdQr5h+E(lYESIDHIc55'a9`GVAk'r4DpGNhPh`T50
-$`EC3UQXXh$P3iqk29LFV,$HMkekZ'`SXJ,1ZirJPVI!,ee+Z5qN,@bN5,R(GATX
-aeVfiHh'[,D2%T*lI(q2*3HGk-0R8Yha1MKk)+"$J6UKRk"HhE$lSSFf(5N#i4TA
-9k83(VbMMA$*&I"F*,[13!(J9YpN2)3G#d`NHX[0+K%CpFRkr3K1G!00XFG*a&*C
-f'jhKEUFcB1TL+0DReE`cemG(Eh&HR8c&3&j`9"SfTe@UR"#S%N5FX-bhJF3j)6U
-B5%h)1)bG&b6'X89J0adG-(A%`m9-r-YTi!Kql2ID1)PM0[l8-"U9UYkLKdT2i-m
-L`V5*C[YjN@KrcP6r3S$6U3+P%RT'rAEUZ'NS0EkK![Zm+14a'18QCcM$PX*9Q@2
-f,8&+EUQl@K`!b8+E-q$'))Q"d48BG!DS#IfjcNX*I`%Tdh9bD-`[Eq"bGLfU+LE
-@b6c9VQ)KN!#RRKMm1aK%Ak@UA&QU%SaFGSCTqESF'@,pICPKSh2i1PGd#'B&dmC
-*-"%3+"0!eXeeAbD)'clY3Y-56&BjL%8[%@A9kH)h6QMNVL#I(&BMeR`Xp(f6&Z0
-b2YVi1U-Q'B(K(AM%k93(qSdmp&iH*h$!'I9R#@9#QlhCZReJ-$DC1#(i1h34+',
-pp`TBa0JcE3"C4-G!N!!S!8%#B"R')TY(PJJGk)rb8+YK`#&T`1FP!cjhK[dGI24
-l4Gi36C6&YT)#,33-'hqH6kINd)-EG!G,0Y3rNF+'EY$Id0r4KPkpdJheBb2(eqG
-L8qImjcB9SNKA[("-k0d!FXU2"0GAhTAp[ETkDS-hCVrPrDG5Ap9`LiZ)Zf)M-ZD
-9A#rPYi,K-&q4RkkSP3hj&KFPGh@kaBjS3MVd4KBl8K8@e`JlU(--"@F9C!MEXSa
-MUQ!PdG`h!S3FX4aH%H00"S485L(N-03bM4f%#RP[KqH6+#pr&8$cAIHZ$kprc%e
-eE-SXqbmFlF+469m%2384i[hkpB2[emZMP8,'G'T8M4&!ZlA9!Rj#Ajh6kDUjGC5
-1MD[dh868h08bBjbN$UNDkFeAMr"#RXGITJ#SDZR3Ci0K0jp*QpBSPE0G&16eT52
-HfPKTbCq)b&dkR8FS4,"CbUj9'c),JrGX0YR6@p'93b4*qQ'3!-)$r@![ih-@'Dk
-"'JTM3C2bJR&c+5H5(`imG)SjRmmY',hPI9FCiZYQ[ch[0HhRVJ)&KRHfDbKdlbY
-R(2T9!Iqp[ej6ULTFF@r0pD8AK6lq)LA99,*!$3AD$#ifh5k!+f8)G%+U5qC+GZ$
-P)!*`P,Z-HCbkQZB,ARir`NjNIXIAr"YcD&1(E&Hi%5jDIU1kJ*VARqYm(%liAGi
-&8*A0fYZEiDCmd-B#E5,bHYiQKq+e616EjE2GFBiUaV'T9Z2lpIIRRq24K(3i[Pk
-QMh)N--V4YAQJ8'PaAmSHL+%E'4llkK8K$S%kUU6%`B3+AcQZ&XCjG#KP(f,,([c
-*+b(G340H8%3)9&@ACiI'qDSVaG0i(Q8(Z0iia"ejRhkcX*!!!deVmaLU3"9X2K[
-%lc5SP`,eh#qUCrN29-pbK!ij5e36Jiec53dP`!ec,&pr!XB(A8cU51LUA3UKP%"
-"L'db[5U3!)LFPcS9m[Ip%hi1"0(b9X3h6I*kDaH"qiidQCVcer6U&qHb!T5&&EH
-*KNT14Daf5K$GN9E,$FY,QbNXchbjmK+@pqbPS`IBdBZ-V0i1E&+C2K1TdV1SC'V
-6bqGTF'jL63%0Am5'rlq21ea@+U`Faj%l(,@F%K90kmhFNQDeda)S'6qBPmGp*Um
-FMAhIcN-$&m5M0100bF4j8RdQL2lc'$9-5LNNQX0jl-VhCAEFmRlcGDlc%39'fq+
-!f+'4",6b"p`e9VYXjjG*YB[Ze(I#L!'Ce9k'(Q%cL#249ViIC*4pPq)`"(EQ@NS
-c,Q,*)J-TNb)T,,`b+A[6i9"0)LN&TjbDcZ84XkNJlYHXlLh`l&,0F-RYcTUC1C!
-!V[dYpMdTM'!jNM(AUL%@NZU)Tl3ferCiUrEmA!G3l9T[k*iVQH`c,0a6NqD)#SD
-MNG!pVfehK)-dLETGRHeYkp[p5%IKq%6Rc)DLR(k2jf44cXa-ZrZ!HdF'5db@'d`
-S"&QjZ`'*%VK,bGRHF4[RC6P3!p9RK312"mZ@I9L%4dc8cY2[,[Yd+3m+TUeF4YS
-bTTU2IqL0q3*FIZ##qPNcA-Fqfa%HL1cBUdCf1)V@qIbEpUkk-"a4+qr,R29GM"H
-eUYJ1-(*j,E0DH'a5m*QMbP$%QK89!R$2RpYlB-mM(f*5[fN,&c`#820*eAVk"L4
-'j"I``-ELap@&&$a,X)&ERN6p6+MLCmeB6YG3(@6JI,dp&kJ)pjF!jrFbcT[f)%B
-IhB+EZ9JJm)Z9j)*cpmFEeq"MHGV5DS6CYGl6#A#fCYQLeb0peXK5E!l'h(hD*4)
-#00!UelP`FF($$jiaS*dM*F'lrERXbBl#!dAD('5#V8J,jdj+N!$rk[l(AL`jQCh
-Y55FdaBE&`[1jr#d56Kj*d0G3)$'&9$Zm%N[llYcFSZbFd3-dNTMC[eSRP@ER&18
-Hc8R2034q+j+CAd+"[(&jr,$N'(9`*!+AF-9()%P)3,Pfh!3RSLH'4ePd!26eY1#
-bQbZdZI(h8$@,'AD#p@'BSbHEEDP6A$*)Lf'58RK030UhF$FIJ-@C$eecSj,q#M(
-MBTk&a!+B4E1eeHc$)eCFVG@`MjhL4jqiS&fX'0-fXSpaFF#`Z-!RINa2dDX*j+&
-Tq,I-A,QjJ"hif985Z)LF8JL%-2@XBHX)5f$X+bV8Jq&93BLY%&**(R195aIpXf,
-KIE[aFY"V0L[-CJ86+jKBSC-91P(iJc62BqPj46hTlHj#YZXR$9XMTBX)3C%BQXm
-Re0ja"FQKTm2Q2pc++C`eJMBa`"eC'rG1),!qcqrEX1&@hK4J!UeVEpcrHXeC+eG
-I[p"VAf@'d3TP2+"YFfA&`hP+B59EA-X@4l"BH,h'9iHPADXki3L2C-a6@5*`2im
-(*[DV2+qbK+hbCXhV04"eQ&,8QUEk4IC#aThUKTGk3+MCR6Qb!@LrAmhJ3JQbIeq
-kV6YGfjYcp-$0lEP(M88-VZYljZHQrmLHRTd$H+m-jaQDqY+"MNNNq)#Jb!G`Q5Q
-eCfFSRa+DfXTYMZb%'[NE-aE4DMAbTN-UM-lMDYL#E@UbZ(BiiKVmY-+X4b`1LiY
-Yq1i8R!9U6#US'ZNMI$1IZ1lGNQ%+IKV*f9!bb&TeL'1Na(EZ2*UaHb9hbf"ELdG
-"a&"-+*lX*F@626k$NY8qjBAM$-+MU($Nr[1XSH,$cdH['5mELdJ+bR8'4BYX,PD
-d5$d8V3q[9lJV@"Dm-43,[4Uk&0SAI#K5crl')QDm-RdbZGj8q`LZLBF,3TDIa$J
-HUr(h08JUK1BiMla+bf$6lA!kqLAbrZ9,Nj4'DedTJd4I`e5rU(3mdLT0!bB#Ba)
-b-#%@5DlDUdiCQMH%T#'F840rQFG$!8`l#+DkFKqFdrLX4Q2HLm"SK$b3!2K%c)4
-VrZ)bjDGVIMqATX,M-"ep$Ehj8rhCad66`%1r'C)C#Hhk*(KY*C8P9r2aNXU%S6*
-3A&PG-TLV`NLNH(TFarZ@*'KmFRImUQ!!q'`!(J9A*[3fS0S!MZ#D(`E!(cLdRQe
-GD+9E0r3@a&6VXC3f8la%X)qfKQh()KTHDV$Y0-,@["DeAGbbDYhYf,*UI'Td0f(
-,k!'%QkJj@JTSLC8#66,NR0rTNcmHiT!!di#[d%294*8,Mr`J4J-'P*frl"L5[AP
-Lm989L(Kk%3p"A)QTA5B)(r%4eHje,lX9,Y(BfIP)L8%8%Dp!c')%-YE96$0@3c#
-B3k8l(%Q48j9L&m[,3phX`[rF9G9-lXMq%B3#CLNrMT&djh'$L+B`%Bfk$55-B4$
-$RA"#U%b-JGJPQCD($iV1C%S5+K"-mkA1FC[$Z+RB[HY)5X6-2MNlZeGEG1!jch-
-(MKTk3`JRid@&-bIe$b3LpY#MXH6UK2"30YJ[UHV$pGLSlFbK[BJU4PDE("#N40F
-a9ChG6b6"D3kjYUa(Ej'YiaM#jePhBref&+,QB9Xidf[#ePIM@R[Si)8T&!r5d$G
-[5XU-aA!a8`S5Cm8[T3d`2)ClC@CQGhC4)Dk3!&-dbDAZR-4TmcbqMm[QHBJaprD
-G0KKfFhTfh,6EU&h*IZ59#&2-X2[%%(XNi5)5dNdIB4h+)KMp,Gabq@EHa3@mc$b
-'Kd(,S(j!(h8)63dSRc3Nh!65bdUfiM'*#-[4l-Q-SKdP9(mXh2KK'l@D'L`Nr$A
-p'bCd('D"6'%(`(8'U')6Zk#[G@FJp)QS#e'[#ijQT"GdC`b25Y)I+KDj-pfC-!0
-Eq33pHNS$@YmE4`T06bLXIG&Qp-8E"4Y2'+G4N!$M6EffH"JrS@MeiENd[GM9+3B
-Q(m@)5A3j%TllI$hr3-F!`!Qmkh)[Yd"jc*FlZ6XUi00GPDM"*A`##[($L-N!!AP
-a$b-Q'i@TH!+%61,(bY4P08h*c%D!GqNVMFFD(C-Z2*!!kE-N&F-##9dp)mR$$)3
--BF-p0+6+j649,XGe5mJ0Qj5,"diIJ8!qmBp&21(EbLeRPa$#i!@%JE$D*5Xm`%K
-T96X*l'I4`-#"K4iSd+h'Bmd8I)-+'1E9G#K0M`[G$56c@l4!-SQm*RHrSGPT%(N
-C-NPiPRY9p1,mQA,HBrNlRP6KPVrVk"(",`$15EirQFjlZ!f[!Gk&ea5hi"APjZ6
-R009PiBfCQ4cL*+P+-N')aibR"U3bdbNeT"mAfbp(F`l-*r6YBS)f"N!aJAimASC
-AM0*p6+@I(qM(jR1%)C8K2IrLX+f['@TGP!h91%!mZ'(#C)3HY[H%mJ3i)CG"J2`
-8VYIB3,qRe85J1!)h$6kmRk!jm&ZUk'Z)EP*0KZEpDc-cf6m#2-5'm$`@Q#%ehiP
-CXfL-jK8E)h(BC!C"8633dJ#3!(f-MQZ)k9'4+f0V@1!G@cR$'Q*i914)3qkQ9*3
-*kU[CamaNZEkCe25&-hd'-hPhD62CQj)-V@C6XCN-cdLKJ,mAYfTQkG(*QD-C'HN
-(CQEqlf61C,Yi$AEP@E6dq'61I!1UP&j#L#iYfEh5*DTaMl@[J5e"BmViA2E4R++
-V,0NT,DREV@I[$'XiFeSi@l3[!6'iJ*I!B`XY,9SbiRfl&mr-j"E&RcX*lM2aM25
-P4c0QdTFZ!4-ZT4h4N!#SKCY&$54j@1hSEN"iQd`TACD`faffbfAFl9P[[5!IjRC
-2L(hX&$rb2%fU[8P"d+!Ek9&%%K82""XmVN@0"1DBHbQ1IhL"d$&b5V6mFN%m*UC
-UGbZD&4pjeXQYr#A2lANmfU4'FK15F+4TY44BhVR'S@fqaZ%,iZQbPcbVe!iehc!
-&'l4,HTNdRK+@2V2e3V6&@L15R-"3)K`9M468D#pHbUk53191D3'@lL`qCX[G,1e
-Vp64Z1acI(&9-NH)V5Laam&I$N!!r'0#&kGX-"E3Ic5d5%4lSUGe*SE))kd)J"S8
-bKZB1p#0`GX`3rQ9!1cCJd$N'ThQ,IT!!T9LjYFULEkY8I&UPiT+KJX3,28C[P`5
-a1*eM,2K%`Bq-8-'548(UHMA4NN-@NPM-BKFGkkHhmE"Ia&@3!$[RVK,#Y4'ipH@
-F1AG[I0["PK38ZaM*m&Q@8,ViZK0h8-"FU"Z0dB(qdJ'rhp"4X&5`UjF(UiDlXJB
-N"!f%eT6"Y46'[fj4I4e!CEqh`iZ+@IN(3Yi)rU8&`Lk55!$cpeUT#e2L!X31&B%
-pNIfFKBLdHq5(d[iapl+GKp'KUUL-S9)`j@HI5rQV"'k@L*HB9J1MfQLL%-P`f0c
-a9a5XfH8Q+pca'S4$QUFbl6GS$kYrHI0601,-8aHfEH(K!i*[)3mRLD`&,%85D1@
-Q0%D@aP6K58$X9NHk+"6`,2j9KYVjC+Q!482)!"'!X!'PN!!hDN`"(S`["FS'ie-
-SK1+Y30P'J$@8T+N@iM'1j6F-h'(M%AFr&N3mK0iK6`V"YiN!MJG[jQ&HKQDRQUa
-!U%+C*3FGT#aYdJe2SMX0&`D*3%8S&6UCN!##)FPPL)A(J'B)#MJBkPl#'pQRKVf
-k94-*FY,f`LKmBplDiAZLEM6cR80elj52&MkalhHfdCUkTh%@Fhp`b221k,lMhGZ
-2fcj%cF4M(efdeB`QE#eCSlFqAc[kj*rZrA$9RrpfejQ,&bmHH[r1dEZA2AVXZdh
-22*krr2FfZfhMSESpYUX2,EFe(+UcG66822hG,cHh2(@miBfIAYN+!!"(DN&%3e)
-$!(VJ%&80C&B"%$%elNAr[fh1-9FC-ZaLV2ibPQ84RhHKLEA%i*JLbl"UTU@'FQ#
-PX&QLXN-mAJmIElU"2'q!jP$#5HQjZId5QT1U9#A2HbKI5h)-d)45$YHN0!&+%mS
-K+D@%FJNPKSTlrrjq[cf[K[6fHcr2rrIc!"ZYTbJRJL!)J%!dcjH+4h8k[-6P,8i
-'d"qrJ-a9XX3A%@"*9MiG6"K')#U9T-H5N[qrSrK8*6e3YQRQpCN2TE65rT*pdNP
-T[mcX84KCHP-9P$&ec,!jZ&eApN%NBIKkqY&j)8R6&E0+@UKSp"Qq3"`r)5Jc6$-
-[J!8QJm0L9JDdi!)3b[@Fq8X89QD2G%LHM*2)H)kDKJ+4R$UKaU,-SPH[2RP#K%a
-RSE6TPBT&A,)(r*&L)!R9#0!*0RqR51iBQmV$T%`M)V`kjNrX0bCq2ceJ0IN$$Ja
-SPkk)d2aL%ESH5Z`20Yp4T$dCl&MJ+pb#aM%6KJhBRdNhA"Aal-TRjdPG,LaK@Dm
-Xkl&F4-Yk&bk'5-JeK+Ck93AcXPk%-'&$l3RGiQI5(4d[&c&*Rpf4kJ*6eH2kXH[
-(5R0T8-GCBR4NGUGmf+$8&8MbF@$CR,)emB(cdG5jpU[a4G!KYIZ3!&#YFiAkNmN
-N-kGY,$5TAQKU+ehD`NUAb3a4jNeQ`',`UC%ZI(lb"&M*PBH`U9i%TLeA$*AC8K*
-J-H4-@N044,JU+l10p5-G6(!Pd6TG3cE51+rS6TUGk0*VU)m$55ceBG"H'V6CFP#
-CP5RDQXCc3b)jq"p5ea2QbJaD(*U`U$AP"S#5`)EcJj9J!Bj0RJaXDKMLL3Q4DVq
-,YeKEH3LLbeN6,K$30p9@mVCk5Y,j3PM-$KbB!(UprrI"`@+l16JS'aRp68bSNR4
--chIK)XcJG3B"m"U*cDR'`HBd#h'UU%GBES@C[`KHHP`3a4`cLqh-IQdrS0@m&)T
-RI`eXE"2q1d5,5##I-LTFTVSIQ'+2MJLM"Y(pX6T%8iJ1a#4%@a(pBU`0d5&%Xf0
-f4*1)TXG#)d#3!*BAFi1+!dJ#$)kY)*3T8$GL649@QK,l`B$V!fUc5N2cAldH5TN
-1EI-XN!!ABeZC*CrkAi3QNZk"@PPY5)JIUVpQ'R3f$ATMa!VbQj3KSrpMQr$(($P
-A4A0-2kpB*'2qP-PSYcMJ!DNK%(FIdMU"SFeCIERa%3J4`SrAN!")IJmCIl#@pQI
-ZcG`,SDG0-bkf5qZIQkSVdk`2Aa&Y30hqXA'Kqp$-8Dd[XIml4BHfBD*m+EfV46P
-mN5AU#fkGI$55b@iU9[@"YUBk9Gpd4AdrZr,jF%TNTJIm6rDTHM3f8f2cLaUEd6K
-%M8-[DKb5kQ33F3Jl!8UX*9@RRJTBQcc1b4&jFSpkbRe&A4SQ%$0+k)&5dK"T4P%
-0&H6Uh$D"!R)S&MHK)C!!41'GCLJbaU9aR5lrHDF#!N$)a6ZcZV%j3i()iNKr4*L
-4H$0XNrbXmJ8,cQj-5LpV2h)j-NkE6N2Bp%4Ac[(&YNC#Zh)PIdBZ!PDcp(,*4kk
-EmQGXHG!cc5H&-*fDZ+[m'9XHFDT!dLa*#m"a'1SpRa,$lDcpLZJ5SFad-0HrBa5
-HLi`#15!qPJG1H#Hr""3H$L$mak$U2rK,%HVEaJL@Pl5q'Bh*+k*G*!**83b1LP$
-MED[Y(L%&((Jp"99[IVl(M[8$RCKJYNei+K$(kq%BG`0-UI%JL`LV8bUffT,dL2D
-BPCDZ#*8@ila)KdJmL![NjU3!BT8-pk(!b!QICH,2[dp%@@#4"rC0R$V-,,6`H@A
-LX(ZL'4-e9d5#96+VG)`D9Tk9Qb3d19CI-N0&fFB,`NF,4Lc%JfC[X4T2VXE&iX%
-NIi!NUM`j+0N@j-N1QXbN8[(TjmmRla-A96eHBfScAMI8)E`'e$Dm-Y8@1&E%eAB
-Jfhr%`P(e&&iPDMCH4PAlf(f3!'[1iG@MMZ-98irLG9deif95ac#T9ah&+k8fiP@
-RAX4J(5UVcRXSfDjH#S2TA+bkk2-qJpPPYRe@JqhXr#Ld44YrCr"H93hddF44Sa#
-PG$%qb%8(pDSAj3XSaie"4%JCc)DLamad`BKUaP+GXZ6#8ShDXjZhdJ[LDk"(e1d
-fUiFa9&E)D#S1'30QI"`2AHI0K3SFUd0#YfUh1940"l3(@SMd53a4'#SdaRIRL9#
-S%*m&SIZ#`IcF*mfKBCPS3!MC!B10G$(e&#H-2*ak6KQZ98NF([!qp5rbJ1TIm2N
-Vp4NH-,miG2e*XhVmb4l2*3`cl"R"+qUTCe@J$9%-+Q,j8*k!X[T2VLVGp-CD,UV
-P`&D'E+KSF6PH38$8hAY`K@lcc2!B)jbiaQ-8b9E6QCK9,YErA0c)4ASmZ"!0ISM
-#CESF"&[pKLV4$,(k(HUmCNc%4(X9a1TY!20GmV#eKh8VQ,NC&lVPVl!DH`Q,iEM
-+aJM%EmN2iAhjr*1hp*,RCLl%Tq9j+Jrf53L(V0$0JE2$LXMqPlH+U,6ri(B4V8[
-qilj8adB8RIKTaK$,CjmmM!kCqc,hMDdH,M2ei3Sek$C(fQqrqGri&iL2!)fdKde
-A4%FJ16DH$lHBGMf"MKqLUa8r$[cBmF20caY&I#Z+jVD!#`Lb$F&8`m(81SmrJ6b
-UG)ZD")+i"U,m&4'rP*r[E4*"$6*SH[`d3h&!L0Lk#m%jqXTpb-V2Fpe(5%'b$9E
-0Rrm6Jme'Xi3-l$`HP+ljCebc9qi'0XULi6Jj#2c*1N[i!5)G3*EhLD3DabX1P)Q
-A#!(Jp"5BQp8@[)BSU,G48'p"8"r@[81!e#RmcN**&P[!mTdD'+m&F1PH#qVQca,
-4Q0k**)eKG(b0N!""LT!!34f"G+0k,[2)m52"jSfqf6lM964%U6P&c5MJGR0J+m'
-V9ReQ0hA!UdRpbpqZUL@ke`0K1E'$cIPl*A2I0Y@)j'V8[6kMN5DmLFmkYH45Flj
-hI4%e[CR[6CPaf$i6J$b@-X9M83dF[Ja&mh-,`jbK*[!--AKf3,d*N!##bP%$Y`G
-ffPQH$`E0G"1#4NPkS*QATD3d!!E1p"Q0r*NbV*qkFCmbH"5$G`Epmh`(*JhXRqF
-F'!(B3iKb6e#0fZG!G0jpA*8S'bcYIMqTiM0+Re(q0$UNJD`MMf9LLKb*PKal*PI
-UZ!N!32"1Q+kUd3"BeCSk9FS[9K0BM,b#4Gem@ScL3p*9)C1*#AIk8JFhHY(3U*Z
-2T8CGeCfqpHr1hSG*RET"kY#*)&BFlEK@TAXRGI"0hbd'TN8SC*ImIS@ZZ0U!,#1
-"(UEiD+$"QdaDE(rp&k5'"c%3N8%#'9T0ZF16L1"jc8N%"T!!)J!)6d"3AqiBHVN
-)!D`YJaf[CY0V'lp#0i`LY(HL%133X53ki9UKB@H4adPUc`A4,KjSQA5SfANS5'Q
-r@D9Em50d"[*BT&ZZ*)"G'ZMEUY0*rKQ0'8G5!bDV%`eir0M1e&J,&BY3f3BFFZ&
-bk5+jcb`haS-*MM#DQ8I"$+KVN6%qXKkAQcS+F30"1m6&2GJ6LcKS1kl0`bFAj-j
-J'TTCV`E6C-%"BN0Bf5b+p)$L&!+a+&3[G[HS0FL%lifDqRkU0V,$$[qRJ'#PaD2
-14EUd8,@fD`Ze&i%V%6,L&D(LU5C8`-%UG*@$9HJq,Y4#eAJp(#S-ei@ZSSX9BY2
-&[QfK5b`@cfK%4M[d3XNJYM2j#HKEQIK"2a2&R36U1j`%4Mde,1*'%(bEjfb3!!B
-@a5mim%dD@,)0,%dD1+B-,%dD@-,!fKF0'kGKEp#JcEC"QbF01U3-f[cL33RTKi%
-)&J9BX'kM4,9Rjc5rSl$'5Kq%Ha54Iic%J5M3!mMQZC5rP`Yh+YCETEV3X,0S0MC
-E6P'2-cU*X)-U3$T@!%fV'V-#PI@5i`f+(rjiZBL"!NMhmaD"BQ`k&pQ'UfSF)Z2
-dIL#eTJC%2iHJhmDCDJDk&DGi+&bb,@E0DG4p(QMHM5PU,aIY$SM1((#%lPDF&*`
-k-)LR3eaZjq#`Z`ICAKb!M(1MEMU'XX0Y$4RR@,+T26[RrV55G,N)9iVYB9f1%[4
-k0"i,eYpQCMT`0RDL'!&Q!aAa)0C`i"`,"*,Ti2E3*D$E&Bc#3i@"CJ8T$(dG'39
-M'k1+S)")G49*a!iMbrP$2Yj*@!6ajFaNX5AUH4$qH+$%HB"UG"kJrZ@&$P",h!H
-S*Fi$e10!X0V*"d`J3BmP!CbX#Cf,K5``ZXJaJef1S*!!YMBfL[#)$ZbDZUD1IRp
-62$YRfCD83@T!3L%6+@GBqqlNl'Td!fGA,d**$PDPm+"!%md[&kA-Z$K[32m04TF
-KS*)jF%BQB5Bd$kcb5`GPaF[PB"!AITZZH&EUb$q$cleS2#H$I1K)82ep85b2!3N
-rFqb0%%PZ"X+)D""a)2)8)NP%(YEGK)!Ac$r'))KK0[-(XeEaXa8,ldQpm`I&UGY
-q$23H#2kQJAmi`c1XZ`CRL!mYXcD)3%AEF"SE$MGe01RPKHA*-8(C(+XLjYUEp-a
-qATSc*SkR[bK3#h@c#aPVS+Ihr[L&Ekl$)-mJD#E!3'PRXN)Xl4`6#*,2%2Jc3k8
-9"Hmf@a'm!m@RK-L'VkIhqp%p+lYbHCUQ5bj1XD8M!2`Mc"a0'CK40GD9P4ic)dJ
-FZA@$Zi!eTH*5LI`cc2"EAMc@&BXU3aeT@SfP(@0GcSNBLSF["VZf,aDM)YS91%q
-&U-[bU-K21LUbeU1X,hJ8YSlYqC!!)*Ri'F#2!6mpB+0ST2h-f+h0d'@#5GQ!$R2
-"S$5!DGJQ$9"6PQi!6ADPUBF)fmJ4h3"q$2M*C$)hkEZBZ8!J[1*H!Z!)LY6p-qZ
-B!BR"kSMX9P,rlm1("2%0#LcT#!VN"TTk3CPk!D54%#4DJ9am("L!D29bm#"%&QE
-'K59UN9PPV&6!pDc-D'fU%pHGV!Yi3QB"*CST)h1C!%Z+fEQ*PeEdC+CE-Vk)iF"
-S#U`aCRB!4GM%IJ3aU$28b%J3VqL)KJIBHY3NQ)9*D$dTLjahq5)!8FP[#D3"!bq
-SF21-M4&+RiM'GAaYlLlLr3+XaABN+G`lp6X-4AIjH-2'T0aX-AJ5`X'3!#cHbB*
-GLIG1heeH4BKLT(!82pRi-4S[6EV1J@$L,Kp[i*G[d`Dd9&30%-+pbL,cA6lMd8Q
-G'NY1'ZXQ,EB%*8be6PVf"j[[mNNH5lBXXiJZMUYMdXZ*Ki4$SfBF*,CD@)l'&Pe
-`#FG%KK,)EcIkY4pTpeVA"**K4m$rQMq`c1%`q)C#"ZmeXdD0Z0P8(Hj13+X1Z@2
-'XB!pM-j@G*iA#QbPcQZFRHZF,+BCl'3lS[YkHZFmrIP`&cc&i3J1e$L$+LA!cBL
-3!2Y'4"r!mTaJFSEaKJJNqcXH[NG[00EeX`#!!Ja*0Q2`L5lrQR[dja%),CB4025
-$,@0GFL1$VY-&9eINc(J6iT@chY1i1pKY`lTTM)L1XQ)!bdE4-Fr@9)5QdU0Je(G
-mBPRdN!"JALbid#VMc,3IQ@P@ANNHbMjAkBU3!)&Ze"AG2-R&'Lki2$[RlP,1f%3
--FYBQCTHCm8HlF+!"KIPdh3UjN!!lbYQL-I[#M*HcRN+"F6-eF&QeIqA5`#rq8qM
-4e'V,@MBc%qj*bNa#b25c%N#Y`dmMILi#a)B8CC!!`pJ5E%29J#5pl%Bl1MQFRb4
-Q$5PCDcm(r)lcA#5`LN1IQ6S"4qq&iehXc-m**QH!daiG%h,bfIYd1Q66K,T6lL#
-GH1X,XG"P11YecfB(picEj3'ZFN%$9@KBiI%T%)d3-jeS-0*eUec+H+`!`Da9bRJ
-b%a8H#V#CF&!r$pNK,"8)[HJ-1ZEjUQmJ%pQU-1EM"fTXM2N%rMIMIaXbbmeJ4iC
-%Uj%M(BM%j3AAMi'DJ1Lf$i&&fASmh4KfA3@MjDVJ5"YqV2KTK@+K%dlXhhhKCN5
-L8%)akNKNjfbVEKVri[lErbC[N6H)BU31'd`jYbGeiF#SP!%4,m%S4%4R02)4SSj
-jMkkV+PFD'AGGqRqq-B&-#3`L#DiiTEU('J#JiCm9c,%)$i,Z+I`NL0#r+ZqE-!5
-Mmai-)9N1JDi*lXTG2L[rYqS*AGUi!*J`1F@664d"2j,c(r[MhE-KkR`j08$XRqX
-!&iHKm&dlJmcAlM@C[`(@4&KFGZ6j'Ab-VCS1lD'f(`S"*UkQN!"CZGqkTEL`6a9
-3%5Dj8JJ3dJCm)-q'SCJPBm9J"5CcCMS!rp'a+q)!-R3()PI%H63H`*(AqEM31r`
-CI&pQed#!AJ''qA8Xj)*CFjfB03LD6QC0D1Y4,SUL%&jf,N$(32)SC369,ED!T%9
-@,)1#8KB&TH1#@DmP##,A1BKmHm#`hHK-%%j@*5KHj1#)M'('*8H4&f`m)bUef,(
-Cmaamq!I%hSaU&''jS5KYBN2!(US6Ia8U-fq-RG*!jK&h!*(C%`Jd!b@mh"PXIV"
-Bf1N`#CR3FB9pN9!L+96MXjIiN!$YDD5L,!(KZK'I&qNc439EJJZf[cZ(B6CeSp)
-p!KF*L%-$ik-%JPNRll!m,(N("X224@+4CJ5B$Gc+J!qP9hchqjU%YNm'IUl+m+D
-[F1X0I'J2MA9SqU6NK'XhD`kPNV`S$`LPP2ekr#Lc4"+SeL3MUaC'9L4mq&RG)LH
-cbUkbECDCTahj*HNb'PH%Y'Q+N!!'GJT8YP#"Dmk!9I8RYhK6GXSThSaX)L%J#mL
-c&cqZEl"#I4c$)8JDKXY1FA%"NE!1Pi!J4!+3!#`)fG&mcP)3H[U5,!K092NCIQY
-RaaZUH0&hrl[9l$!lDT8k-Sj"3F2-4hm#1K9(1"Tkba[b8L@3!)GEK1&G+E6$*eF
-+H4fZlh+(@2jSlX!p$Se&3DFj+PIkDiBkTq8ITZF*8fk-eGe#ABj0X-Mc(QrK4KH
-8,k`JI`p0-d#BS8"b(NMmFk(QTP#"C["rrEJA49D4C[b$bZrf`UfTL*80d[LYcb3
-*PCLQIe!Ch8X+lE0"4a'62NmD(bQFd(JdU&,6Q$4qk4H&PNd*Ce9!&*26Epk-qh3
-k!AaP2iEUPH*@21GNG5M9dH54(5@iS,c4*HQcS(Jc(3U%GTk8p0L5ZX"A[FQdKjQ
-LVA#PL*P5IQFAGU`)k*hUlSPG%*AF8q8T'&STN!"[S%!@#dha3$0PNUB"I$S(rjA
-F+4iL*[TKG`CFk&(mDm(!d-"pD2QmNpIpb*)Ul)dE8"df066*iXN+&*V*f8"B'')
-*)dM6SCJIb6*e`N'5FY#&IjKZG+!c!rJ3-Q1EUFSMXUPVR`iQ-$+!b&3MF49JIdm
-'GNd(9!p1YX"'Td-3XXEXmZAijVSrIZ'Sji($$r4G9V0clXN#m+(S0[80Yb,Vbq!
-J3LJiXh1qDSE)0a6G@j+1!N$r0khZ!FH3!-)LdBFEG3q%r1*RaTE*MJ0K-,*iNY@
-RD6F8!F`fj[ZiJNFMR0([rPG0(lXVSR!CSUTSC9h)2(leA!X(&VfT!mT5IibVG6C
-`"N+h1$YRdpb8S55G&jb*#U"p@l,(p-`DfI6P#$IE*c3E-9!E"LpYDN"P!$J@2-e
-94j&jTFUJ%0EBKDNTcUL%,V%,cXSF1,E,RH"%-"-C-DJHG&[Kd)),L5heF2l3HH%
-HC!!ClVNX)#lZS-il))BZ)9E328"'GQB&X3["2-T5a+6,DMd)HbX-"m`G8Up$BaE
-cKjMBfMhDRRPpKAc)$N*F1l#C-*Jq(B&B[8MX4q@p*HLS-3h&%KU`caQ"A[0*kX&
-Y3S9)%CV4D#d64IMaDIZbHL#-Bm!&2F2jP(cR0Af4*$28[q56%a"CJN`+'$h5rUL
-*'8jJcc&+CA'q$5T&1GP6YSk'54he8Ur5%8i-b%3QQ4hhT3*1'(bJD2l5F6KIj(a
-ee`4f&$QLJ4AMH&YmFpfBripIS))h$8%"&HBf2F#98#'3!+HCHSCEkjf!PmQ!Yh'
-U"H!GC@6CiR"d++"R4e5)Rh'@cYJj'IKiQDGa*cL-)LRUQ)'b9HUiQbSC)D1H&Q$
-J@1Ek-5VZ)31im3&d5Q2`Bb$6p$!"0KV@!R3,0$d5CAqLqfFdML#46$fhc*`i05,
-$a`P8TllTUdiKkeN8Nq`NjXA#5$"@LDY5r1Da$#M%A5dC2GSq5V#qHAh$43bkFJ@
-@p9[@!XSZU2f8J,$q09ElmB,&K'JE0[(bP-#BIEJG&B)#M36#pRj')'!S2(hp"JH
-XjPJE#+dMSXc9q9l*imP`'L4bJ"&`-YBkZD2*6"e4*FbB583cb9@FQ8"0$4C"Tef
-ThL`((R4qGRCG9k!9JrC5FMZ2pGU1IAZ8JCZ6q`!kPfERE0Ji#Ga-82UBf2N3!(H
-8!&92J(U6UR"beiLQ*d@JZZ(,NcVE+BP-NSH"&@#&bN@-+$E-CH,+J,YK[KY`0hc
-#J2ZP'ShI8Kb!baa91VXX8)3@UqmVKHJ3#4mSh"m`M4,c$-TC2p$+NY49pAf!5c1
-5[80NACHAGf'TMUH,R6`)-RiYF#**2QP3hjH6F,4,'5$RXTUR`LQ&R8`d+@B@&+6
-UK0&i3#BdL4LHb3,',iG'C8C,,`XQQ(#9"R$)9iYTZ!-%e#``B$i'Uk"aU9&@*%,
-%4JBelChmUU9IZFYRkSR&&a5$PEJ383P((9FZ%SB!I0c8!G%e6*[BK-$BM'*),q'
-JQ4FJhVl24,0EZ,YeMXU13C`G6#MC4a409i5VkBVSD@TJmCBckCaeK%"afTCaR-i
-&HBXYkrKbqX%#"'[IB"F08c%+!5$@D1r4Q314$eSL"VFTJ4HB2M$c#@c(LS,6JDV
-Mel#"bZG((c&`)PKQDYc1HVU&cL5hc2cHk#,"c`@bp)$j0Lim&YGIJ#*J*YcT2hh
-PUR$TLS(8jYGH&6fkD4!#&JCAcM#kXm@R+)2%fe-UaPYF1R8#B-+&,E%q8I6E'TY
-ULjCdcb*3YD*"6TC)+bFJ-Z[GPA)f(*QS1'r)b0[kjX4,@9a)2m2Bhm&EYNp`6b5
-'(LG[[XQ-`-0UX0j8lC6U51f8i"AYP1SV8*0-#FUL"4"$MVKS-Km(5&cT3f22P#"
--E441UBDbl8B`K+be(JejD2#aii10+EqXbF0$+&-GF[8$&YhAa-$m@!CA69CAP6N
-(@l@#83RrB%S2@#Z,&`"a!+KEkB+G*J6`30Z9`LRP8h,aUTqbp`U'Q9+1`q[GeEV
-"X1++D+`q(XMmb''G(kCUe2'hrR4lF9#0R(#c0CN)lJZZ#L)V!*)iTNZe8mVIZSC
-Ar9[&3QEhSQ&9*V%eL4b16rPD0VEQ0KU-K63f,E#Cf6$%D&59T6)j%TU2b$Ej`l-
--bE10#`Ji9U'+El"M4Q-rh-18,PrQ!1iqJ+[#-ZX0`FbU6#PJTh!jqd%,Xj9$"L`
-119+2bUL(F"#'Dc%k(%2cIkJ4R'QIbQ*)(fA*89$12hClPmAK8BIrH,UlbU[XIKG
-'"JaJi'09[f!A,$m8hDUNIY$*JRH!&9e$8C1Xb14Ahh*b[V6,(@Bd'ZVp("LCjCa
-N&6pFjr5-KTrSBD4eCApP&X6DVJQ1cieFD8b`1bP3@DZ0J3RP@&DJQC+&QTlS2-k
-1TPN6%aD-J`)q-,'ASd#P3pQ9%-5d6q8&$Pd!TjLMIrf[@4p"b%CdGXkQ0'60%(9
-Fc"S49Pc+iFkkb8",e@D5%ipK!Cf(IRi[!fG*qUdNS4b),j,*PRc%KQ53!)3kbMi
-1FJ6l8eQ4eIFHQFVUrALGq1hHkhiYR%DNMYrZPE)H[#Qc53,edQ(Y'BeIfa20@Re
-6K1dp`K`lIPR8#lMD&#@b1-ZBiLcMaG%@GYC#SP`FID)mI(IhD4mY2rkl[6i[9qk
-!5rh&F$MAPcTGXNplU+3(KM`FYppK4UH8"6B+-dcXp8![#RYQVi8J0pqCJC!!Y,@
-CZK9iJ4%""9krT+eah2[a1PpYVfiq+Lb0kYkXYQ[L-0XabX+U88mIpIb"bK*F'I!
-e",-M(*!!dPB!C5l+%`J!#j!!)5KP!5bPC9,3GRjSfmi2,EEc3pYfiYM1$hNlB!+
-95UG,UR5PU+UbU+3AefM@,EVp'MDf30,+'e-ICA8BLjfCk4%Y+B,58N*ke*k8Xp6
-NS&(fZ#pF%KQ5HL60H(,(AXZQ'R@0,ra-hC!!G)JEA@D$@@jHibXiecJN(HCPYp%
-',2m&PdNV`B'iMPqAGRZ2"6(KMVmUc!8P""Gl1Hb@4-$UA$hI8')30d,D3iCImfG
-*5BNB$fAe'YlMci+5!R%dG1U`iA2qV#q"le+S"+jb-"Z#KDNP8l&`cNaCV6+B"K+
-VjbG,`PJm,Lq@@LkHPaFAZaFcAABS"JU&EX6eX!6%(9kQA(8ZNMh-ef53!'pdT'!
-QSLk#6#4-U%LHAPr4fDKRcV(6[YVRG&[[r&(FHmI96qSIm%VYpBp[(ibdrrA)AYq
-'Nj)I%ip&rA01BZ+[3)c51lZ&2qlGr[R[6fhb5[&,eTf$dALjR4-iGI#1D9)$1Tb
--0Xc*T3j*h64d5-Dp#5RiTBeHU50[eGE"QSlb0AGA(I&YfLI&-6dAdmr5G,XZ(p2
-YFHqlEfaHFCGAmPc@EaZXmj5hh9fjalF4#YPHAl5Kb"[Y8$SiG*[3`4(hrMP[9F8
-'Vq3IHIcH`C6rVr[1qZik0Q',-*DPfil*eVMhm*RhkZji9fTiflTLX,%"9krif2I
-!5DQG0YUZE$5-DNIG)Kch$QTk9p0'9p&'ebJErGbfd628S99AK!kYFHr5hRp3DD0
-kfQLEa8E2f$BUkGCKZK6hrXShH`0[P%MZ)C+ICC,60[h+p)4Z!kBRiYjp2FpAF!)
-4dGYPSU1#IpPkaC!!!'dB%BAi%GdZG)c%[6VGApkL,DqL,DqK,A1RGL*rqaam8*F
-Dh6*dUBPl2cTqacZmE8U!Z*)!CcJ"LYJ33iHbEBeZ,MTSiYllEUk*VM8"cYJ5i&(
-G9%aq&#5DrFq[rPfj-Qd&%ANcNB2VTdMfAP5b39,BPD3Be@e"ap'ipp0rkrZBYVq
-+YZp-LR@F&)f#%b0KRh1D1ShVGU$6H0clmQ[*TpD5(!hBYTh*LiT%TA([SXiR$e!
-b2-(*m%Xj'H+8B,NdDA(F@f4qhEcqAFPqk6FihPkqNSq2([cl0!@%9bV$,BYl8qI
-228IN(L*b0a1j2k*NKD1he&k8kr1b%d$Fpp-&RaG[mS(-GL+c95(c5L,F5LBFKY`
-Hppl9j2Kh)Zm660jIbZ59!GE$5B&TZq,H8)meiqr[5L[TLL[P+a**1`K8lFU!1q,
-H$4rFkb95$K%TQjA0V1-NBbF[D@A45EVNTVM[YhrrfY502T!!d%iNY")*2q*NSZh
-BLml5e!eahe1rqkpl@D%jJB`V#5KA+S6F%[G1q9llAC-*5BM$!K9JDRlFZrJl2cM
-$'b*#VP3)Z8m1(KD%A"Ih(6TR[AmYK'a3!TfmmDPaErFrrE6Mri+3!02LhV+rIVH
-8%j!!VYKJ5fSR)Cd*8a6h"Qk&eM-KmiC!(#DN6"b23Tbi3XDjFGrhk`Ef-"RVl5!
-1Nr%VFP"r!e2ImXV*V&[b,4FK[9C'HMrp2MB"emAriB['DFUkZ2I-2brb8K,[TL4
-Z8)MhDkRK$lkSRkB"!![rrep%1I"b-GFB0aaf(5E#Y8FEA[G&1fJD%Q,ThD0f)XC
-+*NEjEqkH"A+FN6cr![,5*!5-6plCeX2"Tlk9Vre6T8$i[5rD6P-faEhl(rMrZSP
-BZiPB$ECJX4)App!d%'V4(rBEQ9"mTCTf3kqVP`J9MkjmhAPa!2!lrc)h5!4B58M
-r0dkNEb-5NM$brllp(PflPDrp8`A4r-&*T+eallB2(PP#B,1E`+E"LGjrlp`m3'[
-,AcA(R#5+aJd(A3ITfTp,+rr&H@d%HIrH[h83mPK*S2mE*ARPDmXNf"$hVYq5rbe
-#(N`Ncdq26%VBZA([[9rkjYd8h(C6F'Y`&j@fa%@Jl*U49mSATf4E15RCC#)"1+G
-pjG4Y3X`V#G4ri`Cehc(P8L$#iSHL285Q&LE6r6C!pje8L)"%kD[6rC'5VSf56Qq
-*,U,fd`M)Ve1eq,K[eX),2hi!!Hl5'YV!UJRSBL@QfQRUpVL[l0@Chb*Nd8!Nfqe
-'&VkcES,FrXXc8iKN,8bbqff)`THVN!!$5I5[pRAA#%fd%CV3@k+*D!-1pG1KZk"
-kq1[Lrq2[48M`0C6JUpaS`RI'$FV(F[rp35*F!a&ZpeS)K`"fDr$Yp*p)1#48@Xf
-p1bB6cSNHL"`bi4E(IGp9qka-Z,`eK"j@ZG'$M4`!kHcNQJmSN!!e%'VBVD!'5i)
-JS$fImICT#K`Y($MZPj&$R+j[#rK[h&Mq')235"ZZ[a*AQd8Em&YX!#"8GmHGIf"
-5%-(L#X&1m[9"-)m6V(pjpZmrBP*38[U9T$ccTCYI(46qH`C&mSj"BBHJ@6V*35-
-j)S+V)2)2EII1!HY@fiI-3G&6AVp`Y&aD9H4pb[HSd2ECqb#XEUJAPe&r"1+ebJj
-Xc)5pY1UDldl[h4mGZRr+ZZqmDp3c`jFqLU69ZrCH@[@Shc!R&FSmIHld0#m2R0$
-8L,[hj2S5Th&S`jdRjrKUe+LQ9Hck+1%jIRUD6jRJrGfHBpHLRP1i8U-bS9brjD4
-lJX(PF['86%b*((31SE8B)KMqAI'aI`cfAeT9[K*G[G(92rhSp2`D-FHAm&jDPI"
-Ni8T43r6KDZ&Xq0e(*kpKHM00Khe@C`-M'fj+H(JEdBIAfCT`52I*DeR(N!#ekd%
-@%H*mfLk,6!Ha8q3-V'L4@5YUA'%Ei%2XYA3K8M,XMbYC)&3(NRcZ"DS3G01pJ#T
-"&TrHfHk2Ek[M'UAMcFPAN!$@Z,08ML*TM6[EaCr1$"Sq(RF[IeXGP#-G2MGMSiY
-C+P$(6PQA@TfR4MhPAEZkjjbYm@`kHm3,&`6rC6AUap+a1[r'BhZmEd2pZRd[JPX
-V"cITmEGbJre&Z3I[Rck3!0,B4E!rkYrad4cI`IZR$TbGhbULIYG"`d&HH%pC+!p
-M-#a-Si9)4r6aeh0jJ#pJ`A+!2ddDi(0P3HlqDlPl[+DMc[rlBpV$pX18LBY*(6[
-h4M[+Z`MT[5[&m4QR$qr!28Qh-jpG8VBFH4NZ(ElSKYIAh9jL`4DE0%&DEcP"9im
-+Um6-B$0e!+*k-%DQeqDT&`i&G+@eH4r0qUqr%N12`+ZX%kB65RmcV(Y@U(JY%5'
-m[LBmH*8*2ej,43GHD5+1PdkdMl!$YGiB5Hb(%i(GB@9PceXYVPB+r-PU[mNDf`D
-'+"Zm5Sf!BB'&,A"Rc&FZ%Ld"fkT9BG(S&V%C3kl55&8E&9BIe(hk*Mm8T@G0T"i
-*k,[B#2*&X2MK`+!C5JQSrC0FC4fUb)Y`R`M*3!-Q4TVG,"UK*US6cEbS#KM!8bE
-Sf$922!EPlqKF%F*")6TNQ!BI"AX8lV"fGL4,LcP-YE1@J)Nm2`-40!bLi3Nd*&h
-b!S`$`9X198B4JEYNl*cl`%"f8(`36E&ck4*ff@NDccT8NSA0,qPH+X(&3EI%lB+
-8kV+IP"h18l,$H8EIrE1qaUU4*rTQ,@&h8'-0MZM5TGe+f'Z&EYD5kfeDA!%"%kq
-$pmpDXUD+e@R'1*1YHfS6Xd(p"YQeH*'KX$LVqr[dLVLdVLb&L(jANlLS'(-X"j[
-d90SL`h"Df@!jXr%'2i-LLUX*LINiiRUR&P'U0X5-),&QV[K[B@Zq[G2Tj)%"PZ$
-(iXM"$rM9K'Y"TG#YU5dqC5M+m[@MXReaLD(S'iJ1[ST,LX&F0RQ*b"%SqXd2&Q*
-L2C6k"fL3!"RiH'S35LKFlc1kEK`JXa9%C5EZXX&b9(&1T%i`ST39-Ghl1)%-pHa
-+#V0Bl5"bHF,3K'h"G9SQ$60jYl*KJHl[bi[pV'kZIH-k,E*a1E!bhbKJ)RErL!X
-`*CP$51ClQH5%!,P+NS#lQ,ll*&MpADai'ra-RXE+K*H,%LG55Q"-@qaNj,I99[a
-F*MAm`!XVZETeK"aCh+lVTk&1rC!!'dd4pG@!#a1qVLK9aq3Z--%k`P&8GDR[@j'
-f'#cEiE6&['3S8"GQjrafUNbZS*V*UPNY0lQ(LE9#8@0RiS6BGIVbmA4P1T4RS45
-j-B#B-BGNJMZ)F'l6#$-"hlYQU&r*UJ%fE**RmN(*B69jf26!pc,GJkJlPF9a9Zd
-`b"#c'3$$9BfTHqA6[FlVbX0p68Y1D5Pj@qT#2KVZTBd!a15NU4'B3R*[p4e@LF5
-QIRZ%ZAFqZDijH'N0!S,kDMdEc+JMBUJb-E$3BL0qf),iGLG4M@aIr0XQUGMbNdJ
-kCRD6G'QG*8NI5l-Bj+DbZ1f&51S'*6BkmpX@HG1LALC+%jXk9Z8ZE'cjYqF)TEB
-&1QN`6%CeUBA"1%b9@j,'BGZ@DVNYa`3M%aC''k4*4KXm-+U"J"l32#1lZ3iC8iT
-D*SN"V`%ifmB`aER)KRerqaUaQ#f-rX))dVKpSqD`P2bJ%fBbcV&LX@Nmml2EjDa
-qkjkCkNS0)#Me*6*(e)c$K5"@F"@c@%'b*$Z!ErFCrBk@PiZBU98$pDA$`dU90S&
-U6j%ARMTEY%ec6M@1f6[%UTmdIB2Pp+5Mii6JTBc$e8*AIQ@J-LJ0!+J2i[VP(!f
-G4V6qT6c48*PhKBe9kbVITSCVD$M08FrI%6h,d3iVSRX`q3H9(r2N"PhP6@T)S'%
-K4q1h%Ch0dIC2%AdINjXVCr,NeEV+'G5`!!fIFM6j2+,&(0@2)PT&PhK6ZF4Ve'"
-!`cb10Rb%k&b1fUFM@N56TbQ6hl1XFL!jfH5UX9R,&3)GDpi#,!JY9caIFc(%,S@
-hlV98D%C)b%eZ"i)h`)QUYM+9AEQSe&6Eh5HVkef&9DH-@6#%N6,PhKT)qEQ!e#N
-&T%jha939Zp*AG49ANUSZ[94B1EhU[+Zb5JXe9@ePh&"Be3ZecM)HLJ2$bKk6J00
-[r$Y6CTmFIUfrYZS8&M@m''"c+0-R'%b"Xfa8-DDF8&4iNNYb4+h)S+pjbj[bXK(
-QD)e!eM6kN!"!YZb4Je!&V8QXrJpI!L,S@kHMB*c$THjd3,pcMcM0f-%BfVN(,[h
-qe)R)LFQQ*"4K[h'YbUTQ9P1Y68R&4'`2mb@KT(*F&Z@#"H1XI6b-Dp!IadrSNSM
-ZMhSP9HZl!)-2NTV&ND5NRZ+)A9*,11+3!04c(,&+kR'1K#8B$%@NYHqR3XVdfVf
--U!VRjI&JDj!!Q)q@L(c[&PrS0)XTdGGVa#2H'U%pPR1'(FT,2Y+HYCqP,RI+cL3
-#CRE#1pbAAX@%*9$KLbGUr+&)M6m1"pDpaNEYDARB1Q6(0K`,83@m'Xf!H1SBIXl
-@3*M22mY'0$RVp[VM8R[''6K@6Rr)j3mpe112`lebQI-JJ%+4'`84+Lm3jmJ!rcN
-iiU'C2V*0(0AcK#X&`PK9a)R49)[11H)'&a0341Z-N45@H$Y0%E@C*b2##RlTLVQ
-U+*-VpqXi+RRF+)YG9&1b)A'ldB(*"SL4cm*JK!k)r%1q`KZjJIL#bPPlURGqRBS
-b0L*#kPbUDR9AjDb2P@PF`4rSj8IiJ&+8PE#eP9$XVQXKYam(AG(P(N4@IV0T%Na
-bjCr-6#Fc9Rj8hj)(Y$ETPB+"TdJmF'Ek4"-m6M&P4-#9iC6PPYQS#JRN1ES@Q8!
-`H($GA3%YiM6()V&*PiPGb8M*M,[-9-MRS(SP9eAM!4*`E4lM3Y3XBL&YhiZlST!
-!f$2CT0'BA'N`b5iHX6T6BGA8J!-"HbSIdhMk*A29HmI6X6`03DLfq&ZSQXNLA[[
-J)kE+#Q[!#QF4N!!5(Gk6#LZXf6IKS"A5H2Va`!+&%#4J#X'19-,Hr4ZTbqllV2a
-kM-dpp5X"&pXT4dHr"J[S1N6Gp(4"L+@TB6NM3mIhdPA-R'&jcKFEj5`#98&'*31
-HJ%68`q@q(D*`C2+5+i"V6ZYq'qK`'Ll[#,!61JkJ`P,HJ%2H3&"dQGR&)AA#+Fj
-$pBk,"P)34r9`%1ZNDh!P%KL0%AVh`'cDUU,"f3d9B@3(DqXcr'J(pqE2Q@SV'J,
-MMYUUE9c-'AaM`S8P)Ldl6La4K1VP%+LjUNpKeEEZmkLFUEGpRZ#(466C#*LfaG'
-&5cG54U644RU(E2kHYmMGA)pBZ0UhQ@UVTJGS!$41arEYf6H0c8j%+Lr3-%PX4DY
-N+C-)M(CkN!$$32TK)R#5$IYX[bdEq&RfLhl4260aJMI3l8KTB4iL"$G1')NJ4di
-X3i!D-K3p'N(eQcN,I3ZpF2(HbrpAl-dr[G1(c1B-GK0V+'D6A4!3Y1j2lSj("cJ
--lk+l&Gfp#hd4VFD+!e#%m!'6K`068BXKClk%kS"9dr#+9Nfp![1I&9Dm)K81UMM
-Si1eMbkJX%hN!!F6[!Q%i14$CPTe6Ck4Y3LaPTm[Z%`S*je`j8@&(TXCRX6K9FBl
-R"lKmdMqqr6D5DbBQPH-R$i!L%+PQ!9#dGfpVUUf`@hD@HQ")[PMUJe'qVa"J`E8
-+9aU!N!$j#DlPSX'8!c"3%"01pBm[q`8qkM'N"d0kQMMMG6`ljj(TbK"'$+((%+I
-B,GIpU!'JGFlD"4!!@mQP2facklF9SfPfQp-*)9aNMTr&Xi&b)#Z,!%bb!%6`!!`
-#q-Ij0HYCRM+KfQ5p1Q#DT`i%HUJb4*`B$(&L-+5`B&@bpLhmZ#@&lGE)Mab4Xph
-)'$6r4kQD'BJRY"#Fjdj%V,)j1MbDSl+LjABGVP@$)28F9qH4'bl9jRZ[Q#YDM-h
-1TH-qAR!qYU6*Bc&%jqd#)+2aVrd,1h3bD3D0E9fa835"'hJXbQ8T%iiI)E"i#N3
-F!!`h6KK#5DX1Fi9m4-ZUQq%H(pGYVd8(hEB4&5)YCkAaS*XI`(e``J8k,4beC!0
-X-R&K(XcS!MZ(Lp)Ef6N2A3BbpXAm$Sqa4Y2AK-!lD`Q+(Me(E*Pb"U4MR*&3b1m
-jRZiF2Qd(Zb8k$I@Rj)S43e34Xf95!FHZ6H3k$aFcVQJDIY'%&RN#3'NZ'@!DNee
-)Ki)`F9GEN@#"D[PmVZU*+VJ`[X*9j$P6Y#D,hCMpD93T*%)6MV)"-XX#L60S6L-
-86jJV%Xk-BQcL8(SD#NDcGjq&fB'0,0M'U0)b3"kX)+ifL#c-,bk9JdJ464HC#Id
-bLD36"R,-SB'UL4"#T1%+F*-fe(-QmrQT2#bb[Th1J4%`3dK'L0*24j9"mIJKUXC
-DrC+jZ2I+eG$eL[0i'5[10HPG!@UkVer)KJANL1HN%MQQ0&3MmS8L',TUiU,0`aA
-)2EZ#CPj#%1d-a+pFpEaGFBl"!Jl3$3M1+CMRFU%!jNhEUI)RVV4m)kSke"DEjPm
-0&34UD(V+kCkXJ-CT621"H)Zi+j`Aic+B0(A`CYRjGr8"5R#KYY%!H(5C6"!kDQe
-ND*A*X,4(*S0k6LD$UQ8bU0P-"JBCDRa'hV$k&i8!Tj9)VY*`$Sm%)e%(6erjRTX
-BS3fS@'0*M-X9j`"UmkKDXpkC9("RR8#Jhd54PHk`5-5e%!S'lAiLS4bE*a)+alU
-)&#)d5S'd4EPNjI,CR+9Q8T6Gb',f4KN(J8A,6%*fji@CrdpK(+%B&@5QXAZXdc'
-@6%-dJQ'aN!#c!dj6+L'J%YeF)+m,Z2LML$`CD)5cEKe9FANR%%AKme`JQQ`%GT`
-ED!N0TqQJ$KaqD`I8NIakaaLA&a'd,Z+R%3PehX6QXb4%"b)'*0imr,b'kl1$H`Q
-pQ$PNa6'GLPQb0VVF8H9b@Fl,e9j9fh5Em'V4lH!XHShi1L0`cebBSq-(HQAR*0J
-ic5Dj'NFLM)mGQHQmFDIc,4d`&ML+E@3'kRLEXF3V2@NlD[[5GS+9G#mMNUHZSLL
--i"1$228q#q)33Tc%rN5Z(K0S`e$Y-+M3l!4-E1046CGLCU%HE1%)1HC(')@`ZC1
-EJh!H&l+!rkH`,1$(-X%SMJ4-Q(i85H3L*QN0M[Nb+S-LdkL,N!"CJ[fkSr`"Plm
-"F[k2+!B+-V'eipKD66!b`dM6,mJ)%5bQfR9IP0dbXh2XMb,BlFe#%,XVFk*Ce#i
-*U(J)9G9DBDLb%kLCX`C4b81&hl*!%J*+Z0J-!D5`f1`UV%LjDSX$3A[4bCLG*S%
-(J1$kk%Z(+dZF#kJfG"L,#CPpTViU#j2MJLXJ1Bf+)G'5L'3bJph8Jm)'CJ6!DN&
-Pr$DZdQaM"hCjd*b8$CK!Q#0$+BE-IQBSe9DFGaB+)-B4"KqMDI*J2+8V!VCLJIS
-2rh1$8F"-iV%R3!%rk*@CA&6PZH2!Q+h+-l,Cq0r)2bmGUNJK@2Ib`kf!3&BKfqM
-i8@A&HFdK+FN4ia"0FAib@k,%iS%`'jd9"YN`-*+JHB5I10,eFcqFNEZiDK-A@Ce
-E+"V[4b@+PL)#S#&8#rN3lUFEYIYXdkUdI94!ie%MA%!65h"MIHGXm`frTJ2U@6'
-%`2%QLVPErVrK`5mdB3H!D!HBrSf`S06SA06kH,P[@9,Ji@-dc)a'HjrRYr6BVKT
-HH,#4(JMS[&30A8U2ajZ8%q-H`DG6#L,SZb[!,68i9F`X"M5b5r'N!MKPcZ1-4i)
-GQ-(J,A#b8Q'+T5ZYJ-eISM),SR)4d3%63'N&-"daJS3U8j!!,3bN4)!S'%dX06L
-4h0+YPJKZk@)RLS33N!"Ne,Cd8FcfF+qP[f5d&d19U+@r("%@8jZ9c$!J24!D8Ir
-@Yr49L&C$6Q5eG+(c%,j@8cZC%)m5)eBId-YS(-@pPP"'1dm#QB*)TXDaVS2B,0a
-[C84pH#+LCY5qb%K-,Z'h(X4Q*L0Y%kiDL01eie5Gp"dX[4VJb3YIK%32@e4&i+(
-MmY#H(!9j`5c1dM*'AN[,eSDmTKeAN!"APJN6!pQZUV3KS0!f4PjT3N&H&b9dCq3
-PEbaYL"GU-p-N4Q",bf3%PTDS2CbQ`43K)c"dZF!XiMqA+eH+!"3H[S(#H6+V)L9
-)c(q5`B!UUUFCl8j'$$kA6@$#h$Z"#92`!NbB!TN*dqKaXf&b&[*'Q8L,GmTA#Rf
-iGQC-cS,m-cqC'C1c8'E'6'D!T!M!RKF6*KI3B$Ra6db(L04Xj06-TJAGc*K'*c1
-Q-H-3YP91CTYc@VK+!a4mZL"!M%h!I(`%JBN$&#X$)"TXYTp4M!J9Q2B&f$aXh#R
-UXY,,"S)!60fd9r+!c#D!iG-EC8+S(c1!SKTT+B-6M0K[UKeHDT!!#q@88LJ[X"A
-+V6IGKA*VVP`SVa@-NGb"Z"L')Bqj,`c!,`Cf5h"qHP5qSYL+kMc49hU@IP*lH1Q
-R$)B)S-9"-eGpB)E'dNmJTZ9"D9eC%3Q-Fi%2mPP[#&5l2B5+!q(aMZGkiCLI[+A
-2l&[3@lM%#1E9JN1&5q5TMpHld*("Nif$9G3%fR$8!)l+aS3D$$q!53H3!%QqRR&
-S![K9bq!ReFlk'#EjUMRCj16#ihG+h3NChJj!33@`d2$%"&dqcb*")b3'LU9@#`F
-62&+L9@([-81+c3Q+c8L3!"(mA-+R&K(T"+XJMcb(5Tm!L5*Qfq"aM8m-YQQk4PM
-e95A"30YEpeIF3%,2`)CZ$(lQC'V*5Npqk+*G2k+5X1QcQ&iZ6`ISlU'KVNGB*8q
-XAME`aTAqlAl4#%@VAcb"$Mf+1VZfJS*6plrcJchKlV"#YhMQ5e%I0lJ#hImZSdi
-D%L`k9!+MUMhG06HkZ%L,S0*R$&@IZD(l&6C($k&UXD+UJENVCY,)&a4EQ&N&K4[
--pX8Z)X%rV5dFR-lCj-(0p*Lb-QA`lGe2ZJVI'-"2YJ'4`5!QDieC33mk`X4jbc!
-UG1PPCjl"IkD(U*BUjQq@G9GVZZ#DS'G6995j'Bd3l3Z8CEZmCDG)rhJCYMA1C*,
-S-C%C#0"3,Z3')Ucb4T8e[RLV6&Bd`15k1`RdHcN*('aib&Be5-NJ*a@QLF2#Y8,
-*e))PCl8a!p1)f6VZfHjNRr9lq-'mJBZ+DYeMS9L[IF-S+mYC'3j'VN@(iqQacCD
-X%'3qDb[k%6"Z)1Y3@@(')kZ4P0eI4k!amfDkVBMHN!#hL1T+5@6Ip95*$Jb[aiF
-X"ZS!`f2X+B#c@)M(Nbj-4-6lVhPMc9'$p*!!Q!QcDl-"hYGHJr%,RZJD&*p`*'U
-i8#!@L[IaQLeQ`J$6l0I39&KJ'K3,Ecf+LK-,*94JeLf$m0S@$Hh`$Sb(fD$'Vk@
-1(Ei"FeJe$N9$cX@"3eL!US89*H,AYq,4FCU+Baiq++DcmQ8J!XY8#`IbNY3"Mr(
-qT+jV,4ZBrErM"RJL'1$*"`[%cE8XAV2B+#p99KL3!0b'@d!j2%fUV6!m1#K[r8e
-%U[eiX2PXfZ,r0X3!S"VUZLC92'X'@f#Hfh`A+b8jJ2*3Bq0UeiF&iQ-8j0Abp0@
-Gh'#2`(Kl0BZ[8,dMLZaRHS#0fAQiQDHl!NhMTj1k(B2r`C@4i6USiV'q!a#U#YG
-P$aiClH*L4*l+,M6cBC!!i--H)a%V)b+U*cF2hmXGRB[C16[(-m'+Xc!KCVXb*Jc
-)9aeLak!N$a!(UL,#Q-A(NlU`HJp0A'a$D'Z8'IQ61TNXJ38DRYNf96p3-4l'$+D
-N+5+'Bif%$(B$D*!!0F0($bVP%V+$S`eH%1GGcJIZGJR,*LjLN!!%1D&,F*q%QCN
-3-i&2@D#D3KR41ihF%5U5k*%!k)kY'S#-rFFTDkTFHKe%,MiJLJ3q4G%,,bB@e)c
-V!X035Rq[1!X[II%T[&c&*AJp@(`1489@X99fLP*)ZePHF,T(8H#"Le4qJCL13kH
-#AA9+FB!UI10FXI8PZ%89Rf-e[,2"D(VKibBlAp(5GpGbL$cCpJ!$0KS&JX@GMRP
-3SGC@$-"N8j,0[pUBd$#8FMXQId+a-##6!BH2dR81&TI`85m9L+R&Ti)0I"`I05B
-@B#R3q(#IQ#SCL'$XPVLNq(&jLr*9E-5-8k29cB,'d(qcf'kYlCL2P@em&pYp#1j
-VVcU"Gc"hBN)KD'9JB%S-pcDG3pZ'8iCr+8ppb$NdN5k#`&Yd5Cr[lHI#p#(E3G@
-6$m)!+bfZ'VCGe@4a9D[&95AR%1`+fEU@kmT$fSC4KX89`jCA()f)Di@2M[Q"CQl
-Hm*J1&8D8l2iLcZiVQc"CE-*+$RL,"R-Y$2%YN9d3+"296`MAiBU)!Ia8idGk')+
-r-0$V'P!aA)N"5MF048#*#fPj1L0Sr-c%crX2Xj%h%ldqaUY"6!@l+@%[e1RH')K
-P!KL08)I9&PpRG4KABNZl3e*Y+M([6Yp,jMHbh5Se6$d2G9TYm3&@TehUhZ)Gb)Z
-%f0MF&Yp,VMF'D'!Y@,%3c0l)I!N[*!-%0B$K0r*"*S"K#3H!Z&PpL%'5!cp%[f)
-@0`$)286bLr6`G8`RpF8MpX*f8Abmd"rXB*@K%(Sm6*p%)$b+[IJ3ZYd`DVlp,Yf
-VZBZ-l14NPP',M&CNe%4%MiM"Kr-q(a@EkC92T,f6Ji5-TRi`im9S5N&'HV"6Me-
-``L#a8B$+$`NB$a0kf-6!SrkYq0`cK03)5C!!J%82EF+V1`YA0"XCkF+!4IF*"83
-(1BYK(dDfTG8jZ&0dFekB46JBV$X$`,)2lV&9U5kch#l8dK$T#,LHBp9PaA1-mR'
-!ScXb%6%lf9kF34SRpY[c'r#6$hDM!3kHceiTV"bU$2(V+fPJ-Ni(ff`61`kj#VZ
-cm,2C9GPGMCpl,9P[!5MKrm*'e'ZqcLqi%SIH6S(&Cbm8rXS50RXV'd1TmdJG(h4
-bpAH!arXlMm(SPIKCDI8f21kRZ@kF2pK3#c)3[NK(cXPESBM(80Mp$Y5CC*E9Xrc
-3rGh[C1l*h%0rqN$1,Q(5$TIf`e$8VRQ8!69qQ)[(-C83Zc`3D!fLQPY!V`%,&Bp
-ff'Z%Z0p%CUShc-e-ChHQr[BQ-[[S4aEjReiM"kFFIa@cq%`RCC&r#!6jaVXpkX[
-[`Q!k(Xm08c!`IU%@`AQBcFr-B`HURj8@*ZA,'d0e(Q@B!VTi"bjH@iQVHNBr2#C
-2jZ%,Na'P!fq`FKdkM+*$$ffdYK)!i8PqQ)Y,5DCMh!(#AC&ckpKb@ApYpfBd6e-
-bhCr3TK1dk8jXqTLbk3lDG!HaN!"`L6[HXffl3lR@GP-ZNr+@%F2h@!`2GXJra@M
-ihNQ$[jLJG1%lV[,JPHZ)T2)@MR"'Q6*")QfM6"D29YkZa`4`[`c!23I!+i%bEKJ
-JIJU#'9LDKX*RMIL"@F4R-r&6!S-kbmCB!)&lfCqAmd36f)f"FB#ISGF-C'1!@l`
-[9Q1TJ$Ebi`6e%p3lCpd+8[cT!*A2ld#aEbJf@4J*+f8$$mj(c`1"R4mQeb)94e@
-N$%Aj@'*Q0-$96L3!H)-)K)Kq9XV9c"2lS&!S8pK3-DRfM9`8jkA9afX,hmM9P8e
-d55)(G4K5$PLKi&d2P3%BF,pE(04ajPj-Rq6FP-19IF'i+(h`'KX&iJ0Za@RBdJR
-$PV)4KZ8l4TfXX#42C`CBBKp(q5(`,l!C(("c,dbU)C)5Id5cY2r"+A!SFd6h`T`
-J'fB['ak#!CVe-%N,TXR[@!'UJbD,JF01@AJ%`Zr%)-jK)dpIcmjj(Sq*i)S)EN-
-@Z#JB&Pp*JkQP`Up!*+`F!M$Jd84TCiQaD5HR+cY2deC@mL19('jA959K&2Ae!NS
-F[UE4l1,AME@5@#m6)hDjLIimKH@ER@3&XcVf)ED%am'@Z9Q@Eq31cb-`Y`,-6mE
-mNXHB*1*im[HQK'Z@X(q2(r89KPR1'[c"'p)MI5)"0""5K[$r%5mB4YV)*&Kq!!a
-Hqd3#N!$c'KadlKNJjdb2l+aViCcT4h@2+0a4NYd2A1RVhXP1Q0hES!TbG0r&b!6
-Ahci'SM+Sh$-p+ph#JB$%#QI`94kH"@(cRNr`Cf#FX(c%'KX"TZ0YcX+6,R!aCH+
-(ejJbKX['kS3$TMlajhJJ)bdpbCY2`+#X*'SHimHFKBQ"ZPfj%"5JPSpK3f%8MV8
-3H&L*U-f+5`Q%`lr$aDf*KfJKKXL3!)diE2jGjBj3$dehGdLEaJA6#,(cQrU%l$K
-"(EN5[,!M!h`Uk!")DqA((GS%kE,EB4PYr*pc'@dS)V8@4YUQGaA1HPCKb#59S-q
-QQrL26E"c)"jE$C2NT8a@ed)jb&@F[f@%@mGjADQaa!PZrD[GJ)DJR1c[%aS%efX
-b`#dll`Bi01ETeU1jR%&dE&#Ba`#QcQ$0bUR[&$fid-BB9e"(iBHF9D@!V9pl`+B
-J1339@c-(bkqqeYmM,J+&0-X6+XirZ"",'X[++%)!a*UlmepL30Z#$hhh#K6U'`q
-LH'&fXc-*AccY*3K+,jlBj#'$L8PbS4XIrXrUDM,BaApbaRMbbF'fX5k0aa*8&51
-M-&P*ACJ&kZGT-6)kT+YL%*pS-06CbA3YPJcb3cApcZbTK8(e0q9!J-5ELjqLi$L
-!B4UL8cNjMH@Ni*fV')qm-IL[8*8Bl5L4HV5k,E&6pUS[(Zc,d'f)$C!!DpmS6Am
-68lp(8b2bJM,%(p$`#M8i)!cm!HE&V`9$-"AQ0qS61"k2)#S5I-%fq9"-(qAT8-r
-PDFDA$Ni-N!$XAXb%#aEmiZG`4hK%-pj45q4S5@5!4&CESjiD9CQJPN'Yb30RjL6
-F%2RaM@&E"blqZ)[J,NEPXBX+XI,*&$NEF+6+1JKLSfc)$K%09p*""%Ti9L#N59f
-b%q)@I,a2D,U0rY3GHHPkQ*9c3p)2kZTAqZP22XP(%UEBp#bZmGN`CrfhX(XBrDN
-X#MM%HVNj0Rcp%Plr'H4U39[Ck*,m4jPSaKZX0%f5VlCd(3-%1iM+3-8",KJD[$$
-'$cD!)@dZQ#"FcQCQmmb(H1KI92rU-rjXFY$LNe4"BjIYq"JPbq+Qm9VmNj[L$QS
-DN!#*X23F(AP8RXL%B'5*C(6)c&RAMcAM2rL0R%JbQCC'U)YG*Yl5&[kN`q[iBE"
-!"[Q-)Y1bT)jh[`rh(EjbR#CFN!!(+0XZGbhE)9qKE)1mqE*mMBI98*Cr5SR6'*4
-Xq"G+-N,L6pr3f*bNCE1r6E*4V'ECqIPTXmB@")0LJRN`UZBB(A!UHC6r0qe@dAA
-,(iBD2$,K%D)c,eJmD*-HB!!`M6-#J"VhBk1,R9[PLRGeRS'mc!jN)([VHf(f!+B
-cCbCNShp!PHbJh"EX(HK!bD*pX+J[Rak#d)Y(A%eJUj1MF(+#!I"HYm,&,Dc95ki
--cQ$+4JV&Qf0c#@ca"mJ`#adUXm9XDSR*2"L8rc`A2$4kXDk8rc`BrZ0Ji,kh1"r
-'VH%J@SE(0m2809GdI#Dpq+(%#@c`2!&$+4P6LR,L$"E$DADFd4F!i`I&0IKX9$j
-AdDH%aa%AL$BT%fKHiLCAJ"YL)9I'JTlUd+L(#99mKBH2c5!MJSUBX(360T*0lY9
-I$(!5hi5,CFKi(LVH69bG#B!%BiG,0c(c5Ef#T'hM6fl1c[Q[I$JIJT9*"RUh)AK
-[a3r-Uk9YiJIPik18Jcb8GTYQRQIJFB(44jp1*)Sr&N0)*K&VBaG)F[CDe[h2$VM
-l`I&'",BTdeB319B%G8h-j[J@)cFH2"MLiPFQ&8r!cr019!QRKHIGaTpD"8bi*A(
-dBSM1GV&VjR2mm)$35Ilc@b)HHXJ$2j!!+Lj1XKh6MDKF2b%)S$LJLP%&iRd3f*(
-94dU8Pl-'qYQTI#BPf4!TBcK"m+MNj3[iMqHC@+L3!0&8IrIrJ%"`(GPN+-cjeH3
-BI)kb%6ph6Kc-4%DD2SA&2`!!-BP"4%05!`"B)Jp9$@C'%4!KiqjKrffrPUVdjZq
-k[VQHj['jVUYkUVCk3I0%GP)h"Zc+!VeZ*V1cb*r(e[+3!)lVQlQ&%-)9lHHA(A$
-+M)K1McJA$K0VN[%mkf3HYa"Hcm*kK("k!b1%j9Q(dB#"*YdNlh`c(Z[[hprrph8
-G),ql*1mP,cm!&AGH*2-J-L)5)I%!%5)'AhPG*Q-ar-LqCJ'NQ"c!*L')CV-(JC2
--S[20R!1c&,&8JZr0qr1q#52iqmk#M2G`pECDKMbLd51Y3amCHVZK48lF$KFUBV(
-IrB)9$i+jGMADr*`4l'rh@haI,j*'%1&V@$'3!$VG3"D&JAKK))8c#+3,I1N**R'
-qR0U+J,#d[d@@iSMNQ$KF4Yka2ZGiShr!2`#`r@&r($qAeDh0F5L,bQK3@RaM-0(
-+iVm'I"EQ!l&N"+cJFTK`k@35*Qc#G2I$E""9ifAHl#RqDeZ%Lf9SP9)$-MJpFG4
-(,I%a,MkL'[&(2c,M3"SY[YDM,QA4,b@h!L#Z%jG$)#S[5Y8d3Vr[c#R(PeXFh5Q
-'2B1c&p9G9m3$fZml-mS$RIS$fR6*8CIT%CIaF6+LbT-UD*qdb*i0(EjQGF,3E#f
-b'F&d-d$N%%((G3LakR`CBrj4Qm0[*)ZeU58Cp6rXD9CVUILMYU@lYJ%jEKQh`A#
-VM&"r&`##-#p$%1HMj5%5b%2'aX&Z,k$'M)!D@DbS3(m(PYUc23a'$(r+"[qKa90
-L"&8#+92@`D@PLaQ&*2"5K(&fK("@jrR#mUhGNd&1A5$mrLahGlrP#DHa(%U`eCP
-AHiaN@cY!iqA+)aH94k*B'YKlIc6Bhf@%("E!ZZGZKp5GMhkNDJAYqIZ65@@"Ab`
-iZmY)#PLI$,5'$C6$b%*1DM"$ZkfpXGehK8d@#85Y+,,VLqj)JfA"Cq5NfAD#LLN
-Rl@dR#[RK(!F6fFLNa$59Q#E&G(+j#d$#C!#AjV$$bU$*'!cfcqq6UVYPj#X)%Ph
--b2#+dp1Ke1PBc*FdU,!",Cj!+UX($1R$aXEGV*TU[$PThAQLX14G[Y0L,"'`a[#
-@YY-#k+6ZSVbX!9+bmX8rDe&65br&k[aCP`6jk9l@[9$VeTUk@9K)h@MH1)SSE)K
-ZjX8Q8XjV-J`$#MLkHD'CP5J(a36hXrM53F25SiX,ZFVd!K-&a"[%e%V6ZQf`IPD
-*Na&-cF4d3N`RT9jBkej8#UXUKf,k,+Y2*X0G*(Mab-1+i+@m6SANB`(jl+1Kh9r
--aU(ZjI!m&m2V&R8E95,U8dG$[-%XNKld`+IL!EIjqc9)K*!!`,E0meDDcQfhB01
-Y,&iBAVH4cjNH,eq'J2'EFcNC&U$JP#CPf`RHQ(rH*`Vc)G@Ib8R$Nc45E4dXEM8
-Ni%)Zq%PF[!q9j1+H00'P@A@'HBT8%J6h$!`(B"+JPFd(8%&[QSP@!CBmZY$[FT8
-b+2+p*a)&A[8R+QCdKXSVA-a+SI+(-9'S(VdU&a19GSmZ[p%#SmIPTUkj!P)E,!4
-[B#U#BYLN#,N5e@r&%DKq)DpLF5(r5kZq2+hLP0EibNkPkS[T%,@H''#Bja9@&#J
-+L*+KjpS-EAIQ6TqINkC3[6[R!Z-Il@kRi)HCSAXC*"b8`+I+@%)+512ZiZr`D(i
-NfX3"@2Lk9f2QbENd&pm@j1,bRr2B,dAHHpL6Z46&6m@P)(jFkV@V+*KR0Nk'5+e
-!A,'[BG2fM&4lMhe9I9TjYI,B9j8VP&I'XDqqkPCHK@KVMcVZT$TiLlj`!`+TIj%
-aVk%09F1N["J+Xh0K#i2)jQ6TZ+faBlUdS1fqEd`"k,*Yl5cFbldEUaTl0eETld,
-eEk8TQ`mJ0*Mb+r1,%1(`4KBZ+h-#M(-%(Jq`@[@-U%9A@@MDC)$)%SXcKDVHj@d
-AT2VD`9k[Hd9jR6rBkkpZ8PjlMhN0#(EcJ[)b41c'SmaBT&IH&)Nq4m&9'*9Q9iZ
-dcc`,!U)F6N)SCh)jb)j`NSi)R`'f!da-%2U"M`pKNQ9@1@9EBT!!hK1@lG"UH)N
-*k,d4e&0iJqi5P-jb&9c'ZqJ!p`&6S@-B8hhMNq&*1mMeZl,e9-2A(aFE5$K,V!$
-K0'(5GQ&k@+`94G'GFc$CCFBmZY'+l,Z5`hmE+K(QbL#%"R`PV3SK-625h`&J--S
-GbV#S5+M3Y"drjUr[389SEb%p2r@hBDX5r0NTF9h$56ERf8(#Zl3jZTi$qkA0N3m
-aUIV$!55eB!k4-hmii,26X9BkYY9SGdZmm+'6e3"3V6A1piiM`,B[b%K@U$L4CK+
-Gc'U1GiJ8"5H!(11r2A"EQ0Tra5&HmDSi!(-U,GE)`0Ld9T+CMC2*hBAaqG5cJKN
-kSU3HAQE'Z[,rhNHaXD,Sl[8L"$(-(q0cUN9bVV*b)66h8UaD(FF(NcrF$Xe9aYD
-TLhT4c"Dd&MBBFAKaFQpp+,pGcYR!S&C(mm&B+&q1@e8RZQ"PQKKHjb+f'-ZE10c
-JJVB3X59@+G)UraIr,r)rq#pkc(p"j6m0r`A`Rhj3eS)8NL@icl"XK[29`rK$d%+
-0`SSN@&!BY-D'r!q(&%1ZqBG$"cAN(CcDC82q,b`k'ENah+SNkHT51(blR+lJb3p
-M#p[qi4!HZ$L-BqBLUABTbq@d`C1rM5eB3jCB,#1,NmrAYl@(X-$*AD'ZGiU04PS
-!F@NA)kU,Em15EU2U6%UB#Gm'`Ci!0&GZ0E@3!'V4T()E8+fTPVq'TFAU&V5,)69
-j-FTTJYLk@&e&!#a-L!,DqmD!k)Cb1j[G)cCf([%iUA1YT-lPSXlPSmjeQ6UAP"G
-!lKV"f2mEEa1klIreRcI18rKG9d1TdIrI,j9d-bZ2['PDm+Ki*0&G[1+44cMerX,
-GKYJPP,@dlDQYUL4AN!$*j6#-C230p&K1V)DjXa0Kif+CS!)aUA$LDV0m!r'B9#G
-i%Q(&MdP8&Mk6&["`%YDdYmL2fB%MHLmN'B+`JQa`JT*[K[R&8N6L@$im5BG(eDJ
-M,Pl4NNMaah[Aqj*f!QELH1dP"@kH3rV81TMb*6)44M#AZT6kfF0PIrQp*8lU8J@
-1fISA,XGL-USLmIL&2#BKGi3RFqr+k#)+F-1!akZNi`%qI"GK,C,jH-P-cTCcR+,
-qEPk'`1kC2Jll+SpJbVH#J0"fhQFfiia%3"Q-[FpN,m[TS$qmaD$a#K5+hBJ6l,%
--,T`J2M&Ei5Dl8RK5R*4MYdjm2)$$rq#6d@SiX2`"j-aJmJD5CJH"5[*aUScZ"DR
-E-4PmrMk!'CYalaQ&4IJR*Z)6Ba+ZR4X"rMmFaa&F&)!mpf`M*RFU%TEfXGJMA+"
-YjiSLT-6,1-$#NAr!RrHcpP3Hi48cY15d`Xi`fi)rQf'"1#aAj6-K*E41$BHL5iY
-#8-[hVLH(`I98i+08i0I)H1$S4ae-bVh8h@5NP6SI!!J!$HkX[IL2'TG!(ReCHfq
-qZ0Uf"),H0S1$'3+m'(heFm5JhMIZI4IKq,#G`6N!H@&M"Kqd43BbFMKNJJlaCZf
-1I((%FV"$USBF8MAd%&QLEd5qQ,k4iXL3!%2UKKa5Gm`KDr50b"[T'bQ1$MQNGXJ
-KY8-18BIYJk39,r*`[G,i%"D*CfE4`XRQh@Yhh!H-Q5($K0[,H`K&h&(m4&8$KUI
-"3+a$6DIb1Ged@'3f)E+*[HXpeTQPJYc5[[@qmpl65l(UB6Yq+[[cLjE8'"X`3ZV
-hB$SPF#+p#G-SChG2r0Q(2kX"#qlMp"FcNE&pB0m1FCJ%X'81kQSIM'Sl6(NIEVE
-rQ*0NF+p%Z&X2pQ%C`ZE9"VTVE-AZ0h[206%FD&16U9ZX`(cj-a*`h`Sea`UNPd1
-92FbXpBf$A*8a#HZGiXlHGakIlHi8ZB1@B$-V0Z$SD9QjApRk034r4R(HGXlh'Lk
-qST&IpqVGJ3q(+ep8la$8$F#!V84akpe!J4ZLU3'P-b5(JrZ@8(3DG3)%eepYjNk
-!)Qkp5JR6c3dM$`Bl(,Uq*4d'%UPiVJ)!Vj1AC@'UllacbZ9AHh'jebG$KG$cpmR
-8V`pfjiN*lXiC#G$J*T6#IbFi$Kd!4IMCli+d!VDeim9*Aj)!V*0[R8DDpM354&h
-'I'2A`MIi*6VD'"DG3"%diFD,`MVKD-mJ13`JE"[IASbmqU8l1$)lR*@[EKSHcX[
-'*@3N#(Thq9I''HChRFr1El2-GF2-p`"X1&'BFTh(cB(&#KNE"@bL0KF#cprRMFe
-PXh,$`+bf'"`$40+!bbj-k#rplUcdE69#+2"kF8R3e`&fEmTXh,d*K,U%#68"q18
--'[-$Z(PaG+0D83KFL4cqNNK))%N(pm4#J$l8m3FSjM#$(lM-$Ha!FS+"LXPLb[l
-ZKUi&Qe,!0Gcpi"$&&kLK4eTL,dVTk&U'V8l,@(C3C0AEG6L@PIAhmY9P4I+YHp8
-PSm'ai'8j-eCG4H69,!lDB-69YIK6``'@FIk4%XN+IF!lIZ5`0''L,K)3a!f$,QF
-bd+HEYQl%CAcMBM-[JASIJ1LQ2,-J,SB("KmVAhUTZY*Y'Mrmihe`9iE*FC!!Jr!
-[LFlR%N&FV"bJ!-1UV6RT+I!#GN9hrDREp'lRC8B)")%A@i@EC&9Uj!&-FBU&`q4
-KDj0)ID,DCk[h6!DHNC-%SLkrcNB)V'5XHLqE0UTC,N**``A!`'SIUbjMBM)9b@X
-!K,3YRHMm!iScfrMhcXE1ar*JlFIK3JQMpYJ*CSVi1#4-ZH2'Fl`j*!6(P8"DK$8
-1)L!M4$Km4%EF4$`Z%ZQi8Vb4#-S0K*rR2-A&(q1RU$K*(lZ+Pr0(eFe&APd&9[#
-R8PEAUBmR2N6T`dMLJdBITK)I`[5K)[%K3KpbB`%e!j0ZU5j4ME'!1mSL9jXaMG!
-dP@-'l(GL'DVYVbjcG*X`%Pm48VaP"3H)r10'B%XRM-lekrY5+XTd"aGq`A6RbC3
-Y&1l1IpJa'@5QVkeM8U*T!94`fdQ!T2&6$8r0XTV059qc%HIdYT1C`adrCPHDl8I
-HJ"VY)MADI&RUc!EFDm+m%BpFYiNf*'8Y40(+bY'6T'hr$ETbZ3M4K9!Kl$)@pT6
--DflV#iNe6@`$*,Ca%YY8'M[G5f,V)l(G*E%9Np!F*,5l*$5940DV1K,#1T83dd"
-#3#X6SXNQK&+!8,b+8(S53M%63JN*S6LTQceUJ`0lTK$SEpp`#ijphCj@JiV)Zh(
-,Aajr+GClr*ZQE(VM5$f+BGjTmAIj*P+hf"Pf@Kcc0rJNj9TMSm2#h4i0G,3V8R4
-PYC5KFe,H&lJ6#3J0US(CaE#MBm@Yfbp5S"1T,VNpS8!ZJ#Lq8Z0kJ#1X!2dd*R,
-#T4X11A"EBjAcI#F$d0ML@(A0kA1fFjD@kPUR*@U*eFCLZ+Pc@N"ZmMUji5fT9P)
-CmB0erk(!0,N3Nd-B+c8+$Za`JUpM*hM[GQDA&-8A4RGMiBk4F--NeKRe-KcPN9S
-JKh9b@Z!+[A3UFe@"i%D-m`cZ*"j)#8C%GLU3!&h&83m!`T)ha@[P%1[",[,bI[d
-LR[Khm*Q+c[lVXl%U9"r%%+!U&l'G!DfA,Di("!!*J2#h"!HQT9C-)XIFjIa)5AL
-'[mhL5,Pdq"A-!!N,%02N[0J`B#[qD$9k6c89VUV4SSF)CKX%c$L)3P-M0$%T*HM
--Y$%mpLA*F@dT"4dAkA@4(Lc&4K6BeS!b9Y2K+Ib-b8ba"5a-d565`a[AiY,E6M9
-mIX6e!!T!DVZJ8Zjb9kBIUmFe&P6R#KZhh0FCjS+*p'0f&JNN6ZJ#$"j`YPq-I0,
-0,LKbQq(bCb*VI0(q#ijED*!!j&c92[dc%IJM`BB2D1lc%-#a46KA26ccYVMiBhd
-`69l-DQ!%651Zb99'dM1""b$!aeDkf%9rBHCYU,`4Q(8a2KESifdm-KTT`BGQqM#
-,iKRPK*U2652$bkYYh"eL)hIfbiHS3Fp$I3riTF'(C@6TUBCAcr,PBb0XkVajcaL
-1cFLH8`f,0[(+Hdhf'2q%"j!!DX*2mYGRC8ifibFV%Icam6rJQq32q!8H3JI62pZ
-P$cpKHGB2SrG0*$DBF2'2IH[1rXJDN!"YG[3EF5H*E+qQQ`QkfCIKQqE[L`ILp2&
-!J@p+(k'25b9b&6kfd32&p!#Vra%LqpYj5QaZ16hJS`IfL)@4&X%Li)9AX,ad8k#
-E'Z@K$a9RSa(h6G&)LQl1dJhJrQLBa&SUQ*E'pJ8l'CXT)))q'!K5bNiXX[P0c`!
-BLYA-"U0ipKRaiRcE15C!"S$cf)'f#lLaRfVB[edK4M+bcl!c('[B35EHcc"4H[r
-(&m!@Ii[%Zjb2`jmf((Q0(3d4,Uc&iKjDl)ET,m1&Yq2#cX*mY*h""3D1!!lBH4+
-9RT3!*J63J)I,+4QdKiiZ1p9`Z*6"A[6L,P)Ga9ae0*l`XY+k2F[`,iU-(CIf'Di
-X1`I9C#dJa0IJJ,6$(9G8T+Kk+cHU-ZcS0#[J"2&q8mH4*JiJP)SGGHQ508-Z28#
-'Jc5pCq@9b&@0&aLQY)"b544DBU&`JGjFK-A01IQpJGJb1Z#h2Jdh+P)1!"PLbcb
-pbUBQ5#(B!H+X10,%5FMBDLGA+IlM*UT8r%UNT2j`2EE+$mCj%YZ$4qU84kV%4iK
-E6%a&0CLiP&bhAe`F8eidiKp&edSK16$+AH[TY528YC5ZRS*3&lKl2Repj!&ZEJp
-fpDH[d+GCdG'I[JRfmPQK0TjqEH3"%e485[@%LCcq9Qe@@"@UR,r**mMX6P*S59*
-%-&GX2m4++-dj+bZDeic[ELBhIb5k*SU-CHfc`d`b'lYmSk2ajlSDfUHM0pS,J5h
-h1Cb#!SL$Q!@Hlq3JllXS#0RTq%##('MAdKScQ)UEp!3h@10N!eLR#VI4B*QGbma
-[lbib9Z$BepZCf&-3NC'Gl,6ZXiTQCm3NXFX+8Y6Nk'%4$G(#D3f16+1)NVr1pKr
-FS`f%del5"U#+8hrr*DNpmSBaAf3diT*rr`B1#3qQ0kh@c+#$5*`53"22D%KF+Ha
-$E*JCGM5XBp8ekcrT'dDhUk+%bq-JAbBl-[hd$$p8N!#q`XcmMp!B38E`!f!-2qY
-N819dSmCGA(+U-eQ3!2jfRh9brYK,9A0LG)**S09kM)0!Z'+-NrbFCRAf)Z&N,rM
-GVBrBcL!je'rK"2eSF1pI8F%pKH+Z"32D@3MX[Xp!4$EHH(V"cNR,aY26+AUS&Jm
-pTFiL"!`HrK)9[YPiqRDTXI&`24FjhbkB4N!j@MjhDqpIJ4312TlK`fEC$DP'@8+
-ITLI!20j#8iFD@U,aC5#dTh`bGJQ6@XqX%GLY#jA"ZVUSK9YrHC*4"A"@lfC$R#6
-h"RDR0@"jhH,XK8YR(CN%6+jJ-NQ1YY0LN`2iU)82S+BepVF!5IkZ2&C&a9@(#UG
-LAcHi)BK)jeHP-@i%iqIBN4pX(X6[4&&RLJ$RC'"X-SZ1-bCcP%k[B4FICJYC@#!
-!PA!iDhC($ZA[rQ3J-0iprK-81C0ldi%NMA$G)RHb5VeC%%'!V@#6*rlM-U$dfS,
-SYXQ#RJ3q3CIm'KXAXfLLBBI-kHcDUBEGebPY,RdU-lPJ[RZ-HHlBAV2a(*b&Q2b
-dJZ`!NZkr`"8pFT+f$fJEA6kR'SDpep,BXF!%+YIE)R-)fQYl6kUk-eA5m3D$(!M
-C9r*@I!A96"aT2Yr*abSA6JeHH,DF'$EG@@!2QqXB#K-&QEZ-JX5$'8-8*UIQEk%
-Spp"RTm%165K1DR$-l(*iU85c-jQ&bQpQPCrZ'J43dUXA,c8(+,0+"Vkh+-Pf00k
-ja`iJ0bj3)bf#qQ"Nf$JRe!Vjl,b!B1(X&',&0BS'm6iR16(C55#l%,,XZKK9P'N
-KTiZP)8l03%afRc[U@&3K8iK6pECa-f'P%F8H0#GPjALIhA"10@cCUC!!pFHj`ab
-jJ)*!)L'69je82'CEGq1Yfd+0rd)GjimrE&+ea4rqTKZEV&)+[C8+c8`)2*836M[
-%MCH1*[&)BiY-6F[U(8-#P$T&M44QlLdb-cbDECm*BM*QYRm2B6*3aV#H4Q!(,Sm
-$P@hQK!J$C-2#F6E5eXj"Uq`Tj%f'm+0`I"1TeGmKL9rPadH2q2!S2T6JS5!%9CH
-GT`YDp"3)1C@@NXS`f9R,hdi0e1&NaZj9&CrkQKI4c&jkMI[qAXmP4A#2U`jf"MZ
-(VSVL6Tf4T9*e1FrhRPrjU4R(CIjGQ!-E`bHhf!3f@(b&a@lPS$ZHR$M)Nc*(CB3
-UEP'Y-i"PeEL5!,S2)d%$EVJIe[YlI38BS8PXKpdGAE633G5!6(4Da8dP1X3jU9i
-aIQl)Q)%bb9k@C&SVb1"c"UN2N!$p9T!!r9D$Qjr"PElB22)A-2Tk)`q'Ni'Y6@U
-5!XKkr0QNZ!eCS8!DXI8H928pE+f((!JdGaCE82(a(e%Sfe$il+VQa-([X`+MlU8
-djbI&e5-8&aKA(mM2M'k`bX!$jH5d-"EEK$reHY)Il-FrSJP,)iH%k(VfUkEL#$Z
-DJmX%3)ZDf(X!,lI$4A92V"`1ZVYLCHbQ'b["bjGM0@#(NJSM*L09KYeKDE`e1i$
-MAmDIrILcLiFmq#@A,KPbk8@q0#UiR8M,bmhS6YDaf(XE00q%2`Jc1V!"Rc&C2A2
-(VhQX'c52I6MJZ#1D,S!pAIEGCA"@NM#P'Xm`rc4LZ5F$J$X5Uf%h+U!6Ed&"m'4
-X'jB+*eTD#YJ6S&[ChR&ZE+Xb8e[H#p!cDalm3EL)Pm'BYY2&[-V&A[CB$lDK'3'
-F,Z03KCZ1mL8J[P`KVMG"Ll1!&`F$ppMlNmY*#C86%`bJm[GRpG""-RYG"c@cA#J
-TGB$-cd6$KM,4)"-U`TP31#UreLm%CYJFV0UFl6HLL9qCEcmfe!SeC#8bBb48N!!
-"&@3)&45V!N(K-+S5cAYU(#F,pJfhTZ@k$iFSS[@k5jAaK'c0X2-+KcRVL95[SHk
-bU8KdPhC5MZh$l`UR3Ma3,aJP&02laT65A9BFT$XXSqiJJpq!8XNUAD*4PF%2UG&
-0bf9*,0"U"YlC[%ccLV4+a@8%3BQZpP#-p8,Pa9B8mR'S0b8"fL-DXK*m8b"SET4
-!Z9I82MVk%`KdYATh*JM9qJRqV&EpZTS-RP*8IKHk!NMCG+RZQK,FGX`V0[(9iN!
-eS9D$c2*riU%ZiHL#D&Tqc`ECmTGRBbh#lC!!#dT4[6r"`k["HVA1(!F4Dp'*'%*
-J-&")A&`hi-!1TMH2elp3QJ2XJq1FqBJ0k9X0$4EfE4KBD)9$8+KaB0Sq#YJ'M34
-U$lA%eR0LS-%bf&JrGXJ[ICUrhrFcX-P`beR*a49Tb(Y#lQK$h[FD*hPJI%&+64f
-JMf#YBJHHjm6Y!CK"LVI#D5[aq8J,J3+fV%PU'bR%-p'X)$T,-2%frc83'bRhRG'
-BlH*Nmj8J8XeKE[c168he)jd-UHiM"dY85EKBEV%mDQ1S&daI(SY#rc%5Dr1&AfQ
-&@iC0C6Ce'C`!IS*+lH3'Kh$A+eHh1DGkTeDf%URjH4UT%8N2*MEK9`*d`$D&R*c
-)-%6I"MA3"RIp8R89E6q!lFGjFfJqe()QLNl2-)60IpaAi+B#(MXqEH*2Ck,%a2i
-fYNC0dI3K6'8NTDL&M3QP-+1$hP!$M9#F@9),0P),YP-0[qY6h&RA`,%G#T*!l3Z
-LBh!k8@E9diTkf*LQ(-4&Im%APDq6JYJSe!-,"FV"aL'rc)+*c'BY[cQ1#Za5&)5
-KQh'rjB88KFcmMJmUJEVi3"fPT)ASeRZS-`pPr-S`,)G9"fMiD1SFXT*6SQZ'0Tf
-h@NPeQ+3k8JVBpeQ!I6i#qciR3ZHIZKR#"$PUi(5QCi$#i`'#qel*"&9R392J2Yk
-`$[Jj&DE5#[D[hG("i"j#ead("rFL2RD5,BVBfMhK*)(8dMi)c[&3-Eb4Mc%!%!0
-r5'ip!AECC3Kh4bZT&6r"qaG&FPpZBP9ep9hjUH+5Pe)!EcX65Jabi54)#+`q'm!
-NNTcIc$#Kc("6J*Brbm+k[,+`k%qqM"RFIp1`F!`,ArQc,Ia+VE*3F6FP'$S0`-J
-F(-$3")"KYDB$')$#P+CH02M)++Q60Lj##0[1$TVM,mP`E!m)`q@-R`I@Z#`jC-i
-%qc[8-35mafp2C!,p(D2DFef1EJ5[28L'hPF5Sp('il20ZB#MLer[r5[peE+1k8q
--`1&1GYI1cMFHAj!!`H[Fd4Z26mZJTF!+%iN!0*!!Q'#&#68KJcGCRG,J5kHJi-X
-94B@KBY3i+IYbGFcr")B4bl!DTN0VP50,P!2VP!2VF1!1p4!89MNU&GH2B[D),N+
-U-[Ukk,UkHrPZ#e6VGV#!&NUID&"pB"MQq+(J(XY+'Ef$0V["k!"DM`@8*N-i9!3
-pbND6rRk2M+lP$@*,e+"-f9)9YV5Ah8FE"aDH`b3*XV(cQ)dT+MbU%&bSjI$3V89
-fdGD#Y$8E05B#!dc#U`4TX8'dCY[e3[kLc!Ah[M0%I+(qMTa@hZhSf[X1a"FkI$m
-"98"mR&,Reh[Id9me3(b&d"@0)3d#55$!b#'#55$!L+h2Em4[KX%qlm#fA)12-Lb
-Q9'Q(8Vaa8BQT#[)B6+%U[+L9UK+PUU`H@XJ9`HKT'I2ImE&K*p%(l1SB9hB1eGY
-`"aZC`8ELMAH`N88K#N%qaD!Q@'$ehf+h(eldk2qq+$2q[LR9QQD-TaI#C$LRCm1
-1EL2Hf,f`PhrJ'&$#30c0*+GI'#jA,r'(4)9#kHBbT%,#X6##kUa-E28i0pQPVD,
-)j$ZL1-4@pF@mBEGG321+5pfMkZ0`NQKc"cCB`#"S-"YZ`,XGkE8iTmV8#KiJ,"Y
-R-'l1JV!RqL-iP'%5a#5)53!6$C-`*J&-2[i4Zj!!S5%&*KXC+-43,H*5j80$0(*
-BYbSTUK5D#fKJDV5FI@aqf5h2"&3ch,#-94MkkCE2ZD+E2J(D-cEaB&#qH)%"2aJ
-XYTedacCB"SGZXUE"5@Jmd$$4`)#4NFqih1EhE9IJ'Q!bf&8&jV&Jj0GrKjPPT`X
-*DRqX8SFri&jh@53C#RjeN4e&j3k#)KQ!21hLBEeDPD3aZ3HrfXQ$E,Mh(,%CB6a
-FldipBJ0T![RDbSrFi`(k8Kd33@"k"4a"Qr@%BI9Q2XaRCa8)dd!)Ka3e!&B-Ge@
-HIMXp$M&8&4c(Aj8A`0LpiSl--9KIkad[5[hm)hF@!r)K(2'1pb%KbMG`&X4V)bK
-H'0dcHF1"C1d&ESL")Ep`f2T4)jA@Z++1#fZPD)JeF88D+5j3$2Ph"`eVeTjUq+0
-G$0l0"AKBU-2R8'8AX`Nl1`Y,B1q6[XHK*T1qVj(5V()q!B)2+0f)$eKqE(&B`+C
-9Q3cY-#K6q3bR'b(SbAN-3[HHF2r*"XCYKbfd94H(i'fGKIbcH&LQ%2lKZ29qKKN
-miZBl5(K11(""Jcp"S5&YS3e@463&B+I-*eCLif212!r"KH-GqY'm@Br@MarDYTf
-U-!(@*L9Jhq6Q[JGT64BVGHJDA6J1KSJCE(Bc3DS!JE"%K3!N9km53,+[K`NY[4U
-MbMEMj9VaNU'jF&T$b-&"VKK85MmH0pDEF93`!rH85LjZ`maBe*j*[QLVFM55aGA
-MbQ8[+TI9Ab+a8Ce6AVif5GY*[%4$K'T6H6Q$6J9"I+m[Fc8"G&CFFKHlZDYYC2F
-[%iqe8YSja!*#Gi&S-6KJRG4q`%RT-!'1#9G9N5"1VdbLL(ap$p)+TDr[35*&I0!
-LTS9FbE(%3Uk@NEMPLX4jqkdh#PH9E@-BYBf(A!m'#aTT+3D0`fJ5bJaK5QdQf-F
-eNhmk,kdc!(%if)8)2X2X5pm$[A'%Z@J)Nq2&JTNd`8cf`M`HChALCcA*5Qf9mQU
-PfrPhhX+iXGbAqXf$9eC%MEQViamKJFkT"5QI02U0CFcf)U%,9U[R58ScKihlQAj
-12I-J3Md[8Z+i8L6Tf4AQdc8Bd"%-U'm'J8LYm4crrf9f$IRdMj8K(cre'eFRT6i
-!j+GhqAEQE4a@*3Bpj)9[MD2DfNb1@%'`PCY,qM"%SC(d#D$j4EAA5!T9`afNUA2
-U-LIcT2%GGXh`HkIJBT'#'J%,KdpS8L-D%%fLFBZlP5HF,#2h5k4Ef+%"BVRHakN
-aVZKT*-E!H#14VaRRehqH4DG80iHd@j!!#dqi&aLIF6h3%er#')VNXrFL(q,2$EG
-m0KrjmjPh)fYrL@#h#F&5bVZ8a!Y("0`8dH"0p@$[r8K22m3GI-[G[JF(%AXCLje
-*%EClV1$hR'S)Aq*'h8F*rK0Uf2l*hhNcidEUB-+2G"Lp*2be*2)6*(!-`'PpL34
-H*EVJPeFS`TiecZY$0AUh'lhr")&(eT!!`&&XArjD3Z"mkp-&rZ8`#E`'S(Q01rp
-hAQr[jmIK+"!qHN0`%@Gcl*f"H`'!d&ii%I5`U+TfdZ#LCGcJ@M%-+3pa'1c-Se0
-Gd98qQUSN6)5A4lk"#X'XV!Bj+*4jHqmGMVa(*S0E%+m80T12V$*-RXK$F,@Q&"*
-prQ$Q@@F[Nefi4+bD6)*N9@*jbq6(iXCGr(-EEL#bc@fF5#j)Q"8ZpU0D0L[I+"*
-[0b-Yk&TJf0)$eIm$Tk4[2a$0#J&6lZJ64JL5CNb4%9B*%IbSrZ"'5!T*`',,2A&
-R2a%cKf&b-j!!MCrcD%82UGP6$D&C%0)8f!!(*mpHl64k"B(KKN3mq1IQ*f&drHX
-rciNUEJ62"UGIU#rY3X`!iD"iSCHGj&%GFD'eG+&A-*KX*AGAA!J9MA`$&h)FFb%
-E1R3r*E9$aNhCJk'%HrQbQ4Hi,)1TNJCT)AFi5P#!f$qN3Z8%QQ!!JPPEaFcDi!#
-MVBNKYTL"#Ud@3pRk3X3Dl4*$d[)2ZU!9)UdM4SVKacTh6MKaC2VGelj[8iF(3hS
-mF!mEk-B!!a63-j0QQ)F&+e@VX&,A%fa8c9!fkNT%6@&SiQk2b@bGSi--3@hXQ0f
-[6kIc2+JV-8e0B*VQ&+DTC*!!68*('l`T-33$eU%`5dd*CURfB-`5&dB4#N2,-'Z
-%EX$$h2B)*Bl2'jM&9$jVp(QG#-9MG9#4Q`"l`(c51Y[192HPXprk&`$dh8c+2'%
-eKHDA+IUC8%0&R2aU`6!%mUB9!M3"VJPia8*(2),A69P0BD1U"YNS02j-dU!+8m6
-XR#B@VISJ,&Uemcbl%)*4UrBd8i2&-0a[SCSL%d+jkk`BZTk6f#rH4T)C-,%4JiC
-D0R,#B3e$CVGlV+PfC)%I3NSij8RK11%L0qTkS"!#&)AG58i9+*aB&@kEZ8ZQ&68
-$5@$KSkYC$38AD$$ET+HBLK++IGfX+%L2bZ3kC9'+d+)8SCq+81-Lp!mm86'R+D`
-JP%YE8b(23I-ac+!e8@"T$+(Fc`aKkj!!)3Xi(1+ZM3&T6eCFa4EI36I&YT4!kh6
-EK8cH0BA"K&2XM1cqS`mF+kqkB`"DSC,Ir-ALeA%'[$ZI#EcjZ[l"0d*J&!qeB[*
-Jd38,GmD-%'mqmGJFP)TrF[l0#r`*3iP(hicKd`m+8UKkHLL1*JX3h8qV'&b$fQ-
-e&&Z@pfM2K0jm[H%d*S%hEk3GS!fQM(8A2rmE''3hM+@Mq21R#9E0j)%Hq)&[BcM
-Af$TFj-A#94!jGZGC"dDRqMFBTYBL*bZQVe`k1r-X(VU)2jIGX[lc'0b@h%JSZA!
-#DDQ,X3m"ZYbBi3%E2`YRqC93'4H3!,UkM!6AFXqFG4i$YTchqJ'&Sd(#qM&q$!b
-0C@d+L4`dL2[9YFFABZ[Ka0SbIICf8@b0Mb&k'KVCJkl1JeQTcX4MCZ+a%$m'T`5
-k%)BB5KcUf8Q,3@$-#qj("90"fpa'$mqabffX&Bp[JcSc8#d3P`K-Bdk1Iq3"Zfb
-1k1T@$*1VUeZmQK&$#@2"#9,Q)5BRV'!63`Ac5hIL*4,EcXmN&[A4Ll!J0%FY@kQ
-rrM8lpfPT#ifdKH'M&ND(,%blS#a*@jJkGU%m0'4KbTPS%NH[0`ejEDBGHb(Y@2Y
-4aeiDXY!qH#`2hEjm[I%CIK'P,UKr-M,iN!!BI)6*@3%TD2KmcKGK80aX2*@2`-R
-"jAHdEqLBVYh3-DXCbI6"4hKJD,#'la%cc1""-l'+M3K-mX3#[LZ+QiD#9Z#%m1+
-9Q$*XX4JqPD$jf'-mJ'aNkfm%d`%@ae3krH,9Cc64aAP!F5B8!"e#9f*i["jNS)5
-'$m&3m-2,)PP",#Df#a*#!r(HP1B)'Mq#'DVbrR(IR`Sh&Zi-LJ+&bT`SJmU%dJP
-HHhX)#mSAj1f,Lk+,,M,VY1iNA%iaLC36ZbGH0EZca!M1mN&*mff['-EYKBk5Z`6
-lZHj-Rm+)"Um0(LGAZ9e%@&eJpe,%("Y[$`Q-MMV`K"K!&1`5+ZcY4m"aHZdBKTA
-[4e01+#pfKZ@$0,'efKIFfT`)JpB4HdrJL-YVFHGT+aS#PHAN`S2U4fXiX)9SEXc
-Ne4`(*Xa%9ql5+b3[L'+5Vq'Sf!T@R(LBKbH'SM66JeCKGQi66@%Ub3@fXQ#U284
-8dJM)jJrk([5h%lPTpqe0$f,B#)R4l(GLN!"iU'Sr$`-[0[69%S)Kj#pjq21*Kjp
--IjJCP0*&FQR'j90G)YJXZ(MSprqFrYAX-aA5S[ac"!$""%PDHC9GTL*R"IY!JhK
-c+M8j+L"#r1-'&(C8RIVLNmYb9ih3fk@CF5%'AZV4"e`DSr!'KTNbK5(cJ9k6"pR
-!F"Y64LMGH&1CN3H&%dA1lhpNT1jDVP6D1M*jZ)jVlMiH9[ZZaGEKc'F!qlDGH$B
-[QLM4P2jT%*UD(*E5e%j!0%qYQ0TTfSUTPDB'TUddG@*Ud$5$UC1Q18`c0-eLQU2
-T0Nbc0&h%G"Y0+c"GT'NHd`UD$Q#DTqNiTJ-dRF*dR+BZ6+GSfSZTLkCpQ2E5G!6
-1Cpj-J*S,bAr9-S'"MQF(T)NrG[baiNmVrKK'B!Kj6T)BIF@r%Q*dINCKj+qc8H!
-I+lLJUaYGL9CI5JaTa-e%Z,XFQ&bZQdH3!*0-U3,B"$$PqJXB[eDErN)RkkX[69m
-KXVi@IpB`@HI3dP1-fcEHN!!lJZ(K[[M0CYi%[d,hlY)ArmZhE[rUk-@q@Gj506I
-iDd2hMS,NVSf&b$8J432L'QMU8H[qH+h+K0BhKim'%U(E$VE-(6[i-LMc)%,e$U5
-iLTajiFVrXCX-P#'50UqMf2Rc[iJc#$kSB'[TXDi4JJUU,Ab*kZYS%[F1-aI968X
-d$'Ce&eqZQT2"cIpaY[TkE)3ZraUr4KLrJ%2VaD&Va`5Vb-2J`fNp35")`5"TVK-
-+TGKZR*(1AU8"GGeS(!-D,IDamfHPcQ#k,%3mTYBl"d0mN!!M#)Z9&CM,#e$U$+&
-Uf-a))6"9NHA468j[2HQp*e3X&+,#NNFUa(!r[UMMP[+CeH4,Jjq4hNJD[3k%4(b
-*3@Cba@P2R#kB5L0b"d5K1-jb-99I)ZC+9ZpP9i+K+H+VeM%aC(0F$"Z#4'lciIX
-CqpD1`Me@PmC!MSF$DdBUKCf9-830TE21FZ$Kk1C('VUQbaUkCYNGZFIS9Re',`r
-`Xkc$YcLUZBhR,*`DG*XBXQl+#1T&T@bcNNN'#ZQ1e#J&G9*FY!$QkpRM8[X#,S1
-'V0bJ*FN!&)8j28BA&i0"EXrTDBDVj,6+AI25YGRL0!A,3#%FD'%J(c*CA1mA8&X
-"$!4F*$UQY3dGYm8$ERTJ+#12I`CN8KPLA-XTLI,aa"%Q-3Q1V9r#b%([bYR'GMJ
-!qihJiFlLDfhRp1SU"mA"@Yf6XcVB'#SQmkr6e8"SJ6lm1am1JQEA#4T$DM"$&8(
-jp8bH!hJ+pPbMl*C8LF5AbB'R-3m)(L*Lb($QhQ2hC"KrN!#8H3c&"QH3!,!R3fj
-5E&JQ"RHUi$#0Nc[V0M1XNj'2BH"qQ&U(la3YQX#Lj&','0lP4CqN,CV!STiLmj'
-23%*)$6VU84JEqfmaBa'lH98-')N+"eC4Q2R[SVU"aK%Lp@pq,Rhi*$%iU5l)ra`
-Ub"*GN!$4'``9N!!J5a4"KY)&'Ee%$a`Mb1KV*%L!6Y&C)FMS91))Hd+3!*c35ZQ
-#I,@cf$a@N!$4CK*N5JF4Y3q'#P+lN4"NL3,&L*4@68+Bi9H&--fMK'Q('6Bjf35
-Q#Xrarf4U'3*q8dMFpN!ijN`H2h%5P(d1"Z!C(5USrlcdVlpL39@@TJR+$N(K(qU
-LCFem,*E'$l+8c1+VC@P,QfQT4NZYbP,l88Y"$QRT"fP,VEa8(U+P2FV5jS-X[8e
-,h@P,HfKT%beY9CCDMc9),"AER8YEfSUPGfPKk3X[r*pdbFh9D3Y,XE!8F(U,q#G
-'%XBFeSfj@MGQ0U%Rdidj@NE'A$,8Q-8!*3@#kiaJBTK(!HeY93eK$S"dHVCE[Yd
-1Y[6Vf!)(35(ab0$"4kiZ-ZMhC#G",D2-'MpjA3Q6@X(X4Mh0!)4i!+U`Z3bDM+"
-e%0`mIjT"Q2cN+3+l@Yf'#&)m,*JJ"4dD(@IYSb"'RL3@[j,r-5eC$hMAlcSr&Vr
--iGbm%XkG4c2f@p1ebfljAS-MJVEKPXme'ZcYKS)2&!9helXX3cT-NE2h"e$`2'3
-L1bQicZFfU['CHh2YAlM(lS2-E0+4hG2lm9#RH'J1`CMM!U8I06&i#QeZ$F+BX-I
-N&006F33'!ra"$d8)d!R65k5V-*aF"4-*cbKh,F-&*f0lJQAA2jRTRr!c*9MjTe)
-S$%f"EDYd))%('F2,%)A*!!+C1ANUT!K"bMmR-8Mj)B!XFXb$!9r2`('&#YYbUU%
-f3d[Y[2#E!j`-%CHV(FAa$IqmNekRp-rrA%kI1d436SXXp1Q9Y%mc1+Ch509kKe4
-VLN&S,Q)DlN`N"j2L(f)#9#2KE1pIrpmi4+$K8hR4GbMP&MELBLJcKQ25i)8J`GE
-@CMc%Jld##"l$[bV"+6SFZRjdF%!fIV$iTlCca6h2er1!1G&cl,pbbGcbTJA$)NZ
-62k"j-9`INCB8,NZT3@#Frr%MEVL#MmG!jP&,-#CPXFRrh-R"AV19&2FFr4TG8I)
-rKmI0rQ)a0T+A[mkK2J1K'@8aQLC*VjDf0BKI@SmjKSG*6BQZ#fJ!#6*b-c(45!3
-0J!QZQ)!jYb2Ga)dI5`BE!kF2``8!!#-E384$8J-!9q)293eQ4!)3)H,Z91r"58k
-mfLZjQ#[$k#Fj,aH#(%fYie+UJ-DF*cfZB#RMZ[%8lNk-r2i@N!"5amfF!5eMhDi
-D0q0f-PNhQdN6'`aLaY"EkeVMC"a$l@QXieLEB4cUd&3003FPS[$hrhl[ppeh`1'
-Cp0PRRhPq!"eQ2L34%#m3!"!3!""4,j@*[fKU`KraSeFSN!$5B481A*FXl*'maYH
-8V$&P0li@53akdN3GL+E--E2PNq8[P9Pl!Cbc)d@IcCmB%HfQ69D%%KXA4a*(HX!
-#39VJCaFkE"jBfEKVS%`%Tq`3CDrTE`C@0LfQJGZQaXh)P-kiD1Zq2BBLBUrZ*)9
-pq,3#dkC$#)GD4FIA)a3XkM6PI[BDN!!*)0m!`QikdABZ8[6&*"jS[eejIY+Pkm+
-2-@i+&Ef6CMDEkX4jG(!C6CSpF`b"@a3l3XpQMMehpCddeUP$kD4A1RNLL8JT1[@
-JNf&JAP[3j2j'%hYkSqcTG[ATh(I51Pi4RD3-kqehdL+*I@pc%HM#d(ZB-S-VkMh
-m6-HbaGS2a``&ADIMjd3Nm@#Hp8emBZ+I"HN$2e$LSRCF!U+dF6-'pQ$L88aXia2
-hi'Gh*0'qJclS%RT@qe%h3X(G1F)6@5Tek&c*TbDQ9V-VNqTmqrZEQKJka"CdH4T
-ES*Y@aKBid-PTE)&MHJqb"@hL9EDJl9%4p)(iCE"iV,(JC,p`a50mXB38V*Y`UU9
-MqLJqD0JpTJ[ZKaUX0p4Mfb0,6iee!$PH9(NqDDJBImaGD62LE@Qdh6)SZbkdcc`
-ce)`#MB3@F`,mLCQb*bEFBp,41!2PX`@fpIY9l-M%VMpJ#,$dYbrXhqGEJLeiQ4K
-"NKHP*'Idp8AVdU0*bDL,&Lhk9NSdp42R@SM15pPTC`rQC'JCmNT,5dNqQaaG*2C
-q!3reAV(f5N&Qh8RV-)keap"L(0HZJ!QpK-43!-cTX`lcaABF-KK#&CKPTi%[YQ5
-1D5($'H-CCbM1-D'%iSMpX0NYNB6Bj!DldT5B"qaI&1Xb#RlK[)dZA1P)l`CVVi3
-6jCM*6B&fS'*ZcZ!LSM!i!XB9r-U8)rcBF%4dDb'JKK&LXY-"8T*6Fl*e@RT@0Mi
-2T#GRTICTfGSa,IGXhCQ8R"0489-TI1"JPLiRr8`d068V94Q+CZZ5,bTMNUSSk+Z
-%H@9U'cA#qD"Gd38RRcFl5)@aB5YFYD3FpeJ9UQT9,M%X3@@`@&J)m-#0dj&%3EC
-@+0h#(APer$)#3(Cma)fQZ9H&K435pdV2GAbGrLFe+5aUma!)&`F(RN5iI(HPF)"
--RJjh"Q8UC8LrS39EFbbY0&)Sb%2(X!i$l3$b*%$@&BL*`cT%S*4Rh34e`i#(2cm
-U(5aQd-De@P2Z,aBU`kDN)`+I@iPKiL0b&UTji2K-J+EFGcl&"+m"DS-3U+S'iU)
-TGdiT2Jj%LZDXCBSS$YeqKeHMCV$11bG-Z6%62QlLLSM5jBrJF*)kSI-Xh[%"X0N
-'pP5(6FGCe"'2[Y680-p0$j1VH'"jB(&hbiY3R,$JM`-CINPP!B8"JY60d&)cUjd
-Li9@$dhS#b+6'@rR)8Q,lf0YJqd,1pK9!0%YXlqY9f&lUIUfC!T@A9T)l&-k))*K
-re-LZNN6)I)S*K6dNN!"P%HY68(CC5%#3!$[dippp`GbPKH*#0+0Li8+Z(pFmA-J
-pp3ZjYCHZN!!b*"lkKiI0R9C,apFjbp3Y)+!j4-q*fHLm1MlDm6iE@)m21YC"BJ%
-6&r*BUX)Ne&N,+5k,bfG6)(D5d2EeR8e+LQCRD%PC+9V@J@3YbkbPRXh@4Id@@F`
-kNf8q`fFT)T[N8l+,K,HEA$*I+lk@dB@P"kB,UN!h08VC598G-U)4!9#($'$*Q*-
-$()HDZ6&N,JpSNm'!"0#8M1AJl&S0F&DJCL`*bUH83HEJ!Q+,AVLjDI"$3`X2qG$
-L!AlG9QPK&"ZE-mFbZME8EQb1cS1LD4J&890Zi,Y1X60aXB-i0R0`ITmH3cLl(T9
-,3%lM@Kc4Y2%SB#6"6a[p2`'3!!QL3((,M($@$h+&JQ'GV0pfKkYSRC2efd+ULRM
-hDl8%$N'SYBlBL8!"B%SdMS`k&(96KPcZP*CF6(DcLIG310rY9M1MEC3rYF1C'@h
-peCkk&fLH%NV'3)KQFX6,fqM!`KH8!dfM53@@9a4J#G,0JfQVV9hm%N&X6q+QJN`
-9B()488&RU*Nkk0V""Pi``48E!%T%3Dpd`1kK&IHZh59#9,TUf8I8,90)8k3Pchi
-$@1*ejd8A18XBEbV9qqhaTP)L0A6Yh+5LA[%hr"6!iSGmq%TBX(e`,`FEVRD`9kT
-YGEMQ9R(dI#ILSX,-0a&Z#5N&$&Xf6SdQ(6bE(Ud*1Cidk+Mr!EQi2$&#!Z$NC9D
-Pr5CXPEE,cbTYP9p9QJ[LZ!EJ$3Bq*lF-,&qfQUUh&dh#5d"`%F,f$T5iC)X,bQ*
-3L"!Y8,$3f%FRqiL`Mh(fB@!IHTMkM$@9Q1SXb,i[AQ02698EQ+"U"Dbd"XbeQ`i
-1F(Q)LbL-!XVcXIecY*!!#JDam`amRL)'C#3dG4`N%SQ62!bB-aE)MHCQTIj%bmR
-@"P*6SYNjkFkS$SM#[RT'DfCT69*CUI)l5)8`221#d$2Jq@Rid,12+IBa34mG1US
-8Ijp2a!&9I[85#*YKG+C@)LG%d[&m9fjANMIIPA8"fp[P9*!!ckJS+$C0TU"e6JA
-j1Qd9&02`l&BB%'UkmD6MfrM&fk5,0mNZY[#,5c"KN!"GA)+I5TRL'f8ASq0R1qM
-Lr-9#ba,LCR8eK!$+Xl,6I&rq"KLK`MT%f3je'G42rHM3QRZ-!6E,''!MUbi6RbN
--%11&41G"0XN13Kd(*3B"!pa!*9G(+XeKCD,Xk)qeb`HcdMr3`T!!rMBCV%b,eZ@
-N*&-Y+*YEp96r@#iR1bGCl*A*'Zr,R-dHJ0qRLI3h5#%"Mr8jFC)BD[5BH`c'FmF
-`F!c&arY3d+DM[ZlRK2CA5c#SiDF2"9ShLV1GND8M!PRF"a-UNE5rHqdhGk#3!2%
-0%H%NSpj8ep4%KNf01b&-([UJd-5G1kaJ5X1VdE@pB`Bp&NNmPjNjKSTKplBCPm&
-%M9YN6,5@-Um462I9f9,Q0B)j'f-bjPcMc$cHN5U$VG,&YlGb3Y8S,DG+MF)ldL4
-#Y4M-di,M-l32K2jVcABa@@ZZL"pLh4*'!E*!Y%mF%GiEDVGlGQQLia-JIrC4F(&
-6dq3Y6#cmbd003TSk1Kf(PKifm)G&d`3l'#NcSEejDN`eaI+e$9PZG,eT2pjlaI1
-PQ9p`I'hiUH!cUardrU(pMcVrFZX#E9(hLiDja[Ie$idq0h9la$VaUdGqIZIh*rr
-Xb(rUqfhrYirY(acSf(ISN`[[QLk&V[Cm*c,QrZEij,P[jIdSmmr2rlp6rrIC-r'
-cPp-cSQEGaCc$(ac-cFj+qZqT+FN(dRjFpj-6Ih(d[lhpakklVpBfhl[jrCBrZIA
-6krrPKrrMfY,TcmriR`rmml6rqS0rrI$[h[[rmrr2TrrlihpmlHZ[[,Ai'fm8,AQ
-RH'("V*IrBH2VqGp0r)GYhp[mRcIpCYG(ZrrqXErCmGIE(klmhDTI"*DYH'(GccE
-mlGTr@r2,2Epqr*p+rqAqAl9qEZHrPhhjkDqXAllbdBU[E[NX9PliaC+AjMA-RY2
-B*-P"9KTUX!2C@XB"AX#f#6IXRDfGjMQM8Q$9%4S9Gm$30cMS5,5rl4j,%q5SpJP
-H$%TB%`TVNTK[5G8I&SDT'k&la,BS[UjYYp3*EqINc38JPaLV)p`d[KL9dDJBlcQ
--Qbk%lTiD-hZid`C#-e(J(KX"8RZ6Sd1KZfE(lAFjS)Y4Kem0ZXF3)Vf4$`220&m
-mHl`@aNqZA2-*dBk(Y"Z6pf"XNRFD$hDiaicdi*!!l-&pcJFR!L"Tq,AQa@NLG0-
-XQUDFJ1fVmpN#bKMC,C(`5TLkB6j-HiiiLbX0J8ML$`JmVBK,iCD'9ULd$m!MU)3
-F1E&(4ITfkNiL2NV&0Jm##5H4"5FaR!r'AdX,#(NlZRE+*MZ3!&9!d84$PhX-drS
-`d)GT,f0D*EVEDF!*FVbLjQ!l$9TX"e12"qiDBBENX+31&0mPeijj0@9#DJSCe#B
-GhmJVV)fm`QVi9!CX&K1`DDL-**CINi"03b9qhT!!!C[&6Q$$1hSjX%%493hd15*
-,hehCd2VZ9bafr9984TQb`hNM5bGG2pTd5$`c+1j`%f6Ra'"N+8*AC#SM(mB823@
-&,,*"E"(2'Q`[$U%`SCY"l!h%1)kh+C*iG$Tp%&Z-*0LKDIK$#J'[[NrCbLl!ie#
-MCUY'Sq#CAK3cmd$!L)l809p@V@lMkYS@5Dbrc05e$6mIbkV9(6*eSH0ARZEUiZc
-`d#Q'S-aqM#f)A9D`"GM01j-Y`)S2"LQ-$REP*PrC@FRD@E9+e"5`%Fe!M$)eHMC
-hEm"MhrJq,IeL02f$P!1j@Qj15ZlCj25,[b8k2`R9EXECj,0D6SV'+Qmr5$J3bQX
-BkIh[B8R[-Mp*ljKIT2Gm!-"+kj!!NBVi2*!!6N6iP3XJ)3Z)&1jZiD6f2Z&Jj,-
-p91XH-a1*YUS'DB4UmqRh6,N0,BcdJh(rPlDb6&aR5rSpED4-"!%@NmJZ4RD$N!$
-JC&HPl2,G#[RhG)H-r![)''52,IRhjHf8Z%!KZh(S)!q[Q&km#%YK$bdN)q%6dG3
-X,5X9T*MZE(*1@P5lI-"XMUCbUSSST3kqMQCFbNCf6R+1N!$(EU[-d%YMmYbY3B6
-9FhGIAcfMTd2fkbR6$#d3$-VU&SQi2riT)qjlkb2ZZ6N`*qj486MZYk"+#'jdA4l
-Z2SbK`e$@d+FMF`q6f[4!8DGVc9B"P*d(ca"'CS,Z)%&2DZ)LlY&CrRDa##T"(HF
-K3aJf$h1$[jZd)2GB8P-m1)N&2BF+bq0`5#E5mL0fDLa)ikJ6XNXkC*GN)!&5-&'
-EBG5'VYfc8MM0`i[i0NI8L`F`KBl)3femJkPDmGfSjG14q%a8S,hGaiIA6VV-mlS
-(X!A22k2lfPTkV('$CXN%d@9aQRrR&JY*9)Zr&%j8LfIk*kV&lAk*kSlk40Aqb-$
-b&DBR)kSlBlDLHMbCLG-'@e(GHG4[8Ae-%G@Gdm+)DUQYU1l8j+)U&e&X*(MkSMV
-')@mpX[Vj%&Ejl8jTP3qITVLZ-&8AekjErSNVa0("KE9CTpFXefUYa1Tf@hD(i$U
-3!05)Lkmmb-U2`CQRD3QT'%PR,-i+["k4YA0aHa9(8B38$L%5fTS()qE8mi1PDha
-D$hI-H'b24N4Er!Lj+(NR"'6LSpf(HFEl)C,bM8"iM%`-Iaj@$1ri+BD$ISPK"F5
-`K"*r'&RJf&KE*`aA1f#f(@V@RGFXX$!&4Be!EdQ5$b(H%L*i)%K&X9CHQ1XPJj(
-l,DqliPh5*cP1Z$J8a4lRA5b[5bEJ*IGGcQ[-#53DQbdXQEI'Qch0p%6ZG8kQJHb
-&fIG9FNTj[(*h`L+Sdf*4-j5l%`akLd9V+ff"kE[RdQrdEE1DfjS*h1SRHL`,QaF
-GXPMd#p3T50DQCfi*FJXCTL`@E,&EkmPXFIcKdUEZYS9hfql5G,UbHk*6c()Ca'5
-cqIj$(A54rSb-h4LiqN)a(F0dNBMrf0-3!8CNd#I-(!`-Z($4lp",iEmD$Ud,e0f
-J6N,!*SJ#QeI('AAikF`a*&d+m8F53dXN`IT#+K1XqPeJMGBK#L8M'jUNJcle)DS
-cRe+GSB,TT33$8Y9N9&88JL$S1[((JD#k$9KqLT[k8()N'D[f-&Epml#XHYj29MA
-l`kS0QUhbCpk4+EpLB2N,JiVbAaMd@rNpe0fJ6P+92j-A,"J3N@G"Ejk8"9qUU#S
-,K&042#084Dk@-a%&mhNBAeS8FPF&lcLm8YC4PK($'f3CN!$+-Z#2`fD!bmm-Z1j
-A"Y3j9FFG%@$i&hBC@ZCbGkd@bKacEPp9m&DTNk3d`C9fDUaqP98$hKiCm'C+U0E
-&84fmmf1"&GB&phiXkL3GbpjFeE%@e(ci54a0FPZ['`c[YZD%)3I#Q1!CjF3KTNd
-KkEFH!BYlU)"NS4!pL&0b9HTkRfNq)XCV0pk,PZU(0)Xck3pRN@Q-4Iia,)ZmjLH
-,&2M&)MYNQF%FY,(cf(J"1A,GiE+LJ'9&8HcFhKL%%lT,&q8)Ll#Jf'r4MZ[DaTF
-UB!m'+if5S2J84r0pZ(Q(*1B!1*`A+5ShmQ5a$H6d+QrR!4H2,LP0J#!XP!DPlC8
-r-Ji&QbmJ10A"hHq%$$,N6(8)C#-5@4D9Yi8%N6QkQ8kh(9f04qpc%kBKR8HC&*Y
-pLKNVm30T@ZM8Q('"6$P9Q,U8(r((e%A3NDDFM1AJM'A+I4e"KI+E4Zl!,'F',Z8
-R0VVFBaPHbBbJ2*N0CaZ3!"!Cj2Ba!,#CXU!iIl$m)VVemJQAqB5%k+jj!C&&j%6
-df'9(19,28I,S#&'Be@K$ibkV01KQ,PaDK!`Q-Tk!UeFMpflj)6+5`@''Z5QC)KE
-FN!"-!UAPa``YQEC',6!*SFTI3fEc5r,d!Q)&phlk56+YiFr`,HXd[X8U(KNRFi$
-YP)9D$bS&")h@M0+5Ah0G9Lei@0Ed1*1-%ZY,$'PN!P*qLV[RpH4SP`DkKkC6jR$
-(GrPlQC*C4%*Xi'6QP(05KQE6TDKm'VP`q`A[2T-1)@FV8VkHJ4F+#F2!"1!a(Z(
-(IQrT`jVp[UZdKIjIha*SDA8CLA4EMH0ke%H)000c`mHV5lGARl$d$3+hFU9E19J
-Na`V%eV'`%X6[YFb@c$pC@'NZe#lTce3h!YBc`)IM"3(fK#r'Ye9X&!Ni'#lh8P'
-i''CE'Fc!`,H(&mpDR3B'[Teb!i2baG6daiTl5"`iZ`!+Zj`R+@aTCEfEe4!1X(b
-ZKB)"bcETlGSK8p)TN!#C&"6d28DAFM$FUhpq[$Ec1J"Zi5paQ,M`4@jM5P--`@i
-lQ3E$f9ma0Dce))P$6'qrheakRIjIIheY5fYc#+E"jVDM[QdJL$1kpYcFH22b2*M
-iG2'$I8`0Dc#(IC!!LMrDZkDN(Q&p%mAe![8!5'DKhILQ5cqBC%qiX,bT@3+eG1K
-&chX%#9#JfENmCl2-XePQfLc2fba2f5bIP5hGY4Z[4kr(CmUIjGA25K6I,2Qe'3B
-05L3bAe)N+C%fdLp-5ABBJmmTipA+pd&J$9[Ij"ZIcN2M[$"JZ+Q%hG1Lh*J3EMb
-B8#EEfJ)m%9-!UiH$!5G6GVfSJ5(R14Q59jbE@FAjF0L+Xp,2LR1YAa9R@A95i@I
-p9C-+AT98S+)-*R@M+,193&UkGm%MC+iTFjX!B*dDLjE*#e5bcEDbcAiel'Dhq,R
-C4Vmf@k)Bqb'CVLF9lSM3UqRYf2+j3('R''G&X0jI#CpG&,mDh9Q0a*2!CU)mE@$
-jQJ3)KmAFP01"(hYi%S0hjF4HH8C9*)BTGf'[T)k&$iC6ad+[IqTBD2"((E1p-M)
-5&@P&XN*1QLjD-&"Z'&Mq5lG8P,%iD1&ZB8Yl[3@D)p4TVYSCRhDTm%,Aa@C,K&E
-jaUS,,dkLeq*a-Y)#Y4K5i9)IPX*h3lE(MZd-eA*!0Xc#*G+dSe+P*&2h"&2hYm1
-UqjLIkJljTHj-HKLUZH8--+)+"d%9LcZh3!'XmQh5SF@jHY9mKbiaY(!L)-5R*0i
-dUdXNM9RKV9V&dP9)m(#B6hilFfbr`!+9lCD5L38U`X`3-(IEdMLK9ZH0+a8b!NJ
-krLdNX49XJ@)NM!r3#!D+q1,6%954D2S%VRB3Qe[@R9a`ENb(-'IM5PQBmlaL5V!
--C2kFDIZ(Q$%"R+%[HVNj()8kcpQD%bbMC$eEpimdcT-1fl@G"lr)j,4A)6c5cfD
-64bS,KUDD1HFJ$feH`!G-`$"f'N(-lja0Y`eU3JQ2Rki5S)!YD+U(,kcpqr'Ip!H
-)p5FAF,@8bY55VkJPm+'0@T!!K,ql69A,4PZe",J"%#9NB@S[P061Vhqma[8)'3H
-1UGHAF)1)a++2eHYIPPf2cVrBaC4H+#Rp"T%dL6R&p5Jp(I(Ej'JeY8ZM6d6aiE2
-dL9p1KJZb6-8',5Gj!$&C%3K,(JN%9,VQj!)fT!rYbq3X6FEFURTl&+I!UP*&[6`
-SLB34fJ99[4&Eam#U$&)[Udime49k-#Z&YNYqd'Sl*p36h2KkCH0)aZP!X(48H+l
-K)%C"cAXFj-Pa36c1cNT69$(8`d%$ZFTjN@G,+CM-lGRAp'pF'HYPbR!V6ScIV91
-93@k-PC(%JMj9'BGX(4Qrbb4P8%"h'3j#(iT#N!$2'4)PjY3"$Akq9-#$N!!`QqG
-Kb+153T4YYq99frC15E4X0MbZE,LbYIU'YiE#EEMbSRc$h0@JXX#28h-J5Y+HT3h
-cS5Hfi5eUCC2`ZEP4qJA1S28BCeCfbKaE-&CCq5&c2KfcCH#(2qDEN!!D5[,)6I0
-X1AE[jRR9MmXVkca@@DH(VD`cr+bXNrbUV1Z8S)qf4+UDDe6$-m16b"T[2UVi@Kk
--5Q3%4`ZUp'&L)PDpVjC23,0HEFV!"*RkE1,2Zf3A($APcSk6Qd+kV1PC0cXq"Ui
-6%LC8Z3[4G&h6)4RU3fND!X'j#emK"j%-q3C$YQ'"aLHD2!S5UTKJUQKaETYI8qH
-MX(+E3Jb,632,pdbaT","qNPJkX##X)rYK36HaM,kVm0Qp(Br-hU$AaNpcBDmpr*
-N6caj"SL+!)iqR39c[EC*3DTYF,Ub`6HEpl,"qfb$MiEGB)@I'jcYe`CI83p,"UC
-f-X['"i*mc'RC*KYZJpY"!JbG+2DAm54T%XULSSi!Y8U'XUZSFd#p,%-j9&358$r
-JE#DK0"9e(5LA$$@SSX#UM@D*i6M+TD+3!)LdXBH,Q!m0XjBbph`VFl58d3F8-,q
-HV%*V05UC60IdU8YkENTGdV'fUNXk[N0GdMEEe#A8-5HQ,U'f16Yj-)i)Scf-#*q
-SedQfKEQ%4d@CfB)U[e9eqAM*jH-KjeM[CH%c6[bfV5[5J#5i'PScb"5Aa9(aJ#J
-@P@)R8[1Z6QT#JjDP#!3GQNY0-D,49AkPm0hKLF1fN`'[6mq4E5V5bj&,10+6j'0
-AY+'Dkh3HiTb,%0`!Z!bS)l,M19'VJ$VR4,QGU*H"5R+L8Kf"ZbTb'T!!ef9)688
-H"HS9'@T349d'DVF6e88+8TkVARNG8bU[[ir,$1GPaXR#E9YjlDE!d&BTFj4U+q8
-RZCHc$SDam2l1Z3[IbFU)(ZcVddAp-24f"Pij%03iBHP"d+U9XPiE3Z+d89%U$jJ
-5'iI!eXr+Ua"Q&X!c[6A0p``e59`'!i&5lX,fQE[Je'q01rLbc@cAKJ)Z%"5Y'lM
-4cCcVcUjiISI86EHT!d`"-i4@@`-M4Ji"BDDUE,%S9CTAY!RVjKEB*B"@m%`iJ&D
-`fMq!9Y$Y&d$E9#0TVTm9-LTbab,ZPMZGUDT"er#N+pAh,fr0(C!!3Mi`B"l@,*2
-0-+VSP*PM)&!4U0hJNP!JUeVR`S")VPUCkNDBkRiE9RApIUV1j*IUbRLL),jT9&P
-l&#FPrJ5T)9dbEk'%2'MHc[1j&UYJL6F8`k3e0BKF#-iZ%5EK6Ya@`(l6SL6F8F%
-F919dMpB`%MS2#k@ae)aS+K-cfi(6-3cD+Qf@'3C0Skc1V-,&4iempZJ"A"bSA$a
-`mYQlbE(UQlb,V2CdPk%i`KIQQ00K4Z%Fl5(K#E`P(#pLQJCA$DPaS!)"l)H%BpN
-e3KHr*B,T)ae[JE4(Kqk(e'[EYDI3('D,dF8[q9GqKI6)6UG,MBHk2+(DA&i0ERa
-&@(*9JC3ae6R'9'I$-Y9P2jNUfaqQQQ153PUrlR@'Y1Tc2IqkYkU!XZSq6h603qF
-H)LE$1Fi*cBbl@UXLY6Kj8e5qMK%0j%ED)6pHZ)A6qDP@kc4j&k[@LmTA9@Rk8N,
-'&P5SB`IBkDC'R%YBSC''eUMCTCKP&*8hUNd%F%+0KU@3!%*K(f[DQaBMlM'fK2P
-6SCi+RK++RQ&,3PQi-pLV-h'R-`ee)J-G6X(M#5h+'0+aPiXkcIPUiJ4Xrj5D-FT
-a&4@cBciV1h+QcC((C8q9f$`e@12)298FqF*H,V)pmLlCNGH6FeYaAI#N'q6JAFm
-[UC!!M-E+U4(epB3S[+0H(Q1)%QP4f-X1,-4L0Y5YZ4HZ!-!r`4+ac@C6k&LVfG6
-CkY5JESS0+"-l`hEfQ0Iaa!G5iqJaFS1f25Bl6)Cd'20@0V#kaN%p5'abAYjNKk+
-'d20%%V0V&8A%C)USN!!TSN+f,GXMHRA8E0TXG3XmdE6T!`U&&KkZfGfmSZ0j`pA
--@h0$F,RGUZpJr0QMNf5Z*ahK935L+Ta*Zd9QM@6fFFAe+LADCXqR`@`!eGYF0i%
-AAZ4"+,X`DIaj[L$"TJBH0H83"j%@m22Yp+2QC)AUB$EPrMSZ0F"3Q'mk5#jVb3&
-3@'!-CIldI66dBI`T9DANpLjmJbYqMj3KKDm4Dj2C-*NAm`lcHBHe6,f[)9(,9VE
-iJH+8,jc"KRl)c%'8c'LK"1rQ3*`A"HDXYdRX,4N3Kf6r6%+MNMAB`#PHm+GXbAF
-fRb"i8%'lbVDcfCR"fP8T,'!m8bqiCFBQe-3&6qV2'CSD)+%KPNQPf&UF-Y,UB&Q
-i@cC"BLZ(MPb5$MBS-H%9+4aIH(KbHSd*AR2!pJRj%9(pR@!9kII$9U3YIPDN-rb
-U5*0B4CUfPiSdcEq+G&IE`2,(KbR*-SM9[$$9kDM5#F44RM2jmNGG94P00ke4%K$
-`*M!XI-U889$LB#3$2UTF4XBY@GNRI&mZiN6P$4P*Q8I,$Djk#-Z3!%*B[[j+'-)
-bdjD`I(e#)5cTRh4!iMZ@T#"F)Yd,Ce15Rda#ADNa30Tf'LAAQ1SSlPFq,1c$cMi
-ml-2"2S,X`mXq1YfeRPTZF,`aMCZm`SbLNXM&ElTimqhfiLA8p,)S`!3pA%K)lNT
-6aiXp3Khbe4KUUc%d9'2)8Q2S4SfKVKT$EbT$-,j!mfp4dA3a(Uaj1,MjFI$S6Ja
--G&a,me(6`++ND6e-b#DSNrEcrYQ"i[lClk2TEldbH+GIB&!mj1UhS($+"lX2DEr
-UY`4)XBF@ZIVYS`VL%b$X!9,d*d"iTK6%"5!m!9,m"5!F)`VLA5!F!FU)Gi%)`Na
-Q!Ui03S&eJ!`'+(-Z!HRPb"+',!(5'k!-)f3RhrEkA$4('pr+1mCBaaJkmLhaMP!
-!bpBe,&ZRR%V5NjSQB*+IechK%5r@G[+"mH)H4@hV-*!!Tj(a%6UF3&0hr!Sh$#S
-T-@N(%T0f5iP$Bp19"+IP+ja*4Q0Na$*-$fShaZrK)F06a8H3!%k"VM91i($0qI4
---5@D9j+9FM!hRi'jSV"JESQIB#lK&jLlCJZQ[RF+)'LA(f"U9dd`Y6PqZQ"Ummf
-pJkQ!5`kQ!UkU`G5X0[r!9-'Yd`06N`HcI[aN`&4$krmD-0A3qKmhQ'TS26d`e9$
-fT`&-0C5G(TK#FZJ+8S44BT1*pj2`lm&Bf+HG*eLN6`p2fNHI$Z&JRd'H`*!!2Vh
-#bcil4HHlAi&i+8pmc"MR%FS'DV5"NRVVdB4$3i89B)ih(eD%IhF(!dj35-!LZSS
-hQQEK(3*'N!#$V(0JP!`Lf86pN!$a"X#DJmK,mq-dj5JPM)Cja+2CdY-`Dc@aj2J
-%3LRTr(S#""A6F#8bJ$faR9r,(`#JlKUrL3-EU&N*p8M"+#Y3mZZ0@THcZ3J'5"p
-MJ25&X)"dRCq!Y03[3*TIdb4Y@GI!mRp+0V6mAQUf,U`a'R@53'LJT-S!#L20CFf
-@V6D1Fb0b0"6('jZ509a@Z%GUq'hC5Z'a*DDPDp"F($YS`EB&5T)5H90a5fcGKl`
-4258*R%Gh3QNk%QDdlDcTVeTH21308ZfeH&KRfr#AAY"'b)M8bXf9#r3,*$-bGL6
-@I"9[RT-+3TE`cGF"3KmiQ%aTdMA@'+@XpFNReQK8`AV'9Lq&CDYjrV(9V+kUf5T
-dHpD$CJFk8PEH*m5X"c2(',-&!#)Ih(GSAmiRha[ifF"(!pmDh$6`YAdI$UB0IRr
-`pAdE"Zm0CJdQG9`Fr,Z"dAdIGk4dI$a`8V$r!*!$+aY"4%05!`"TZa"9#f5C!&P
-YNqr@ET4DPQB-deZ'[)aDkTcEN!$&')l!fdfPeV'9EXK#5&UhYGedep1cke-)Ke9
-h23b[Mmej$"J1-BD)'03&G8iLdSJh%I%(`aJ3BN!%3BKkHh*c2$YLl22prqrEkpZ
-QQd$1ZArh04e@0L32%4!3!"!3!"!3)HlIe5Y4M`Gr&088FU5%&GQP)Yq%Lpa5T@c
-DaeaN%2ice%ZZ'4-CTXf5B#)f+F5%8G(bk(!3cX'Ep2@(&'GpE2"1-5'Pc6d+"-3
-dmh3eF-)FFrHTG,GFmRMUE5NV2*klTV'EraLQ3Bi@-QEjKr+N1-I#qKV&Pl*#86k
-M@krTeXPZh4!0K0Ud'-)ZcL3T6R3$-$`!rShGATCMYhpeqZVdR,*pT@RTp[`MkGU
-pf9bmV+qI@aqMSq`#%b8b@+0FlCkJf'3ReUf#F[T2chZ(i,!GTe5'mq#feZ&@2"M
-RDBdH9Xam19F`+TU6iP3#3S@YdFb9*q[*a8D(DS03hHT'Tk@*%+RUKI9QpK++26X
-3aiqjhRV-A6X9d4'ME36qmE!E5fRbEU8YVp0BeSNI-hjXq2(LTamr2[`d4Ha"1ah
-ejG+-dJU1'X"CCFHQb9dMKRlb0pA01L"*Y!&P*c401MMFP8B*(38-[$*#)Xfl$LK
-1a8P)&HHUKN,0(-"F)9`Vl2BMkDCe'q`KVDBR,6FM4eX@b%Q9[Mrd*lZp1+h`5,(
-@ATSCYMmNMlrkY$fK0%1&led0Y1m0p6aH[#A!e-IU,Hk$8jr9T)3YKi5Tjm+0q(-
-jH($UZ4"8ZGF&aca(G#4kb$heT1KZQ(l0q-(T8lX[,TRD(FeFlSXqTbK(MNR+Ph8
-h%$D94)dA6*GVh*cTH-jd(*L1$ih@@i`B6K$GhZRA2!Q'Nm"`%KK'L1%[9[XaA%i
--JlG(#0(r"YpR!d1SYm&pF1ecQXTSjYTLQ[EFF$6c-ATmJC4-0bf!65iVQlA286A
-"P,rb+9qDTMb2abd96[NVQe*b+ddT-CZQV-IMfBUQP0`U65RN8il6P-1V'&NPC66
-PcfmC6#Q8TRc$TcaVQJ+b5[396[Q'69Pj0deCf@+D!V*@0P8dCHAGI$2Zi2+'d26
-P$@iAYR`l,bjCANHJiQSISfR[EX((T`JBeSpR+bmZ@41MirTrA,lCm+-DNcXcPpI
-G%9AUf-1D'$f)Z&(2aTC#G$X*F3YLG898JZikPc4P-`h$-J%#NC9Prf*m(%0!X(i
-m-rlLNV9"1UEracAc$$qU-4NN""Jjp,!fb-KC'qb+($jP(Jd$Z!,NE)F6d8b9r%f
-l[C!!4-[9IU+PEJF%cYjX8c8bG3Q,%`"QK%+cS-j2FB%b*3S`b,I,0l0E%[piV"1
-rl5aAc*fP%+JGdXHRq%HRmFFeXD)IPfmfrSK"BqMih`FSe`EPfcAcf+h%*P"dZ69
-MLV*H'kb!K(R'(`'N+(8prYd1Vk)%X,+U!3a#2U*aGQaaE(IA+#1UX`b"0A9Z*5Q
-1[cL&6QN%iTKh)Bj(h0JJ90',2)MqL,bJDepKF9UkeL6lrS$e5J[YQY*LEAkZaVj
-IPS&eKH9(8ZdjU8G+Fp,afFkk35B##H'4FL@b"ZiP93XMj%Jq@c$XBCY3dR*r6Rm
-ZSh#X9Z[Uk0I,4lplJpr4Vhq&4bqXN!#D`XIRk*0GM3FcpE4&K1@Lj8U6RaPJC1c
-`KD+PQIQjTQ292F4@5Xp*e4l*R$b8jHjb1q[X8,h6d*ARZUj0eqE3e,(J'GKIV($
-c,pIe"f-!e)C*YXcLq[6bY2fC4c+H'eXq5"la%+2FM$*YUUBiEIpB-J*#&P)A5Sl
-JqVQSfJ&8E&e+"`+PK6E"ii%DjQh(BSjBj)"LM[mT0RAD'bbb5(6GR2X+&TF2%Fi
-r8RK!Fk5dH'`Bl6FaZMBYHqaKXIr99XkZkm&B+fIA2!1&aE94VFR@dA"9&@XLBS8
-fh)SU&Y[bSUdk%R$C(SH0&#X%aF,f9,YBGG@U`L'US&KGXbQ9$m'#2,kPIP6aG6b
-#6C)SY[(-@A!5&1HTPhUf1TcUTGMfpDC9)M6Slp`TMSM19$&VYpBjUGV4JSh#@1H
-,l3X5A*V&RHSE%E,FZ2NP6%D)j8hEHlB*E2YrmSML+fZRfa!'"+2H8B$MAFIC&j3
-cP[V%qTJ%`(dT(8%P%"IfP,K8YJ3`#284Qi`[4DFFk,QZ2j`HcXh*'#XekL%pBXI
-f'4rEKQ1E*hYXFqF)dR#k2[CQ(0aX1VB!TQBFfPE@3T0aD$-rX0Gde%SkDK)lDRY
-`*(6Kl+M4JIAm`$ce`(AYiA59GL`2c+X0UKr5+j!!JML09d1B+0S$iE6dXH()A[a
-C3r0,$3fII@PKE8CQ@TQfk+)(D0%dc9M9r@+$GIj-c-T+8bHcI&H+,CVR$G1rTF1
-p`l0F9&8V3(H%P"a*F6CXAd*!UU$X[DkJmMBTpJH%BKk@%*S(YeZ9fdZhm9bj'dD
-h[q[S[pPbLjpLEeFqMl2eH$aqLVfk0SSpQDklCrpN&,[+acEMf(2*0@!ppShkQb6
-&0KhlHT0bffJ5$QhHEU$Dfk(Dr,"3lIJ,fie9He0Y9(YLaNUY9EYVMSqIDRHpk0L
-TGLYh#!$"UNlUb!2$5F18H0Xj6)J2R%XkaaaekLAcb[QI!,e'Z'HQ"p2`VcU(Z8(
--2h9X3+,[cI5"MX9H`&#3!)aNC5Y-m6UB#+hX3mB#HZ$"hF["+2)V49-(f*65F9E
-KB43IJX&MEZe4pK&,fP``GAlP8U6TCf#A-U"06U$9@Rc8$Q6hAHCrXUdJZbrle35
-CS[bKaJ"N[,ViJqa2Y3ECC#T+VGA5!'5R'-L-!@DJB*XNF$RTS5*`@B(eIk&@DBq
-A@[f50M4dT!*)6i-`A43DeTN([A3E2`aRm3@iMpH,#8%[8Y*dbQP0qF&bTFlc&2p
-c`SfY1P8l0JbH3P)#*5Y`j`9F#`Q9AR%[Ra$M+Ef,()TbeF'pRJRLhR[,PG1H(i5
-48YCHlIR"(YHpDXmE520m!``Q%)1M@cq2`r!XE"f0%h[im%R5m%Pmq'8-[icKiib
-'la%6a!"F4DHVcIF'2&IZcI"Fm6b*G*XR+FRCV@M1LKrMaBr#MCc4MrDi$RlXbI$
-Z&K-1"V#P'q$,A-#d#jjRi!DIJ`pAHkCK1k6Dm`bI-Qf6#aX4hX&Rk"m2-F,8P3#
-9"FcpMHfG98UM'!r!4$`[m$r$!-m`dZCr#G$q0m"i2`$eJQF0T@CB93)G@4mhY2Y
-JD-GcB2fhBd5-Tm28Q-@,)(Zm42CiN!"pdC-+XZ-jJFY"hR*+`8-+GN@Np8U1H5`
-20pH#52bp4h(-+4+l+AYFYkU9dpbaFBDrHTQrH(Q25h66mM!NIqRGM9GAHplL!hl
--!I)@(rCM$K!!(SU56bDRHXQlHl!C[,86P@RG8RC,'`T*`l5"(Xfm2ir3pI2H%"`
-9NSZk$EFm2CdH&hYT%([%`%e*h#@+fh%!feE2'(+E(RJ,!q"N[&md(E6TB))RQk0
-aYS6'Pd$N5kQ*qYe)i4R&i8Fe05"NpVAP5S2RG@ca[6l%RBMBe'SAMf%VM9*TXNf
-+1b*[8,RfDBTcdmZlUSF6#pDV*(SN3Eh8+RVZ@rV+4FqV,Cl6(NIac0+JXaYY&U8
-4,YLq(8XpV8NAS&5YT&3)15YCi3iL2(T!dCR-Xrk8$Kr5*+'5&KbK(f&-Hi*,eB+
-I[!5Hm)NYXHdA`3M*kc!3bcUaY4IaRSQkSRT52lMS6S4Ff1ULVE-@T(pXe9j&4+M
-k+$9H-ZaZcXe),br9j)bPZmk648T!+#GR4I5SJD-LbqUSX#)aHCi*L6P!HU89DE6
-TL+1fmmRcV*0K[&EkGc&*E)%YeN(SCQia)AQ[Rd1NkSFUiJjK@kZR1!Ta6"ZP*ET
-rUN48hV#2K)6L#cD5Q0$B`Tk)LlB%)DM(ki"8&(jJ"2Y51R3b`8D1Ql"A2`UKeZN
-q"&GVNlZ[f-H#'-RG'M-a2)k85)JqK0k(Q11ec1YfNIK6@3HG$TXjZe2L6YT+Z"-
-9cA4V0YhD"V&B"+EpVVf+Na@#!E$X"UCieF&9C80F6KSa!U2A%%M"#S"8Bq(!0VZ
-l99lhD)BaN!$[Ye@MF%LraSQA%3l%8ql4iM0q3$5HX)B%Zp+2LK1MRkpG+Y(4H4K
-&-JihiXAC9$2[BXk)"a#)r9%a[cRXD$Nmj,##1"AXKej3kTeLBLFAmmk0pFTN8$*
-Sa,B+D*&CjDqT9L*2%iZN1*1B,M8)A+U1SV%,@bE*k4pmSr[kJdI4d@r@j-(aVJ`
-p44fjBY2d5cFNA*a)r,EKC6kf$@j4kG$CE#Ca`%331[m&[20I`%@4ac5m$S`V2C3
-3mT&9$6"mSk3)Ni`U5b-BE+4%[RXcP1pij[1T'c")MjqVm20hr+b5EZC$$"%4'b5
-fYT31G*2[iHFQhVRI40f"T!JN5-dSI)'M0Ei1dfLqjqqd[8%Tc%A%+!G!ie1-r-E
-X3EJ0XGbAJhFLlF"#)T`'hqcM*0l&MCa(SD6i3qQT)(i"42jG)6)9CT(4%#aAE*d
-lrpCEq5,50+J,@&5I9cqA$J6LCq(Q,Rk3!%5rBrbA$ij9Vj11J1lJ%XL2PilKFa4
-,JT3R1[aEDpM$MFD2B%MH"4)Ej9IIRFE61Di(%BXk2UNf$pjCrkP-rU90r'8R%BM
-dAeH)A"#r`a!U41BhL"d0+H(Eb6A"#dpLJ!k(FP4c%2BA!@"r"34@KbM0EcBChM!
-RE8L(JQ(kYpi9lfQqp"p1B2rF@LAqeG#pA[8k!9mUhf++T#'eU4j13"L(UTMN+((
-Q`f(!YjCb%mD4m`!Z[cakk4fP"eCB8V5`)Dj,4CbkYD)$9HfiA09SBieAY$DQD*D
-0*YG01lNNk4'SehRSC3Q[D1KSj($%6QP-(r&UpP'5T+U@0M"dHMC,VL8RN!"d!6m
-hK&X`l)+Q%S$Ic!hACf&mE[D8!23Pq2KX1)CL`8Mk6l83kd3R@0r!MH@'A56!h'm
-[pGb!aiF`GCL+(+1)kE"L3q9jfr-HNIRl$-pl(Jq[DZq"M"L[V"-Sm2'VjPG*e6c
-*50aAHkj#94p!+X#3!,c*b)qfJ4pYJhbdS4)XprmpXcMVF@!5PSVj2S#I(1PQPL3
-'aNR,HRN&HJNr2q2%rDaL-6$d'CM2mMc!JDFh!PiIIUlM`1[M`00ci%d#m25Hm3$
-HH(bF*!([1L2JA@F![1XNi,NNi,Qimir!pS!%YJFJAYEK#-GPp9qmM`[!U`*aaAZ
-YJ!NUT*)!bYQ++RlMbGXYIY8q+f%Jh2JPG91aM#qjH&V'+r%bL+D0*Y%dalU!$JX
-8G,h!k5ERlARq5mKL6EH6"0["(ClIF43YNJT"c1&#M4HmmIbZhLBKD*%IJ[lV&!Q
-i6d&QcGHbB009+0LHjF93fG*6%%$H&BKM"i*3ZX64YmS)IFrMCb0(hr-FIDXiqXB
-!IDZ3!%*0DFG)cTA3Yp%)I4X0d,G43YpK#Af(6HLl5d,IACKf`P"iH8iB#DppZ@-
-RZE,PP$&QF*2)B"[f8&bqlE'5a!8+jARIG66jEei`99%j5DJCE@YG+V+a9P[cr`Q
-C(2@5@B1GEL3TGj%8a`(C4!&2VG2aRV#+##bcQ3@C&0EGaK-%*FHHMYrSN!$9613
-!DA,!DI$"E2#"`LiNT#TQ8fKb$`Y0T!&bH(+23AJbhdS@XB6L9abLE2BIq(Z%+FC
-T2+kHLX,4LF0I#NIrC0qlBq5Lm[p%U$NaGm0BK*UZikC3mjeA0G4m[iUKCLf53Vi
-RSHD)FDJTT63pAU(Q5+e$c9GKbqGa#$9rCa"UMKL(QK)3M5GX+K*U9MXD%'TZp`X
-eGA+SkErPpkEVHaTiMVbL`229hLkEiKGiMR#$H*2'6#Ne--e1fM)m(S5FCk3EXiJ
-A%$e8$*f&P'%BaZqVUY'&E')ICH&%KKJh)UqM3)icG%U6,R%MC6dQVIFc8(XP*CP
-L%)Ef3V#fA3[9mYc!Tfl"S09'BHLA2!4&J9R*`0RL&m$p&6rrj)E#2`d-8#6BXi-
-fMS-*qSr*"+)53"VhX#-d[L#&SJ@'S5JRFh%&SHJ0k")@aeFp&&dmd9$dHKcKZ(5
-8-ii-I`1)#1C'@qrM()c@&3P''lS)4Xp@5',Ai@L"`B4DKU166r@5`p(Y4F24'*(
-'`Xf[B9EaMASHN!!fM0+$U4*3i`&9$dXR5ip"@$SLKD@5fMNE6)'T0ei+6"YdRS9
-iGCCA2`K![l"d2Dpikj0-LQYCbXhc6E*jAL6Pi3*h'E%`G6X3JSe+)$8,a[SQcaU
-S6``,C2'L[j6m3%@-&KLCl!Yi@VR9E-IVAQcf[+fAYRZ-JPB8IIV)m`iGiD%-ccZ
-HKGJiH3F%T[#+r35@H-*2*-b[-'5G,i@X%Eq3!(8,2rB@kl'(@P'Y2r(FajP2-`T
-DCdP"+phF*`Q0DAj"d@r`Xi),M49&K%Dla(i-AYmAG5&4FKB(lqSZ`GZ(Rh95)%[
-JAFh"1`AJAHejA3,[&#VFD3,[1L2`VLX#hR9qi$8)DaqLB*S!1`Z#DP%&3Hem",A
-4#S*DAm8LT2(CbB5e"3CKV9A-946@GV9%B+`#fm@e$Qc21+Ul%*-I'BHfALp(kf+
-Mm,D1SrM,,P(m2(9I8V",+2k5SrKPS2K,cjX5LPr'cjXQ&2FDSELh#)Tlr9"X%2S
-#aBXp#kqP2bF-K@3Y`Yk*TX-EKEdM21aPhAL0+I"e0KL%[GX9%T%8pT,SE+K0f$Z
-a8-3Sl(hJHa,f2V"K)Q([b#X*HhQBa-,HGakhX2IpUSHp%pf%03jl&m+S@#JIjGT
-LcViK&m820%F+Y6Pb%EM#R1I#@Z*KYp1(#X-[2eEA2mX+&aLb!P'`9`ZcFa#')kQ
-RDij&@0kbG@)XpdqFT8X1EY!dS`eT&mI##dYF+*9p'F,Z(NT#S"3&+YL[A[*K2M8
-qb"-8PR&heaceN[Yr'ID%A'kICM'UqXXKPd'5`Kb@T-"Z+8%"dhK$'MfB+TUp0fU
-3!!,ai45q!"DXiBA22NqY6d5kJXZ8VZ#$N!$aXZ*d9&JqL%)i5!bCM53'Pbi"k5)
-ZeHQ`46rDD6Qqqk4VQeT"FfVE"+KSTH,N4Pi"Eqj$CY#f$HV+Nfh3m"i2VDMaU3[
-ee%62KASH%T9Y4f,-+*UdK*!!IRIkr6[h+56%)-aMeHr@ImS+!KQRMN""el'd%BM
-E"ph6Tij6YB6`4ih#IMSc'DV@)d5LR2aHASLU")dIC%93,"!(`*r1Je-Rd5(3b"%
-+i%dG,lU4U-m,`0UAF4-$4pY&4kZ4MMD01RI6dISJ5QeL1hrejX(-U423$81SHel
-RM5iJp)$`IE1V*'Cqa!J)@X0-S3S1ZBSG8KF,pTR%F+&aHG3rrF'8bi"5Q9elQk6
-[Tim8NblQT+9b&p6AaB@bM[Ur-a9YCFeZm5EB3N'[cR)l&BC,C%@c&JXP!p4YPh8
-'3d'%`MGpJ+4V)&G-E1Y$J'YKiA8C,k)Z0j[PLN0E"+8[D&qe!jK)4A)BUUPlqXS
-X65`dIH@H3jNVpkc-#KjFQ58H#`BL1d9,&N3mNZ)Y-iF4Z*XMB6-DUU%QC+e&ML1
-Xb,&A[H5ICb+m5e![QGN8'4D2eAL$&h8A$GRAJ(ePSTLBp92&U6eER4Kk'Xb8qNq
-PiVjkhK(RX3AIePHEN5MeX5k!SX("K#F8TmBTMML'1VB%SlUG+2lEcJS+5k)B4H%
-qMm1f%4Uk&FpaSSq*!5TL&rNA%1ifUF0HZlffSP)'*J4iH4T+HD@Le'i4-"BB(E3
-!B#bB#"LcLS$4"MF8Gq'0G+*j%5X)r9J$K!Arab"m[bJ)UpK&9!a*3e#Z-MV`+S"
-beGL$FZF0IU$dB`e3V[UI$-VpB`R+fKFMRjPN,8DqmZJV,dBqmaI@BZ3VXkY3M$b
-,'PqQ*K"3Q2SCc9(CJ6hieX8P+kI*VQdb)S0ZhJNB1,#a$%mMc"K$)T5@kF,TEH6
-3jX@aRe&M!91c"BA&4p**YYVp3#dAQQ`P`"ThN[kUPU*(8HqB62Vl363Ge-T5YfI
-Qb`C)%%)qQMNcAjTbKVS+iq-9)EY6,[$jljP($QMYA9-S0ce+95JS05B(NkNrdP0
-bS8ah5hXplk,h*SRZMJmkcI0HShp,ApXi2'[hpedq*IlFf[@IafNAm#4*YR'a[5`
-0fGYf3`RC3d8jk(rQe(bSJEhKTBScMk3I-#+&0I$3MN1fV0a3'$QXq%!B5,%a8Xj
-5F'M4plP4l%56"a)qdFlL982D1!%"kB9(-LUQSS[P'A&M4i5U+"(r+K14NCC6HbT
-i%lCIam(*G5DBTTaDqdPCF&rlGUIY@+1LG6CB(,cBHbq+ZbmV[Ml,V$4m[ml&5EK
-"h"NIaaZXcA9eJS5FY0a`'"@m!Pb`PDUkd0+*,B6SF(),3Ec"BDG,8lbGD5K8Y,i
-Xj[9&ADIe2eQ[A551k-J0G`FBl5mYdfC8U$Q&p2pqa9pGDF1#e"@'8$q3!(9flIS
-bhqf@@ml!qFq%D4e#,2hDpB%il@`M"Gf&T6+1T+CD!pSL5PSB+14SZ&f"Nl(*eY1
-SP2A,`*K6h0"J9QM,J)T9`m`dKa'S+@K'[X+"&RRJFIdaaDG81#M2H&#6FNEajRf
-,@h,$YMZMZk0rUFC@&M9ecaEb*Y+V5N@2CMc$3p*(Tca&hih2cXQ3!#5D52qX`J&
-HSk-e6)D4B$63)C&a5CP5a5Q#dF#crJ0j8m`ZD@J-6&eX-'rQ'6G[-QQQHDi#"*+
-53-QFC&Cf$Yq4TV63`qb6r-'XQ0q&)U+`ej1+'3f[,jPC4X(qi$CdecZJ'UH0`fb
-*Db%93HZL`ZCrA@c3F-4T@L`b$0HZ6@@$'idC&bmM))ZTmTLTfe@$#rk0r*K@cjD
-F1DJiU+3q9&,GfIESD23$+F(+3pA8De%[q@-aYMdEN!$'hYM[#P%eA5$Zj!k%b3Q
-$3Y*jUPe9AHD4L5e6N5M`@qE6"LbK`e*e%!U4$VKSrEX9I'l!jdSbQb+0cbZVGjF
-jRfq-*!DR+Q*NUP+CUVMhJ&0hcG"A!f(c'PFK8[hMQcY$SC2Yde$BiR&i#1aqGN!
-laY&Lr$'dqpNpfUAH2"aq(Jjr03kIPQ[#Rk%TeV-h9-T%5iMq3Vk%*"(cU4IJL%"
-P'h"`%3G[kM6MYK+hZKVc[#[dEqQ9'iCR$93R'S#MUA1UST2!-FB%$N8j*bD%QXN
-4+Ri9hi&Qd"lh4`kJF`k[rfF1SMN%)M1"k$5C"4Q6Ka$T5)L,qJ!JYGqiFP%5Ja6
-LM%%P1iT!d4f)BeARamEeeT!!p9lr5QV%D*jkbD1AUm#Sd-U)#[X$@@EapePYaAP
-8A",TZE`"J1C-R+l8DR+AiRm$8@5QKdHT#!`*'jhaDUH[YRqXcG#Q`N+VJ2`+f%5
-Ub+E3'!M86"eV2JZT"Z4iGF*9Xa@AI`L&UA(Zqf'L1[Nfbf'Ti5aANY`%N8-Aa@8
-ZR-b0%Q60E-ePc@`CZ&&Q5d@IV)eVlIF6UkpqieU",Yl*33f#!h)"dPBS'[@Ebp`
-TBN+%YR(G)K8QaSZZ(%IL6YjiQ'6SZlkLRNH9mHUi9+$UK"RZqT5k%2GJQq`FKlR
-rZ99GikS"A)3V-ae5!aFme&bX5-9eI&,M,U+I$KZ#4&D%1E+*Uf20&ATYIEFJPS,
-`'+kDBh6f)QYJ)PSQlKK&b12Z`64rTbJ5T1k4A+*SRQVfDUY,&!hV9HVkYKe$'1b
-F1@`01lHjBCBl)m8)pP%d6Q@10#HG5aM9Y*U-Zhh'$VZVkl+eK36Y3%qf#69@(0"
-RJNQS"lI@!"ME5GKmN!"#X5JHZU22mFEpT$!8J5CYQ[CVmRJJZ!!IET3HEX6$$G,
-$$AMiKr6`$cc-PalQiq([dX2ImA#9p(!9(Uk4(Ul"`ccTB4iHlT-HlX2$,1PK&Ki
-HN!!H(UKGd2kBcbKSelrbS2faZif#p[86#GTcDE13!-#V[84X9pi[IrKUA5!Z*AI
-J5(jDDSkL`19b[fDlHhV"l,3c#IJM(LbB24-&ieE1&Z'm381-q*Ma)%r`QH#H[Q)
-CNJ!b9ba,D4[%3hdpFbZ(JNPJfDFpA!U1B,PL$M&E-8FmZ')1-5ZB)c0E-5F$MZd
-9ph!fph!fpcaj6dTZYpdZ6CI-)bp5i2[$&YFS(0@fAGLqfYFDG!I1"mk6%+b2K@I
-hMX)Gbjfam@&k*)GfZ&92'eh2QVH5-++A#4P86*%C6Qm-3L-23'4R3)cN&ZE3BUI
-f)9J5+qZ9##BrSGJL1HDY36GF9ZD1,6`p,$Hb-l[eRHBDLbkaT,XX%S%M("p1ePJ
-+F-%BR@AY*aSEUSpTH%QhGVjSDHY1$8$-fC!!VX,*L&q&jNMi!YY!)-L,XI!f2ND
-G)TYkQC'ART[2laJSEJCj2KJZ684%q,YrD4Ch[[e"*"UqkbpYZp$JXN6db$re[cT
-AkAE281d63hH@NrP0$V(EGLUf1d2Nj-DY1A)HblE6XPr(4iC0$`q5bU$CS[0hBK"
-qE1&@-D4[#bTC6bMQ3ZHf(YSFqacJ1mF),#l0B-3TCq3`-l9e8dGiD(G(f,Rl*dL
-qi83&4fl5rqTmjFlPefQF`5F9fr+rDFb$cB0JLXD$NDTc@bNR%hp`Db0AHK+DjER
-!&XR0N!#@i@C!24$Ek*U+5EMJQVME29AaSUNYjqifh2DVE&Lk$BpC2L5Eh,EEYc8
-Ppf5#"%4MA(2R*CQ!eI@+lS9@hEXEqX*$qMijQ!XUcc[A0dGfr[1[iB9k1"Yaf5+
-,r&+R30Abd*6(Tl,#SBN,01f",B'RmBUK1-`E,0@TcU,a5aYV0Z-f#0&G"&BhE9a
-cKf,ZC40akH&L5H&EcJ#-69"#-Hc8GfMbDlBK*6B4j0%Ph(B!01'8h1#1hf`+IrU
-AjR!VJA[MRNfZd@B-DGE%$VGZk9L`jmkqk&CaEfAJLrIJp)64B3@b$VFL"2PY)h5
-a'mC1CYYX)LG6QkV5fY'NFMC$,N$P"B,lJFlQL),d!RhP$L`i3a0L"$"Lp,Yh-c+
-FG`,dr0B-j9cZSq3hjflF"10AJL6G6k%#kc4$JbHk4ViK-4RD`cR-*)2!D%A+B1D
-+eXifmD[EGLM11r!!CF!ImE9$1eDd1Q,dTr1e1hD3!)RB*kN20Ei5*(F)QL2Y(&R
-aL@DSqEf95eDdDT`dA(a4CHjXCJ`(JI,"CR&(d%iZNQk6!P)h"8&NbaY9&1rhKdB
-pRQ@+E43TJ%TC(Llad%JAB5,dDeDKiie48JfFc6cC#4Y&A$&#CHcQH+V)hD,Xp@9
-D!%IFEmqh9[B'+[3$"(pRiqJQ9l!a(#KaP3eP"rMamqL`MKKEl[LbT,KJ&-lfZ8a
--NA!VJ5'6lc-YfiZQ!qB'i$!lj-E%"SJYjeSkqJ+CKC9JaX"i+Yca1`2$l-9[T'i
-F$[$8Y%al0UbYF&TDF6SRQ5T8reIR@CA"K40-3TH*DYe1U-3**"1d-m&-&iq$qM3
-rkj+Ec+9dEJP!%pL0CL-AL&MkT6,YC"Br4BZ,#-iLGb,)K6,8+jA8e6c@p,Bq%Vd
-c!21P2@P8Cm',ZNiR5b+T9'S8+$95AN8NZX!)Fchr(r-(a-3%&bk8XlZ`(),d!pe
-jQ$j1RI[9Z3hd&A4VTcPDM&Q(qQM*!TIf%Gej)M[9aT*Re8Y@E(dEKAGJI!8!cUP
-+!qXB6ZiY29b4122GV)2,,&ZjL%-lR%N`3JT1jVH+&Rq'`@M5X#lUEY-FMalqcK4
-kpHeRaXMr(+j&A',2rD[KbUJHbA6LF9`bbqcJADQRp5XAdT,ZkFA'*j+(E&#5Gf9
-AHY*`m"`hKq0e-+1TB6,4R66-',lNMcK0k@&YQ49eR($4N!"`G2P0[cTR5,i1j&G
-'G`%JPHH`S@2@L-&i8Ra92c8Z,*&LSdmid*c"%i-c'!Qr0P3H2b*iT6CVmULbi[M
-(5Pcj0PBaIR81f`j50I[f-e3c$1M1j,`NCc%jEZ"LZTi",FL!PZ!2Y+#LXh#f,I8
-5NCm0"SLa4(#5j0,Ydk4U+Af#+Jl!8GP`U9'[am(Q4&A5B-FM)-+0kMZ#p1i@PG5
-Be'F,3HDCS3-,Ed%cb`FJKC`J+3CA@)Z+40N)c*Fe2*!!bMf2+)@hH)Nc-(('!@q
-mP0H[#FZKE!mY"aEcjF+%B-,DBZ"-5#"61"laLN-*He#"1pYrEfY8(YENYDp#8Q`
--$c'0%`m2KejM3c4AFCFEY"HjU$N-(a"p%)(Dp#iCaMM$KcR$KcR$Q$($rl3bc%N
-cBNF'`feSNP#*i)q)*#5GiY02Jj-(#8Rij)1M1[H+RIUjX"d*24TYUT("#G3bB(b
-14MUbi2DKBRflMK)M1"LM2(fZ4QQUT`ES,UA!4!S2P9##(jU$4aLTJeSkJlKaMkV
-NSNbj5,$3SFN[(bi@De%509kC#9mQ"+03B31[82aiT-b)+*r*4BMP)NLRDp+CJ`M
-'9+&G2BUZ3SC$f0`b*&3J3X@j4+B"H6iVHDCM+l*UATD4,P0%*)N%*MSU91eKMFf
-U41Md2EJB&bBL93+Zf%IQSJ)d&U#B6RLI(LNQ$jUTQ4401dqHIjKBb"2#PK*AjRB
-[66)R+(mdijU+miCUP0X9mfjmT0FF"3d!Vq9E&abLTmfr&a[CC$C3SF[`QPP3`)q
-a,XL6E$4j5-E6D@T`'6ZAaQCGfZ&P%rNRQc%a#B4%!"YE`K'iB,hXmcQl(Df,fFR
-0`!d#!-%F2Bb'k&Ph0GZ0T1e-FYY'#*c%"%VFBXa)V[JrAja%lUrF!3di&M+3!%)
-8HMQLkH)&qRF)R$Y0)(Dk4kfJ*@A6m+3Ll5N'-)5-3kRl0K'!Ak3#1+UEB6k1UNi
-Kc"Z5`@%UKX%[eqX(0K%Z1JRa5A%b#P39)5Q2N!!ibrbe`Jj'bSJdDe(6+5rcmh)
-#3d@6MB(UlC0CR9A!V-&Y8H@&B`@ZUM$L$dMU0b%&EGcj)F9@)9+UMC!!dQmLC+S
-b&mcUPEN101@#%*Ch1ID4J)3Hm#kd+Mb&JM)CILS[!93@RpJfTJTh,+80eldm5U*
-jm#5UU4-0cX6a$BSQ@A3$V8j8C+QaB-DQ@m2PY&(+24EQK2eL042$&98kpNUZC!N
-+NF8q-S6DF%eAVFfiSV!AAbY-C*R3hX)'bG2jT65NKH#FNaUmb9r$LbF0C5Z63aK
-M`4K#92NBkYMREJfA+R6-4(,ZRXCa0T9LQ4eeMEBK&-V,JlJI3YAGTMb-`1k13m)
-AP@&2$6VKrQdJ&DJ3YbNqqS$J)G,a'"ccfj5kMF1BE0(L-RYRKViH1$NJ0Y+3!'k
-l*NG,2CBL1bRbSq5N'*!![TY%,)`S+eJ"a$`#085AY$`6L$+S0$U$`rZ-$ZmhK3X
-HA%T3!Pj8Tpc)Za5Ub+Sb'@RI+USNaYa(P5,2jP3XQVd`#he)Sr'9aA$aLlU#UBU
-[d-a!kQLJPfep8$8BZNM6)l(MDm-3ZYL%-DSGHHa4%KE(B$$Y3aG&65"%NH!!iaN
-1J'BZ(VaG(`0*cECGk)4N4,,2!#k9QP)N8mS'%(YK(0DcLfhNEf#"$J'EMDYRJfa
-bC5[l("deE`U5c#YY*KVdj9h-+6)(qTPCHlCHZ6XX`Nb'Uc4XUARaf-!'9f@Lb[E
-bJ,JMp*Th0'&!X`LGf9R4%K8'K8j,MQrQNfJkbh,IX'YhYk['qFJ9$+m6Gb5pKJ6
--+[m"fr8[h,kKlhkD(M0pA"5fE('KdXDNaIXdLl""HTL,)Z3'&b0NcF34e*3QXq"
-3&1iakN,K"5e0Xm-'06QfpR'R&P3M-bqF9q*+ik+&JKe+2e)[qD,KE6dCPET!C#6
-FZ%+['KTX$MHZe@2KQ+D&Ua3A2(a+6"1Mc3"bjm%CE%NjbET[HMN!GcK*%c,hB-T
--rb++jJND#59ZHUKQh3JZFN20@0RF3R`FE@m$m9&(1ahLZhSFiKjb'Ri4c@iN3a!
-Q5Q'j9ST"dLMRPiYGMR$Y""KP@)#U1&f)J3R%qRDJZjm[SBZi81MN*1q@T3X8mb$
-BENG$9@9@RPd`jDciCq88Bm@,mjSB[@'hldmYKD9[iN302,mKQlkQckJkcKqGiJC
-YqR2TGXQU*j0abZdFPI4C-XRTF`4"!KF0j9cJ1SPYZ!(HS-6CCPl3T3%r1NHPHdp
-Dbj!!6[P3583J+LU*$Upl6l(0p-QV*(B11I*53A#U4fbNDN(C&eE6&i6CHPeGESY
-JmqRTr9#``["cKT23+!"H$p2V6"6d8[Kr&i5Hm9F0#epGqFpcU`H%6fBYq0N#BFZ
-Mp*rDIGGG3UVk0RA+XHqV$kQcNLmN,aILm62QDI92PmkD)D3+*p91YH@aj+`VDVI
-`KR"0mM2khLmq&$+%[`XjFj,A#MeU44lBV[jdG[,8bqUI#e1%CFN[*hrci6FI#@(
-KMp*)BGR6`UcNbmN6K"2VNVqC*ka-[Lcm,hj@#qA6K0q1&j,(#b@FYSprm1$jTmH
-0HhT`bjA"Z)%Vh30#3#J62RlkeeHq%Akp),P$k&Z``b2J8R(+3qSI6"2HIr44iAm
-III6MHfB)Sc1%jfF)Nai6PTiBk"EHQ#'X9aIf,%Zq,6PrF,m`@hhdf-(Nlb4r0IL
-QfYBXR"YmF0Vb[42DK,p-+qQa#h(6"0Ud'Lmi!"*lYlU-X4AHIf[4SLr`)r`lAKb
-j8,$L3X&bGFTJQr"EGCl`dK9K3$hcUGI9Dki)*eHG%-je#"d&2e3I6ABN[b8F&[j
-Pk@"LEh*1F[0J@IFh`X[5L'pqU-j*rQAbQm*[KG5PJc8I*KFQ$kJhFXVb-Fla`bH
-&kF)5GD2`3q%DiIM6*eF)&iA"RY@[Ulm9[K5Q$Mrjc@@Kjm,2ZSAA&kPI[0)RI(c
-0K!Hq'G-Rr13(`XAahH1lCj`I*h3[RcC&+&`jir8C*i@,mi@2IrhM%bm*&em6[Rh
-Q0d*fKr$-VrYqG+jlc(N!N!-B!!!NL!!!9lJ!N!-)!*!$)!!!2c`!"kR`!*!$#PM
-!!%U!!!"+J!#3!aTZ!*!$!AB!6R&+JfBL3Hd!)#!m2c`!!#)mUI!!!8T"CJ4+3'F
-+5%")35#!)8%!"%+R3IVrcY$m!3![##mm!!!CELm$B3!#V&52Cd"#1!TH3UF[2%4
-"9%%r2!69U"p`!4(!#Pj+RfFB6R%`2+P`TdC$qJ!U)SK"qJ!J-$bTF+C(5S0R"(!
-"6R91l3!L6R&+JfB#UI4`!%jeB!B!N!8"6R%I1[rf5KpQ%NMRi1""q[rU80"1ZJ@
-Z60m("bmkrpj1G@"b38a"4%4$69!!!`#30&"b3@e)jf$`G&#I`Lp)!#!J6b*8-@N
-!&!!B)8!!*$&m!!%!,0+4)8%!,U!#hm*-h`m'6R9+1!THC``J+J!)C``J3#!3C`B
-[1[q%6R9)jam'3IVrRR!-)LS!"-+i!aTKT'B!!6j)H[q16VS(EPK2X(Vr@QB!!3k
-K'Li)##S!3!!%C`BJH!+QS"XX+J!%+LS!#"JU!!5Ae*A8)$Vr9U%H2cJ#)'B!!1a
-86ba))$Vr4#)'`VJ$'PK"B3$r6#!krcc!Z!-D3IVr1##!5S9Q"+%LB!3J4D!RCJ!
-!Y#T))!j3J%(kr`JJJ#!kr`T4J%(kr`!JJ%*R5(S![#m95(Vr!LmkrZ)[1[lL,cV
-qbLmkrXS[1[l+B3!06M!ICb!r!%U&C`JJ6D!US#YJ"#"0S#-J6U!I)%HJ'c(I!L"
-JB#"1S"mJ4k!EFJ!5"1F*iaRN%3!"!#!#!3$J)%fJD3)!!"q!!5"0S'V9e0I83IV
-qGNU3!'F)F!'JQ(!$S*JJ659)!!K`!%cIB2K1G8cIB2KJ!2kq2`!J6U!I)%HJ'c(
-I!L$9e0I8-$J#)$(!#Q#4b#9)!!K-hf$i6R919J!!51F!1#KZ!!a(q[iU4IVq+L!
-8X**Y"#!5+)"+J'm5)&-LEJ!)SLiJ&0'6NC*`!'!%-$crf8cI(!"1ANje6PErb%M
-R(MJQ,J!)+#i!$#KZ!"""q[fk,8Mre%)ZrmLK'Le)rma96kJF-"mk!!a&!!"[A%K
-Zrq``"90&2`#S$e92,blrl+J0-"mm!!a'!!"[h%)RUCYC6bmZrq``"P0'2`#S$L!
-I,8$rm()"(`'TQb"Zrr"+N!"R%&92,`LTTM!I5-"b"-#"Cm3[,[r`UD0J["!Z!"4
-R#PP2,VJ#TL"IS"Xr2+$m6VS%KP42,8$rd%U!C`!"RLm!6VS$ePK25J"R#R!"(8!
-!&Nlk!KK)E[rN5'lri%KZrpK1ZJ9U6qm!$#!Zrq#K(Le)rp`J#'F!!@3J,[rNS4i
-Y52rS)!KR!!&8,blrj#m)6VS&Z&"2)!0Q!!#Q@8m[2%024%9#CkJI)"mY32r`5S"
-R!!#1)%!L8()Bdm%[#8kk",4B6h)$X%&QGL!0)%"`+0(!,8Mrp#*Zrr!N8A!BeF!
-Y5[ri,`T1ZJ5k@%mY32rm)'lrm+!T8%SQE[r8*dS!+&P2,blrm%kk&F`J(h,Sd)&
-4J#G!!#a96dKkrM)[,[rd5'lrr#m-,`3[,[rF,blri#mZrqK1ZJV'9%m[,[r`UD-
-NE[r8*@lrd!!-*@lrh!!3*@lri!!8*@lrk!!B2cbKQ%kk!eC86bC!2cbSRdkk!dT
-86b)!)!Z`J@B%F!"J!R!")!!P3!!F*83!)#9-!#4)H[[-2cbJr$mmS2a1ZJ,i9%m
-I!%kk&9)r2+'B6VS$$&425S"R"(!"S*JJI!!!!9S`%%M!i)"b"V#"CJa"qJ#Z)R`
-!!!-m)SJGI!!"rmJJE[r-S"Y96kJF-"mk!!a&!!"[G%KZrq``"90&2`#S$e92,bl
-rl+J0-"mm!!a'!!"[h%)RUCYC6bmZrq``"P0'2`#S$L!I,8$rm()"(`'TQe92,bl
-rm+QQ-"p)`()%`)&R##mZrr#TSQ$#*'lrm%U5Ca"96bm+UDB`(dM!FJ6!J@HU,`U
-TSf#N%#lrb"e!!"C-haai6PiJAdr[!!j1d%j@rra)j`!`3Llrr$mmS2a1ZJ)X9%m
-N3%U!Ce`[!%kk!B"B6dS!Ce!J#LC!)%![+!!-2cbJr$mmS2a1ZJ(H9%mI!%kk&$J
-J5b"S!"#J(b",)'J!'+!I)(`!!!&D-"")`1#!FJD`J@B+F!!JI!!!!c`JJ"em!!(
-rr"!Zrra-h``!6Pj1G8j@rqK)jami@8qTG5!I+J")E[rSU(3J$5"!)""bKY#",8$
-rr#"!A%K$l[rX)YJLf&P2,ca%394"2c`%eDQJ)"mS3#"!*&!b+J!)NQS!"$`"0#S
-!"T4U!!)q!MBZrr*)`cJZrqj)a*D%1!&)a*D%DJ*5Jq+$282rpMBZrr")`cJZrqa
-)a*D%1!*)a*D%DJ*5Jq+$282rp$BZrrE@36e$rrSb,[rddN)p3Iri@8p#TdKZrr4
-)HJ"QFJ%I!A)"2`&brbm"3LG#TkN6)"mQ3#m!U(-'K3#3!hJ[$#",F"$4`#m)U2C
-C6kPe)"q`K@3#B2496kPd%"pQ!Q$fF2mr!%*R)"qJ-Lm,U43[$+QM,blrk+Kc60m
-Fq%jH6R8!!J!!6PB!!%MR!$!NEJ!))!SQ3#"!)LJ!!Jb"38a"4'B@)LJ!"Jb"4%0
-08'B+-#J!#R)$X%&R"(!!B!*`!8cI$!"1ANje,`TC6cmmU'j`!4m!6VS5H#"I*%K
-C6cmmUQj`!4m!6VS5CL*I)%Uab@B'-$`#!'!%-$`%!#4I6R919J!!,`-f,J!)-!0
-)`!+!!!!)!%U!E`4`!@!#F!!Q(djH6R919[rm51FF!$BZ!!Jr!dkkrma86ae!rra
-b!E!"CK!#3`Ir6VVrJ,"$EJ4`!'!S@8mr2+LIF!%I!%kk%I!J(bS!@8mr!amZrra
-1ZK(J)"mS!,#&CJ*`!%cI!$K1ANje6PB!!%MR'$!i,J!)*'i!#L"+)"!Q3#"!-K!
--38&%CLJb+!!#$%&$8QBH0J4brlC"CaSJ+!!%FKMLU!+!!*!$rc)$5-'`J@F%F!"
-J!R!"(8!!$NcI$"K1AL"IA%p1d%j@!!"96dKZ!!K`rcm!6VVrNK!ICa)JEJ!))#J
-!"()BiUJ#3!$rB!*`rdjH6R919J!!98p)EJ!)F2mr!%kkrf33(fF3)'i!##!S!!3
-#J!$rN!0J!R$r6Pj1G8j@!!")jaJi*Qi!##KZ!!`J5c#m!`&`!#4-*)!Q2!!!!56
-ANJD5!!!#5!D5!*!$)#Jm!*!$J0Q5fC)S2!!!"*!!fC,ANYQ5"T)!N!0m"T)!!)!
-!F!!NEJ!3*)!'NJ#3!b3'NJ#3!b!'NJ#3!dJ'NJ#3!cj#3%cI("K1ANje6PErj%M
-R(cJQEJ!)+Li!$#!,+%!Y32rSF#6C`#e-rqa`)0R!,8crm(")fF!Y62rdF$lC`#!
--N!#,X)9M"R"P6[S!XN*!2J"#3$e!rq3f"h!NYN"N5(!%YN"N"(!!B!a`!$!$@B"
-U!PD!j)"i!$J$,86rq0LZrqJN4"5!)#lrq0#!d+lrm#"!-+lrj(!"&"*b!")#if$
-4E[rN8NGJX%*!2J"`!6`!0JG`(lC!C%4`!EC!C!4`!'!-F!!`!e1!DJ*5J1+!H!!
-i!be%rrcBV[rX*%38J#!Zrrc3J0#Zrr3J3$#'F!%8%R)!%J,MB0a!8NGJY%*!60m
-Fq%jH6R919[r`51FI1#4Z!!JQEJ!-1Li!%#KZ!"*#3$`!-J9`!$!"d)!d"R)!-J+
-`J@m83N!d"R)!-J,5JG+-)%%`J&*'B0T#3$`!F!)p32rb0JDf4@3!!,K#3$i!3N!
-p32r`F!!`!q@!d)SJ3#!3,8$rp$)'F!!`!G#,)%!B%(B!&J5f4f-!!))`,[rfFJ(
-!3G&Zrr"`!$!$8i!d"h)!-J+`J@mq1#lrm(B!0J3Y3rrmeS2@M#"$5P"Q%L!Zrrc
-3J0#-)%!`V[rb9'lrmM)Zrr"`!$!"d)$3M#"!-"!p32r`B"B`"G"!d%Bd,[r`FJ!
-b!Y+"dS`J36#!8NFJ,[rdiSJY32rdB!$rE&*'B!$r4%cI(2K1ANje6PErr%MR($!
-NEJ!)0Li!$#CZ!!ib!h!!-!(QJ$J!-!0b"m""1J"`!#e!rr`d"()!-J,5LL""%K"
-`!"!"0!9b!$)#iU"b!F#"dDlrr#)ZrrcMLG+,)%%b%(!!-!%Y32rm8N8`"A))X%&
-Q"N*!1J"54$)Z!"*`!$!"d)#`V[rmB`*JUK!Zrrm5,J!6dJ'3!!&-h``i6Pj1G8j
-@rra)jamJ*'i!#$JZ!!`k,J!1-J4`!$!"jS!m!$)%G!I#3Mi"GJ!f!0D+)%-3%(3
-!&!!Y3[rmF!!`!63&FJ!b!Y#"jS"b!V#"C`ab!E#"Cb"+J'FdB$)d"R)!-J*8JG+
-+)%%5%(!!%!&b%11SJDlrr$3'FJ!b!P+"dSSJ34)3F!!3!H')JDlrr#!Zrr`d"h)
-!-J,LU#e!rra`rh)J0J9d!$3$NS,LU-"Zrrj-h`6i6Pj1G8j@rpK)jami*Qi!##K
-Z!!iJ2!!!!564VJ!5)$`!!!*)dDi!%L!Z!")Y32rXFL$6VJ!5)Li!%Le"rr!N2!#
-3!i$9VJ!5*#i!%Le#rr3N5aJ5GJ!@"#e$rrMQJhS(aN953ce$rp`Q,[riiS0k!mC
-&9%-p3rrQGJ%k,[rQkf-p3rrSIN$)"h`!(!3p4[rLH!(VC&0%286ri#SZrrKq!FU
-(C`Kk!$S%8i9J!RVr28ArhRJ)286rj%T'CdB[,J!5,`!r!e*+,`T1Z[mk6qm!$ZG
-!d@lrj#mZ!")[,[r`2`-[,[rX6VS,#%r[!!i[,[rd2`-[,[rX,blrm%kkr+a2l`!
-13N!p32rB-#lrf,"Z!!aN!!%k-#lriQFk*%!r,[rS,blrp$mZrq3[#dkkrBj2l`!
--%J!J#R!!%!%p32rDG!!d!05Zrq`J3K!3FJ!5!00Zrq4J($mZrqBr,[rN,`Y1Z[h
-`8%mp32rD-#lrjY&Zrq3`,[rDX'lrhQB@-Llrf&*ZrpK`!$!"d)`J3%)3B!$rHM!
-ZrpU`E[rJCJ!!P$!Zrq*R1L4!2blrk#mZrr3r,[rN,`Y1Z[d'6qm!$")!)!T`!"!
-"28$rfR3!0!$8V[rX)%)3%()!%J$6E[rNB"`r,[rQ2blrj#m,6VVpD&"228$rfM!
-ZrqE4E[rN9QlrfM!ZrpT6E[rD5N"R!2m!1#lrf(B!0J3Y3rrm8i2@M#"$%"!L,[r
-mdS`J34#!8Qlrf'$1%#lrhG!ZrpXd,[rB8Qlrf()!-J,5M#""%)"J!2kq-Llrj(!
-!-!&HJ1D!60mFq%jH6R919[q-51FI1#CZ!!JU,J!-+'i!%#`Z!"3Y5rr)F#6A`#e
-,rq"`)0I!,8[rc(")em!Y5rrN,8crP#Bm!!!"*0HZrj3J2!!!!NM4V[q8F#$4V[q
-8+$`!N!1!fDlrP0QZrj3YE[q8rl3S2!!!"*!!fDlrP#eZrj6rZ0HZrj3YE[q8rlc
-CV[q8,@lrP2r8F(c4V[q8,@lrP2qN)$`!!)!!dDlrP#!Zrj53!)b`K@-+F'8p3!!
-S6[S'HR!!,J"#3$e!ri`NE[qNeI`!!)!!,8VrU#eZrk6rN!!YI!!!J!$rk%KZrqJ
-[,[qN)'i!*%k3!&"2)#lrk'B+F'Fp3!!S6[S'0#4Zrj!!8NUel[qSBfJJE[q3!&*
+2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ
+2rrri$rrrq!!!!3#3!i!!!!&!!!!#)!!!"*!!!!!*b!!!%q3!!#!#!!"!!3!!Kq#
+!!3r`3!)F-#!%'Im3#"U+#")bLL3Q-[)b6M3'15CPp$)5C43N#'Im#!4``"!#2q!
+J!3'!3!#'`)!!3!%!!#!#!!!6j!!!#FJ!!!53!!!!!L!!!!&!!*!$J!#3"i!!!!(
+!!!!$i!!!"r!!!!ri!!!Ir!!!2ri!!(rr!!$rri!"rrr!!rrri!Irrr!2rrri(rr
+rr$rrrrjrrj!$2rrrrKrrrr`2rrri"rrrm!2rrq!"rrr!!2rrJ!"rr`!!2ri!!"r
+m!!!2q!!!"r!!!!2J!!!"`!#3!i!!N!Kh384$8J-!!)!08`YE)!-$TQ$$UQUc-,!
+")Q*J0dZafeQ9S#"L`alUfF#B96%,BbUkpkG6V!S,L@2)YZ*heJ"5+2hK[F##5VM
+&3+GM5$+1VpRh*L)1[qR'r[[BRcTA6bLQN38GNEU#'ELMa4UZU'SRT%mb#Zp&cJ8
+!N!0A384$8J-!!3%08`,FeJD6pp*'c886E3#dq6FZ[0Y0'fE#E,kV#pq%hE$Ej0e
+feG9eB3!*1+@)rh3&qKSdTMBHqm5GDpP1JSQ`da$k`,2S!'L3!-@qrJ5q"J#3"J%
+L384$8J-!!iS08`UE*!"rKN@`h6Nj%l$&$Pe,6NmGf`%9!pZaqYJ-9[A12LLS@(e
+X`@kXkXE!2f0r925rrfq2mhC@'FEU!!ZC03eF9Shd`Bj'pkj6'Z`%Xr-S&0c&iM*
+#YY5j)-Pc#j!!hfq#GS,Td84dcbPjXa2G[-RZ+i@%-ma,@ZUD8SSG#ciIQp0r"2"
+krMRUbY2UD[qIAfl(Ujrp3rrlNCBP!VJcDU1#E9E"5#Dm4DYXM&@eAPXqBTZhKHe
+K&AhF&mE5@NbNP,3#F4p-ISc$ekiEjSHQ'HT6frC0h3qk%'KDJ#F%b!#F!%bpqLd
+!rZS*!a&r!2#LFZ%#%"b#J!'#BQ!Y1)Z43BcI$%,N%MVLkQ15c,dSF4p-hh6j4F3
+VE-XB!*!$-!#3"`3!!2q3"J!"!*!(!J#3"`-!N!F%rj!'!*!$"J#3"3m!!!3!N"'
+"!*!HJ3$r!*!FJ3"8+rm!N"U"!&6r9#[r!*!BJ3"8rj!$9#[r!*!@J3"8rj!&9#[
+r!*!8J3$epT!$92D3"#[r!*!5J3$epT!%q2D3"5[r!*!3J3$ep[D"N!C@prEf+rm
+!N!k"!2Afp[hrN!Em9[D3!b[r!*!-J3$ep[C@rhrhN!5"rrIfN!3Vr`#3#S%!pID
+3!rcppeCrN!@VN!0rp[BVr`#3#)%!92D3"2prpRmUI`#3!e48IeBVpP3Vr`#3"S%
+!92rfN!0@rrMhIbTr!*!$9&5Vpb[fre3Vr`#3")%!92rrpT!$r2hh9P3U9*!&Ik[
+hp[Erre3Vr`!!J3"8rj!$92MfrhrfIbU3"948Ihrhq&6rN!08q2m!!2mV92rrp[C
+@rrIhIbU"N!5X9+Y@pT!$rrp8q2m!N!6r+e6rp[EmrIC@UbU"pT!$JArrprD3!rp
+8q2m!N!Er+e6fp[hppeDVUrq3"RrhpT!$92Mr!*!)rb[fpPEqIrH3"2q"pj!%pT!
+$prMr!*!+rb[fpPEprj!'JID3"IIir`#3$2mVpT!'ri(hN!2fN!2hq2m!N!lr+rD
+3!rrrq2rrq2D3!rIir`#3%2mVpT!$prIipj!$p[Iir`#3%[mVpT!%92D3!rIir`#
+3&2mV92q3"96ir`#3&[mV92q3!e6ir`#3'2mV92p8q2m!N"Vr+e6ir`#3(2rir`#
+3([m!N$&E18&%3e)$!,l@%&809835!#&LlPE2IEijMq-)4`KT+X'mK*!!(Y%NTpK
+-4U)Q&`hRN5E(*8TN,$Nrhp`T*2%f"NPGrja6SJ34%(%Cac)d&3D5J#&BPQ9FP`Q
+-l9M@CF45aP+@@NZTCF@aeV%faYchphZHpqkp'%8kRErrc`!DTDFNbS%J5))J##)
+$!&f6rh(9q9FeSM-)I0p#KVi%arMVLJqCQTm!+I&hMrr!(6IPIIVIDLY'Ee+ZhRm
+E9Yc`MGS+ZNV%3Elk"K'ee3FGGqPqmaN&j&$YrPGl+qa2lphjlZb4hi(B@6a5qqj
+X6,!a2JpDqYrpJa0%UJm(1P*1N!"lRaMip+GKfdFJ@EllKe$bPfZF3mh,2acBDhl
+h0Narcp-CQ+lNkIhdHV3LIZEcCqMeD%@LMDFV345ZqrbCJRm##$j)Rl36)##1@2Z
+AR![(,@'J!M@HZIbUjF1#I`)G+3p%jZcQPBVS1dLqRmm[2k@bX%5PEYlcjk+r8%R
+ma2'6D$ZPp&rp3pP(jTHF#4#VSZ(#H+rkjmjIC2CDHkXAZfrKjV&`)8mf"XE-HEr
++FmrLVKkfBA"4S(II4fij`"3'`8jGHp6Hq4fa`HI1K!-48#H1caTc2UGL"90"N!"
+d+j[+8SH8T@T+CjrGcMqrk2`&*Fa%dbp%`eIS0Z0RHFB8DJT-iHB-V6N`43i9,iB
+f$UPVQlm4f1cBV"+ebPkX2e+9cb5$9cV5cZH2R&+12IpCG"k,2ir&ReH*dQre+(G
+ZpcG059kkBhV5P$4(cARh4pfZ28GS+,mD#cZFhrU$HHiB[bV8VVGpk`p6jNl66b&
+ck9#Gpl5l91BNkk6+GReR9AjT%4&0fhCfh09KSkJ3Hl5MrphCSY1$LCa5G%SE%8V
+Pi-hr+Pi%D,LRZlR$jZNdD&IqAi9bqH)8(DLb5imLX9(llQe@,0%A`A3')KPYZ6p
+p8QANJ`5-IiL@Up"I,hLPpiG+G5r-ke1QK`G6b`YHJFL5f2DcM(cc(fI2h[@q+JC
+#&1[plpi5YZPM'd%%,eLDmDTrXHd6c6Y4)hNSAaQ',8(N"d6Z(HUqepT`ji*`4"m
+E2kkr-IkmAU,lpG6i,T!!r901'M62IR(%I-mUKF8dcGC,4Rlhme8U!V*cI#6PGVa
+mT3!-rVaCaIe[2EE)[X3+Vd54*,pFJm0Z0l+8qp2GZkd0bIj`[0R1bk$XH"fLFQa
+B3-Va&@hN1qS!!9r&DR-HAb31Meq`M%M9Uqi!C3`HYNl$brYV-YDmA+P(2BaKDDA
+)Q(B'-EM1b'"E5Gf284#m8MTmAB5m,`,PI[E)bbQJT1HQJ)+A4Z#l1rF'hPfaFFK
+Zld!%K)i)L)+PPr2EDYpGSGYm0e0`QrrS9$haJUNMbQh,65SLEcX+AQP6CX[mUmZ
+6jYiIj0hIDlCB,(PAcjSQA`CG'I9F59SXCSX[Ua&*2I0B1"DpqJ!fF5CSSXIPS!2
+mdQ`T6qCFHrqdHk,Y,p9(PVi8L$rf$5aG$#ViSGeHi53bA%H#SK@66VhNRMjl8e5
+0pimI'lhTh3TNPYHh9VBfG5"`l(D+S'MZERBf,d3NarpTpCp@iif"Pd!8MYDZd)G
+#1DH1)@+QljFc4`BEPFp%"4%)Zp&`,"6r)1T,%CSf,h)l#ZD&EdF'6*0eRXL$94f
+*[E8cr9hhiT24G@["c-9j)1Bj,"rLfL#b`EQAmd2*83$HidXrUV6r@pFr2!IJZfZ
+'2Z3lTq[DXGBaAbS8c`0"6i[1qfLXkcjRIpF-Fji$%3'leH@mc3U02cqYC1C1dCh
+)hQFLHepRA`@Lrp$*8#K(fp#FTd8CJ"P%Tp,@iIMTj%Hp-kr(dCA(FlClp+rdSA-
+pahe"Jj)e"Nd[Q2R$-mpGZ8jeAF1I[1HZf1eGmbfeAGFrGd8jZKB9c2bD'q+)QSI
+M#T1PZ'!b$k0!U'h[`8qSB0ihaja&*&a%KAIL9Ic*RbB31ARR!JaIK+K16F3V1LK
+U"S!-NLd9&)eUVVhKUqEA1cLk6pQD[dI4FXS'GPH-2cF5T4FS1VmRVMF"&(*U"28
+''"kX#C!!Ge`+c`R`VFN+8P9iRr-"FekTFZj9%A2HdNQj9e+8Dm9Q6A)IS&H(Y&H
+64p6XYqK[h9[6Sh1210(BTQC2SEpe8qk2cJ8S0hfb-pP)&q,Q[$S&B+f*0UKaFDq
++BEXh5pAXeqP[hH[h4ZG1@RhNhMF2S"LFYIRV+,+q[N2&R@RQ[&Q6dBfK'$'3!--
+TQK%J3Qlq-a",URQm$C&Ib2#XimqA"iMKrF6ZGeC('p,-m`p&$[E2p*Z[2Y!r-m0
+mcGSMDl0GmGN6k'rGK"R6jQERf'BFf8rXIZFJXAAeXNRQUqZ5qrYR"XcI`D9,Z$4
+TlC(5Z)I9DA-R0@E6dQG0eJ1(`5Sq'V0[FP1-fGZCNDX(0VT8Gr0iI`P(PrH0@bR
+kLD,+bQi()0AIp3pKPbY!dF6+"Q*4rc@(LJiTfmC$#Y(")0NL3T)#Xq@4mK+hUla
+E$%c33,dA-@dfE"mdY2Rr,bG4P1U2H%&K4!$DL+(4h%"'6A%4mTRKH6Zk!FMHTeY
+4Z0Q3!0e*39I3F'6D0m#VFBH1EjkmTF6HK-98M*G5i0BB[#aSm*[E(H`,'M`ThF&
+,#29EcaNm`"+1ZUfd,fjqR6iG3rBqHepV-l+jK%UdrPNf+T-bYECMNP6*eMpl0S2
+`i"%SSUUlA(d['MD&8XMHA2!1K44&%Yi$BjpiHjG+q6T*0$LbXd-bHpUIlci65R#
+@Q)C,PfQSM+!X9cPh)3)M4UppQ`@VRB,92Q+hqA8+I0d2X0fPER6`084c`Z-jZe5
+RpjLqXP$bFVk-Q28%`f)R!YLF"r"p-9p01c(NI#iZ!ER,bS'r!r5$4,U*N!"-QIE
+kZflH#d#jL`$r2Rp8(d26HQjDlRB9eDPp1+kX5"jV`['&HQhl$'BZBb0P9-Z""LC
+Vrr[e[MC+r)5,cf2CQ4#AZp"Ffl8H2cGMf#Tr2S(8A6rcS"N#L"C#!fJJ#SUB&`9
+Cp#KB91FYEfHq9,Z236"a"4QMlTq5q4)GA(f,Gr%8G8hS63Lb83jFdkJ)5AfE6Ie
+Gah0-#,6ZM[kZda+PNUC'"3'kGZ9VD%AABI4aPE2SJXC2'SZF#5f,*5#pL#2!3Eb
+hA8`1*jrEh(9LlikZdmreGPdH[HPphejc9pAS69d$SH[QZ&%F+,AD`m+,Km"#4ib
+McMq`MPh1$eq4AEAFA2ZqMcXcIcL1+*NdDX$KQjJK6d2RG"3$%2d2cGBa%N*i@Q$
+c48$TpL['B9qQDPalHUJ)%4T9'f0dp5+LlM,bFFRXh!d3`H[j%kH94i$cl'A-B)'
+h5H8bNei4Ml1JqVYDa$(,2-,c0SiiLaU9C*NB$KCNPYS[MDjXPTP5D(-k[jMCGGU
+h$m@jcjah--empB+Scm(&j@8D-2jP4f4M'VCVT3!-&p-bFFb!XmMi`VI+D&)!3"0
+&fN0!+N31Ym$XTj+mJ@i0266(E8!J(NB$b'X!(-ER)Er515Xe&FblGY9$*DVY5l#
+LqZ8@$ed*RAbP@M9JUj'JVHk8Qr&9mV6&V8A)E1m-0r$fMi`rre!QEia)U'ZAmED
+9kQ22YX5Sf"5$5f%UmN4E5AQ*3@`FPFT44f#YNE+3!'&N3BQ1SCfp"3r$D#U0)rp
+1%jK!c@H294r`0,[4R"$0$CjQ+jSMX[QFGiX$D%i6cGiYpU!j*TUp@e"dBMDL6ce
+4[N#RfccJ9aqQVhj)i&FI3'mbUY$RZ)%B[DU6%D)(B25PL4SKTP#hpUkEf)5-TMX
+3R90h49Qkl)AikGb#UrELdA86EmDQ)k&LC(AP!"IM)5GY&iij%fi9cp(V*Yj#'Dj
+*q4"TMbBhVM6KLYJ!'D$0IY"5DGr$PkmcA'i%S@6%IK&!E6N1I"!r6r1PF5k-Tf#
+Kj9Y+*[CC+bIfq93m3S2%jNpM`kG!'VX"Qdi*IAZ1QiqCKkCTP+A*ka0cc-0**(r
+'jZ2+%M,lmQ3e0PL$*9[hE5PTDU*TmjqGG8d!KbLb"`6'Y6$a'V)8E-jY[3Z&RpT
+#*P9A82JT#I+UC+e+AMS["L(#k!T-b%T`b'3fmJ2aeMkC80SqZFhI(l"2Fl33UU$
+`+RCCr41FK`KJqm0JMQhkK1P44',hZBYeUhq3!!21jANj1$hU'X8b+a!0h3IL4"F
+G1"$B-D$[)1#L&CQaEJ2jC@PjS1i"Q*Gpl63-B"U`ZAZ%J-L$"'KGEFk$F9JKQi4
+pE8[2JC4pXGY805A35d!5QHmXL*kDEXAPF#PY6faL1B[&jQA8kGJ0m'@D&'JI&8#
+&0h6C,iD,R6%KM,&U"jDkC-6rm*[(9@#JDK+)XK98V%*J&3GG'KZRP(f-"91+$5F
+h2i&K*0)V"dQXBNK6&eiZm4iiGFC'"%[cDMDXa#(M$c[V*[BC5)P0R!%@EY5+UhQ
+1H`PBf3M6!YA0L*iUZ,6N)Xa0RCDZUGFF9F0*D5MS$8MeQEQb,f0MT2ADddNbrH[
+,)&0"`i$SH@lHQ'JYE#[TX)'e*P`aiHG!FkZMLi#h[JcI*JP1ml8hD`X0hEG2CAQ
+lD31eRBCZC@@-M3FM!2QXJ9iM!b*i81"S,"q-F*1bqbd!!E$dr[DHM[lfN!"jq$S
+6)6%"#dKDMN%-0hZ,VBcm-([,@$8br3SDG"L*('9j%XNFY4NA-J!bc+!APPCeR"*
+"+%iUX2%-[*JPLVh8d@6Sq0kaVSTd"cKm+QfZD*V0@lQ5M`*SfF9J'!`F`hXXhkD
+VB#PP9@p`F[(pqXZ#YE6TeM3JmV*GqA3Cb$f'4*3IjUIA1iY#aaqIHB0r,aUk9[5
+2,IR!1iM!3"$djNfX-#i@V&3C0UTFmJ%+4Q3"YV)D``iqKaGG6IM%ZeBkqpq2Dd%
+H,N6LF"(B-SAXHmGZm!qVmSJ%`aaR!,5qk"["0Li%Ia8Q6LTfdIQNB0il(aa0NM$
+J96miU[J&!JB[%-RMk&H4phhqr'1AN!$*pVr[Hb0+J-XpHEhVqJi%hJT&aZ[J450
+p"bMEkcX`HY-0'@DrjGY&6)#k,JjMaRfH9bpkAk9@`83ZFKiENZI0c!MS'iIL58T
+%d'"+1,`cJJ2VqJlN&#f,(NV+`pZ2q20246iDB-B25,$KR6Sr$PJbVf$H'lF3Dlh
+VPXcVr92%*Up3S3#c6!3J'@FZQ@HZV,LQBfJMrXN2VJfD+kIqJ)T&HSQ'2#X"JiI
+#Kd6$q(-Bd&kjYh,US[D[4YG0rF(P35bqNpLEZT!!$UM+GhH+`6d%[,jIMbD9Q&!
+`,c$!B"!P)U)3ah(*mL-h8-,k1P-[f-8f$GHCD"[jFXJPVN6ibN(CE,NSQY1i18X
+fMeVheVCre3jK,(N0!ZNXQ(Gfh5L#KB$+jfVE+lXZJfK`!XZl"UmG!*i(#ZBeV![
+Cfi'@4'kXcL$KlaJ1CC,jGPX*G3YHU4fJEMPPSLBpi$,0k1TcC'ER9Sj&qQ!`'1l
+8-`rkbDal8cF*$41ERj'fh+8Z!B'L4K5c`J1GUNBKqrQXVUB[CY&@dGa+TISF-a!
+"-V%&c4[ZSqNRm'jM*J8d(J1"VdaXd'$1UmSR3q-YRd1NCFK!Ab0[1DCm0RRiPYH
+UmSf(9Dke[K4@mF)[N!"K(YZN4jCLNPY("hBS+E6G6fZS`b36r$5r655P#,ElrA%
+CI!$f9I*kk`kIQm5+c1%VC&H9P%cJ,-2Q'`Pk-HrAAG4Xp+,*#Cc&9G)J'Jbbc&F
+)Z&L`4dlk5&L@$bNVH1iT+[LAG#%E'[2R`j3kJKmXIAmM!RVKMR9p9CHR8(B'eQ,
+@(H'BTAr"UqjZCJ3J9AJ&XElJ9I)+&I!+Sa"'4eh&$ILCT`ND)UKF-KN(0(J2300
+&0#N%AU4Q-1#i6Ymqie+&U+ZS)(9[5cLZB1%X@4BXR("+#YPpTU0ZiQFGG8dr51F
+)3Xmb&XM&#`4bT@$Hj[[mqCb3!1c@!VpFFI#VTPXkkTBX`%mAKJBJL&[pq8$k&lh
+C+T`CG$Q,#ZB9[)ZXmJ[H4T)8hbbBpbmE3&)%3G8aE$$8C3!kP#`[6FEbAJV$Q-C
+8QTJN%pZqbk%8'MZ,5q1eb#JM+Z+cmL60Cm'N91f19iFE3Nl2a@aaX5d8SBYPTFQ
+r`-!%,REc*)e-iHPL%PQeYAr""-(FNB*jkaCGcTHLik#H)!fY!85cBDpe12lD1b2
+1)EAdLB%4-bB!TAql+'bLD$BNGkiEAlS4"+@#9a#T!E+e5SkBhE(%!hI#[3fkTVP
+MQ@1@+K$!q`jZ8(%i+1Tkq3U!N!#i``@lYZ[#&LY!YNVpC8V1a2NSjm[NX!QG1dH
+qDN-R$VJjbh+@Vm3a')8ZQL0SMQ'58('mM$JD9$cC8@Nc053l!Q-2M+RG[&PKUN&
+&lK`*aakJ6911iBhfq'XRC2Fk8d0m$k)irZ)J-X4frBe[)&*hp194CE-fa"prTlL
+l)6N9DlM@!A+-c`E'Eh[J$#LkGldm($HT3ZY`BNAYCKaGL1Y$PM$)h(ekrZ&K@j8
+U$UAQZ(eYKmq!b&%fClG[hj0Re)[+qH59(B'GMkLX8"+[BbqI8@@U%+Ki90mj!U2
+`64YZcbkiKp##SRTP0#"0afGb4'!K6$`G)1S#A8B'hH@)eQYd$Yhq'%`p(3[@K'2
+@0H&ZpiVH#UArI"BL0fPBP-d@6'5bi(qeB"D'"pcV6YIRR!15Z'Y2(MZ$bI&chcp
+h'T0")U9MXX`AHJA'#HVCrheFTmQUGdiFab5jlf42p6ZB@'TVD8$bH-l*@TS-9Q0
+'%bAq!A'QM5#)3a((@I8+R+"e1ml'6`1mM`6'h$&6Jq1hPbNbh`eL9N2b48bTf1F
+J3mH+3)`N1m)0)Y!1k2P,J0+rrVEc@h9QaeK4FEM--EDa1'c#Tb&FL+B'Q'`SGb'
+1YB@!$U%%S5ff8M+J+l0NXUq04IPHiX-"MNCAR`hkBVLLh$%fAk5)qUXN-ULb%A0
+hF9Je69qJI#XHriDH`XX&M-bahC'de(8`@@Ed+!Y#Ma5K"m#kh4LH,9'aYSb@j[M
+83B#6!jp%E54c6$,Bj$Bb4XP4[5'CqQ`36UeHKBFXDhe9,m+`rAFFM3d[jd!%*F4
+J+MD2QEjTlB#M[8*mBZ()8d0ZdrL3!0XKZjm2)C*lb!CfLS!@E-ELB#Fi9`&YJ6"
+`1J-$#Q8MK-N!`MafY6[Z[eS1H*)'k)H*(&!-j()mqCKUXja4K`!@eeQ6[XKih"d
+I6q"k0ldHDB8KdLFMG)5080UHae[B9$FI9$Eq*BB@dT!!bkrb!-Q#!bcF5+mBI9Y
+99VT$LJe$kLiB8UL+HH!KCVPZI,2d!L2N"8KB%85jTK$*X!kH!Xi`)1#LZLJLBFB
+J3*-lBPUPNXLS+L`Q-GcIr"1)0c)bL!`Za9&cm+!#T(bBM$UDafR*PK[eS[!)43F
+kLf')RJUA,4JlJ8`hFc3F-aAINqGHB6)&aXEV0-m)KKGf**MiH5X5k3[RG$BUN!!
+L($$$Rm[11K"Pib5"-NR#%&J,FDR3ILX)!3llh(iL"r6a"L65EM(8aN1c1a)B9QC
+IM@(GpXriiS0)#Mrl-9hq-CYIM10bGQJI%4hS@"cr0"pEl$R@G2FfQf1lSke3j+N
+YC"khQSLU)%PmaQ,JlAJ,q(fILmd*jCE`66iLNcM)`"F,*X,'CrcU,MJML1#3!(d
+JX"@,BlS0$(Fb`bBq`N(%%5`fTLd@)[k-@5ccX#JGT'9[S8ZVqG*RI+5AZHXZ&20
+fKSrHVH'@#iB[C(,2A!VJ8(b1fq-jmc8%iNA1C@(G`S(!b"6D,4B*-Mh-#FN*8"H
+6f'R4Up*Gp(SL!L#Dc3BLAL()S0fD%cV(@%c90P*QpFX"kA#VGCpd3M@e4cVFBV*
+R'NK[GaC4P-FqCa'K,Ccb,,TL0liL4iG)N!"qePMNFa"KJVT6XaZ,B&D8F[6Drak
+Nk5QlT!1hG@6N#),+E4MF`i2ADC%R-K,+(XHV&fNi(B#KUp!!4[3lahGe`&%E(GJ
+mI`J%i1Eh'iXFA5LAi[E&[NkqJZf%mi)&$8AZ3Ud4l&3eJ"eI["(%am-rYEQG-9U
++"0F-AR!pQF@`8`cTI-38*+c5)'&p*)99B4E#FNL"Y(k%K%bH*KiNreNiI@Z-`UN
+i!pCllErbGAX'-L$IYi'%jMXD,+bTlEMX5dpB%qr$Ueb[X+CL!jm0K0a2YbqHU@Z
+$a91a2eJmdN'0&edj@f3b8m@l-0j)%GJi1A6`f,QH(%@QLa9cb$%G"0F0J,IX0$N
+CEL-(`jCPPNG4I#YeZh9Qqh#B50(plF-8fB'NaPa%04pdJH(bVST9E9d9kdmRV9f
++#(YVVH3m'-R5LMNbBL6CC&Aqr("!@lTiKF4,-SF6h+D`Sa`HSDh,[[KddZdC#,+
+"fq`A3meLk!($8&Hk3rH)S6E[8*K`"E!NKf8CQ#Zf2)V,hCJ@PQr)f&'9dEE"heZ
+9F6TT5NKRJ,)S!6MH4@3#!%L&BJT$(!LNh0&&eq5,ikI1R43[#Ud8cCI#a`((LNP
+YSr2j5!)1SeMDQ9'2+)JiLU1B"3*e0dU"`PNpNCMQG6kV&rQkCD-NP*5C!'UBC"-
+'l0H,k#)Rh!pQI*m0f6cNIJkLBQh`YkVd)Xp&(%R"$d-fEp3!Ha-pFlq*R'TT*+4
+U-N3``aJ#6DFf$DZfc&r0cjM#8@S3V,U'Jl'6XLqp4F8`kF3%KK$ZcT!!D8B8a0N
+dMIaA1jm68`E(QSjL&`%'b2+'9A(RJ3J4FNmGKj!!$kJkAIN#cMJC#a#TF&NdF+6
+lb(#b22FI[K0ifqebEQj,2I#Hh6kSpKef8E#NUC2eK6`jHL)@13aRNLV`GQ!c`)3
+E"DPa)3'GQ4EDY2*TBUABkBPdL4#!3PP[-4P$4J)@ZNLU#"C%fEaMa"R2Y-$XXCM
+!0VciTRKKNbpmUd**PbGUbY6IrS)@N@%*G`cj6P8IPjllerGE5iLF&,DPkXKBjY,
+9HFR0#Nj0fIXp[V0hPhRddSk"R3@E"r*c0qm)X!NaEh+bqZ`jXFR5l@hbU0KN0(I
+RD1E[4JY'Rp'fSH9C+&N[*fPL%Z2*'ERmN!##NJUEH&8SAK@)"Mp&r42T'Y(MCa3
+5d`miTEQ"FSbZ8XZ3!*3T$kAT2k*NSr0a+Yj%8JE&hq$1hN"QaQJJ3kPpaEdjp5G
+lk[9MTbTpCm1[j*cXJF@dI[,FIQ+cU@-hPX[C8Z`3%33[AZ@1@jjalUD)DH@SJj!
+!#DKlNcI-pr25AU1L%LBT&5-c$Lk&L@i&3!k)bRk$"(1f)*PUEi'(UX63%SU`f43
+P!M4Y+,HEF!RLfVajCb$6[k1A-crlP)lGf,B`D0Xj[1d'1Zib4@mmbd"G+fmp3GY
+k8j([%`&3cD(*NmMZ94a"&E'hA-SE3D6%D'J"M0J[A4e&XZ"LdZdNdpkQI9KXZ9`
+kHA0Xq6C&'S3FV3p[+VU8&kfc[`hca'3iIM'jj4R9AFIJ`+epP*@r0C!![`X)Xc0
+h"l1qa2c(h3bDDXcVdSZC3+6mN`U%VT9"a'aAD-+f&`+TrREcEY0ZApf9*&dKe*!
+!JcE'j+#QfdPXTBJ8#5AE*iA[Y8kL+amr3d@ZQLdB3T%l*E0hY%$$AhD3!-k)8dJ
+,+j,'$L*k`c65Ab*"+,N8H)!!)Ap[IX(!cQFm5lVGr-FNQFqR5&4pld*8HcU'+'r
+UJ$PC[BmflA#BUa85DL3ZY`YNd6L4XUJBA,FB39*Q#D03l*2$m!+QC5Y#QiSJ5NI
+Z6de4BU%+D2SDRHj(R*5"II[RL&ENimRak8A&ASmFFRH$#1)RciG!ZFVk*VrBBph
+m[DZ4[1UdEVjdM68H,Lah[2&hma26iM@([8%Abq$8e@4$BM3[LHB8E*J+DCKP3"[
+iaF!R20$bS60fG4p-KRUS5*KB@&G%cSqYEk*![F%bB%R$`,cZ0,P9f-Q"fZfpJJ9
+rMQZhl#Z5M@3Je`YcBIe(cXHad6@Q0%TLiX!'X'!+(q4JAi)!Rd`"AUGmZYa5'*V
+3CU[h&I%fkf!QL'hN&Vb!%AL9pIE2i9AJD)E%K%([)RX!iSh-)-3lQM5Pq@*e-)#
+Fq!Q@B',Nk*BE&`l@&E&Shk4)P4Y"S1TrKK43Q"B,*!(`Z`C)mXb1JKf"dGbDZ%,
+"Y3,)8U`jT,qSV)H8AiVH0l3PdlkLrad#R4J3@`'3!'Pq(5)Mp&cri!K8,fKCecH
+*d*4Q1D4LNT&[5NC-+$#L@SDfPM)Jj"Bl"mlAB%&aBJ@CS6-856mcA)E,QhF-M1l
++cD"V"D1r`p@bcTf92I8jPI8pZKp)ACp6AhQXrKa[D#*J2*S*%dlmf0`QLVk&)`6
+(&L+NfG`45k8hQ6("[b2`ZicmJ8bD'"JLC)9Ki9@8kB(SSVbChpZpjKfpMq`Xb0b
+j@ASh',dP9*E-k&-@3[A#$EMq4Pj1I!&0VZj*IKClijTViTb"+IFK'X)(C!Q2$[2
+EZkSj+&05K(#`)i1m(S,X4RD4jrAdE`rN"hThH"Q3!!X15m3!J&(i&$+*3X&dSDD
+-iIA!MY`GSjP"&c[)+@b+J[a5(KH)$QZe+JL6N9Y"mfS,1JK8[kY%@hKZ2MBBb2I
+[+1#&,cErm9T#'pXq-#"4je+H0Hd0bUJP#U9-L)lfa5rqJVdHLK3fRi-C(E+93L4
+LdZ"Tr-iL5N!Xq@5S#+$Bqp),KAl9$N(Nr'M"QlaGT5R0%k!TYpXb!$'q',aG"aF
+8mP-`ErR4KL,MD`!"THNG2h'k22lhXih(Jeh(A`fSJQrZ3"&q5+8jGdI'l0H(Bhm
+a&Sk,J$Q*J)'b#p0b6F"8B&Yf2,1c3(UV#Ji1C0N6fkR)eiU0TLNIPpLR8V'SSG0
+NA0a4X*Q[0C(6*rD-PVUQaBFHJ,&CP-$%N!"GMiD8Di`h,CE&AG1IX(PfAG%EHH4
+3c!UJJl0)bCk2-d3BX(&f5ijh%,R@Y*K!6FXBN@R-H4e+,b,5fj`k(S`$hlMD1[P
+lea$BI5NS#dE323AK),&%4b%#S+"jM9GBH$dCM%(`!6mGdUUl5Vb[GBI2`a)+P3m
+lB*kmhP4D&)Ud6cSPAah(Udekf[NS&TY"aHl)8QBLcrSSXcqbiG(U&!mpiBiIHN$
+[V)Tf5)1fQ,D%MC(Q0ESM(#%&,d*)G55J[TXKr-8i)&)(3`B%@4Db*#eVl%6"beP
+M"K9J5[2+SZ"%3P3[qZ9)hD$VajE`TLrLZPKZ'4r!jRR-"#)-EEkk)XHEY%KICdF
+RA34"Xdd#KhVdSX,"a9UKLB0"*&VU2GJm#J-5N486)-,(Ab6"3IJ-MUhN)2KF(La
+!R9mM+dE@$l4bi,#cHk*C44Lf,jJjU8J(8@DIe0(V26biP*dpVj4-'TH')6S2HEl
+Q%X8faA9&(BkLQ)QZILABU@0@,TE5!I'k0*f#l8d10TM-DU)3!TMY&B!'YKJP))f
+K@I`NZ!b6+@m$4I3%STY8"aYK%NMV49[UhV0@%b`9%krhj[[2JfDjXq#Cr&dC(T'
+5KqU%mCE*mSaq*i%*2TIe8FT@I,Ted[GS8Ya"!"H-`rjdHJ3+Z,jhC!'rB24raKG
+`lIM4cm@!5iH+5)"J-HCPKB1kV2f-LPqLlIH-Q%PYcS,(2U(0U6K`($5CVpj`K$H
+0E"Ub2i0YNE#A@c&*e%8'fF&EbXCC%i!#5aL3!%"8#M+3!(ZT)a-85@UihYX3TiC
+jhSB%0E4i'b,8X*ShKpSS1%0EXQc#dL0-0)YZi8!U0J65flX+r+1pMq`Sb!LFei4
+j,3R64%5KG)5C(5c-9D9#Q0P"`YbX#A19V93+-e9$Q+RY#M0&`T`A,-`"Z4%R)Li
+8T@JmT'kEd"%M-3+p"VcSj4fmK3(ciZ9H`(c#`'KQ"RbUN!##9YL6',MSY""DMCN
+HX)afGbiBUac@1NY(K`$dAdbLSE2pQGS!R+#0Q9jf`bc6@B4)NT2e5K9LmRrJj$!
+@!Eba+FT$$S5f-m4Ce&j#a3qF!6lMrPaZr6eCE"1JPDGjJpGfCS+SXJ2&I(l"T9%
+"NU1S6U5%fJX(C5mFH1A@Y4aiHj!!mG1NM!-2@I3YP44i#bDAH)[bBXTX1MKK3m3
+LC+jcC-BK[(HH&h9HNpREldEpAX%eDHM$bMG3[294`Q$N6XiXLM[Z40(44q),,TS
+%Spf#84Z+U6i$H&&Y'6LUQ,%d8GLqD#haA@)`E!`49@8EaVj(bB)'DNSK)Dqqj%,
+543481T*H#)p9hSdPik8%iJDbF0f9aZJ$ch*[e,e'*$%+V32""Df[8f5BV$a2*X2
+VLU4B2-J%XIaIL%A)C1H16#mFLq"CL53mE@+#Sm8-ME5*52E6!,CeqDU$$2%mbF!
+dC1R8K1ceB4c9k8RF1U6iFC!!pi68lYr"mFhCbM!G*4!"@D`V5N55Bk(+(TR"ckf
+'m'Ja3j3Y5d!Up'4VUH[(eV8q&-"4&3@K%!-i-fEM'K#4@N[VS0),@h@'8UfPK"+
+(&'dZ`Ap6RS'Fd5[)'4T#bN3ZEB@NN!$F5S**hUfi@)ReFk+63'""b1Me%$+d!YY
+"M'1IC5Ldpea3D-0i5FrS5!N3V!)X&fS,3A+hQ)T(&&LG%'H4JAP2`B)M"Hp'%-'
+kPTa4%3"JGpB9Z@h5kk`,86&*@r9lNXS#c*0FD`Q-3LLN41$5Y-1N*I#aL"JRbNX
+TQHq@`)E"Z2&IEJP1rJ13!%JR5FF(G1-!&ar3h@&#C!(p&"S1XUNpiU!bpakCT+`
+j$'$d!4VJ68VqkmlHED3NaE%1(*[&acSk6"j%5BLM61jZ54#6frmqQaSe-B--Pdl
+kF,XEhlQ0MEZ-'`2BZ#$Y+,DeHEDeXC!!8N`'542E&STYE8@mlDp0e+L"qd!+!Hf
+,cBSp!LpQ&Vd!P0cBT'*Lib`Km1+D`h")%`h`!UK[NF!&I#S1kX4"EAa3*apN2-5
+KfX3KaHiD`+!mi0qHTTG"J'K01'cV$YUhrB0@IK"md+ZHKAM"2C(-AKSZjQ051)D
+b!T[BfZ%Ze**35aC3Jr4)NhEfFQT*E'$bH#06Kj&&425,M6U&0c+`9r%D[I"QQDr
+[l!h+-EG+"&RE&m%2#i0&X*B2Z5$hhlV$1VGrf')pq,$A@GcHmPFiSA&#TBD$M2d
+TJAPD$DZMLS$S8kHcN!$3G-682jp)`E&iEb$EA3@5IBbM-QBG,iHT4T`!YZ[fGdE
+Kd-0"6XScXM0kMpVGcX#83(E'faQpEKU@i''G2+a31MfrP(f*"UCSi+@h,rA5J5*
+LB`TP6AUf-mhVH*!!f0cM($+`1D`3L4+"fVZB0"#[9UQRpS&G8eU%$BZCbAmqJC'
+DXbY3p!U6@FR5C%0b)*Q42*%-*5mQ*b4A*eZ6(b6R*kFRCbIA*I[LYRKa[$aq)'k
+*qq1Ia+[M4q1$m3IM6m8Aa22Ldq1ciq[LI3PE)LY4QQK)$#3b%Vj%6f*DBQeL6U)
+pF8eL9Q*ZBQ8N(M&&4L)()J14M)J[dK1C&PNDH6EbEQ4HC&(N[XLUb)Ud90Uq0&G
+DBjSjl9,DmE5FY'MDDfP2Th@PjD906lXjE88X&5Z,Z@+0XFfa5l%cXD1a#E&RBqf
+aDf+cBR0M+hI(GRIZ(YRYh,eTGqlZ&hHIfAekGrEZCE[(GbrBREIlUYfhlEjppiT
+82&@BfTFU6ae-E8TC8jG5*cVle0rK*c[M*EIDl42G5GbY%YdhZ@X9hEHi1b5kMh1
+h6R3Ij+iZZNpcYeYdImRGL1L18cHf3R6RF(H9k$l&hAY&p`RZ,K6GIqIZ$D,l)AI
+E4EHCZh0%Yj@lDd@hKEZ64IFplJk,lNcZIL@klh,hXZKfFEG!G0rRlTMSIXVGJk,
+l@qkfLHi#lTD*lQIF6BRZ"p40Ua$Grm(GpD)lMlZhLZirFAH@k2irlPiMZKZiqaQ
+QFr%6*D&HSLB5!!eUj`&V4CG&R$CCG&QSDF1Lbf*-qmU`e4cHUNS-N!!-D`M`Bqi
+1LCFXS,3kdH8J502&9YQHV3V&!"C%QK*G$U,)%M(m,@d*NGRLU-NmB,VSVZ(ZI$&
+m%$r2m[!&BMX1MXK6KZfHiJ(,$%hrcNe4FB@4+C)MZK`3NH1'!kEam)#KkA&Z'M-
+d[FT0*)#r*q(a*VTK`(Xm3"-!Sf&%%`!(GS)%F*8Q[-60BVQIFrFqdIf#Zi[%aAr
+NlMc4CBq9H&Gd'Ad6caTB@%dX*#CJqJ2m,1-"&`e#'H3"eBBVNlRT4E%PHjC%VZJ
+b%LBf'C!!jA-HINJ-B)qGf#-BCi%N6+,l%RIMS[YrU4YILHPh0-ELYiMZSpbGB6M
+Q86SQrJ0$deTZ-RU!TlPTMU(T2lKTUD&T$6GG0$6p*cG9#lEq&arpL4M`VrLC`J0
+ba3!@IRb6B*3$*Zi8`im3d[0`%X#r%2TV5"eh')lm*fT+9KLDjR(6+R'0![-)0pe
+RD'*d6-ihA2XP0fNHJ&P22Q8B`%'IA'CSBLq6M"UDfVQT8La['QrL&YdTh!f)lK(
+ZEKEGYlRE+,U$h(@*lZ[Fh5HkVh(A)EU[8PFeLHi%lLiAA3jfCSfkDlPl[a$"%b4
+mBPCT'5#MM2T-G&Gcph24r60heiMZIh)AUR$8I*&4A-(NIiSX*L3k9&`G&m+NM,j
++[+#-*eGdD+XadD%M$iJ,K!JZmH)rd-N5(@,%*$T8M%Bk[a0i+I#f%85T99pc-fJ
+$93P')hMKb$VP*)IbdN`NlP14Lq6NNS'CDlMaVK2)Y$a1b,0J5C14U%`m&AP4rL9
+Zi%PjK%`j5e@5Vilce5)SiT[KZIU"HPDCP9pG"5fK9kP,UNHG8408LhS+h42U'MK
+01)VT9DT56BC$p89U!cV,9$XhAUA@P!fTAj+3!$'CJmNd6*j`(mAR+AF22Tql+r&
+TGCr"TpPp!Trhh*IaHGGp#Cp2hAjm2R0EmINIlXhir$rh*R`fZ"[`bA-Ia1GUpb&
+mVR'Air1hEKfI4Hjpq&c[lX5Rcef)cf*h#TqIZ'&CEB*6dE3F`k)Pk,IaK)Ul2+$
+IjmPC!2(HaC)(BDUp0(QE@T1m2RPIFQ9bER*9FPemMaU2aj)9FAJbe4VINe`+)0!
+4leEYm6hS4P@HqJ+LQ+&QUGR*0@U9@Ub@!ja-*BZKjdK2ZM$)Q4`$B'P19LApb5q
+5imNc56F!c'(Hi!B`#k2[j'T-MT!!4m9N'LBN42)b*-4X6%L-Nc$*`@3b*PpKmLB
+Q*-C"6&l%j#hbU*K-`B6%q$BQ&NbJeM#j(j2A-5%a[SC*+5D[BM+#b9,bU*JmMNN
+h*XX`X@(b+#Ca60BL-#X`qEqB,-(N36**`q4IbD0LXJD6Hc'"QNme(C29Q&b2bCr
+*Sf,b0#Ec-2N26"CJmL`Q,CMm'*-jQ(b)#3QJ#a-5`2X#L@i35252M%6rNj&S)52
+4If-NZSq4D!BMd4mBL@jK*2SM)p%U4U)r-4,GcNMdhaQ*eM-5hF4)Y)k4k&mBLAl
+25,5%NHMAM%3V054+e%NNB[6je"Fc$DPrNmEUL8i$HLd,&j*+"Him&!BK!*YFa4[
+q2@ri)fh$q+f'$CIaK[2PK[(jKJdRKdH`SCNl0h+R$6rPq+R$$jacKA@h%aZ[i#9
+pMCId3ej5"5pT+LpT)V23a#cB25aF0V$3c#cm&m'#aI!UbUrq5Eabm@I%N!!C`G!
+`ELSMpB)*ETJ,KeAM8+'0$Alb0Qm8Ka1c"#dKqLJF1*GQ8U8STHITdjMTr@6XSNp
+aT[GMTLDeP$Y1qUJ*G%h0I5c+JqXHLr,,P2b`N!#Z*h9d0%hX#4rRb@`dCI2&Tq3
+&PBhV`eS(Vh)ILrj&0*c$'rcAm'QH&)IVm'Sr"QfLKV[q3%D9C*B+%Bi,C2jhJF`
+Y!TPR#Q4Z&mLm3#$cE`8bIb#3!2Pr-6*r`FJmMj(jlaLC[m2)r!0'jQm`-XpLC,k
+(NANk)r22'CR[Cf6q&52c2h$3hmY"IaX(rArPS*r036qAJrjR(23hLk!ri3QXIr(
+jD`D9ib@PhTd@2X36U%kKb42r',E4C-iiSY#,XG9bh[`A[2QY[2P2aHBa9U0N9(6
+5a`lUq`6KJ946l'&P(`kI3aK,NB-)TeICa-6*QYU%rUpJ6VpQbeF`V5FRqh0dkjc
+GM44YI"[8(@hHAkU!U(#Z[SQ0Z+2FU@26b#JFqkq"X[@RSHS6jZ-6*m1!l(05I"e
+ApKCfN!#rJ,S4aDEbNmIM['dfL"Q9jVe0FGr41pi!ap8e4FKaim698,eB0h&1aT'
+Hkrl3c)lb2GZ')e"98!H(Nj1PGc([$8G1AqAHpe$Pa#lPP-ER%cpJTVXQ,L!K8Z(
+[8Fa3d@%Ecd)dAX95Q,A#fDL[XK`#["@4#Ch5R*JFP)1!mR%V&+1j5FPpkYp(fXc
+Z&%erLDPZ05V0%1CRVAKKJm0UNqAE6#L#BepfD'8c$MIrX6$9L8!MJpV`L4'Ka#)
+,*CmldMfI&2,"D9&Lj,TVSVlPa6&h,(25!pP9+P580mQh%LqG-$'0kj'I$!j'pBK
+jc$+'b8lAcKppjlF,MhIUmi2r2PeB[ai%lj!!YQapk*4"K4M-pb[-HA"J"U-bUM*
+(8pAPA4J-El2$"f"UQphm%XacXr&c"6p`I0rFaXS)8P*P3h1@YArQpGLUYRf$ILC
+TJk+jQHe`9)5VJkdr`T9"0'`)mi"a-[6GJ&G3lpfr!'TDqLcplDq(9&@q3D6p'-*
+#l9p"al1*lckYZJ[DKThCh2mN1EQC3BB"AY8iLjfX--*8E5DQ`SHXrHh[qmV*F@(
+lql[)E$K+$JqKZ+2bH$dlMUjYIaq1"EYEcMQ,2#Tj+QQVVbeQTq01hUL80J*"X2q
+1Yb%'BA"k'cZd@-b1,[VF1MQ0*j96&%R%N8Nc&aI6d!#'FR8$(j*clLLFlN+TRRI
+JFJc8bFQUakRSc-8ZU3$!pbkcYNNbe(b#SPE)-5aI-MJZeEEcAZ@JLF+BX+QjAK0
+V4m)Mf)8Xf&RpCp6p@-!C03-EZ03-r0b2ReRi@HJ9p#Q6['KI6"GK4$1,f4UJCN6
+chQE1fkLdDi+jiNBbf*8$EYA)Mb5%X)NC5c3ISpH(Hp@Y(T9Z0dX'b32HdkVQ3qK
+2YTjJY#[ZVleKf(lcPYSEVV$brGYEpP%9B#eI`SN,)iZe95fU,4iaPcq[&Mf)bpD
+ADU8b%MJhZ0k(J)(4dBhlS)U4[2hbjPGjfaK[pH8f'&K8Ji',c-#dZmr!0fk4$*K
+@h`%$keQeNb4!plF[`mpV3,VAb*%c(3,Ma)@Na0Xcb"[ikl9"@a@J$4F'+(X`FDJ
+Ki$1qQ`'061%er#cc+NEb%Y2YF6K[hb"I0+e(P#i("5+*Rj)$RTp1T'kS%ESNKGL
+dT(NTI63cC1RJi'rpTL+3!-'9ZU9'i'8hV8IJ$6BY*l--#VbQp5eINKH9faCfS8U
+XTJGK3JceFcq(HSab8VHNX8!4YY05pYQYrk1K+(b'$2q&`SV,Zr,KF'1+fGmkSD'
+)R@RcKGB*cL)5"+Y@DAK`-iS8[-TdUDI5(e3j@fkM[F4bLrhjJM8I,9KlC8#F*B3
+iQL%r'E"P+6(XZ"5CDjbL%,"&Qa$C1KECZQ#4r@#2%0PdLSjZ*E8QfDhRDSM[YDC
+9%0qbT[9NU-cL@q84(iki+`5Ph"80D5c%(4SEY-4C%'Q!R*!!0HeAUp&Ch@Zi9Z8
+0J,[UIL'91#jZGKQD'pQB[3Q!",pXI8*F$4L%FP`+K4cGXf$@YAa*KPC8eCLQ'%Z
+)K`!QA)*TZ4iDJj%$1J"Di+`HbZGM0ek"$3KPi($'j&ML&4QTrkJTY2Qh3c')&0Q
+kEBKX,BYX$BYX53f4d4'EdK'C[Pf4dE9bd8&QFQII"5*$Xb15MXMSUQi3Q9j$C%Y
+BC1Z-)P1-6-)Kl-+(cb"a(M%8cGN`SUd-lf1Ji8[q&0'RB0kh#iY8FjBl*KX*G0f
+'J&EEPd0!cl,*a3V16*Hhm&Dd2E+AiZCK#@l`J#m"C%fR9f$Ie%aUM2TDchN8H3+
+-NmFlZS6AM*!!@P4cP$1HX@5Ff4P"*Q2KkF1D%N%@N@$35UDmV0kK[3Z'b[hYA6,
+Vii)hQjD#SMp146r-GpMXPbXVT1EGe1`Zpc5NZ+(-`l$,EI0fU*!!pM![Lp&#"")
+-N@h2NUUkq'NK-#Jc&5qk)DTU91,5Id-e-YMq'd,Na+L$c"(R%K$!*KJQjFhqEqI
+XIjf@rAZbmcfR+R%mP%cBjj*b,N4liSSK1lmA3de'-%5!-#Nj[%-khlXGcG0V$Ud
+"p0",&`b&2r4H-`!Qqc8fDM$!KfNAdYdbKD6&BJXj1+8Lpd`bMS6PKLeA#R6l#[k
+Xj-m5##qRTC0%f2T,0LL9"`@,`e30i5DYlKHPYdK'j"@K(V0CBd#+R8'ZkF%JPa#
+CSN`&kKCL5I8F2KK1"mmKmE$RkR`1`AG$L+VJ#B`p0kB0)'8cNNAMXGcda2DC"[P
+Smfr-AXM!(RY*I2Dd(Y1m[9HeX%R9ZKJp4d3&Mc2E(k`[)q3%LMYDcXRQbp'pBqd
+2HT)p`k3q8&0`DFmMiU[HhliDe5+NN!!3ba0EGGRckP8L4Yfp*HfVq4LAjjKRkeA
+mpR32!YNV2UZQpiLY0!U`%3+K+Kf$[!Q$bL63jmiNe3h9*&lf++[BSka2ak1!&+*
+j+e&Kf#S$8"65UMT)ea[GIiIHL$G%mm+YmNBUH8JlF"XHKMG-rl*D,MaKM898+h@
+9c$#5KFD!JCD1"HIc@fH3!,UeeU22p3Tdr6m5`%YfcaV,@6kpGrVBFk0iKH$QcCN
+jCe)JiX),%*&%SQU)C$ie5T58bdVDq+J912Mlq2Q4GU3j,a#&iQ8S&eHT`k2*EQ,
+e%mlDRaa,&NUP3QUHPM&Sl"L53eU`1@$m[jb5D[D9r&*kS)4JHri&E#m-CK'S&3*
+$bJ$LGSE($[HLhQFcCd9l121jK6mhmfFZYVQYjCZ88B[XD)iRiiVabmiJYDkb)#,
+eac'CK4Q9a8U3!#Kbe*Z8fjUNahqTPS""a'*3R,d!"I#iI6D+PDG3h9VY$CrEld@
+RaAiV*G*CK8RR,rIX0EG[!*'*Zrr1A8lbiJ$m,-,23[c-`Xrpq)(D1B$**Rb1idH
+(Yia`m6e#$YA9Y1B08+Q2k`qENcCpTq9-XY[5QLaN)S+9b!mJJMU)h)$XS)A3$j0
+"*LkS4$GYN8bMC,2GhR`&Vl,j5U'Al)"XB6f@-FCU$rXSqi)M5VX[*-dVpa#JPih
+%#9!**XePP#e39CEQ2&4G9!%eeY'e4qC1ff+a0fhkiXi@5Pl6"3b&ZI-"&l**+-H
+Q5R,09b-,@q!N,jDhp-M5D4jPi&hf"3$AqM,bGq9V@a`N4UlZ@6ppfS*SGCRf)SC
++IQJS5'#G%Q5Ka$NjpS0kc)mi'abLM&aQE2%X!AK-4q,JYfCr%5[G3kEN*dH+c4N
+34C5'@-,1S85NjBbcL*hkNjRkE-i1iae$NB*),Mkj%93(mY'Yb%+r)+![E%&&([-
+3T*ma%d0-#*Z&R`fN+J!+e%8c9mE@hriC0lp'(dR3bB,+1Qc4MLhDaH$Vm"UUX1a
+Ii'H4Ci[VX-82d'RRjYGNT3l*"h(a#L165mdqI19['j)4rX31`r&V-TA"5532-Me
+&#"@b`kQ['cmHa"Xa-e!kRl*$!&EhDeNmN@4S)dA)r,khQ&"A89%C'"-JS@*!Me4
+PIb""ahM2YN&(H%S8B#bk1M4FB8*9#AXp,-&(`1k9jMF%F$eE*ViqDS0Ul'*Y8&J
+1UY+@l3'$hlAR`HZefqH$P9XB$-k6B($cPjk%hLfLD53)H+f3!!JNLCMNp*A9KEr
+Z8HTGic@")L*J@"8h%,"1A(SYR8X93NRh%UQN@mYdf&-H0B,eL-T)SE$p6#CN`hY
+!VTJMP#TI*Lp+$DdrI3i*L4XqZjc[@IJ($2l2Za$mTdX#p)p*d*qfU!(bLd59TTk
+CVK0k'Y5I-k*qdbF60kb-0-C,M$#"4EZf3MJ6a6AfIL!,XcS'N!$k!(`8Y[4!HB%
+I`UU3!0kqA-N-CZP,`@VlTlqd-GRk+!P9$R4T!l0V$-c'`-G&SPfbY*c89QL9%!c
+VPNc+rU8UAc@[F3-l19S1BGYDci'%[p)LQ9lC5L$)mYCc@kJ`@db9H909hMKfjDb
+[9#GP-UJZ!)4r5NDHcfpjRXQi2PEXZeJ2!%e(Z$KUJI2Nc95K1Mc*A5hNK,e4G+r
+PVNX2S-Vc-Yd2%Sp1VbaKHZ',@c+p5QbVi`fSDU2$eV+AM['YGND-+LL#*e6"Q)b
+F1+e)h6a()Yf+#+A6q-P"0i#*AN)48Tmp"U8&!(jZTB04HIG(V9!M#U8A+VN3&C(
+%2lf*LSeNRN"$SDUH(&2Zc'0(M51RNj5F5MjV',j-$SHKm[@me63AUD[2*ZFSY!8
+TCda#aBBTXP0Q"RAK3NrR)f`3N!!9IT!!CqDTV'##R2-[j`SQm))UQ*!!LZli#"*
+EUD*%E&rcSIe&T&i#eI&%II[1mi[Q,A!QYj`U,L1RTf88l1[)`dQ'e9b*pU()&e'
+I%`EdP,hLd3#qGCR"&lRaUZD(,#Mmm'0"S)ke`JPQdb$869D'%VKf"YeTL!LbLF6
+ZrqC%kQ,DJ&A`9h[8lGTm$Ib5`#Fi1QiqBhLeKb[XApRmSPj%6GrH"e8c,!Uj9"a
+5KZ8HC19r+(Km"-bhk5@mM#`TG&36dN*1Ll3!@Mk0!XMNLDl4(6XV9-b9BDJ@D)*
+-hP[r5UNRIqpVfj9298QpF!@)@5`lVc551L"lNbre3"m1aM#2+K'q&,D*JD3b880
+%003k%3@%K,M5mC19VN%iKP81)F[2FTFC"[)JIVNQ@*@kCpY#3PIUjM`&%N#M*I"
+e+SaLr%PC%'5@dL4qi[K*i#H#Rc5ET59'2i82%6VG$'F)b5-39LM1R`KrIRSeIIk
+42[%@3$Ir,#G0GMQCD#I(#c89[&r)9Xmif#+&YPmTUK!r3Tl+fS)NH3cHa$6qX#I
+DN5)+T&2X1%FBK8#iP%jfBT)8%YP0Pa(aCb2&J93PpLP@[H)Gb-*%C6ERG+(LCL8
+lY"P@!j5T1BG-0V'&3a0VlD@UI!,)b6-B5-43e8m"fRdp,F5$"(&5GU-0DeVV-I-
+"Q&HG3G93R#U`3K@h$mTJS!)#JJY[JZ1RY8JN32&AdeU+NQ4P'qh`(R(lr#d"H`Z
+L(GG+&HQqlSH)0"kRS52@bfp"KAZG%95(JbHISI1DJCbpED5D0c&U'%J0HF%0631
+'"X2&TT!!0c+B"2#15aE"j'(j--hC3h'(9,&1&h8DHXl2)ZlQS5DUJJe)%+&'QE9
+iSihYV9"1k$,lm@Nc`cQa[C85$XfhLfM59NElqd1FN5YejqCk(qS$k#Ni@9X[(4@
+C@"d2950L#AbCUH*I[J-[Q3$+4r#6p[9h9#iL[i"Uq1P%`-6$*dMj%rkq,C&aGdb
+JJjA8[a2Dk)m`ZNQ%@H`F5MdNKVJN!V-M@lb)A5GIb1,0JpDpB6SDe8)j8Q+*3Bm
+Y!29`TY$D"RViJ%I`H"43F)K2T1dPE+,)R$jq'@U"(r'E364p"!i$(2b#+Y2JD,S
+'2'#&pP!#UdY+M[@8P"`qQ2RpfK1RUR02RAVRPG"QrkjMZkU9pa%A@&R4)dLUTF,
+`J'f29&QjS)fd[!L!pa'!X9$5fR*HHkb&"dY+MPqik@Q23dL6"fL3!"AF@mDJNZd
+4I31TH++)AMMB(),UcC2HbUZF#GmK9XD&aj1!TmAJfXD'Gpc&3N'AD!bp%$VQMM4
+#P5FEdE(SSXmr8pq6qIec2I@eScR(cTcYU6r@mdT1I6T,PJYZJP1h,)qJi@5eXja
+99IIh0UfNU[3G,e(AYdH)2J,5q%UZ9U(FRlpI3@e4"1VG2RGd%B00+hdTU1Fff5H
+kbaaGa*jS5U)TXKq-XP!M[P+J$G#qD@8S#8H-Me5C1CTY-6Q,Tk+Uj89k2!dV+4'
+`5LG$[V&G8[!4iB(SJ8+SfUJdcq!8Uh%SGTHGcfmMadAG(4%iZjiB8LhRpD+f+$Q
+Jb1,#+lUhpe4P*H55F5Vhl)QFNcRI6`mI-Jl[U[ElMhQFi5R2`a``b!S40#(4)"G
+1#Y2J&5qjc#12b'SY5F@fQaS$9&@"X9PlY*2S``LSJCb6iGVk5[DCkA%"+[&G"5G
+2R`fc)L1`#q1F'Jd#,'Af3QZ49C!!ik$CF#!j,"6RI8!4jXJXPjHEA@CSVNTYMMi
+Hh4a&390'cF3J&6J!(9-&5mPVSJTC*5i[34C25K8Gd[Y)96DV#dB[`Gf-F#bfHHF
+S+V$+pfI!'@fQ8PRl`##@*V+Fc@G29Tm+jiH)hh1H+QZeaeNKaqCJ["0L*@9G@D'
+e3l5!DqfdJ#X5I*Uk3LaJ&9@6M*r&3BYS%krk101%`hbUiU3MM5-NaC+'P$1f5FR
+YqR3XD6H@e'DS[MF,#Jk`+2qZ$1Q@cQ($)[b[p!bFVDiA!XjLTVRD*@4$*13%-9N
+T&1i&YLRNBU13!,e-NE,+r8,-8bH!UE3Yl$`jUd&cM[FU@1V0rjdr&kkU-k&d5h9
+I#lDS9Z$UqTlkc*1RklF6q09bkiTj[hRJ9ka),r#*VFdl-rh3Ea,BiFmp,pRDI2C
+Fk05jqN"pU2VldU%ZX88XKD"K&3aGPX5GLP,"d-SfFhN`3ph8l#+!T#BcG2%V`8a
++bmEI"#1jqD1EP@dh'-JpGI*iZJGr)MIiiB,Il1!I,UPjm&XiH&F"(qfi$NI[UUc
+@$SFU5"-I$N,IqT!!L4N3#2,$JeT!A-"!*c9l'6!9i9%!eZ2"$GE6SiZ)kp99qI5
+)+Kp,4U3k0c##-,J%9hkN%LZ`Ud"ehJL'-ZYc6Tq&GTrHNj@"9bSp"C!!([cS*'&
+qF"+,mM`H55j9ZlVEhUMNijR3ik38c2Y`[1EMQAciQRJmNj43P-`+Nb2UB1*!dRa
+0ql6+L%@jkl`28[,K*pS@fU1@I*JVY[!ml!b5&,bNec0b6SC'6jmm@hhb4(@p8%l
+(931f[%J9PQE3Slp!)5BbhV8XTMj0+(4pV8%JSjG'GqD1@Mb10,A-'eN-1Dc2!S&
+Z3pXJ+ME5eGMAbDM'pA95&9ckG9*SI!LIEP@(6kGbiP1Q$Rip3ahi1T4lU8Cm)UV
+KkjPU2d#NZ"V#*i)((QN"f06#&63j#'LL`L&fVfkP5Q-pMr(6*i&m*1`253CS@2`
+i`0NfHar-df*FXGl$dY6d&%bi3#,c9q8('kPj!3N`dFP-P$%6aIM%e$l,9bS,2hZ
+SBX+PH)dU"dHSbX1PQCMU-(NFi`VL1T&m([Q$Q9qA+TfR1K)@%9mP!fX4&+`k*Te
+DT398"41#ZJa+XcpZK'VMp)FKDX8cL!%kE&Q1JDM'SHalU&*+*kI)hhV[BjiNhr[
+B4)QCP$Jd*EE,fZkK&`a,jp!8$NeYpe#(105a9BFkYZ*3"`jeE2G3NcM8a*89hY'
+K&`a,je!6$M9Yqe![+1fYpNX%4p[jQPILlhd-!N@%1j(h2KC"PpV1i*4KF%SXIeZ
+$(BE"$X(fYJDE$)00hXV&l+55bG([Ce1T#'H0LbQ+SE@9`6&CmH"YB[!Y9'#h#D@
+EZ,51,beK"ERDTAAN!IYD#!@KBV5Ed$rX)15!mR`+,L*Q93LLiqdk1C41HqpM*J-
+j0,CG*GaJdKV+LlJKiKNJ'e+H!58`lMeJVm#R%G%+AkN'')fJYP+kC,MDc3**UGK
+l(k2UM8C2KE#hL#TFflJ+ee[#@FKBd`Jj+DU"M4e!!#82fIS%9G9KV`!aPVXbbTK
+B-6"N1-BBXDa[4[,T!IE@P*Q`SYM@pE4X`q+hFCQZY$i"F1+0%Ir)@4!*(RHP1L,
+F[))%C4$AGVG!jFH(QMHiLJbAYi*eU+AS&FaRD6qYhd,#H3@C*k4lj3'G!KJUG'J
+`+i)5#pD5#N5iTf+GN!$T`X"c)I1'-Uh1mJ`Qk*-Li0,'Pq03@HYZ$$&4Q8bPl4A
+6SpaYQR9%4%)PU"LffiNipmrfBl('8N6p4[!TTD+6)YqdBPk#0#C1RV@pJq0XBDV
+qkQ'1jQ[rjFLhc@M%#jHI+M6EQ'#b$C,$b8k10Ud!`AQa[@RVQ5'ck'1a!qm43rL
+8CN`*[%5Qm'T'l4`[8pkL#%cAiB&V@P5EZjb8"1IfCPL`K('U1,#Fa(-RSP,ZE&l
+Q6R'5m5"ASqlC4LVqFTTbKf68(-M[4pBG)3,mp1MX)l12r&dIU@NJT86D%&651fh
+G0+UQprlSl'QcThd(+LI[(q9"N@eY-phL6(SLB4*1UVicTDI%mY[-H@5ZV881N['
+eRK$4effj9iTT3Jl@4LfM@KH2Cp,R'A6KbkCBjCHll"AmkH02Ne#kAR'BUPU,'%K
+P9+f3!!8&[9QBU$Z,$-3S4(TdEa49Qj+LNBdL)S4%qEA50UUbFTpZ-a)4fAKpR`!
+cZYQd@I1-UB,(,aY-ZAPSYdDb%S-F"Bm($A!B&%&i5@&hMJJ3T2a(3Aq2bq"dQ&6
+4XBKTJbVb9JZT1Ac)JF,U!#@%66Gq@Jaj"Bk3!#*N+%qqh@X+6a@0e$#&jmF5)M5
+08e9"S&09"jR%!l4#m8CH"#Lf36S@D#P&j%DJ[&@0I2Z-+NFeIje-dUH([1K$X`R
+0R5UL4I6HNfNSD0BaB3V99R93&2jIYEj+&BG53B$ZhhLl3YQk(FeEU*QUjl*l(VJ
+*"QH1X"!H(NmJhbdF)b54N!!*+HpbM49iLq9#UBqaJQiaH(B(2p!89$`9LUedU[3
+,([e+j5[9e8JBArRGD'qQI6D4imkG$9IbSjB0%lN'$ql&a$JSHMr)a$SFLXmV)9)
+E[CiULjIUlja$GhE5-&lJHLpK$K%EA@5UX8YcJY%(Y8-2BcXRJkc2dkDN3*Uk(5D
+1HJ$SrqG,C'kY(Fe$5l&C1@qrXQ1S(rrNN!#BL3lL&cGlMU9UcJ9),+m)3'L8!D0
+KBKU+DiIZqTERmNVYXSG%QU%4QA8V9D&Qcf"(2c%L`L$4PF%NCC!!N39"QBR,AT)
+b+YhX4@8[Kd#-lV,24h$Bh6THcpDrL$X3VGIH6eRVI,jJS`Xdh%KbKU*4"d@I&'R
+%ipZ$LIh`SZ@Mp"!&UEC"FV*"R4Y[EaX8#3!E43$Bl6@6!1`aG6PB9[dM,SKS%('
+P8LD+H'#&Q-a1lrJE-ql1m6c-@Y0EkirM!I3!XZ%68l%RNGP!-I9CUY)C6DM!'Te
+Z929b&Z"V'6l&U[M'XfUIfSI24qSM[-j5@ALK+afG%6@LTrlbMVL4Mm$RBI@`IL&
+iM-2D(Z8%9B369,'(hU($m-&KD-*Kk1!`G-Sik9A-55mFTMm#BrqX%5Z-PE2SXG$
+Nhm%CP%9IQ"AHR58pb8Xkc-Y!CirD)`@&TR*9MSp,ZI!"q)$2)A8)RcT9Kd&19$&
+e&P91(8"6JfT!ClrDMmiQ1#(l,JYCXRFMXiG2N5Tk8J[50Mb@i(DC2-a-SY1S'Se
+-SS0(TX"RXpU-MeQCmFP9ZAmj#'*Nq%Q0BE$k*,-DI#M!MG3&hPNI[@R@kEC"1$e
+!dRhU'HQ9,ZHRRj5Aed3e"c1RZZ9PVPiCfC8r[qC3HF$I,rFFB,jE"ic*bhGi`1G
+rM3-qhiS$0QN(6#cHUJ0SU%PHj!US)d485ArcUaD*cHG9c,L$c@@ah%QAC#DUCCL
+FbGfNCDh'CQT#49r2UjC`mFMckR-pZE4CcAPi9-h4Gm,MlhRBV*kpJ#d3HUi+Y!h
+5"i2Dm&#)RA,j&FZhab+CqQM1jLT@dAA*N!#f%A9aB+HX!!!LhmH+'&[9($(jR#B
+hNL,[&TS5Jq,5Xhb*SUfMFVLCL)icqk)8,8qQ4k*a$L*DRJ9"FKm44-P3aM#B"F2
+QA(2N8B,YflAL&Y'&,@%E%Y&cI"5Pem)0RBL`IME3STlpf'qhClD`XS4a$0VRBa5
+U@%cJM&S6SNFj@dQ%(X&@RrE`!34XB41`e%JXpBP"JpCH*0mcL,6*CS3r#TZP#Rl
+9LLST8iL!bHAS84L@9K5EDkH1LmKY1,qDZXB[Kk!#@6JVR%fJN!!B5XDiH`LJ%ip
+')!Tf9#eaA+r2b6Q9SjqYe(F-F`6"cXV3+cfC2AKCZhmr$A%p$f-'2(A&r[he`mI
+U1HEMb5GhH1Flm`dpMhShMi-b)8B#ZG)9CD0m4),b8MAR!`bUjJG4)[&b9JM4`+%
+-2[G!f$4jA!Tl(JZlc"046Gj@L5Tijj!!%QNBpMb)LBNHTP%HB3L'#Xh%M0A`HS1
+KBV["J'U,l#-L'!Bi'&BBJS&"D%-`["J8$#ZdB+"&h-d!1(EQC%lT)IhFfD2e*6h
+2hkh!)$#AMIR*#p0$fLbP#L(`#)l,C28S8r2%JNb5ADi'#UaGF-LZFr8jaVf90!F
+)-K5B1E@UR!-K6#U`8b"5SISfUP#((5SlB")X#Apdp&)SL2C'rPI`9V5&[eb&l"p
+3YG%(2Zk&&p%fUL!#'aZBfYNKV,C9"@e94UK0bAUlBG0YXdI*KS4(+#P0+"8AT9!
+UhK9#kI3+4G[iEJLQaR)!e!q6!Hd&akE%XBerh@-03SI"&&Id)4G[-JUH&'5baqL
+X)CjK,I#&3`UBrJ8PTdhHj$4GSfcHDaT1MSRTm91-MaBKLJdAM'%LT'bCb'e%CLF
+9!V,!S#1h@DJ&(5%+Z3`V(($lE*SL!TNdb'cPad4-qDKbRT3lr[JL$3@m)U%"5)"
+4CIS8582&aTJ+!S*S##9`dJ@%PQL&XFVDQS)HejbipPRE))P'YiV()bUAQr`kG8I
+,PmNL)9BU0RA2X6EKr0b3!#`+GXC+J-#X*4F@qI,eepB4Br+e8%'H%ZcCDQk)aKF
+$8Dj!HZEL+N*2`Bl,F&`T[DKjh32)TN`rmZ(K-S-%l6Gf3e$$E5hf94JE1mJ*6lR
+B'-T"[)C1A[6b2JSNADND$&kQI8ikJQ%9iTDP04R9$%-0SLK$iHhJk2@CAjZ"6P1
+0l4Z$'QBZGKX*J#6FlUAT'e*j&k"9S!AM0911hRkN2J,cLN*k**U4klTR`%#cBQ4
+8haNNZ$0HlaNF"5FIQ8*Gl"IJ"3HXKR6l3dNb,i,h&pj3H-&ZJ'm1IV#8V!ZmR6N
+pY#)P&i`ifa!K!L@4"m4&KEfT5dH@4I@N85bH$VEmdb#M&"m6Har&khU`9,(L0@r
+RDiZmRAql@00MhE-rb'1KB*8HkerDYqqa'"!P&E@hdbE5%a#3!!K[N8[SjN'"Q4A
+q1r)F0308NR!-J'i`dVXL%4Xl#M%fbme6,pC%rUE#QNd6qbjSmT!!Aq3MaKLcmJU
+hj`'!4&Bj0BXb6RVX0T8+Y%Teq@ic9qZIP&kpk6J6B"hpqBa!+IN3+16"'DMDad0
+&i`qEi$&@#3qbh#$JQcYXV)D#(Rr4)ChL0B%LV91%e)MBfL5c883TQ2KKD0'G@%F
+EHK0CNJ$U*@"d2)""iaTkQpqKC*-8hX6,kD2ha!1-hYeFl1b&B%U*mEi3)lc,5-!
+`C[2h,2!NZ4V[--QP%C)rTiXACVFbUp00"V0cD@j&$a,5r8(fmAKjK%LJIB[+&4i
+l12,"T+Vmi`%5%N8pBN%*lh,kI)EPh#NA-r8T6l&kTabfq2U(HP@%(N[!lGF#ach
+``D4M&YH&@hBDYK6LQ4V`E#Q+kFA$fTEHk#02BDNjaTkP4HH!X2LH5YA(p%FS+H4
+",L""AmU,A18fML4!mp4EA")eb[&#SJb#PK5T6beRT#X%'%9GNd526'a[TBIe(D-
+U!bLMUM$VH2!$J0Z'3+kBd2CS$C3eN3F24PPMe)mZQBHhb$!@reZ4F50KXY1)%Q#
+,-Z*Z+M+P9l3[$MS'%38AH2BZJ`*N498d(&@RNm2+1[R8(J2`99c`1&A3(ij2HHP
+RE`Hb[jKF1eH(qCmb9V62*TiXLVfi-#qj`U83aCBU"lVjmdqNUUEFYqb$l'1,H8K
+#6baGaS)VTX+fh2BJa([c5a$jR9j`6dp!P-9'aa4JNKe2i''C8k@ah$Ui"(2!#B-
+*L6I(QNNN&$bN6qIa3M*ZI4#*X0bB%d6r"bIThEZL4j-rQIR"T"0lI[Bf4`alSQK
+')RM`dDJV59lJf&bJR!-2#Jc$XFK`F$((4Y4`4#N$PYMfjl04[i-IB"FXc"e%CZ"
+!BYa%J*iR1p%H,`J9RD[*`BHA+b6K8a*%pjPP4@kr(a1!H#8RmIS-56a1Z"Z5H&m
+&*I(k2%QmK%aQMpjdVaZ9AcT4XcL%p*2QPm#XRpJVC8%jm#"Q19T5m#bPqR3IdRp
+kIHAaFrSVPIA$)9KdeKmR!l5lPr`@Q4T%3Sm+!B'1FGH8qa8j&ZRJ3MJc5Sm&S@a
+'dKBTR5('MXGSLXF5UG-+E[XU"NRhH-#c3c+$V,S!)%dIF**+L6KTr8934Y)PLpR
+[cM&m[9-lc"K4q*GhU'&TXlCp$$df!(AcPKU6'1NeMYld+h0`FH)"K@kU@1cY6&@
+'&m[PeI[-f`6lj`4[0EABd0%0(DHKBp+LIB*%C8L@6-hE9V)NI@'aN!"Gl%$"N!"
+8*)IMRN3S9B+)3Q(E'`"mL4JAb%c"!1kqmU$SSfdNNd4b-8)&@-hNB[U!hB@0p'#
+cb[%(HQbr2[(+SI[[@@F2!Y,mJhG[@hViX&pGEa$&V"T*hpLf'S),j*U*V+dprUq
+rd!X1TU65GT*q-)&2"@CqmCT12jk#XFM$5",'&@4JQGa2NaV-VC5Ch*G%4$m)8Q#
+EMbY-"H"bN!#UZEkFMkGIIKNre1eQi,H0M)JpMNYJ#UZH%YRi)5r"4@6'Tmk9R$K
+jVPlh`AB64$SLcKfVVMqCFf&'c!hDKIhlaBhJM*J6,EqU##B',0mR3FfjI9Y"#X(
+59cA5*ZNPh*F(DU)iUMmkk+f!fm32p)M+8e26SUCNHLqZ-E`3'lbX)8'41+`)Q50
+&%M-aK3C&Dai,X[c"l5,T'6c3Cdf`1jFF4h,'fm1NR8-EKa"VT69#&23`NFTT(50
+eKb!ASb)S&1&aH*!!,f$)["h68M)+iJHCj!8kNc@LZca9@3Z95[4JNp-*dALa*%"
+8YfC9hUbC%P0-aZi'i6V*N6Ga!QJpc0l#D&EJDIL"RUV+jfJ#fI!"%c5BF8rM!Vk
+8kS3c@`!R%iJ4l@AI5Ma%bh"3%alAcZdc0M@CT"GTFV,`Z(*)cmZ[*!'PDHLbjm#
+*XhQ*fT!!ERPpiK*Q)j*qSXi6H!GUJ,)3NMAk4M$)V"@k@9j5B8KG5,,a&TT6Cea
+)IPQhC[[NPiTRYBa%223"-MpM0P9a-6LENJ@m9JQR4RVF0LRYlPl`),1&Nil+ZK6
+L,'F3&C&l(CcJrH(YfP5G%)5Y2I)a1VH0`YXJJ@kh)2L0"V-(GdR5PHR6KFGY)dZ
+V"U[HJP,2&9$jD33284ai56IH5Q4ecq9MXBIe6aHHU$"H&)HR[*Rmh@&2'RCYZeJ
+RJ'AUBJ*BqR4$afAS&"Y*Fm(NUpm)1E,NbiPMf`)9MG'H6'#D19(hHmLR%kZf48!
+,CXHqG2[X""hJZZ-$f+Li8dBAFN,eNMpIU1[T%eIjSG%d%Z)f`)1DK0jda+Sj!X8
+L0!2Q2Xma)#Akmlf(H%Qe@KC3mr$d`'Q$dXDMKL8DMV&h"4fcm)+V-bFfE!mJmLc
+YXGr1-K3$ICV*'%9'L%[G"T(9!(L%qVV)pMbR(*SH`0MdE2U,#aCKNlX'J#f%hc3
+rR8AlYb('`R3@@#TH(M3XX'aE!*l"NI'UE36**d&XllmMpSa"8+1J-4+P(GXR5YI
+-4TQ!mpL6d[L#6@e'ZMKU`26N6Lm3(A+3!'*S("58h38&fp!reb$RkUEY)mqfN8*
+@lfJ`qepbSGIF&VS%"rVf[FffaHAeH2Ejk3Lkc(-9*Q$E%rA@4KBB+l5dIp&IqpX
++1)1Sr@f6+0*RrVEL5A5$2BjAV$$9L-LAV(`FTP)MhJLA@!G9hBR(NLMP"q%KNYT
+)I2UNZ8FfY'HTqNJER)Q9*[@dTG-3bA+,(LmY1P38&'ee4PfLSJkJif'EqXPED($
+K%5F1Te6f%6eHBkL,KMl3T4j)8I&SQMe)eqQ"K9k1lP2T#8RV4,HFUqmjmBU[T15
+aJbmM%A(J-")3Ciq9R10SIhVcJRKeq!$&rTIdj*`mfh-1c58$rKHU$9A9Epefap,
+GlKKYGdaZ"`$h6JmS-cakdme2Nk(2R`k5dI[r@K6H!r$HMdNC0D)cMSi`UV3l85c
+C`JGaU42'PeBb'm5$d)eiNMYC0'`U#M)mTL+"GHK+`#jpida*R)rqMA5",KPrqDr
+NNSK!YRhaR%jh16plF'ZAdc4E@ml2rMpEcVD$jl3)DX0bm1#'Fr0![Sr3a$pB06J
+5'"NX$p!Mj$hq2q&mBMmH'p5"a`e'!aJ[aM!hrFGli$q%`FS'6f"Z)Kk&kZkcHdV
+Ldad+2iKG2%ELA$-a3*0JGUZ-$)r)*J2,$X'bicGRqHa[`M)%r*1e8X!r@EXe![l
+*rZqZJ1m@1N$!2aQ4![l*b0B+Q&Rq,JTi+eM@''kMid8d'apX!()[-0'1[Kadl0I
+&XDI1hFdMjlVrqNGZ4CDM(ERjZj9j-%YrC@6TlQ6Yk6(fhFQLYiDa1rCd4&SfXh(
+(dmG2PEa`pRKpTECI`l'HliIU-Eahi*M(bE08#S#&$#"#-ekH8ECA(5a1j+3Y1Q+
+0q26'[93&#8@mk+3k3b-@-ASh,De+&lde*r$46@)a,pqY$+ra(24Fj(bI9Q3JBE#
+c1aCSUrm#J@UQ%0'KF(e2pDPM[d(!p[lP(,M0CBS$"8R0)4r!V6k'i#[%if693AX
+($RJ@39Kj%SD-,k36KLm)P500hLf5UMj'(AHCE2`CLZGe19Y#+F8Ul*Ud6AY19Cp
+kS6iR[9fhDY2Pk@lk5LLdh8dhbNGEjFcF(S,$I$Z65ae%,VAEViPq$%GaTU3'fNH
+Gf2AXZA3fP!Kef#QEL%4mS2ENZAGHU*&&MBcHp)GXGVB5SiL-l6PDq9HMVr-F48&
+%$r-&MleI0cd@[HGp*'AJY1Ap"FEQmjiAlHldKRrDRIl`6r0UXV[UmYDa'rffNGq
+$,jFm8epCR`1m1hEUH2fadchJ(EPV1TNf$[PMpRITN!"M`BG3iJ#223r60#3H1''
+c6I-V)T23%3pY#lZ2)C!!rEh(m2marc&$YVCG,d'hMKe,Mjh1V@,Ri@hNPPjZ0"8
+rI6+,j8I8l3Y%fFPAYh6@0hV6l6N803d@NY[hE-FmQI$f0rc[k@bBRNFlCXM8T@2
+!U!ZMDdm1Pe6A9iClcT4iFk+J)03b2UVSTTJGchG#G#C5q',@(JD,2'bV6)K(kl$
+Y(@dCk$dVC8DDS``XlFAPNp8[R2cqZC,+8hM`SY2EjFTiY4aAm5`bTilMQ3[ZB#P
+N--HAqR(TPFTcCmlkHVE$keNr3MEJ0k"1X5j*&ffBC)R0$P*Q9,RGIAM&!8B8XH0
+f0R`C'jjkTHGZlUKU1K[jicVfcUDYppM2'[eecA0VL[f181L&1d)KHTcLpX(U'"a
+9,RC(b!'VIZ-GSY%,fd3MYE9Sp%*00)T["4UpF2I4k)9YS*%aN!"@ADm&dYCQm0X
+)T"FZb(+$5&&4[p4AppM,KjfrUqr*S9cRRA0rFlbq"l'Rj`lmMIEIK9"r[#4dmQa
+1bGRDN!"faXXRU`(&R1`jP91bUlU%IJkA$*!!f!%!!#k-384$8J-!8f`293e&0!)
+!BdEZ-qqG1``M)M+6%4(KS+K)T%4QC#kpp`lAe0a2CQDZPU+)BV(3K@K@TZqp-l)
+I89&3dGa2CZiINTQ3"!dZPmY9CQTUVP6%IG&-cF`)aq(h[M2JZ*rqk[mljqrl2pr
+CchI1!4YGJ36"%q55P0#FEhXk-A''mS$mH)a9ITaEr8RhTcYEV&NH`4&#Gh0RfhU
+4ZS6!1U559Ab9e$#@kV8YeSkY(5YD5mDZN!#[VK6PPpZ*p+4!EIl#4&P6rU2Tq(i
+e5CbQH@`Tp"pL-[p[i@6CUFc9BQeGk&IL-Ijpi@`j6NRMAaCq)DpArUNYXlRSI('
+J9QClJ[j&I)B2+[a@,PC+HAlK"2Qf-PCldPC0"i[EqC!!`U(b!mThfRffFMTF(+(
+CEII6(d3VRe8i6bj5&QJ0YMF6kG2L'rb4`UPbRA+4cbam8(j4H9KlbAD'6K(2F@0
+KFaN*39YV@dF0BS*fh[B#E5-qcam[6*+VP"UH@pKI(U!mTAeZUkI$a)9D#eX2ZNM
+mQMpE1%HZ8%CT*EC'G)cBLSmVA#`h8pVbdB8MjBl+H+h@jUGjBRXYaVBlNEiZK[2
+A#V[+Uj@P[&0KEhQ*mVB@DPY&1iK4[+$`4rRIbKrD*PXdE5aQDCrC2UDpa1@mCf%
+I18bjbPXArLTrU2bQ[@alP8i8CfJRE8IT0q)Vr2I#kI)TTCd@BGY-Ia)riMmAYT5
+[+C'm5H%[mKVP6qeIYSfdUEL&CaIHI9TqAmR42V"YSeI%bpS"fc[dZ[JZ[e5B+Hp
+AZQZIf2j'qiTlH,I#c[*Hj5$[9rL@r&IPX2DHl4$0%)1ePEB90%"mMYmV$*(h+6[
+jNF)EmPEPV,E,YS1QLjAF8RK"PT3Jl92E"KSSUTTJ-e'(Ae3FFL'9rBS$G3p0b0+
+icP2i-AkEVq9(HD+@U#HQ*"j,[*fi0T'lR,(Q0%qFYLbjLliqjCLS*JpF,mQ(A*+
+X`0KF'bMLe44*rY`MbGZ6*6N@TKVQ'CMe3"CKiXHN#N*P-!1A9DVV"mC@UKT0Ue3
+pG(fPUK0lM!+C3Ub6!J6"QGNY%6j'E!UabaM[`&K*GN+cCTEmCNP1d59CGdUb+eR
+4*Re1ZrMI$YS@ZLBdmPVS+[rEL[T"a'ErdX!9%IkDm!&[qTpAAr`D`9,P&k0fqeG
+G@4lYrq$$04'Krej6i9m4(GkL`KrQMj!!0jlhpkMpb0&L0a&+AakpjX-e,G$Rp@$
++3PC%p1L59XblI"S9kSm1p)ZEed3XMrlr"'PU$k9(MjldDp3T88hdDhkRAe08*mG
+-)0%N1lPIBpE[&"e1mYLAb-K16D*1dHm-e$M"1N9CFd)rNB3H,#')&-ZG@-"BQ*3
+%*"i81kPQmS%6U*0a%'!#e5SC+%D"i)!f6338kM5T6UD3!$)#-91K,4i-C9+Tea4
+[TUPN54IBc&N*V8&1LQkFFLT3+PS`jd@9!AjDa!R56d@bS-4!4)89D9&P%"2J493
+-p!QD++hd+D"&JS1J4HU[P)ZS%14M,c,*3!8c%F)YAQ!3LN39pi+$L)J%JLQBJB4
+k[d$p$&GTB8S!@k5%**j+AK"E3,K5p9+)KrXKM(U[$S'Dr5krZ9*eQERIT9$5e,#
+*+"1-L2qULj[4hIV0$Xb!T'B6iC)))rK&[eQ4A@E4!K8ZcYK9-jQ*Z#3m,S')8QL
+#K%!d+G4P)L[4BBjAVK!`'q,KqY4!"(`dPEaiHDB&85C`Q)9+NC!!jS8S%J+T@@"
+5ITI$5aPF46EI,a-MT$-(i4Z9$%2`b%9`TmaF#J%U9`D5HmTb'$B,VLAqdpJZQm!
+JA[!U)2IH1GP6-C!!kB@+Hc,hDH#RYDi%"#(!+mki,H6k0&d@,c19I9"93Pf!AiZ
+RPP!U1[bqcI44ip@2hGC`HQ*%95#*!'l@Z#,)"+1i#%BmD`Bp@(")F-%P1&a%"-j
+#6bH5hZkZ`QkmaX`@i1CD*48%#e-[8-%NHp841),+N!"H11Q#6cq$)mMJ$L4F`(N
+&#8U&ET&!&S3,$!cVCdAS$BKRCH3cG$$M*`f)U1+G`34Lr(k&c*&kf*3VSZU(p5h
+JM3"-m-S!Lb5Q&&8'HTG)(84-FC!!K4!-(CbC5Vr#G!QUJT5K+062V%$8QLi`QAJ
+m!3%DLJJe!'Ea!Q%BTN0QSQJK"Cr55JIK&j!!-Kd3*AM+k)LRbH5$CJVfBA$3)+H
+IQjhFCCCbA*a-N!$jc8ir&Rkb)#dSf6'c8h!38C,d)#EHBpH-&3fV#KC4"3ZK%JX
+6dN)`dd2dQF"ZFK#Gb-SZiV3E"")c6"jlGF'VMM6S6)4S)cTmj!K)P8jXVj1Y"HM
+je-*@P4D'-UQ%$JG4LJ3V"N*C%5p5@#2P4%[S,&*B5eL%I!*(S+PALTaL#,RJ6Z#
+GD1kFM)&ih#Nb(q*#X$!*-B"a%&-NS&V`UB@Y[%,S1)L8i)hB,#IC!j1&F4"9&`K
+iMLBA,%bpPpd%dKK0TQ![)6aH)!KScUi#I55LJf+3!0('Hb8&!NHNQP91#S2CL,4
+GZbCLPIqmCIAZ9AYfqk286H'eiShDAE[$9fb9VSD(ESc!Ci9DmFIDGe',1ihKY@i
+,k@V%KZ94S5ZL0fk1q#!L-R6h[m9lELYZPEr+-cQ)M)Mj&010%m5*a"b"ENG--'Q
+cc9CjYYd0TmeZCY+qQJYd#jKpNKc5B*@0#Xa+Q#fLR"k0#Gl#M'&%`%lRL(*Q(jK
+XQ1kLj9i01f*`D$c*)'2f%G2Ciii%)QCh"[41Q,5$X8Pb3$maac*0f"hqmC,)6CZ
+M9qeBMVTTG'LN'*3kKH3Fd`da2#aLFr55H$64041k$&EjqcLbd,i[aRSJeQeK,N,
+e1V(RfB@9Zb0f`a84SC(ZcVJC4AaKdVjI"HCVC+&pVf+p%qX3Q-k5(*`[bNFbaD!
+MqlC%EPS5'HTIFrI@DVbX%m%f"#BAV#G&qFCUmIU4h028E0dFiED4abfYmVaUdpe
+Eb1'QhU60Um0N!ePSmlCKlF6m)%`d)*@+FRB*S!fd@YSNX3d*M0UdC(RiRP"rT,b
+*Z4,qRhF%mZeK#L6jlLHL*DHFb3C&K8B[L3JM`ZSQjZ$1fV`#b%q'l(#BBC!!EbE
++1H@LH[0Qch+D!Y`hHYCfNcDV'T0Q-(@5R0P1P#pC4-FY8S*k5e+CKVe@bkb0l$j
+pdqD)2CZ@lSRF(EdNP!(3CTf#L!Acbc"CNR`p9Jc++BrIRKcT@QKda,R0d@Z@,iR
+'Le(8TZJPkiML5GUX2#fKbR4%M&`6'Vdm22lERRp0--jYmLhZESTN'LUAVpQi1b)
+mM'@j%E(D#+56@8QB)jf-1+mPE,6+#GN`9f'SPK!X#hKKHLXd-R59HmBi2T1-Z'D
+kCHBCJC`c![PY4(Hbd%Ed`ASejNeK*QX*f,1%2PC(3P-#i`D"mCMCD-6-1f5M(j`
+QlBGB62aNSIe3!6KjQ*q"@DNPf!"R(Xa!kqX*mjpYlI#If*)F6r82Te+ER4qbY4q
+#@B2b`fA!L-+N-d`6,@'"Hf0LPG[`dih*$deBBp,h5jJQ-$1XGa15L-E(20d39bV
+B)DADN!"b"RC)#F$1a+3#4Y(D&"d2eRJ)S"ZmB)FS$'aRG0HG8GrT["fJMEL(6pV
+8@,Ze+EYjJiirpj!!VYU3!-BQE3JfIdK,Q%PD'm"TXm@DdqE33dMM3kCU3cRimkh
+b8"I-GUd0b'U$l06QU[9XQk6MS3dpS`h&JDM@*[L)@jI"Edk(3m116iG$VjUdS45
+6%,,3KQ*MKRk#16CQD"1Y6AZ5+NhH&"LdI01D2DYhV`P&BPbkHhR8jNMLAUCK0LD
+,BDC+mZYKSU9$*Z1i%,8TI$Hq#*bh,0dG(KS"kH&Tf["5k@cRZ5FFGhLG0K`(b0A
+D)#Hd54,S3S%H%#KQra&SAi&f%fKMJ9B)p%H"ILA3%SEYK0FkJCB*p&H"[Lj39D#
+E"GUI5EmVd+8#r8bJJ3,pPd!(#p6#0&jQiA@f[LV3R`9Daq4dJBiNG9YUC8T4$kN
+8U%-NVj%QGPFYd!9-(D3r&ZJaa[-e3pdRd*G4Ca$S6,ch-Ef[-KMM"ET)S1RX)NL
+Jc`QdYd"(#r3MJ5B)Y$@VZ5pNDaXlc`#"[+DeBK6E"CV()-d5k#Q"TJNd3+#[-%@
+6'BQ&!Re6S(m)Y)U4%LE3C`4k6D!I#R5Y3!F*p"m-GC%4"kMKmI"LfH)H)a6-e`A
+kPN#r%qJ0JBi9k&5"[XCS5QHZIjl4p!XMb#V31(CDJCd6Qc&CS&F%qTj!jc13!!U
+MB*9!fl%0+"CSCi%D",T(S"k"RK1Sb$`b4+"C!XeJ"mCHhQCqlm210N+Jl3@D`ki
+A-9VKr@HCGbB*p#PfK[i-4NGfjP+"0K,S1`,0&fJrJAi[d+-#(523L3cB-2Er)L1
+PKVN'KpR,FXa1jYBM!Mh%GJ[!lM)k!2Zhq#bbJRR`3hE)4jMS9S&Z%fKh*[S4mhi
+pFaa%j`RdX%"hJA5f26(3aA,2CVC2XjQ3!*qTISIYam-#E5E3c`8D)Y"[f!'J`L(
+3-`+G)L6HakPLmlH2b5[+hM+[SHR'"DlJPI0VqS6PPQ8F'PM9qQU5de)jZD6$UP(
+E-rF21G-ZBNTXqSkj&394FkUlIc,ih2464V-U6'VEGI9Sqj9Y)qUD4%j0#pRhCAh
+@Cm1+qahmp[c%9a-mJ4ZQ0HZdG((jj32$,lDm0M2Zb-lC,4T(,bcY[$GrhBb6L3C
+0&JYVApmphRVhr9P[r[Q[TjF&V2MRJ*l,qcpaq,fr22rVKimRAj!!rY[SlG!a$ea
+kGqK,2feqZ-[CA9pprH1rRhfblpr'r[hh9jVV$Y0r1Vi@2[,qR!pqH11A0BqX[rI
+F&jrhq[LTCplkkk!AIRZj68V3TrpSeA[*Z2ZZ[r2GLcprp1#a'eZrlr((TN@hZqf
+CX2DESd9RKH84Me'6(E6aeKhN)26iJp$M$lT-&YUJVPLM'aQ8"60$-k)KlpF8MIF
+KdcE6'hAZE4!rS8%D01F1IH-Je)d(Qke"JmZC%J!GA+m05N!9(khdi,Dq53-!IiY
+*&FaqEI"qdUL*FUGFQ(N`J`N#r8`CM0pk`9MMkkN'"fZ$MfM'UTZl*A5'fFD`QbS
+N'CXLiDPGQeD&4['$SC'EYNDZ#SeNDk*Zq#fU-)'E6JXXaPN@@Z@aK16&fPM8T`D
+M9MS@PE+a$CSa!f"cB8MA$1S2$a'c$eqqXm+c0a%`0P)EL`V,@0!r&Vh,f-ZDXFp
+05QmF[R`cj`aYl'c0Q*FUI4E5hYSpUh)4QBAD@+2@h(Apa&UrfdY"[Pr,4hdi(le
+m2ZV%qHZdjQA2ZEmej1r9mX1djQ&AI-IDX(Y0a+1Sl19RhX,"hTTa2RVqI26kq9q
+5KCBr(1Y69MmkmrbT@R0IPE!jUa*L3UfC#F%q94p%EIVS84!aSHk14%cBBG)Q)1Y
+0##-,E8)%eX@BRi,*eTTRqkM)m&(4hRSM)IMi&mjE9H-Rc$qqrM"K)26Q@Fp1'1C
+Hlb!AfJ5mINh!keGHQQqYjC8#e4SSe2Rc"+ej8p&bbH)&%Pqh!'rH35d2qc,I#ri
+bd+MfBpY)%M`A(VBlXX,2VQk3!-@HL-MGbb2@X![rZRL5hG8epP9IV[JdE9Vc2fN
+"eh56PSIAQVbTC)'Z#"&G@Db@"rH0pm!85r+I0M+aic'#h,UD5%L@*T(Z4'pkD%4
+lBELm-&cDH,blM8IH'*m1'(BbXG-NdG,D`c3F2YiI(hN9qY4IF9I[Zd[ebUA6$RK
+)E&ihM"pPP8HATETKG!Pa`rJ#6&'((Ue)FY-B-Q&Zq(NKNB!E4VR6ZZR4d*VU$!,
+*TBh'+m,S$M#Y*IQ2*Q6#R2(c3+BN``["#f$ejUArXkG($p4'iNRC,`HXXU&'P(q
+FM`R5Kb&'P$X!PJ'9I`2D+`1DB!1DB!1DB--@[#[2GprAT@LY(a+iNE%QE54Dm*%
+Uc"&*EJaR'T!!i*UM@62JRFf!pY#!PcE$3"pF[&8C#%df,ea$DkEpV422q4"G1A+
+%0SUF&Y[5I!&1qbV8"X13!151lXH!e'&!4M2!h3BdNJCXXf%M`2VGYbrqY!m4k#L
+FH4612!U3!%CPiXcPd)Vc0Xqc%iF5Z![XY)D!YP1rRCEC+B'pdGlCPITfiAZhm1-
+jC(K8k1j)ARY#1q5[[H-,LEqfdRYj0ccL`ifKmF5Ymli*K6"XI0-`jSb[DEMj2@A
+-$Qe-*FZ)Bf*-fKLmp)e"2KPc5T*r$N4'"q99GSTFMm)$,HID+EjqYF5"$SPbZd!
+l4@jUHG&Z#D[R*Yj+kfKZ`"1MVede$BeF*HhVD)QV*+C1DHZLfY'MkLh)@McjMQ3
+Y(QabCf%jMAKpm4"'kq)&*QeaNY8b,Se*YGrc+HRSX)RKk&M$VdAiFU`h,)q1L'm
+CdRd#m55-fkQ0LdP913k0p6LFIKa1hcVMVekHM$[T*2cac0Si9-I'SDdBKfj`h'*
+*RVj8P+IM4IUhb6$"-2YKLN9jiJc4-M'BDHj`%p@T1Hr@8%aD,[*B,R*AlRj3H-C
+(BEr(i"IGLFcG$a@S-ZELNf2Z*%QHN@DR'AD+pplICm2dJiN4kHq#2*fFSP4,T#!
+BZ`rkImfe8hcFl&b"H3M-*qJ)M"[)DmYfpSTDDC,6k2[Dlhlb&0%UrqlIULAQf5R
+B&QMp96cNX10kZZpkqR(A)`69A)6VhhcA[lPI$fYlG%ZLCYDGbCi8el+dpE&GiSi
+9@HhhEhqJr,kb*iUIUAkbp,DrYQh(NNE0@Y8-U2qmiZX@24VHV([Mc%XAAkakr[`
+,jrkqEUfbHhAiUY#P5m+@IrCae,qM0fhm&lUZcGFqZ[VKUhrpj'plpm6F@H$P8kq
+F2"Sb0rhXNF[pZJ8&"i6F`ra'pYdV1CQA,Pr210c[VHjp1hGVrhVAecUmhDPhRjj
+C[3TqR2&0dcqEr0,ZTjBrYrjeiQr6IjraMDe`dRmQrhID2qErmm[JHfrj[`qD0f[
+%$d1'$[r12c$afd'$aqC2b"XrHZ5SJ1bJZcHZC&l+ZAji38EhcRdIR[PJdZ-*EBc
+0$BRmrkd24-&8+@hiG1@+IFrYf,9ckjEhYhf`rpd$laaklj'$ALIF8H)JF`+99BI
+P3Z#i,mE3ZCMhAj`ll0QRjPJ@2VhS`PG6Tc`5H,`2'[pa[!mDrq(QJbrQIZ@IIGS
+(Ih(h`CM&ih,l$hYUcV-,&beiHZSM8ilc`8drFqT2H`JrmJ$SPMmPd6YVZ-A[H0R
+fEMrk%(rZ#Q,FISVE,e(KGrl&FfXRD&BHpHridlJMi))6LAAG*+rFiHSd46Fcd6X
+S10&0AH1pG5ZrqAk9L@62GHaN-[HJc*+,,q0TI$f2j9ei(%S`&A%VaLcFMc&4$r"
+bIKm[idr`B[i-VqC2mP+8Er,c@Yk@Gq3P["&[aP[a'Mk!er22H3Ar'Q-%HQ#lhd6
+"Z6F`'ZBPM,"kN9IajrPjrJ*+a2kGVd2T+'c8EVkDKk0XA5KIbTI`-,kFImBrjP(
+mhcbDEm*`XAra5,k'4r$0r"VrL&rP(r*Aq9rj*ra[I#rIJehr[e(`-Mr&Aq%R86J
+VK#HQml2m#,r-qr&Z2)J(m`"Jlh%[qJE2jRIj&Cl$-rNP#&hR'I``40rLhAPIhKN
+XlIRV[#YrMAIJEr01[$I[`h[b,0k,&r!Iq3cq$@r+rq40q#qm(Iq*Yq3rmpEm9ck
+4rmDRmpqCJ!e&L2JNrKmqQIqA6q2ri22j2rQAS1-HS(b2hc`qLirJ2r!KI#JIcVr
+M!r(lPJrLJrPBRXmRm$`qRSrQ)rNS8*k0%p`&e9FB[6QJpc"I!*UlJpDqr'%qNcr
+)NrMM2)'hi8EHR"YiS[$rI"B3886!a#Zja$I`6rP+[S,[imra(A`AhmQhmLhmIEk
+0Im$hmhIj!Ii12m6Ii`H2b`,r0`T1C`%-(C+jbKhF`Lr`3$k1Im((!$ZAHp(pq@+
+HbiIaCrP6I!k%&[+Rq5+)IX@RmLRm%E!m9KCSc2pic#a!"'`mm9CCi![3m"@IMGq
+*@H![q0dk#i`"YH0!Ehp361Kp&[3Z3KCi'Y3q!RT[Q3@iYT-q,MT5GZa%F"dNBGN
+N&KD5N!"fKB6e+ePB3%*X*3R(KT!!813L`IiP#F94**4QXp#CK5BX6#AKGL`,45a
+%X(#CKGBXj*2JCd,qYLc-*k&f1`Yl@CK-3YX@*$5UBZ%3#FdBi'EY5'K96-*D4UM
+#!,c2VYmY*H%!#qr%XG#-K)2XU*m`e&j'p0l"*+aQLPDcBiFa4i60C-&!JX`BC)%
+%bd85,T5am#S,SdN)C!i0C!F,kNG#-'-,CN3%lfIK*!Z-p'!Q'X!1(,#1"HDQ!-B
+F-)q%%#F,$5a%NT!![TU%E%C+pMB@Q,VXB56FYE2!MRUAEGL9lLc-CS%GpFSF%R,
+fXF#f2iHj,-I#!Y[#(1DQ(,E0Q4YC1-8#!jDC3-+PD"Db@*M1!J0cLC&bR@hYG8E
+Sp98XX10PN!#MdJ`rbi1(QBF1Pl"`MJAQTm1-PZjR@!KNJAQP1i2FPl(eM@'"DHd
+Ec!)lDprK,,"6GQCjV60MkmCfV"YMkmCSlpDB"8Ce0lBEh4KEq`-X-+VE-`$Y94B
+BJ+jX6lT@Xe$"!YZ(VQaRZM,4eeJHkF!8GEM'!Q@"%G5"qE8$bf9[Gf+K*3XX(h9
+Laq[%9(4LZp5*NGZTJ)8T*241Bb'-KA3@-PKJDDJh1dE[*",k-"9pf$(kX264Kaf
+lclFX'%RSbG*S6lB02GNfp'5(lmPbDmmM,,#ddT-4fR-J#bc0CE(f))Zj)iZe%eP
+X#l0BRXTLc&RXN!"C-eKJa'8a`,eBZZr&8RB[jX4HE(YkA@@"Y81p@-lU0CF&GU3
+#jU!#PXF,Q)X,@(BTB-39X$cq)p[X(dRZNhq-eRQX@HIGB9UDGFeMeXdlB+,-ZNj
+K4Z#e)-ZX*d-SZF+X,pY[eY0+c(UA3,0qc'R@5jUBp9BfQ#5cAL2!4--%`d`fkr9
+f'&am$SE2&CK9-#V-&CLQ-&2-HN8T6!--,LUbB5DDp4DjCVe(-8`pc$UBR6"lBD#
+m"j5Edh6G[&MA2B+ZP`h6pCVjZPia8pGEe1Lk@+lVTP'k,N&J"4ElCZMkFiGdI9F
+C6)QZlcbJke[VGAh,4CM1Z[iH,[C#D#mB9YPeI@N,Q,d`'6"6G(e*NUk(PF*Xd2A
+U+dkp)G#T[e$Te2pqhUQ[a@4YJ91[h1[8T@bRrJk(`3@26GCjFE+ZEi5a*H[1!TL
+TbATb3M+)KX&&#KBZ#,QQ*H[,&LIVAF$8CAkb(YFf@6q@NDcESj2eqfFNkqA'C,h
+X(%aZX[j%#8bIC,ei6V,q6!6-CCM*bATe4E,qT!Sc+9N[pF-FJ!'LG&LbIRXR$"#
+hSI!f''ihKKN1!mAq1TJG-,MdCm*m#30!Y@N`96#"-'#SRCHXYrA!Y%M@1kk$!F%
+P!&S#SC)QbASV#J2#@N&a66P-+3`30IR*qS#9-$M3!"!h!%$V2i-a*1X9eFPkLk*
+N[3H!0B$TcHR*HPd8$"MV)2J'(2)'$[2'h'6pM"PQ,`b)I'PLX[im'*lI"a1FV*p
+h`X!Cjl0JmT,e&cE!K-&dJKN#!mHILi'"mR0ANr9eB&bl'JBES)"J%3!&1%D!X+N
+'"J5D31bRf,L9F6"EB#$d(!kcS`&Q+6Dhh+2c1JpbS8G2i4lGe3#6$T2VdCI&`25
+"QH,4d`5Bb4jp[4d'&qX(H[6B%TL0-(-mHTFUMajAiG'2&F0NH[5L-SpZ,I,SGJm
+-pHMP@4kp'%UI'H,4Udpjp#FAHr6E-cak@c"h"*!!4V%H[G8)Mej6lp(V)cckj`"
+5%HI4[clTdAZ%HI3h30LC0)rq8SK(V`+bDV4(h`'PZd$mVRBHI5F)f!R%eQUB+"J
+!HVq64pm'JVD"BGX`Mrl"!Bqq(i5p'qR4$dhdk1pGKHRUd9IM-Kb+`Spip1@622T
+RB2TXU8H20RX`qKh9AQ)9LpqmJC3dTbQN)+,FB@&PF%aC-jj@bP0)Q@ZVAFfP44[
+`p5mSPrYMfr)ZFD*M1hI9#6,&jaamI'YMSfNSfiY((NPEa"[RkVQpL+H93C!!qi[
+iN`*4NFGNdBp9mIXVDB-lKYc2Td![Y3I0jiZF86cj)XVYHP8'*fdj%4F!h1i$PE`
+@C8',P4[[lZGaCAaP%9pAcYmXiUe%SRN+dac,$[6,`NUDBUHN()X0j`'N9ABeL`2
+X*$H4qdfbjMNH"j&[h88UDCilL[RQAKCHfZPSRQER+Fd%jLdE%4eQ[fIMDi[T3Tj
+@a&1fHkm@NkXTpRZ,mAIRe"f-UGTleBi3B0j[$fR(%mY+'G1kH0q$UF3HNXZ2PP@
+b'lrE$8SFjSS"CHAF&BGAS94mX6dMPqrH9X`IL-2Ie1"GY[0RLRLpRCF8m9T42Xl
+eM3P$U@qbe+lQ%q`dXJSQ%kXp12r4ZI[!rqMZ!cHlqm$alMj`NlX2T,UlNRlVlZl
+T4(5drGjd1)KFRAChVPI*[9cLELGM+RChGqcrLHi1J,[6`RKD#8m@6l1k@1QF@&&
+Z-NT)aeFDQVk$rje1iqI6a*`@[0P1ATI'DfNf,cl$lbrRY6[B(Z"jFi+rNXCL0d6
+CNQjLT-`8rHe3a"TMTQ,XkVc6++[ENTfi08RcRH`"V4qES%JK`!@4Dip&FN$XBiY
+%NRJV[pl"hHPSKmTDR)#[H`am60QU%r"KGm+h4(D4YmY,qCjBrNN*IcH@2eR#cmI
+b&dYi3bb'K2+GXIbj%PiCbm85[M5@ejI`MV(F[pHE6ET6Up9KQ%)FV([B&0JLBPF
+aTa[*c'Vh8lDF5fDiV#",FbFb`h)P@elccE6Z6#hE%#bMI$2cF(Yf%BmjXj0APh%
+VQYYLhR(lkC6(dNqJh6'ANcCc[G@4Y)AXCcql1JT*m@Cmb#JqXZ`!DE46iY`br#T
+l!&+#aD8Zj*jcT,PR46J#QV[i8DGM-[kUQMG6'DhT`-A8d!bbb5QahP5@4h5hY'-
+mQ+2k21YI))Y(FVh64(qe3Yd`'4J!eH$@!rA1U!cdamQRZ+Fi(X,K"$*+jcarXCJ
+h&2-"aE`Y2ZF8mqdBI#F`0K5Ck#1SIIMT4EVEBU2EBVrESXTY8CfU5,,%+6bj@2!
+"$`E`fT+$[%Zek0M2AGAHLbNSFPVNl3!$L-4fDZ'HDT1[6f4-4@%mZ6TH63K3QK`
+'*m9"859I9ZheU+'*9a1Q,Ae5KkJ+AEjlE'J#5ZfEek'iIMb*9c'f`,G)3"%m*aQ
+*3IcRE5`l&8J"C8AF&HZHYEIEJh0jEHNkAR5HM"55eeHEb19S3Pd#HHAMf+k9UCK
+dB2aPk+0SGjlL%NlA!N+3!#S&YCNE2%YkjB9DI0"+,NrYSNNpJ0&3j%j$@@U#EZZ
+1Ef"iqhiHLqDf'%1p[3iMASPPCf`6*MhQr8UFGrX*@PYiJGf-rc'AMl2%e2!+&fp
+9aMqUjQfVHAJ*appE,#[Q6p)qI"q5r'Vq*PB0[#,@a$,pA!+2NfNlmKE2TUh*1cb
+EMV)kM'9-F"kQ,SDFrUKCE'#THNJX&V#N*Z"(*HKqI32AL88#Mk[RbqKF(KGE'Cq
+YUeM#a10VebeGL&TJEG`"Y`4b&NGG**I@Fr`TAqXC9"'93'XP,brQ+$a*X["LVe*
+-4j2[)GbEVH0cr@M4d[f-@ff[9I9+hU@BM!Cb&FIA-(e*MD8&3Be)cAdJXN("Ac1
+c+rFHX22ee6b1C['1,PDCD%UHXFrDJ8H*hi*f6PV2XK24%-c1jH-E$[(YGTj@$m#
+mVCGpRPF3"4mCp`Dkp`3NT1#*F@8#6ki#REkV52Z&A*jAp`Rhfa@,Ui)-*#,UCXF
+,K2M8V6i"#5R5I9@Mql+RZKZ#GD3UiLpEbCTQ9fTPh-ZjNf6b3(-,NM63XkBf#"J
+jRCSdMia[f-*19mklY$MZG&qKX1YP(cd(6N"#+S6dMb8mVGSGm!CkdCZ`EQjH5,0
+`-E84*e@2$5Ff%i&S*'HQ0ZSc[HeQ1@fCLN[bYAAAh(BiBB&LP[G@+,CALrMQ)Vj
+4i#Yhm+2PI'8FrkdYAhQ'QqamA4Tr2TDI+H)pl,bqM$GU4X+C@)*G9mNI2-JrAXF
+hPjN)M-R)6$D1f@$b6C2-XUb10N9NGJfTibUC[3UKpQ4fKAcV*,21j%-R*ajUL['
+A&FaY@0Q`USTIGFE+%Vp+akUl,pqCfj-CbHXcb&G30Zd8$bbDI$CP#D%V%ZamlNd
+)*-(qEi&Erlm#cJ&`eSFS('LFlaX()fm+&f6V+NQfS&M#K644YU,SJ68+jZS+f8T
+00aA98imE4J2qq*%e0jHMFC2bef+-Xm!DZlMMHkb!h&4'3ECAJ**dmBKP'Z&e[bR
+$$BV$@'D)XVd5"J8Bl"8VC2ZC1j'BIV`+5akH5MR&Ha4rM!m9ZV3iR[+*@kSVYPY
+blh51ieAK+,i6RhJK&MNmG@5S(l9V'q3C`dAjrR1Ll-&3XlUGS[b%8D!BNV@mE*G
+mU(bA[+1$+"H23V&H+XNE)dAjpLTXH["l$XX@$-5%%b5(C6DCANL6N!#---@6!4C
+1XY#1KA`5!VDcX)k&#"Ek%GD!H4)b!CQ'!-#a-P'qKk*Tac#m1AfeK%&eSK`h4l5
+FA8M*)-8MqkK'BLE92)LjE(PMY6F1*$*UGJQYP,-&5FhH4LXGf8Z*kZ`1@,FM&m-
+Np@jAM2#q1`6,Zc1K(3kiJL&KF6C4[E)Df#Z[5ZU9B-KFk8k@VE%F6*CcX-a*NmM
+S,MQZJkMQR#HBIC+D%iAl(!YC0T%X19p5-V!rXaMBc(TJ-hG)DZBT-XZ@m-#"d*1
+*mY*aGP'pT%$UdRjFASU@e%Y%ak8-c,,)E$TQXmPXQ#Kh3HAimN&-4SL@beeTM&2
+!@#j*aH#&5[Nk8XAe#&c#C+b6j!cXBTGk&#k1Np6$F)Ckq"ba"-cK#-Paq$)pCR)
+F(N,$6BjqjfN2Nk9I8d+bh!p!BMH)MVIb#)hGNC1lR`'UAP5l4i+jHb!`+!k80KL
+BJ356)-Ppii#"jrVZ!+C[M+6f*@lUDj6NcP@i3S'`cPHa3&T03alV$'Gf+`-eh5S
+`$,qE3[C,lJDfEY%%Ua*lQGM'a-k!UQkcF3ZG+XT@`'i(ArXDaYGqTD5fA`@CpK'
+BG5FhNkNI,ab[Kf%)6Q0!Y)[bki-Pe'I*HEU1NZ6A,SVb-Tbb3`Y*lA!!["fL*0V
+"6fDCZ1U1+e$iGLQbcGXl#GIERE"Z#FK[6i28fm1a(%f@8l(XC*E86KI*$&QJ%`j
+!1d'9fLQEi0T,DZmd,(XMMeKkKe%bQ,Yh1V!C"$(ILjJM@ASRS9!$hPAU`09RRf6
+T%m'bF*r,"0%BL'qp##-32BXN5mpcl2!p9dPUcj-%H36)PPlN3#!A!*RPNY5X)f3
+'mV1)&l2b*,9A@mak98Q@APF)6,NAXPG"('JXD)DE!KbLJ,LNi#STXSM@S%&%D8e
+-YSZ12jV3'*1MD3`*IpTCX*(3**)NiLDML+Yq15$+b8RN8aJQJdNa3)Pm2"KTNRr
+#P42Cj+GTD$K)FF',NZ9R2h'"iqG!`[[c3-R4qJc4e6S$3@e06[[V*j,kD`LCj8U
+@L6-BcEm95ilT,$P2re*bc%JMdaR4Zbc94634'rrN5XRaj'GdYdNZ959(k55DD**
+[BrbQ(iAXl$E48S*,1+S%)qMXUd@j%BVZ0J*apN1LT9%61V*'N!"Ef55eKL6C'N'
+b$0K1%lF,MRSlJ91I*$NqEdTV6I,R+1CVR5bU&FJQFN@$C-%`),*(&56h9Q36fjR
+B!R)rF5G&kEjM,85,[T'N-BYZSaS'3M[E5`jR!C`S1kHL*9$K0239F8Jbb3Q5aE1
+4MSG8bJ,mp4V`GdR(S29TY#21Z'`a%L3'fAC"UGBZ*((1&aeGjK-+ic$`)KC0pE%
+-60"3f0&XaU,UG$rkS64X6$Q5j(eSjG,kLBkbFm6ECDGS4i4FXRLLK,Bbb8rdNH3
+R-$SM,3*2`ZH3!)YR+L#N2K1"&2(-CBDC$)aFA5&CU[I6F'a+p44iRD3`aj16%#b
+Pf&U2S*D5c-6f)BYFPJiM40lH+DQhFD2H*XRp0XRNYaY,MY[$LFaY)pPm2e+#kNG
+Mi["(%l3rNk'r*1KF-05LPkQY)Y6@"NTU,GS*4qdmSV`YrTa3faBJ[JE2ekI4m5D
+jicUNDE`0G9a-(&e5)6P+USM1%QbfbG')G%0U)h3*PNCcD5)b4LXd++h#!+39P4b
+YKT1$eT4,MTUVK+ZQ$i&5Nbr*!cc3'bJk"U`N'JBJ3DX$*S&Y!$aF$`m[@bdkkMm
+MPr9S1H4k!h"iakLSaJ3MJeYJ+2`bY%`p8)0ai9YF!a+EDk!S[cNG%j3+VBZ5e,S
+mF0BC*I80C#A('h-*l$0QbA'QRY"bCLp$S'Ma'F+d8R5m0*'J,Ql$XNkd9&@beV`
++6Ae9-$P'e96*mA`"Q6j[P"cR+iMdH65D,k!(G,``PDc2SF0eJF4c-C,Ph(6@*Te
+E$#V1SCpbJG5rSc4S#SUGVpY(BmS%bpV90!Cr@Q"Y![8MSbVS3&1'LaB46N+l*L*
+,#*`iAEJX18aQ3V5TKSA2b-kC*N%H9FT2EC,M8jEp9XDaX)9FVm4iqC3X8AiZAh,
+Xm*!!LafXDV"Mk8jDKcZ-&S2E8TU*$Qd1c62*1US*RKfLQS,q3ABe)-PJL&%bp#q
+,N4`B0)JNQcBCIh8+4C+6N6l@Sl'*h8M3X@KqZe64F8L9F49d*&afV&Lb&*8aP,@
+)SHc)9IFM&59MG2Tf"42dC`qF`J5NP)0+*m`6%c'aS)i%`-jkdI(-%(5TFMA%G,5
+&6b,&kUL`hNBke"XMEmj"YbYha#Re)fL$m-964dTY03)CVCjF$3!i-i6VdCHE9iQ
+1cf1)ZJUdRfEXdGFJ"(mh41i4KTI@A0(a4J0GJVb!(G,QLr*,+)+V3AA95@cpD+,
+ZHB`Ca!I@&qT)8RpK#S,PA"1k#%GEKp'FD0lA`Trc4)Z54"GY&ba#*8dX&bbQeR3
+4SK4,&lN%biCkG[RTUqabj44fZ@mRZC5ILm)`8P(H!8I(L)iG@8KhMPeeT'+aUad
+KB'H9j0JD4ICTka$*XDfBl13fN!$h`3&5"GPI4QqEe2h)D1UlU!r)ldC+mJ%-S85
+Tl(G3HC,IDBP4Lk,M8![5M4bDD-,c+I1ZL&l'![bb"`j8Y[R-rS%$TaQ0aLQ'")0
+KUXAbJm%`NeM-Kj*jdRMB49124N$)D$!N-H68Sdf#$3C$*M$'N!#NK3C$`QK$r$p
+MJ[',%fl(q+l)C9i#8I&Y!SX*KS6*E$Bf&6%QhfKmf-J)Q!N8k(T`P-@5B,&-p8P
+-(A6mHSc4q!JB%Sa2'ie2UkSkdcL(")+Di*da`8@$9IC[JI&"Lm%id`YL5KYS''C
+*mJNpmXTR&LKia%LSAQMdS4qFBdNb6V8B,%aTI`[a9)*a9XJ9Jf880&V8KF`TM`m
+2cKj'e[')A#q2PmaFaZF&`pLQ%LdJ[Mp"2mfFP2$J)V*k#Y1(8cP(NYNBhh+8Ec+
+P2a(+L`IRFpD#aqFDAMe`XXKJ`'DrF+&T5$GPT,*)I+RldhrHqhAkiqaIbbYYXN0
+bfQ3("#Prkh2Kb!9PrlJQ2mijr25FFH18Jbb%AmLi'a*bTFf4ekIq-V9[qkPr(ZN
+ppIH-H`%&)5'+1[QEbC19SfkQ3rr*#%-4P-XK"N[JVcG)`*qYM(bjFI2r[relH4[
+*aXBNNTX6r[QG,mGrFE6F5,"(dfh'`RmQ')F(IMNPm'Ml`+m3XNmf-Aa[1(V%BMM
+kjbXYjKK'(hd(fH,S,aE$b9aeN[UY1Yk!c5dd'#BB$,-0re@rb-kpBM&FV999cTF
+Y[ID6)McmQk)m-[14rNV6a['cYi0HIbYT5TqJG2c%P`)#P*m+TR45CQ$cRL-lQ$9
+6q8ijU'c,[+$m6$EQ-,(G9'@&HPEPhRr2+e5-`e-ArP,MCrXTZFrP"!DF63qfh!X
+-#0RI2LFS4$%4Zc0!f4,J$Em%0!eS(46b'p#I"$3*qM0)kD#)bMY0a$JPAaN"PIF
+TdBi3+'`IQ"QFFb3N5+N-8VCQ+[455&r1rrT`qVed!KJ!!"dI384$8J-!-Xi293e
+P04%!)Q2Z8lqf,mfM[)R28V1CQ%NHQ9+H*8NV&pJFB+4T#MkDhU3f%D-h"hXeY#b
+63$H$Z4`[4a[bq4S#1T&aCh$1V)[Zl!ib*%4QPi-XaeXBR2@UCcB`U)b(kf"`&Gh
+)F&J1'jN-rIlphQ[64QD1ZhI[jamETLF&3C!!"%%3")"SIaIQ)p%SARc,,$0"Z4R
+BPrcVf!kYrCaT1bma+BR[-QHF19HKiR#D2aa,D6Yml5Gdhl)#*"SiTJU@-F%8Rr0
+l6TMTSe,qB&Xj,Rj)"1iM!NrIcLS,HdimABQ2B[RMFIRM,KM%C-11C2**H-M%&1#
+A-aDHRSU-8eT"*k-,42LP`QLJBN5l*cAq(*rqlE$MlpXFE@58kVRMSq)YZ@QZEBS
+j$RFkb&3BrAlRD+"U)3h,GFB'&V58QAZ(YG2FSjf%c8IqHHq@k@IR9r*$XdeRB4D
+Ck51cA29PD2LaK+q1Ubl[X+#fV9m4'[@+ahLiAfh$pa#Vq$%4XPaK&A--3"'i@NF
+[020%DS`NLjaF4GUQC*Tp6,Z5l--iBV#2VlhU1-C(1efLcq&G+$LX,fm5USeKBK%
+cK1'),cmqE-3-BSJ,!&JmlrHeZEU66c'#ELp-3DU$ImdVaK2KZ1`dNJAmDh#)b8h
+aa'LRP`4d3cLNRfQXih(rEiVdl,'KPXRJ5!aCTpZTrZY`5Y2G5&B&R3NNl3cGPpj
+3CSUB3R-,4K`#PYIMr$e`EciU5)I`*iK82U3I419Fl'"U&$Ek"*C4UF'B+&Hi-lS
+ZJ%,XKTM9VL4K%0`bDl5$d+X5S@hG50DYHp(VG*iTI[(fq[*iFC[#pBNPUEIlRPr
+Rd1F-Z,4dBJGGDi%qm@%HR@#"DdY%R'hkClqL5@b$I9jG9ef6-(`Ia(D[dJH3!-)
+D4!*VBXNIBLT$P*ZqAUpE[ji+1Gh,YR)4e4&+2`DhFQ-iZ6i`TZTAN!$Q5`B[VFI
+eDS9`,4alCY@`"ap`j@c9#K"!%b-f"K$$kd%D6!e[BBJdNMdq!c5h!i"N#Kd1jGq
+G94dY!c#'kVEmJ$,`68R''-Q8DD-G`@%lJZiX3F'DP(Cl+FH'U@b,bL@fiBq2`Bb
+&4"N5VD0N$(S&5(8jjVLrEE5cl#AphBZU)d#AkZDV!Pj4(`q[A29LL6Jm(KC6im&
+$rp&fC'&B`C!!9(T)plXAK98[-YCN!pDVcLM-diIYcG28F#p%1XPeKC)fA(h[hj5
+"e'JqHIXYE0!lkeTFERC)Qp1fICJq66r6I5M-j(*X(dBkB$HPDYk#+QNQj)J*0XP
+-,5e4cX"'!LNG9IrB*3kr@f[SLHSVM&'Udp$p5rlLTirL#LUKL$+3!"FI[UAEr*5
+HjK"5h)eY-HjdV`e)+5pp[,KP"$CN)+9Dh)E"-NVQ"Va#DP$h$IY#erU[kH)(hAN
+rMMDG'NfeV,r#N8,9Yp5+%ML$JI98Q#DNK&,f1KcGTL%P'!KKF*d0q3%T"C&fM!c
+Xl2!Dc'c"JB*NQZ!+cie,5BCdLQ%1Tm5$5UCm5LCF,ihQaV9-HfZ&Z"4T"*!!("q
+`%6P&)[r[eFZYDb(&M)dkQ5lQK(j-+68LLGF%*6(Sii0pVNPpjDMr,ja),"9mf$4
+Flc0l'H+K3bXS6!cd3Md4iKhM)SK84Q`3CieSTB6)VQP+5QSREAG$8+fFE53"j6,
+Ea&#IB+Y1Mf#3!$YDJ#&Zel32S((*aiY!LG[Za1!#DN5NfGrZJjL#K"iRT+QP)qN
+9lHH!,QBS""&TGjLGS9JfN!$lA9b(QeCJ!@jaPT!!!42$&BiN*dqBIJC3Y'-lTpr
+Z)fDDB"HZf-daY4#NiY96F2dq0`$5Th0$ZaeEKZVQDjX!kMD[!!H(BlAN@1#JcAC
+,9(`8`X4K6*5mh244L#BDQqS@0k,EhQ'Z@k-2I44D"SFcLlk4Jj5HkPk&e1$Pr*1
+T2h)(&29N$MP!'*-0q4SH1'E$4LUSZld`Rk@Hc&ZTEjB1p2Fp3k"lEdN+bD`P*IK
+j*ar-lG)b5hG`8E[R*`&#RK%FTLQNECSDDKV8pLjU@a6`lp0%)*M(k6iA!+Y$ZfI
+,$R5cQbjeDTZk%dZ(QS,D2CZ(QLjV'llSr+)0AIC,p(ImTIX2PAA1DFf*@UDi3`q
+qLc!0[+jc"be6r#*cHGM&MJlkp5#!Nha[bG#6,2&GX-4(L54XI02C5SK%3h82ZK3
+Pb*5('fDI)C52%Hiq2m)3SCC5La!C#lC1j*m-+rQNc'JM4VdA16-hb&Za[[HrmJ5
+%'#ZD@DAZUfLrkXVRKYU[EKPU2bC[D,1TUDjr1DEUCRVZU,Zbj-rBUeB'lf&+l5f
+9`L!B3NE%mq1c6BmYmTPCTcHCGDlpZXA(QH)fJ+J[!-8(JHa*Plm`XEbhl[8GPVV
+#jGHab2(Si4eDA6mYiccc34J&,LB-eC@8#jNflb5&+NMN#KBh)1F*pSChfLF'SaZ
+JDR3'b!dB-$BpX)rlaPeN0#0(F*,hpf(`&`d4PUSQ&#IId1iM#,1C&kbSQmp#*%k
+H%6"J5Bk3!&p@1U'qr9S1$"%$,$m%JE28b84rH(*XNCQf(Q)h3K(f)#Ak(4MMHql
+)&'XK)JC#rdP$dK8F46"YT#SYMa5k"4FbS3Rb*6ZQ+Kdcc"-@L3fLKFR(CrT``5d
+iP1$c5!FcEB5KX'iQI553!%MF+kNafNCb,cr06GCE'4kM59)*!%[MFV2ep'"IqU,
+93U9f-KUP6b6A*c$SPbNYiYlqBi33Y0'@B2[0#!G3i@Kj#Th,lL2K3ULGP4L%m!X
+Nac&dHaLTdA[42)#KmXQ!ph%&CKaGe-aD"KZHSbCDJ@F1*q8Q,qfJe2(A'aNiDPf
+e4*a!XVbhr@UiL+&SEi0MmHK*J#B*d*!!5A3$8reVeebDk82#*Uhd&kG6X%ASG00
++4RP5AqRGAe8#PEpB9[N)1XV844HR3d'DHDU+UD%,[P0FFldq)%B1XNY##H(UGpT
+['P$6jl1jRJF)-"eC@A,NahpNQlJD2fZFI2XIS)*e)S&VVS(KGM9)E'p!3P*XP`L
+pdbRFe4hDl8,19"Hpe(0mG3G%`d@rSUlRPkB,d3p3L$Sq+%@$M5iF3T!!`PhbiBb
+X!Tf#`[4S'8Trl`Pi8mfak0F&fe%*V4'3!*DYD&iTqCUqa&ed#68V1P1Kq'U$3pb
+0SK#`DU3!`*T6PF9[l[P+#T`%2Xk[+K-T5rr06rD@G!ZlY%"cA'[jZCQkq!YM%&I
+MZ4(Z3!-65TM%J'Ld[Dh%3qa(jVe@m`q2[VUC$8UQ"e@N-'JD"fd`D"4Gm0(-"3m
+0H[ha6aiT-I*aj9+U*Gca$ipkaIjEiF(mVM`FZUqrIYMbhE[d-f@"`rAdee9II1f
+*J1jlqG&KSkcYm$AkklSfVrk*YMf"+L(L*T%r'X[lqQq&qX*3HaT#6H!U8Y``!9T
+HIY3T[TpjR8FRUlF469LT-@L-pZ35Z,4U@Q4D*&@UjUHCcUmdH'5SI6k)r4jTZ(h
+fSK5Fpk&JlhhrM[D-&`McQ&2,K&9b"C[Dpd)G#8ZjT-Vi'UQ$1i(%VS`FSY2)G-`
+"%A(eqC8#,B)`LqJTHF&+9#kD+YSI0M@eGrNX$#ApcZ5Q[ARHFmIlHL4Ri'U*(QR
+B39eb6SRNa!8+Y00Q6NP$HF)iRjY5*E,Zq5!f&Vi)Bd@UQS6KSf($q1Qpfma*j$2
+c$lV4D0AYQ2,@j)eQCXJC4aK'UFH-MNkqH#NX2$X!e[BbS*[E6XaE3q)!%D"Q2SV
+0'J@93Sj1lf&CU4G9@Eie3#''!LLk1'`Ff"i!D(DBflY#F0N6U9Je-Y6HjHMJr0-
+Sd-qM**!!QYdmkFKjC"Ee3Y(5cAkHZk+$%HLdK-Mm#mL%,j+VA*9FBJ9AfarHI-b
+2Y-rYpDQ+pKX2CF)M8%GBf%9#MiKJ(+#iPVQp(THmX5b$CL`)P!9Sq#J)6L@T)e)
+$N!$'SkiI,X@fUpF6[+4EY`9E-16%ajd'9eZSD&3N)a#@(b[kD90l@ApI"AH8&A)
+#$daIC4)+1BS9TV4!i[N5pp5iaa+eSGM@rI@$6eV%1kB3'&ZKZU)-,1iX@0`!9Bk
+aQEfUG2(q[M"hG+H(2#d0q63lj02fKcd@h[1RZ@a-ZZciRfDVBb519f+lFeEE2Id
+Vj`b2VPl!KTGmGF1adC9EbQHiIZB[YqP,Ne68djZ1G2pUL$lSFQ#L#$b2,QEdQAf
+*Eerik`G&lTQBdAY(CQ(Zh4UZCHM#0medY6[CiIkG"RL#k15lHA[,IN%[E@c4-Q4
+5LNCr%JL,-GY2AL4N(@DZ5i'4a0Uf+R&R4mAcqRL`Nj!!G4K)1kcYDMGi84TT"5Z
+Nl5lNDLHEF$c(4bhH(iCj34iJ22(3Mr*i2AK2cR*[IIarBQS0TP4liAFj4*A-['1
+*R'RB),#DR'-LIKc[VST'alLHZ,eq@FCTQ*b'5"8*m-cKS!TM-f3fS3'EB-8Qb'a
+&$GL+V0L+C$Dp!CYZaDE,E%S$0X@+6C(CFJhBFPCX1CPYUJ(EP"AE9-L8FdKElLQ
+Si+[RTDZPBP9U`F!,QUUC+Uj@Gei$14)!BH3JXD"fGZhI,Ab1lq1&r#3&XY9+NhN
+cZY,"qc['NN,T89PFFBdePfSY8X1I80`VlZ2KN9b[8fqXhjGiS)kQpNp#h),3'%&
+6JHIlqb*TdD1B1ScqQU#&8+hp9X8[)-j8fRHS&0*pmY1l@L#XRbh+DIcShRfI$YY
+1A0[3NF`9mD1E4X5lAlMDpKbFKkpYk*5F-FrG,phIGK,1BqS6lfeSPGc+q0dhcc&
+@8ir@Nf8@Xmca"6%I+i,ELPQhRC`mX9e!GhXd`aJ$ZQK[Z%LR)XKm#U!*@D@6Hbi
+"m8)i8)%1VPGALqX92KG"4LUrVBjrl(IFHceY2"&iaAeN-P"8++*Ycmkr$dCBA5@
+"L5NeRZp*ETPd5-CTP9i`$GbfLJqXFX`CbU#"P*NhYf89a)Nj@eCa199`#JUVeG@
+GkidCk0*[r1V2Aa#MUhei3B9""B9K0T!!KM,8#P`8jl"0(%Qc1f!3`BZa&c4N[q#
+B`mYZ5NYjImkF10JFEPqJ#5a!TBVfq`SC+QNCaC`hS`R9D+HdK#VcCeGmE8eI8AT
+#4BB8R!3U'-XUfZFrRe-jc2Qj+NIZZVfbrqqNQ%ZeHr4aNBB1-!,M5$kIb#ehH'D
+r!6XA!UIj0'aD*Aa*d%+*RYYD96,Pc"ZeVqjP&43Y9YdTG```c`ClDE0ZDjhNDAE
+VEJ(XpFq92J,f`8kDHTK0[89(3TJj0LeZ6d4bHVZb5rZH1dq$bpe!53c[BX2rkfF
+GVN+*"c"YZbd`b5Nj9E6&clA@B#qaS#$beDGJ0,ZjRr0@4AfMe@PmNYRr5Ylh*ld
+`Q0L#jR,a6`*&q"`dPa[5jf9cZ5TppT[,"HRc&A0jA2UF-CFA5CmAcH@6p2R-hh!
+p*#hA@V'GK@V@jhd2CK3eE0!brEH#kHNE%IIjV-Rj'i28U,8bIE[*9(MpMNe3--!
+383Y!l%a+!RU"-e4$K04H[Tj8cC'VqB(Ua"#-*9-X@FM38P*a-3UBj[aHCCb1[CB
+Ufe2qZEK5r2Xj,Keq,MY+d(cEMi%dSJ5'Z6*!Q013!!!b9`B0FkS5D1E+3'*133,
+5A"PFc"QA`$9A"Kac&NQ!QbZ$N!!j*krI55!NT3%JmHM&cEfkqarV8rk(S*E#D[V
++8+jTTLk@8*8"Z8D9!FR--a&aH$q56ccq@jdec(M!eHddC`kjN!"-%Rjlm[aGKak
+i@4qJ5NTmS+B9iS(cr&lQ'(BmF1e3)*A3pk2KG%Jr#V-rUF(j91!91H9ZqX+d$G2
+LNVF9I[dacT12Sq#,q5",dP5ZZh@%ml2ka,)IVDZR!ZMEbP@![BZDD0e'2XC9Q-@
+r9Sbd#!bQPFpaaICfkdKTI[cHeM+Bbp%a`TJV2Eb5eeBe(UPGp30Z)$d[a'c"cV#
+Sf%CEelDq@[c64l'FarF$,RV&-$d+%ecfkhI`!0+Ahp9h8$!iR4VTTSRqHU8qE'"
+"X#S"V3TQ`N%BFafcRh$qe)B8@Y@&2&BDBZC!"'M+EKr-ck%q9c25Z`AV1Pq[4E$
+Sp!-6!0"dKcQm%!dVkN"Y"qVe`@8C,+ZL#5mmP-(K4#pIACP'jpIk!%DMHcZ!"HA
+$Q[TZrDfF))A'`c`QSkh!`S2cTbK8h+A1fC@c5DP09`kTee0)R#1mRDif+IJZKIU
+m"Kk9LZ,3#fPbIBJ,"'*A"UjeG#fQqRB"p,mS0ZH@FdRj,5,V2Pj6D29T2-6lSGe
+1Sib%i+5rNeK[%HpJU5XeI-&CbckmXZ1L-mNq,XXIXc,$&GRa[,1CIFb4"h6,$(R
+jBfb'AN#q(!`&rmJ5(Qc#`ij#Ke3"&S6kTidI!*bBLh!M8b!Gi+bJmGNhm3V3kbL
+V('89(k[i@'@#95B#e9e80e"@IdBjcDGd5Rk'jJK!d6e85IRrkJ5RN!"R'b3CJ-a
+ff08pKBF[#MhjCk$-LNBSA&h-G,KJb0JBj2TVYdClbrcCG)LMkV"c)02TLK8+*d[
+CN!"*0X5')H*V0IP,''!TQj!!'SFBB+XUdePbC5@fG@UPcJY,XdX)Ep5m9J0KLU(
+If+'C2UZPa+TcqM-V"R%%IkKqq*NrD(bP$M41)aQTbh`%!J@3!!E5'PFCkRYIFE3
+3NMP,G`BZU$U8-4ASCCN`'0m)T+Xp*lLHdJ$SZ*Cj1q"+iQFD+YHQ"E3-8ka[j[!
+)Mfj)&6dTID3`1(@+6chdSqa3!6r03Y*ZB,$KX,4aJ-a43(Ie1rq(ma8hSY&G,&4
+Ja3f&d&rejTQCK`#a3B(C%kNd'I(*K1ZpRkSMAiER!A6aELi9T$6#ffUU%Glf,"$
+HMeF0AjAJLBm5"BkJBirMF1+3!1eCpTHhEFE,QeI*F+Vh$[q46rhk"(G%cZ$K+Fp
+XSi6)-)j`QiQBN!!%kN8ap%LA'pMQNe+N43XBlTjYR1Q6%CrE4'N*N!!3'3P(QJ3
+4L(#pYq'#MRQ+UPX8N!$m(8L1B0%m%J`a"3([im-f'Lc1qeh'el)rqINp4"U21&f
+CE4aYQHQlF&`ZMYcaJU+b*5hf5bVQV$0lN!!mccVGDHG)YE-flBaakq9aIH9EAN(
+0UhLXURF)!)(C&36YVk+EPaf2VQ%J-,)JU%f$)&'FhTDre2",E--F#pb`R(bTfXp
+!9YT)q8#*PE3YhqT#LUCEj1fUaABP[`)`p`)"*LP1Q'EckQG$%M,$m$SlT(3h116
+`riY3IaSp[CmF4lVqQ&cYei&dblUi)`m!3'8D#(FS8S4e2i#4fV24creK0lZq12[
+&6"p6k(P'B$-+iiL9@UrGG4bD#)9D+UjkUGbGmB**%cYZ3Gckm4L"%[KU)8p0K)G
+C4ab6a4SLF%ifeP259S$idb*e)cX$&3[YMH9iJ)!PMP1R%EEIKp3H$Gi@2JdP3Jp
+AS*Skj3ZJ8rG3C5-HKHdKd@@V&V+Ec*(cicXKI$c"TJhke+#U@LQY*$PET5%E-h3
+Y#UqRUQ+5$LX*Sp4pN3$Q2m%VZHSrJ9KmCACCqU&Sq3%@JF,,@4J,KZU$5"a-2G5
+&!`$Jkrr),9c%bmm02!`ECjdAYJ6E)dB-DFKk5J$'l4kB2NI'IK)NF+QV!+&C9Te
+edDX3'Mc5"5%U@'#UrL@#ckiLP"E*RqJ0&SJf(dQ0VP!pa#@03XQNDUKH-I5YI)S
+HP58#hp(Q)+PR*f4-[Q@Zd&h0)Nc$&8@SU+lNU0NeKKp(f*!!PE@3!"eqLSD(-rT
+JhT)II4$U$8F8Z@Ap+0H!'2le%c`8&[%CXVmHVR+9,M)8UVjNRPeb#*d3d1HEA5k
+-#j@iAQ'AQd%Pj(,MBN(mA!Q2dH2BqLJV*$&ZX8FdVbRF(GQ9GNZ)J66V,JC@eN@
+[[db-f3-Q'ab3!%Ih+D-4YAS!$SbV2YM&hIQYA0YiLMBA,f`Z""q%+e+hb5iGBaH
+BeLF)p"XK9S*"SiFJSZI`+,B3CJiSQh0XdU+(J"!H))4d,CKbdSQ2,`[iS2CY2#h
+$Y@p(k6(&h5"I`PG'p[0"EXDVRe[`QZ%DAQ(ZMhc+51aCi-$qp%$6EQl"MiDIl"!
+TI3*P$F5,#)5NXif5@!)a`3#kF9FF,i05LUbJa2VlX-8FJ9&aK!Qme@fH,DELiZ5
+0ZlQ+`$"m$N2`HlP0$dJ&5Bp`YAJhMp-N+JDQK@9@did0TUA"+!k3!'r,Z4,KN`L
+HJDK#BP,Cc4*2mD&IYrKDACk&KajX#4m(3j%V53bB&1FG`T4iS#CmPN3N4VB0aU!
+L9X5k@#-)KG(hKGI`EF1rKH$m-"R8k2JM!P521$5)!JAa,0Ve,-`82hhd`#dph4L
+"!ZX)(,LTHkSGpB%$,qMZDXI0J1iq8*mb(rJH#BYTp`Z"!brY41MSkbUp[+CeH)6
+Ub%TRSLC!BEmS&*App5b8[M8b!J8a3N&i8+))I08S,)E!rTrdB"XD9[-9JG4'm*E
+6r0mbD'5qMU!BJ39k#IU,+kiMD+f1rY%"(('pCB@P@Xb8'ZDNALKSV1SB#qFPX`r
+!`CDi3%-*JDZk-9'%RcJQip)NT5iMER+N"la$c*2SbMS@0)RL*q+(bdKcJ6'r3NY
+8VIaXj"G!3JNAIC1,#1PJ4%)R3Vr03"@(LCm2Zm[Ubkk9L%D'$lca#%!-P*13!+)
+Dr6*fk)H+`&!c`X9f),6,Fd4!S!dj$$J3'PGb!imR[iNJd6H"FJBaBN(eLpf%YLk
+M3L4fBQ&,S3K4JE"$GS1@-XK!k(&'D8+D6TY0b,MUG43Ld'rf%c3'lN,L`ZM[mdl
+lF039A9j*CCR3i#,KZfZf-Ab[lUXfS%42X+!UZHX&J@+SXpTd&jIDJqTUUc"2Z(H
+dIm8e2pfaqri(1Y-0GTeU!IXFT%r@UIkH1R[QA',IUDC*XNZXUkk5ZXdQ[5[qId"
+50A+e9DSbXdA6YX85m2!5ZE&$flDB!-L8`K39H'8r(LlEch96)d,V9!SrB+VccC4
+&L'I9FFMl5[!@TEaP4krABH@ih-"4k&9d5l-Jf+T*Z'VYUV(UKE#XV2LCXA+&#rr
+i"8'6-'3NNX*60*'FeYUB-Gk3!)-5hK55bDI)5G-)b,SL6'G*Vr!LP4JZdQhPENR
+NP)E2#cL,j`Ab#DPK*V2H6`IA@p*AX5*ceVVU5hUcbqIp`9[8Y39V'J!PD8HH3!5
+'jU6GXAZVL9J"cjlTXM63MY6PkQ&@j+a"'[5Q*+**Q``Zr+q!X1#c9B0D[T!!0GY
+pDH,Tm$IRC3TGcrX3Z1'QKh4YcAQY[fr(a2Xm(C*C(I#')82[)cA1YpUM[ZcFeS"
+TC`2(A3dFMk3G8YL1(DP-&VRKB'&H61'bB&fC+8(*q@3i1bQ("UG*90+dIC!!#"k
+kY@ADbXmFf*jf1fei4&SpGJBT%4D`,E6C$i#C$1%9bhC5j@-+BR@B&'kcCf(ZK&A
+!ZF+Y`Q+TU8r#,Nb(FIccT&6HJhqIT1H[SpL*bRA&%l1YDhR9SB`M1&NP8Ce-Q3P
+MQN3a`59#q0844QGEb9N3eK@[q[2@"rHZlq8T#)XkR!DFSUrP`VUFacS%9Q!"ZG5
+Xm&&)XMIPKhQe1CG%U-XDAa"TMb3kRd@4JlUI3[S4"P4X9hR%VV,AV[+4A@@GA@9
+2hMpc#eI1jAI`e-ikhPb#"h*i-il6c"la2JJcaPUqTCQ#9T2XD%9!dPSdZ1M"+RT
+S[IQ$lShia(%RIN&Ki)Cp!%rkRbQFj-e*Ai`RA&8`J0[`8B+U!b'Y0Qqc#Cm4,)m
+IIAEY2afkcFaYS6i`8'%JGSGh$RAfAR8)bh)"Va52`mbJ%rVSrQA(H4bLT#U&e2a
+6-361e-N%A9B3lF0T*#'!"8q$X9K!Z#-+c0Ir`h3+KkA2[Hae9[H4S#&e,5LU(mr
+qQHAJXmhI-2A8G0Ed[[fpbXmrD1fXHBR#2YriYkG2EqTCfl[9[!eemqbcrpIFEcj
+VEZhSZHrCGhS@rI2G[cl`lBFIq0hLaB[rpMFp1lrmUl-G(llBmLqIIpIFrR6MhjS
+[2,h(r,fR'mepYfS@IIr$ccmhrldjF2br($jVR[QEhj`erqpIhVVfC5-!!$`1384
+$8J-!D53393YXT`$4A*IrZmplXfafiKVA0)3dZ5c,GSR*CJQ5559Sh-5iVKQ6VUN
+0iXM@d9dV5G`MRTc8VmIZ*P'M@*U+YCEK-1)`0!S*5@!XNcV1BM-JBMN4V-qR$V8
+J)+,L"#ZTD2Epr1qpqla41X`jhqF('k5R+#H#)(J5f59HhZPfimAre#`BJ(jj&j5
+VH'N`aQ'5,(Z`hfGY!UT8QKD)Lp'r#q06&C-!fEC*qbHpP,+)TdTI%B[%8j+a4cC
+N*@f9%-E8NF(QiKEhr1GM2ZYhdbjmk"F0l3'RD)')*RN`'&,`iiF``cET6CM!*(+
+B5m+!$M0$cT1Nr2QUmM90%G&cX!L+j`AE3-LXUH2UDHq!F[V6JQ"!*'2IFhGc2m3
+MLRK1R-89d45+aQB"9+K'VSEepArd5YF$%kLcP+f*0km)4(fRM,kIV!SjEG'3!!E
+GQX4$h&mqLr[hqhfRp29V[CBLI@4'X'S0%JGYk$CNHLV0HT3VamZqeb@fZa#&k+3
+FR86d1KDGG'&iD2KG!dJD89@B-%Hi(aX@eYcYR[Y8QNBjl5A'IUmNe3l6UXIeDpH
+[jH35[CX8Be`NSkHdQ&GX$m9T14KZFKa*Y1"%*(8ZH@Jd%&c`lHMQUR-k9lm6Nb3
+$YF1-*Sj`3deqe&+9(l@0NZ#+TX&T`*YMlBKijR8BP22E%0Q0,(A()@Zq4Sb$1!D
+%!lCkBpa9PUmaMM4&L1(bdA@k"KbX%BCS2jU(F59Z(9%!+TEI4+GaeQQpEUH53C1
+h0S`9qhNmpar%pYG(mhH`b!'Y5+HY1!6!"'0F&!B&(D*Xm"c%Y'Kk9Qm@jkp+cFb
+SLbCENpm'4'D[$3-**4YUmL'8@6jBQNB$3k3QG%1,%,[rhmP#CpSC@%J$YIm1BPK
+T'VC[F@%JC1i9-J3XMmcSU5S`HSjbIYlEbh@R4+CJC,BN"SK!Mdc(*M,'YYf`'$l
+b+mHIJ&(EKRm0Eq%qD#e$h'@VqhYEi%J60aV32"@S3c1&CRp!4,-$cIm)Y+)jJ1E
+aJ!R01*TT!Am6`+AZ`1a%S`()J,PM-4KP#Y8e1909q5EI+CMMqJ$SR1*!q4[lr5R
+EZBfH'9*NB$%4C1T['0#),pA4-kbMrLBR@'k5ZcNL3Y3!P#`Hk$683A9$8'(pe1U
+&U+1Ha,lPPE`q%%hCM#DGCGD,Y5&Pb8Xe-b-G*IVqjMNJ&Mb+e`#2I`"M!-a0Y[6
+#p%)J3Uf'-Ej&h2UYLHljKUd!jA@m0FB(alKlkUJBY346YVAH!rGLQc6)T1YeHHN
+jZX"3[eKhB6)lB('6ECDD$,8fe+R*KN2UfmI,lZp*mI5d825j2M@*a(U@@,p8BMd
+5"eML`&+*!f+G4#BDEQ,%%QK*eDRR3mi'Ml!j*QhZ9FrEK`K4(c01m55!5cBDp3L
+k3Ij1"5VlFKY(S$N3L#-SclCk3h,$U)KMERIAr3j5T##Ic0qBR[8%ck('Y4JIaA&
+1FQb+NKJBCMQ6-5kHYZabD3lQfI+!J(V#6dm)"KE(r*Z+aHM"BQ5[H[&dk5jAMr3
+CU0"lKS1L(pYC%Pf92J-9-8%XNNhN)c$A1Z*jPKRJGZZjk4"[jrld0*MErfMNR[-
+%$LNcIR!&Y[&1HR')3$3!rKp!q#qHbLN-fblYNU)X`5RQq#(HaRfK1*m&'`YAPGB
+9k06$a9!,Dl`9'Y"hGANN!3M,HZU0-$D2kQaq#j1NaYF"kJB8TLTk3L*@T&4-[#A
+Zi@d"*iXka&8@U9!N@e5NMP`i'$SF!&e42!8'qipR[0C"4`%8i4!2dr*ZGhQ#d"Y
+TND$fY5`bZ$9[G&c*@[V+++iB$R%I*5eM8hPkVj3N)NQciZSS4*ZY&-'$,-+)#%8
+rQTLP+[%9'+kLMp-('+G+Qr@L)d,DV''ELD%U2U2dqGa$[&&0iM@SeZ0e5ah!Uep
+Ya5YGEB&$KU)5@(i9%4I8mhL9UXIa-UU@$ai#2R3GVeje$+q!HJ'[rHSSAMCe%*Z
+ke5'm8USCVcUe%Ce&9"+jMl,$2AUe'FEU@DU,I6jN(A@01MicBDi@2USF6I-IV)Q
+MUT9p0&$6b2PF0M"Db-8@kPBET3()b`d#U8KC4khH$dEC!'2U++,Uj#JASUV9hKd
+dP@i`h`$jSh[(U(S!AHAiM5%A'TImqfPLrK1D&AlZAVCMe*r*1Qm,Y6#fah'pbPp
+P9(CFiAjr&6j2q"r5k`RTIfl8Rb@a,'4c-#fJRUFMN6T6VmZGGFM(3YdpT$iJGDF
+qJ-mrU8p*hAA0mZprEP5p"%#Tm9a&9eQH*Vc#RK%5)!V!eIfUM-`2A1%3FErVUR5
+[-YG3d#jPb5G+!"TDA*T2N!"9hBpIA15qBe,c)!%PaH!a`YI'YLIJP0#!hedf%`U
+Jk'FMJ4$SqHiCF!p*VJ1S"c)qJ9eHHBX(H0XX)1-E3HkET'jV$VJAN8P8iHk+6dM
+i2Bq3!(F-C9X-5,XB"FTI89jd,#PkHSU"EP9F89PRrPZdc#,h#h#5@"3lGASa$iZ
+R,QlKi9KmmL[SSKa,Xq@aA-A85RHjl4`@0f2l#kBhrJjr)H8Q3%aEKqd3Mi6LYmD
+ki%669Xm)*JT%eiNI$Aj-q+(NqieF@BLJZcAN!ZKX46Be8$EGd8ZI!#U9lMN0h!V
+L!1*rL#YAZlS5$9a[`'%Nm9-2-3-$dcXZ)a1(2hN)L[rR,VbXp#0hjLbKchp(Cc%
+NL`!4-(AUJ)J`'r$[-1"4U31BAqCN+Fbai&hRLc`+3SN!T$l%ikU#P`,!LKIhJqb
+5,$2AUbei$E#XhXUbHJZbHTCl!L1P6J$H1Pd%"`(2a0"B$FM,RDYhPlr)`i'N!$U
+0cELBbi""LJ'$1NEBC[9kqVj,qr6eki*6JmBE5!Lcj"4,4M#iJc*E+9iekP-lf!@
+m'Y3([Rp8,AAr'U*XGYMkqUj#L2aYIIHT4KbGfIhV+@B+q0A5Ur9GLG6S9K)(6&R
+hbY4AE#$[3-UQ"-*!5)"'PKG9041K#F38i*'"'%J*j$,(!15&R(`U*X'JXkSd,94
+28@*Fl)HaCp88-hfQV&XR1MS1Sq01L)'$0mCe'TdQG)UXkd(@[DTA`kB*3+phA&*
+&TM#,1pk1UrJ-Xmm`I4SeBRr1[Jr5X89UK%Z,RbS5ScdiI'4URqfS'Jk"9!eeUYJ
+e5r8K-XBq`b!'40iH6&f%F1fGGBQYGde0X+41C*f-F24-TAX#NUB9")m4NF`amQJ
+(P0KT)*'-c&%d-hSUhG05Sf$EUc5pVAH*Y4Z1UTeXQL+Qf@%VbKSh5FmfBC*dk&i
+FZTb"+c3$Tlh)2Ud(b3RV'IBUSCIICZ6q9c&KS$jH"#XQKJ3&iVL%)B'`j'#-MXY
+8",BdhQJCYfK!@"6--Q(3Lhk,b`!)Fp`9-SY01+lqJlY%ca6c`AfTIYX+)C0lkM#
+GLB%@&Y4"I"[55!('e8EQ5P0K923qDK$JQ-'b$N`iFic+cDdBh+*")"V)Z(jN6cp
+-&A-Sikk8-TSIl2F8"#Q3!"DbS(pDNkV2PP!&)!V0FXC"CJh*ML*!Li#UlqK6Uk'
+B&c*50T-6$rdc)RHbb!Y#*"Xm9bmjKXr9G'3FRpq)9i`&2pAq%j4Pr%FTbrJISJ$
+,RiRAerkUeMVr89cTC&dh8YIqUjJqQ!691rja4m)Ad9%`!ZqJJp"(L8(fie$AdA%
+BNbaK$L@#qHMFXeFITDjjjFGf2CYe,6Uk&XGeI9MZ@PbUDa&Gjbc9XF)k(Q2GeMZ
+kV4rAE8cZYRj*h6)Jhfa$4b&#Xe[C-CZ1Cbbl,K[15ME!HBSG"&4+"2aK!!5r@1H
+jfP9)J6K3rZ1K$V(1Rb8%`XCkh5hU*3C!b(d94"ki3YP%3N8$6S#ZESDF)Y#KMp0
+H)K)!f#qD1B+Z944!@iqU#K$&9GF!b"TUdIcLH-D+e9C[LK-a,QUdGiJ"Y`Bk!"D
+rJ2NP5ZDA82d1A&#l+9MA!,@Ql-AGaa35PR)h6-UV`VDc,02Xk)0UM1@JA*[GUij
+R,0J'4cFSei&i3aXqejHQ5F'h('4RZ@I)'E6A%0%a&Yj"*JT5GE94#"JQ@2!1"QD
+&VK-b)0SZE[&I"F"G4!$FAa@UPd((`(FaE'-V!43p"d*e&!G(,LB9p#%Y,c!EJ+#
+#$$,58@1CXcL-5k&5B3(9+#bJ2["a#kLPpJA88Q%"p4)!V@Am!PSXk(8``'-hBlL
+YK'""A-eF1FK*#@BbCj2EYMG8ea#j&Qe3MQFXr$aP&@Ya@&!`a91Nb[EG6STXH"d
+TXSd3UF1`b6e$R9$e6RmKYQ(302MN0`QJAJ#3!*N(ef@P#FL-Ib%-keF[5Q+DQhS
+p"RZB$@q['!(Ld)b)3L4ICmcKrJPkG9S34c'$b!Sr%`#X+"$YBH3MKJCd2Jf#QaJ
+!9N`Ri5fYE9rVE!0BXa9"FG"hR53LaZ*hd!FCF2'c'"([LphPZIcmcLJ@Iaq(9'#
+P(bK00!9*EDTpA&FY3J2#i0VE`DcQKNK$8SViei*"cK3MTi`HQaU5C1KHRMI),k8
+Y"5+iZXS&K4d!Em)[lrV9HR6b&,+j$mBC-h9,9qGZ'H6)i%qa$%6QQJiS04[P)*c
+cc3L!466@I6IY@K3Gj"`[UhMFd#i&b*MB2Q5CI@5)69R*($EBRT-@F#%cl6Xf4PG
+J!&0"8Mik%M)X9T32YJI#FQIl'PBJDXeJZl!9RG%#j6!1p`AfAd!J(cU,TGTd&iT
+pTi9L(l13!20M&m,83cF2Faa,1Rlkm3-#$CR&8f4!0Uq!%E3@@kI$!0S2Xf5Vf%m
+*06RZG#5Cj#3VBkUC'Zjdr23hY%N-ENLfNmQ#NIkL-ic`B`LX6dfU)a-R1UYM$(F
+b*i0Am#''Q[%KL[X3e0HbV@r+@pm%5d4NT3i!T"KP)J$XT*5Y#"3ZH*p-)C3G"A!
+NQH$)P)6"1-P-5Mm0GAbrB"#"cf81!1XS+6rcABb`a)#*NLKU`H,d0&fM'TNa'(L
+$fBe-+-J+$T8"f41#%l@a5BpAGC1"1VMhB4XR-bN,)Z)5SVSk'!05)%EYKL!0$eN
+S3S8L&4M9#4kdJ`5h-!&Qk&+ZF4J`fh#dF#QYEE9k9a-L-Q#-5mNkbm5"I!cSSSZ
+PLGZ$Ua-bXNDJj3*qMZ2(D,`UCjpLH@!hp,l936D9CMB9#`X!qaR)2NSSpqUJmF+
+i5qE5)Q2GZ-J@[BLYcR(48AhpkU$Sd68#N`QUF8`G&%rlAZ)DJhV`)M2F08[0`*`
+hA9bMEE$#3CL-8FXZ5k&cC8M6V!QC0&%%Ihi@r'h4D+c"!EmeF@E8S!V'+&b0f#m
+$3'ZN$JkH$$QEdBQ61[%lJY"0V*193LGeJNPV#MRk0VQrQpEjBI*XFcZmeH'-$P!
+fK9@-J+X6#bkfSINSSLISie1-YhJSILhbpHq64Z-3UM%NKD-1`D3(T!-"*!jd5Zl
+VlG'9[dqH49E9L8Bf5ZDf$,C,L86QJP1`HlUJe$2!,URe`h3GaViXpc#"U`XNT%#
+dN8FHG54jNE6j!S3'N9ADJ6Y2`YN%#hE0iK3dcLGe2FSCLMaIp$!&[G,YKBTZGRY
+lLLM`a$!VMQFm53(ZUTL9%!Q3!)Y*%JpFD-Hb*i!bV()[NS,5#k4qR6I02RJkjbd
+%6+qQqQqUTKH[p[rjIr%NNXBFUQXpQ3+IBmSU%0dSL5A81[bBmG-)-Kb3!)98'Q1
+,[K99&Z,XC6+DF%NMI$)%Ed"@iU-%+L)-DDFU*-Rde0e`3*mpeNk9$1J3*98l@ac
+NdT&+*RYi-lZK'(,eFHQDH(IqA3(r6EJ5cTa-l[F(Gei18B83eYfA"K,%2!X!aIN
+N!Ac'fSpG&JpqF!)CXN-mq&`kUQ1F`*5DpFN2SC`KkJ42mNkpjX0JjLfSV"fbS%#
+j8Hd3&2M`Airr9UMNp6#0qRQ(N4S40"3T`[9VJ$-!b-IbB#lYZ*4QE(BGK8(R++G
+'+hkFq1Q!S+-6,[Crqr(*D)3K(11L$3'clhM'ICXEa[lMe-kI5C1N+5,`UFB8Bm)
+%aABX'8C9)L$@h%F!KiHRQ'NCANIf6YG4P6D2ZDlqlfpUXFU(EN419EY8HfIp)$R
+m1@''Le%RZ*l#MimaqdqAql5kS*!$&ef)ZPhJUSqZdT8l,rmX8qY++`8H@TY6Y0N
+@#89aT+pH8fC1"RVeHDUI'CVfJh!deUS*&iKiR["D[Gq%%D59hp4FL4)K'@1'L19
+FmeF`J%6P,'fS-MNqIR"-4T,HjcB2$25S`N,#$hc!JSeZ,9!YRHMBE"Y06d0fZ$"
+dL0q!bRNMGBLI4H)0,,qIP[D[SNrpfj+j#-Ml)Kc1rMS2SSTJ,YT2,Q+8C39cNAr
+H"3V3`N#"0M+&p3BjC3#Na5m`C99GimKS&UL,"eP@bf&Cl4)RdfmTXY"qbN,[P8`
+Hba!1LSjEcUb0P''K[KkmU[%QB%UmJHSiTSX,*[4BdbQ,d3q1B5+UJ$46%PKLd%i
+)QIaer"lS[6!J'6[&r[4ppZ`M'8b3!+Ak5bQk8eqrB4BhXH9%+-YMXN(&*cG5%%D
+C5S03bX`X523"c6IMXj&pTPJ!kD-!mMDK'c+9'q6VNY%PeMmQ%@G1--@ePSZ[4AI
+iD@6QfS-K-Q9h8,D!N!"1fI'f`@ITNc*'M&09M)*Je8B58j%UYq51-K#pAlP!KT[
+8FqGN80C"S)`*V5NJ)jG+GYbULG"AA49ZFh0TQJ6XCB4[@%EiB&D#Q"QLHm-HS2,
+[fK'QqHF&K+PT1d-NFJ"FVIMTr5Bj!Pa!GmLSeUcjjbP3!ATCcBB"j)SK9"*LCF+
+'klU)9F9'#E(5&NpD(c0T+"!qX'$#1c&*0+@jTC%&6'3)MIJ)eANYl-p2q"1XqXT
+A,GckUHMI(*6%1Cm&Eh&C"09&e`dRqhmI0mL"iM!#43-kVSI3UH@(Ukj`@h'!424
+FIGJ4!,j2dlM9MLU#*0Cr(iN[JcN$SIL(B23rFP9[MUDLiYLa1d849De@29m@,Q3
+LplekMCFBI88FDkV55VbJ9eR5S$KfpFp9ZNNqSF)L!Xe926d+JK31Q'8kL8UJr*L
+58C6T6d8D2*)l"`@EYpV&C!k%JECc)Ir$4@)5`eGR"$1hLdNb`AE!i50J5l8*9mM
+p)j38a2(MV`4%E'fcGdlJ1b3(clF3221T0L98ca5XB4",Cqj[Q02(5hDM[3jU-,r
+'!Q1+!8DbLJq,pNHK#0Y0,5d0Y3d5dV))J@M,C)!UG$+2`#6-m9%F`N5YT84jU6G
+rZ-US`H8SL6UKbQeQ961K)#pj1ic18#&$6LhbIPmLEc*(Q%Tdb)#j,N%P*qFdM4N
+,r'Vp,qqLB"f([ZD43R+h*#IRQqVaM%II!I%K@+INV'BSY(X!T,[KrT'aI@ri3,L
+`0!h"`L#KcVLmAM$FM2aS)KaUM5hMA4fD%5$3&QI3!!G8S%B6aIJMj$bd8)`r5Be
+KFL3#BM3-Tk-qE0L%!%K58b"1DBGLZ[e-#f@GT#d58'a4!2*LXCE8%kU+m*Hj+@Y
+T'N8)a`i#IP8dX3fS`2#A06(DB0,DF"0GYD,lNSCD9'Z!8m5$hH3Z$4+BaLTBcQI
+9A49bHC%(XSijAT2VqRET)T`J2S6#YaQJCM-FFc!X[QJ%6LcZ"*bG4Vp[F@qi5DV
+NA,N$US)`MjQY0J")LH3SmL&BcS6@4fkU)icCaqVJ8$TAl0BB4MQ-T`05"NG9&Kb
+'CEHPPcBe4KR)h)D&jc)30aH6K!-)Q*Bj`RfR8$ea(ZYXb$B3m"PJmLFJHbBSUU,
+0!N0VcUiTCZGmlX92d0+Ad`ZNRlU@0aB%XbELZ%X0IE%iL3+f6D8$&`ridPR@'K9
+2K@dL'6F('4!QeD%9)P!L%CrMdJfY5dQa@li%d`K8f$JC&EF9dk(K!`(kYK'iP'6
+mYD+VXU*b-NJ@aL20B8k%bS,SE'3L9!RFcUQD,4$mE"Tf9XF)Cq#+qbm6L@lG"(!
+k)"2T$9*20CV6#&TN-NhUIq3Y)MA5f$QH8#QD0V&,380[+XiFJ$e2&YCa4U,Rh&Y
+J*-J1062R*K`XULK#lG`k&eHcL8#*$!fpa)5YCjG!PQX-[5*6YX+RTTLEF&JdJ@-
+jp+VQ"i0d!(9U36#6SI3-DI)'8L`!8YNR'G*Y*2Lhl"+9RT-()IChY4cXYI5a3qb
+cNdI@#h)'3!CCYk3-B)-!8miJkciR!5C&k'bSDmA86[mm0'BJYBXKF'f9)6-MIG-
+e!Nm`H$b)bPf8E3+Y1!`hBpYdGr#6+ffS3JAAbGA%,"JULJ)GibrD4YP&cSZ0&XE
+5ITEYjK,c'QTeXYeQ-Tq`E,G*kJ6CVVbZ234a6+#E%B@`F-+am&Qi[mjM*(%$PdZ
+1CkbpA5)*+0-55GV)l%e1Q#$+#ib3!*1-N!"l@&9@ZKUMikH$A$Yeh'861d!EQBU
+0rK%LI'BBA[Xj-9NLlV@jGZ*HqcB4plBk3e3A[B$V)(2XZFN4)-p5hjD$j!kDYZ[
+AK#cmGFi3-qj"i"a&NMpe9(dEj!54M3R'2TkcRbA`MBLXS`Ym#h8%CE-&lM2"jkc
+Ufp*a$V9,AA$[6I@+#RFFFUr*6C%4)bY9aih'%i)ja@%5mSa(A$Bf$NN'S@j#HE$
+K+1ZQ8"TL`%!AB)6*JD(SF4Jbc-Z0NSJ8D$a8iqaTACA,AeJGY28'P"QcB2Cm'8d
+45ef5Kp-$e2U5,3+8Z*P0C5kbEMd#[+5)K5Dp#E6jE@+I5FIjVh0)FS[599`aA"H
+kl@e)jVl1%$6jNa"S-KMB&9LSSi9fpCA3L"D(!RXklH)*J)@JS#30YB2&4bL,XXZ
+MSGMc,6'V[G#&MlR82qPe60-*-N"`2[--"4IhPp1a-%$Y8+lX,ShZf3*4k%lVeRH
+DPQHTDC&"Ha+U)Mclb9(ZFXm#Z#b[1FTlhF0!6'EVRjjLe*jf-jZfA+L!eM3`k3j
+bpL46,Y!44f*$cB6UQ5mbmRBL36V!54ede$!Sc#b66!9`9&9SLNDDk+qd"k8cS13
+8il8)-F'NjGE*c*4%#'YXSmK`*#lX6Y8-[a1V'Cjbb$,mcL%)NBDR5-J1`%N'El5
+0AJ,a(1T$BZr`&"468MAmc[%-6DRH$m8rLB4+*"53!2Z(3cbaQ$U3!$FDT)SET$b
+XR!`dC#(F@dQJ0pr496d"(rV"PLCXQBZU)!#-9,N$@D#$$9+d!6"J'&A$c`l2`'[
+@F-BKG$Em,&k,KfITlFk3!&54Md6UrHQlR-krHRHr%b#qQ9be#i*-M+$N[lYcX9k
+0h@dhhK*6l%0HGKMU#9LNf5M@$$qEI`D[@IQcZ'614X+bXma`bpLM)@0`Km0`Zj&
+e4SJN&G0!bXd!-k#U8T5rAQkmMmC'kF0$CVZ0&1M!*3h9TI@4+HCVF+U61k'+S+*
+p!GPed#NRhb6RHNNCBK'9mJ)"R381Mk"5lcNXJUjDM#dDUXEpPB%,b!mC'5B5qY-
+(`Q+1Sh#Le1aFTc1)Q#Ck+8hAPC'Fl%!DZdP%`mPK$DSLR!088AfqNj5%d('4`,U
+0E@KPVK0SL,BZEpK+!&kk1-9X(BR#0EE%5NCf%+-'$ST*!Z[I2j+b%[!lG#SIebD
+ekcTYNQ-L15R#CEB9@qF*#4!LYX,!5BFN*CNZNG0ZUrBa!`bIS#9pKG4%B$"`[-a
+G)PVHZK)kpbBXip5mjaF[lS*DJ1ENM1hCU!D"TUBaTiNl-5L0AE@8L*T95()-MlQ
+lGe*8J`B,T4[SF,bPDFH5E$ZLN!#p(4IFAN,$L'#K-*M'`"6pY941E-AMqbB'U5,
+(Bcm&kJ(('M(R,cf533GJ+%mmB0PML&Tk`cNVHRLc"$aaQ+1"XcIj#$q`b1hej8#
+aMDC)X@dFDL'R0Ka5ip$VPjZIR*NAC0'[rD%`Q#"$$DSX0$Bh&`G6HD@[@-k9pZU
+TU"60cZPNZ"9cB(!KTEpV"%")0LRT9U$e#S'&D+P**dE@`&`#`IJed4,6d$3F`a[
++00((e5&#PBe*pM&#(mJJ9F26+'0P,k3*R-B%#0P,@4b6q-SaLDpd*['9eL5qSNR
+%mNVh15C4,dr#)Nr#41K!HKVV1*,LiPHQZ*3*d)AbM@"c+DS`I$8@heaSMikT5(K
++5R#0@NHPT'm%VGHP5(Z4&iKm!%YhXk@M1er9GDC[U#@(9#!kTU[FF0%()qb+mPK
+TM"p4,5lV"2YRMYERHDh28Uh2keUIPl3qcqTmTPmdU2)"D+U+A9pVH%S!*H8J[EJ
+JR$#[6,f%3UjHJJ,l%NMIdahdlJel*Tc-#q*B0prHSb6@(ReQj0'%f$EbfTEF@0X
+pq`U$kq!iK)dR`p%*4GK)"lripP`H94*E[[M*qHd*8ERUI$JhV&`fdB(&,QiG&Nf
+i8!3RQQ*f)Hlq%"IL5X)Rk[qb,5&'VLaER&XGZEcbbFTp`Hhl4!AELl&p,pYZFJp
+MZdP*I2VIGbaDR4!p0j-EFqXmPeZI,0XGh!C"G(F`E2)Q`K(jJXEGK3XD*I'l+mZ
+qA*F3Sdf[2CkELYlcbYlJkT0D8cc"RHlYf1a8%JIf[&qhp924G0Lj+0GX`Y#rI$R
+iD*(BaLED*NqdfEd&fjZ94+kKH`@Ek$)fdCAb4,p`6(32Zp$KrK`A1T6%mZiIUQb
+L56E49Tf*lR&-9(4lX9e8%Rm+6Pj(%f8Xpc#@lb@@XfP'jHdqphTXpbQ*9hV[rj)
+1L$'p6@)k(,,QEU9+3d$pfB64N!#C(h1[`m@BNR#l(mKR8el'TVb56CNZY6(fYdh
+!"lY5lGk%+p9+BYHPYG0SfZ`!&2N!pY!"`#3e&`FJ6G[J,XF&Jj*iU'GPH)N(X-G
+a!%IFdl(j#&JdqIqmFCXmC$B90"b6+8(9q4*5+lT4)3N(JUCm*%2ZLHKJ5%Nmql1
+qPaNEPM%f#%Hb#"Ga+'E1MJAGX'YMlM@i0UBN6RmHIfX*"f-#!a4T1kTH,9B5FcU
+IZm'1j(8kNRZP)e(Bi4@c69Z8K(IdXp(Ej)&Hr3DE3XRPTfNJiX80`c*4aqRiF''
+6NNLG[IiYGJ!$l!$Uf3%8XS116`L+EGlLB!+QSme+m,iCAmcD(J6M6Bca6TRaFFE
++1,%5A@jA%UXE02r''2ik-IaHLH%5#A[SF,"YRC,`pcS2E[K8M,0"aU8KJXRcee,
+a("&'`%$"j'lA+)PeccqHB+`GB+bYPkHdL!4el1MRBa"&E(ZANRMXYLFQ-TDD'%Z
+GM+@&K06*%e2S#T[DHLAieKpq3BU00Q2MM'6M-QXR+SQIreIEkY[N`N0NeXkA"Xk
+!L`ki`)9K*6(hMhqrKkE)@"ZA@EY2bN)kV28U`A2AR3Z@`&U6R$%P*NaA%M-IZ5r
+bRl$f3b8arjkr,D%MCB-d13lrjc*EKD2kA%Q%M[Qh%P1[$)"0a&5*64i(NiVB%-Z
+9i%rVqRG[#iU4%40B4!ap33)(rifYq3RTi0hcIZ"LJ,'$!10p2m8NLXA)A`A$#Y[
+L94*lrXqF"$[d(Hc3DfAQrC0SqR%`('AE3**9rq22BFVJ&1#C&HX"e`('Z,D`kE0
+J1-+fi6L@2cPNBXaiQTKaq4Y2[JKfl"%pr`,fXNh)--p-fpK,C$$53F1q6`idIK)
+-Yl%Y)*46Mrl2QBaC1aLcDKdC*Bk"HpJf-'V1MdmCL9%dT1SfDlHVQc&+#FFr%`B
+1NTlf,p2eM!&2Xi$K'd,!i'!5MM$fciIICm2ZS'(I*`1M(`Y-fU`N0MlrlAQ-E(B
+`XUN9JS#I#*-(DDfjah"5B&&BX9jdA@6$rN+-riX`E)##D1(h)b`62-db`6INij@
+',E&J[C,BZUEV"`bS%*-mpqdEGl$P5Z,a[rcU5CEeGV#X9fX26Kf(L`cD2Z9+#3f
+F(9Ymh,&*6!*a$Vp`ILF$hNmc8[q'RG5$*q9"J3PcA`Vh-MDe%*X@1!Jp@#3c!BI
+59qIq*6Zk9RCd54Q!,&a,e9e"kN%dC'D!A&kFrHD[f54@XNNXFi#2K4+jje'9hB@
+I8CAGl8T`rKZ6IN$NIU@@X@k(!h`X4-GllDcCqF"62fI-Db(Q,A!!MQ#ac"JFeQp
+-kmrF4S1L!TaD'GKB+!eA!"YK%jD2XXAA39abcpcr[m%,!PM*#'#C(@`%ppK*qf6
+a[feJM+aPM0ba"%BL`ah,2Ccf(4Q*JmZZIRccH%B+i))aaX1'YN8*rUhDjh`8J1[
++5JBZPYR"KB-T)2(MmCA2XdaAbd$&$KP8k,)&'HrqJiIc@'CTSFbb3!)@#KZq!a$
+mpkf+$iLNQPSar$L'pL+E3&4R!L#TZV@hrjKB`4LQb!`VBL5`4bB!N!$j[AY[qbf
+aJKeT9$l52Arjl9r2j0(Icq6aY61jUIrhQK*GYBL*"lPq'4RUYb3Q"!dH5ap8CHp
+EL5MAY&aGjNfm&6c#*E1XM1,H2X*[STk0T(3*VUp-e9Kf*[M)VLGhR9X`R2h(6ie
+*-I*N)I[`LLXf&9jGGL4URC!!mUIRAFmE6Y!L2N-eIh*hFG#AK`(8hPid)9LYKJd
+GI0-ZRqG5hR"3hT!!q-2ZNfI#R[-BRPRHF$QjTXLq`HTbZ@K,1VE%,JTG@(5kd$I
+rBGE*9rAAVLklr$5Z*X)VlYZ99el0*`4pLD[,I*iF$#PX$AqGbB@%2q`U1S2Yp@`
+l5X%9%JJ38C,23p-)IlhHNB4&CKDGb6N*"DrASC!!DDTipMSG9BiCB#59PVG)aKK
+9N8d,q1#&ZUj6XK,rQU`US3U9',4(X%T82IB)9+25q8a-YRqmTiXVjBXpiiFJVV3
+VB"U[Z0+ZSY'RS-MKic9lp(Zk)#qT#GS0(ZdD8Z,k3$5T&BI9X1GbqkDC%rDB2Br
+mjZ9%$"9lEUVK++*1eN8IqHRZa"8Z4VB8)J0f8!B8AmX[ePrc&PpFF0IKP-(%pGI
+#dFfl*J3[,RMhm0lb$Kk1ZLjD,e,%&h,%j@CdKSKrBK'a52LeciUTJr@)d1eJeEJ
+1*XS4d[AhTHYYjNKGp#FR,Gd'aAliEU-BHEJ`(,RF6L!Rp5N9!"0ZBam*L,IYMSf
+QKPT*I$kFcCa8JZ+Tr2AlPG6@RkcI15peYiiCl@1fK[qL[G8p)K64b+TSCVP(B%6
+aePa4hc`AFTI8A0ReiLrZBFC"4RK29$L"6X1jr(YFa@XHpq2e"2IJ04m9MV,FbhN
+%VfbZi1AQE8hNR*idQQ1Sh'q%F`bUd[dS[m2eZJkJL'G'8HerNf6N@kid`5KJ@a'
+i!dkIUq6K3'#M8k`MM'iD!NI-X-J-6#EQe!X$6m8q9Lff2T4XTq+SEd%N0K[QKB%
+8Kb0$R)S0J+20B6L$q#@5JJ"iRM`--d4CU-"-#5T(FB6b*MHjD[)2H+"MD$VhBcQ
+r[04PYJ4-X9M%!+2[I&Y0fDT3+a9+bcAB5-khm`eMN@@c6N!iEABX&!mB)-UF(fT
+KaGH#X53SGBAJ#&ilkdiQM#UheA`CJ-YClN%d%$&*jrVVJ8Cfh5GFEaM6rrR11dQ
+%K#i'U!Y+Q&Q&LbGF8JG'R3kD3KUGcr-35@ABT`eMeJYkrR`iC58RHA+6DKM,19H
+DJkP8c&`Z`S(%AB&03F'"+Y@ZADf!$5eGFKp'S5mP9,5XpN!0I4"iV4#'DNqmFfI
+Q6R,5`e*caNe%)alX@r"P`-)U+lcHpf@!()-Ki0QY-j(fBcICiMB-I*(fNZKb%ET
+dcVU6R+*0P643pk,-jSpKIb-4e-b*aMS!1V#2GHrHhfV"Ka4e%B0C@3Q5Kq&DfNa
+,"cTdMRdH-rC@66XkmkIX&A0CA$Nb38CG$I`@L*N-MTGKX$kI2BF%80RcFbq6%6A
+h6SJ@H5X@JS-1LF3pJPPiIpL#+1D#ca%NmTA6qGpa1B)f&J4[2%VXS@iN0jGX$#4
+lMRdJZFr6U`'$"Qh0004-bl4kFi,A8+M%Y#biYU'Cq`D'cR1,UAKA02E"A@4d3a8
+fMX!ej!EVC!SqhXU&S"&$[T-9IAXC45a!I-fF04ERANE9I4qj#E#J5NI80[-9)NH
+@55k3!#"DMC23dqfHHF9h0i3pGe*4c3)$K@a$N6LQH@6kaK(9Xb-DBpIEY+ml,TI
+)SY1&-hmU4H+!5aTUTPPCj-YSpP-PJjQrPDV,#fki1Trq`$Bf6!-MNAN13KVKEVN
+523N2YQ"!+fK!6"aEkElAU#(5B%%K9HrMF)&-cLbL)VTRYV0LVHr8AB6%8B,K1RZ
+Z)!CUV5Ql5b)'e)fS+NGaMjSBFm@b9`2*!lLC5SQfQ2T'b)80hj8&rB25&44qh%4
+092XDk9Z824G'rDcXZ44P2D(1KU[ZEZR`p'SkJ5i,*GQl#A6!DFJ%Ce)8J)`X(Vb
+8*Qq(Z0DIBSij10L!4V6"aBN,8c9f3h3ffcVbY)B)K`UbY*')c!PAabL5AVChSMi
+X4+)c$4'b**4`FkV5ckkA24J@KLYeplfcc0Nb*8e,R8e,`kRDM+`5(lIe#!SKXdq
+eQ!4UJBR[M6'EVM)h6!e&V84Q9GmBS8*UkKJc9)NCL'Ka-,pCKrNQJDP'+YRr2E1
+8VhQ[,*hrcXHaP2ImCbbeNa)9pl4TX64T2L)aTB(F$U6U3&5S8-D6e5`)E3eeXXk
+`'C85CqX92#4!Pc8Dal48h@PTY!Tfd5NJ4G3Z)!8&[,5Jd!Vc8j)Epi$4*i[`)*+
+TQ!c5G!S4el!9`jT-D)5pd0c1SE%adcC$YaKr[K1&dR53!)LkB5cpcTfA5@`lFe+
+U2G@2606R5fp5$c*%U`UXdLmM-5Fjij)VejDJ-DTT1HdPdeF,UNC+cVe`P2+0he)
+(YFGlFM*[(4Df`Bdr)V[j,[Zi#qYd,m3eNEXj48R$bH6ZbiIkma[&IT!!p%9-BC!
+!Q[im0'ppG)AAjPmi4)A%Zr0(@F)C*245dh-EQPCU4TaSpQ2chqHRdqCDGlk&*IL
+3!(#HQXT10+p6XqeC0-pLFhhq$GUm`TfrRbA-3-)*DXE[4c16QXNK029X%*IP365
+a"#X5EP+cGKHDKkPT@S9Q(YZm9pjF1,l3SKK6BD,6V9@9Gm$0VkCm#d6SHS$BGb9
+h$eG93E24iUXUhf)V2QC,43QPF-XSKGYpb&B31p4A8)eY4ckUbYpA),V+#UMBP*V
+bLGDU!K,JI8JG%@P(&0XSR0192rjmFP(@M'Xe"FeBZ))L3e53!0!qV5+(C15BLUj
+$`5HN6$K&PkJ*1f'H@CQI5#@S-20`0BFK)Ja46(lLfaFKpP[T@r%234r8Lrbm-&4
+P1(hQKC)2lqCj4!P'rm1l88dPUS@%bp@0C%A1[*4SFN"5MTFXML3@YM@Ej5,fE[,
+,2(8JjaAaJ#XhUZ!(eC!!`kI##9'e"0qN)P,8('V%4I8m08bL@NS0MDKHTiC69#p
+4SeP%SEYSG-"GAda2Q")%FUSqT-kU9`)3(#RPAA[A"2ejK(L%2k[QhpjEc5dR-b#
+%TSS2TEXX`U8Zm3"9,HhrII0Qqi#Ad@#CF!d$erLUSrjBG95")h@Kd@c*NlUYJl+
+plU5rQ$kU$IhmVC2i`6+S[,LA#U)PaIbcee!"FJpFI&Hpj)VkAqU0+M"),"3@!KR
+N#H#!JH36r$TlK-9CZ)JLNAeBE04-dSC$*lLa))qBh&#$UaPmM-!ph!rFaZUDUS)
+mHK!(%Q0U2@e(Ja`p*KmD,FK,Tk)Zh03N3lHMB"i2246&#%AJILr3pCfSrZJ'-(k
+(PTq@(P*QP&A1bB6$-A9(aHd``6fV2,LkV(+H[)d+ZJ$`q5dqQ$15Kj&+66NH8I,
+Z"HBbTQ&$l,Ch*,L"8&%qf(DLUbJpM9Aj@iaUL9+hVDbi(`R)dkCH@L!pcIkJ!V[
+E54-FS06cZP1QBSL!G-%&eGdLX3M&Iqbh&em8%`S`%UN3*1fVV'#I+DY(@A#GB5T
+QP6#T!aqFj`FT1"cP!EqPEqQV!2LlGE1Ra&+JfbMP%iF9aQ-hb$df6Jq)S%,1#[E
+3kmZGY%@V`Yq)fSpJX*FjfbY-k91BdTG#K&0@FPUS@#VC8'+Q"h*)D$`#lrTr+&&
+aH$i,!VITfN9pbBqY+#XSh*R#N!"LYTVbbT!!4SUq@Y19!)%8'Ne5a+8JI3U2mfM
+``)eTl!PbhGJLZIRP'P[E!leJ36%H%A*66)ISb`p&q`4AS$#Df8-fXU8LY$)lU4*
+k)lNN5K(eF-G@h&YUF0QpX8P&`%0S0d$UJkq@TYN2Q$'3!%MR2*adiL`cp"0#B5$
+&3(+I3P&'p'NmBL$#MeZV[Jb!M#US-3jY4b$26e)J,c'GVXQ)kcV"fB#U2+FNPrX
+"9P'`C5Q5EC@FY)fGV%TNme)E@U30$,Q"F[RJIPG0`FXJUE++'B6kS*K9&#G#9Em
+*BFPH"e!j"&)&N!$'$b'0TB614Li4%GkrPkSXKY+T+#jG3V-&dp1%`KKH(bei@8$
+P!ZqYFfVQiBF&AS&qUNk,,!X9Q5Uc0BcGZ2Nc%FND3cXV92-Q#hMH8pI4CaR6m+J
+VE)$VVA@%8-@5(PS)#'bRX"5FcI`ilK3Z*Z9PR$PTV%TQjNHMPHX2(IA[,mM&beM
+`6%25&@**$ehM8M9lUH%TNKXRjB4-01kL5Y-0F)YSm&#Pk'LRIT5LN!#41d2+SD1
+H``A2%%R"JEB@kK3bJ1RC5fQ-$5C@94&$UVJ$4SkDbLkU51-r)444%fTN&k[K"Vi
+d8B'C&AXaQD28&4cD&)R!'L)dH5Tblm%VM&K3UCCeJ`*(*3DaTCI%PUM%P[RC%P[
+8ka*E9!Za46e1E#&bBiP253a3(j!!'C)R0iVPK1Yia"B$HmJXrf9RMXH2+L#kc,P
+Cm!`09DIbEP)i3,JqDV'Y9Jmd1D*cY%YNRhVqriCpM'h%)1l[Cf#J44jk@F8lK%)
+6Jjl!`iUJcQNSHper3J+&NP-S#S0j&J8,c%)9Mf&bTK6F+&Q4#QBS+,-*D4!++2&
+$NAC2Yp88r"561B,'Ed*Q1([@X8SDdd*K@dhP(d2KZ"Rp6`qeq,1bh4#)C19[KLL
+'AY1-LK4TCelS#$*Y)hl-Q)LCCI``QNGLT,jrL*r2-4d66HI"',P'2hL,9Af+K$V
+PBVeDf9![b%20%BCDFe4YG@r(Um@pQCDVjYqPS-%c(B@mdB1d8+c'9DJ'l)&Dq!M
+JBh0k'V&"F0aN#`bLN!$6QXSeS6UDG-$h5@rfjTUql)H4Y4pR3'X5N!#,-rK%*`0
+6+2JfeM[B2dZUcK&U49GY+&bJAL"JA-6MX13L"fl#J08MZi,h%)#LSN4kFZ'Nc#A
+%B09j#6%)T-2Xe---AVG`C"HBb5D'KCj"*8Fc&EV0UZUIFYqL$cJ0@CR$HBp3R4q
+6+mANB[VB&#2ErLBVdQd3+QE0,hi8UXFJS0JpD-&2)6PdVc0S)rBG)SS%lJ$`$p2
+$2KJ4,3c&2d*4f*A[`mK99INq82BH9dhP)hU6&`lQ+!a5fJK&%&RDpG'jr"Cl&#U
+jR%1d39+Ge6G)DE,5JeNL9Up31"H1,)k'"@M@f`M@4#!)U&32K3X9dPZTbUl$'0$
+ZB4[L8N%J+"#4&6KL6Em@`3(P#J%2@(%'V(3DqjIZMMDeaf"@1+(qm0rA(FZbF9X
+[8mQ25QSZ)ql)M9Z1kVa@&'YT3XR@q!(,1JYkN!$jep1$T3"XPJ(Ge2bfV#!A!A1
+R'+HQX9AHCSmLKDB&+*03%A`E1912b8AciPMU)DLMThkdrf-86UcYV'*"NNL8052
+A8#6$XPFC+3h!"2`UA"5h@9kaEi0a(SCD4'`MT)!C"lD0G%iHCD)l1*Hk0aFJ-$d
+@r6iH[F+50i1B0X-NDHBUc*4bT#9)d4[)aI58e!N+e*+0rTl(f11cULPkJjNpQ%m
+BQ*m0,)R(M1LC8A%c$8N2B'"hR&lZ%J55Q$3T'[AM!r[8+#SM!B8JYeHBHc)&``V
+BBZEYfCP8l#5U8k!T"5i4'c*Z*L%H&-c,!*UVff)!(33iPYX%),KmX5i!A$jA&i`
+#lBJ6q&Xq*q"ie0EbH`Nd"P"pCrQpicDEC-3DH8$R`NBmHNX'BmYR#i[4m"VDL%(
+C!ma!N``P*C!!$`6LC3!6TD'00S&KHNbKGE$p)UD0kMc2iN%jXe$`RKC!Tf$JGqZ
+BZXbMk4FaUI(!hBEKKK3fG)99NTb'U)dK*cE2AJUm(Y"aF+HZ$dYGHqBi#P)*ZLU
+cTBSA@GNRPJ6BrZQ`$0KbE0JD1Si,!jpdClF5B-[Q-Q"V&('G!*XdZH`"LUK*caB
+*Z'@IN!#!@lD[jN#f!9Zi"0a`j8ek)0[F,I+`M##-Iaj#%$pHq8PaTPcmKNL#+Q4
+l"SdQ3F($Cda,ZAYF9lPErM(+hA+(FQIf-&GU0YNIhk#T%U[QjNL$mUmIKa!R*HA
+Yai9,82#F$8QlH[IMJ+6HM9HU8T`4fiM@jP[8'BEV!K)bUSf)fRS*I,&L48HT-$q
+lbQF@9$lc`9k3!0GPU8KP"NSJXR$V3AT8K%VQEQ3hbR)8*---@Q(D)aI#Xim+q`8
+!L!L)0aR+(D3*JR82Ih)&S%q,2"qm*E&',5$#08-0)M*$FI2EDl+@fk4J2#8(ic-
+F`AMY#rCJ[(D5&)`[NEa"!L'&Ck&SLqNI6pK,C`*G-UqB,!m4KG8!'HKHrNc0JHA
+2%QNLick$JQT(TjLTHJJB6LML#d#Cb`V1K-i5NS!(GMiqa&&XFj5jSJrGLRlVR--
+4)(kX2Vf2JMkjURL&[DTLCMe!Fp5H*(F@JcRN$*%e&Ga9-$A8LZ%Fah$5X@%U"R!
+FQ`DJDZ"K@9SQL8b*E-@DbRNS9#q6MPBk8TM5Ap!pE*!!&bS[qE1d$reIXh812FE
+366jrZfiK2,*b&jG0B,+!PT!!cAC8MKG%B#MDQ)V,([0XBBqcl%mlF!dIp)M9d"%
+5mP!'3KBZUlMTXc*K6mfdANQ)3b)@'"5N5akkFLNYX&kRf*i5UJ`1FTq%RmP!5qk
+!%'VRSDVb0HA$l19&d"V2hiIJp"db4,UUbVCMfhPA@GPF9ePPPQl!("Vi9[!"+Y,
+`q(ITG4iSp)388!#G3$i+8,IYLPVR%522Gk)+4C`+CAri*+Tkmaq9C'j-9C9heBh
+4aa8bh1q146++M[PM(TK'ZaZL`X&3GBZSjGb#bZldhHQlfD0*-qijE"K!aFmjee"
+&HU()#1r'e')EN!!!KQBr%ZV3`hd5P89U#RUXhUjLSeq-0V"#iVE-6NmM3bQ*""Z
+N)P!bdD'C'8mc)N1%!YL+k%K3l!fBmme2HpA6Rk)!3cbB"9A5)!1(Z*@%d[2)-2Z
+MNUUi0!@M[miMG4+G5a1SMM4%(&1S+Hq#U[6be*25*9UN+Kk6,p+%meq@6-*Pkme
+4RDRAP+qRap01,8D"8IYX*qRL-FiR#XaJ6*KhVDEb2+E3)Q8r2SZa`FIBd!NfR(5
+`!B@4L3S,B$#FarET-%+4)U-hE-A%i'2lcbdS@kql4"Q!bD)2f4,@F3YSXlQ0,B"
+K2eC0#q5rc"CSNb+MIXS8c"f"Cdq3!0MPH9qD[QFDUIlm'@44J)IlZkMb,Tq+M$a
+**bJJFdh9phV`-i+I)(i+MjI0L`qfipSNjSia(T!!Rk8ZE(e3R+`JhMZk4k%#hq&
+`Y!J'Y-aR61L5A)*bZGGZlX(M3FY+FMp#eURXdUPH[j!!9!"#`!"`FV1Bm41&(3,
+P6m9&C)UZ3PS34#pp&P'Kj"3")&VLUd5a)TAdL%%@R'@*0G25S6#@C1k[UCU@lTk
+[E659+Y"5m@@K&NI9[kfS9S3JI8'VhNfU,(piR"RfGM,9!U59E$K$EYqdd$'&G9q
+LeAd*96DU@$-N"+eafNi"+Jf52ZKaMc5YZR(6SZ+3!+DH0%DTm8Z`J*bI0[`F4Qp
+0Z""&CPdJPi#XCNFPbUdSr!R'Jm8"'#EFaNC'8LC@k4iCHP-&MY"$iZQPJf95jbA
+80qTi$#`Q-*brS0b,5XC9j9k3!0SD0)D"'"jP+*5*'Il)!$aX+5XITS,+l)r[N!!
++epFeemeJ"dL6-&jbdH[m%SmK+6'+#MH5Lk@DZk6KhZqPDd1i*L0465L1H6iH&cA
+IMMa05mpkQf8R*l*685!UHSaa18X9TEMV4@lk,p684$%ieAJFY[MY2Zi$#2,,(84
+rL4F+*GV1@$Chb5a,ekSDKi)b-MCHB1)RKiK44`!9K9Y5q"$B8KR!be4j&!(!933
+,QXUc"0L`42NJc)P%F"ZIcG%aXNV9eqaJ3bjB(`q0f(JBMifq@lGU(KA4p4f(d*L
+bTEq5rSTK"A8e@-Fe+'3($r"'l@b4233"aHV`D[B)"+SbM%(*3i)"8,FU(N6*cB%
+@4Q"1aZ4k@3#&BSBHhJe@84FY,1!GN!#BNk)UEU38UA39`YCppL[C%bM)E',U4N-
+Ilj6G23D)Q-$S*LM`TJd!1(T09eR"fr6J9GP-MJSM1qZq-j!!Q[Qr$YeGm$B#U'G
++dpUV[Yb*SUZSmlJ%A*T*ZD0(eM*3-6L!)JG,b%(009[+d!@jakj#E*2V,M%H&3M
+ffJ!Me9SCA-5[pI%K!)0C-X%ZA$,"5S5+l9IF@h(K*K(`N9`q1JJL&X!)UGaV[4Y
+Q1e"l'@49`9(QQNFS('0*J%3("!c!+&"2B'#,m9S[[`A!95pY+mMG-"Y43l+$'d1
+*1!FaePH@%RT5H3NIbFSQ(-D0L`J+#88@$RcTE4m"P9jkSldb,T(TT$Ge$6RN5!H
+KL8,L5+LK,aYG3-15NRYAR5IQkEmb5S@CG)XfIAIAb8NqUCSp@%bLR9CpGhm89'V
+C)&8NMHZl5FRA"9LNR$'a[Ve`Vfi"*$9iJ&,24H"JiTXQIB[!UEq)(KmYHZ5LNa9
+H4#98V-AJk-&(8[EM1Rm!!$'*384$8J-!@#)293eQ4K%3)H2ZBIpY[jDUp1E[ZVk
+jRZEaZDkVHUUfHN(c4(C50`EXbJ+pELDcXmLIapEbN!#1kjZjK4$#&HhRPae`bSb
+)6Smi&`i6Dj,a21YN(VF3AXr#HS4`HJ-MK19CKp'!J5EGT*Yp-alVlprIrrGe(5#
+rZb6[*5mr!"9hAL6c)$)L%L(a!"%L"PpTP-PB$$qbVeN!+5B(X%N)SYRX3H!NXqK
+m-qI!,%8XPH"lmrkmEm))rVkc)1-pA,fYPL'2D24)kp"(KYjZD*%6Ym1&LPMXGlp
+JaB0JVPf00MpR"2[Er4EIeiZN%86i'PB-T%ihN!"&B5"H'%MK$!,T!PpkJNQF,kH
+f)L!Xl@q4T6JL15B1Pj&hV-mjhZJIm!m!E(rB(mI2CA9VFac+SM)DP"EI'%bdX[L
+[!Cq&q8!X'3%VZ"`QA$UCK!QE-0hp-"Y%eALC0hZ+rpS@i@)C@UA8J!a16ace88Y
+mM)Z2U%EmdBr-1*!!4SZ[pDK,@I4,bDd!L1[%j4#)bSY50Bh3lcYcb[(P&NGhLQ(
+2i1a&GGF9mB$fqmk-mN#RrS!fAA,8CAV%CAbFM+MbT!VD*bfbCd1(VeQG-$4ELfa
+'-0d-%$P%d(%G3U`kAmDBIp6Qm"[*BQeU58Ep$hZDe9SUrUKYkDjY3)jEaQd`h#S
+Me0m&J#$-ba$%q@KjL!6bN!#aFE$E#kJa)k"'&LXUd0q"TICX$i-4`jqb`ApSmC3
+B3C9!bT4eF'RTBNBK#E`8BC`G)Cc9HEk`I'[hC*!!8aF)[cr,hGe[HF*T,)F5E(A
+Qe4iMfGB1d(LjmXK&jC%SPJEfhKm0pRFC)BF&X1kjfb&ejk-IU9T"HrlqC&*Ci"F
+,cZibNJ,@*`1YB32P-,+3!*-Dc0"ZDfpXpeeKNd8#85Z+l2UL1p*J@I!C1@QfRD"
+LbNPlfiP#IMM(`83f-LNa65@Q56'GA1i#N!!`'F#P1Hb`-QJb"S2pmrZNkQiCq3U
+#4"Fc-VcLp(3SG6S@mb80+Qa!LbH3!-VU!82kX,&a0kZQ'Qp1@RHH+#ajPqqd'%X
+%V$'mTHfd!$UTZbJ[Di#8V(caceV8e0*,X6TreL9"IVUAG5r8ZV@QEKB@8MHD0ii
+L#KZLQhQaLC6cQJc$J!+1EPjSCLA+36("r5bqG0#`p1ML3Uib[F"%!I%'-EA5Y'i
+EV*p9iQ3%8c-aR4$65DNAeVSAPF+UbU'B2X[UNmP`&`PH22+`)RJTVe-Kq9K!2[Y
+SD2FAXh'SHcNmcmA`ZNAG4T@)qY64%'m`Lk3(2I#TH-"YrRi0%L%NX'hc[*@QFpX
+Yf(3VLaH'efhNFkE(bjFKB2cQA%k'"5JiT8RCGS)hjTrhLF*m529RFY,`*)e8@`H
+,@`d*Z*!!#hi5&qp$*EQi*dedD9DGBCiLP36"232$!CJ%D'Ac!963QfDL9B!PMbl
+dZebP$)TmliP%J9IpLBSCRD(b#KHc8UMmB8`8UNH[bX9%TGfMbfqd`1KaZDPVVS$
+8"J["'jL+S"Jf+8+Z429EF35UAmLV@&c)rp+U,dqV1+8e[V*6UITL1N5Y*`BBjRQ
+&&3@+!U*Nk,Nf3pZGZG2Rjk3T91r1ZF$i4l[E+IKKCZKH"JN(*I#T-TD3!!,5Z,[
+i1cbD(iNfF3!@[Zl9Q(Pb,Xh&Y`@jZ2cR22C,NIFHpQ3Z4I&6F5Q)(jGkl5S+jTQ
+0Nb&5+a"Al'[BY$dMeGjMAe@I9PkY22C9j3VPPA(XUkqkP9FKfYUMMMZT$YkL,pb
+!31TIC-aVD%29-#N[KX,XA0M#),)j@6TZDqbB,LeSZqmE8`#kE&Xl#rGblmDUaYk
+09IUl82eEDFVQ!`J0T[c+r#*%1,b4KF[+R!$M()((!ka@250Ud98@QMBC),,%iNb
+KURGjf`@T[RD`eqYH89lR$rEkUjZ8epjMAJ1#hEbJ[!`4Zr%S-aETP6G&SXp4F"9
+'TGR9)Zdcci+!+)H6%-UCA!kb)jbN)m*RJ1d!%a1%IZ$M3jKNQ991fCBBT2H%C6Z
+d'PjL!RT["288hU#l"+@cA!@Am5ik`(h!91JBaP6Iq'4idJjbrDjX2GA`pFI&"K,
+1%LY!1%fBY&fB(KCV49&djaa-GTNaMfkd)[ZZj2$IKNU%Z6))S3&I5DY#5-b-p(F
+!')abKc)X+K)U0'h(MrRVHe!4fPY)cdrpEGLU"(pf5PcAF*,0HAD3!2!ZEBkZjm"
+qDA2N3dbUrR!!55fB3q6-(`lil(5XPBjY0GVG%Lpmk'3e!&4VMI1pi`L`l3XbNK8
+U6U5C4#HcQZ-G)NA"#5$(q'm2h"DQpPpaL&Hm+Jl!R%U,06)`0Uf9C'EMC(*hBA`
+qpDaJKSiSUBHAQE'Zr,rh8@bX+,Tl[3K"$22(q*aUNCbVV&`)cEd8UeE(mF(N$lG
+$Fj@aGHULAK5c"Df&$8BFATcF@ar+EjGc0M#SeG&m-"E+Pq0@eBNZ@*NQKYHjL#h
+'mLB10lLJ,84XL9@+Y-VraIq,r!rqLalcAe$j6m0r!IbR(j5e))9N#Hic,*[KI28
+`rK#d8+1`)JN@&!DYX5(r`b(&N!"VrZ(333ej"kGffC!!r`Z,6NCZ$,FU5EUk&!l
+I,UFVH2,$f-+fIcL%"bi1ijLj5+TGbR)jEI$NEf-,eT!!*4E,b1,Nmr9Yl5%XF(*
+AU1ZGBU14&N"FfX@)kZ,EX+6EU$U6%QE#Yd'`*`$0P9Y0,D4D0+RF"P4VUZ@[B@Q
+aZJAYBNK0ASabQL#f,PCA%3!,%k+!pVia),UKh-jQpiL0R8Fm6ZTF+kPcZDKcqDK
+cADE1*H8&N!#l4M$frmEEK'llIrhRMI-8IYI98'VdrrG,*Gh-bL0[QKBm+Kj*G"H
+[H1346VfrF,FKGJPP,@elDUXUb49NFMN-)aPp!cf@%kYKlZa%f,KB*UK!6#UFZ0S
+Xhd!m*Y8*RN4Bm@-5PBA2T!8mR)3el5hbBhEJL0i,5BBJV#!ER+$NQf&qX4541*B
+26p,K86AUL)YAY#45r2(HpEkNRB#C1&jl5B'Ejj!!2V81TRb*6)34c+8ZTAlfF0P
+IIQq*NlT8J@1frSA,XCL-UNJmIL'25FJGiFRFZc+kL!,F-1$a+ZPiJ!rI49L,C$j
+H-T1cj4bRU,qEPb'`HkD2`ll+)jMbV5!JY*hhQFdi)a&3"Q2[-pR,FMVS$fmaD,`
+#K@)hiJ4l,)-,*iK2c&DibDi8RK3RjGLY%am2i2!rq'5d'JiXI`!j-jLmJD6C3D#
+5I*`UShY"kRC-"Tqr$f$'CYal4Q%4rSQ*q-5BK'[R4S$r$mGa""F&)-mpfiM*RBU
+%TAdXpJJAD0ZjSJJTm6)1X($N(r$RrD`pP8Gia3`Y1Df`-mbfi-pQ@#!1beAj6%J
+*V92$SHM5SK$8mVhVb@&`24Ai+"Ai06)H12T4"j0b,h8h'@QPcJF!!N#$1fX[rU2
+'*C!!4er@hTX[VVBYJD#hcH"JKJ![4Prp($'Spielhd8i2QaRF!j!AYLB`3GYNB'
+-(!kCS%1m@EXMAaba(1b3!+SKKe30285@k"Z4,kC[T$Jbj*!!ZL'(e"ecb"Tp)r*
+'qND+Sd-1U4eb51f3!%28BIXJDF@,2&b[0$k%4H+C@E4`XRRhfKhh!@0Qb$$Kp[)
+H3K&h&$p4eB$KD6!3ke$6UAa10ad@Q8f)E',[HSpeCUNJYl4[[Hqmpr45V(VBMTr
++r[bL*6A'"Sb3!2SpQ%i*R%K[`M6+fGd6IrEKcfV!J[XirF9-C'`If,G$(#B"E*Q
+$ZYS(SpS18pk(QqdrjL3Ch#X4lYD$I9L'X(QeJHiD@l(lcGjc63`(fY4NkKBV-&r
+qM!6FYd,0X3,Tj9"P$c0VIH-J9f9-`RURZ,2hRFGRZcY&lU!Pf-b+$6Kk@PEZ9lC
+q$F'I8CbhRI1pKSZ[D16A[AThi-2KbKI91`4e!c"J+e(FHMG3i)CSDN$T$-RKi,i
+P&*e'R3$"p9HEZ41JL&Z[8X*dFm2)Jm%1Kkj[5BH"4#UHU`$!kq4P@CMU1qqFF[R
+9APcZpFP3)I6mI6,eki2GH@+#Zh0'!M5i#DA`h`Q13`G!%AlfZb#YJ'hYH((5Pb3
+!kq4ETj'Q2Bd%8CFahpLem!eqLBifKN8R8!40Z2'LX%iifM0)$J-)fmDh&b1[IZN
+1MX`1Cq@VQiD(ml*a#4N*JYjGrT9aK[PGjl2cfbach6$c23!E6K5QA1GaFf#a3XC
+'!CZScBA!mrGjBh2CV0``-+XY"XF!N66JXJX6qNZr1bYp@id3#VaHA",dGB$GQc)
+EGfm#S5jK3Nd!IMQ$a[`!EPiFhDK@&!*A)SHr*")550,"2E%3S!per!'+1FcJ"bj
+c!cZ3!*aJS'+bQ,+rZk&V`DB8F!eh2cK%m39Uk*'@f)Y51VU@BD[6-TBG&&ReGKf
+1C@Ap[Aae@C&mkejeb@K`,(KCcSa99a&j0BZ$0KKaG5hqe(#!CCarT%5b3Kr`MKm
+j,%fBU)X%"(($S-ZC$26TTUdEF4RIZ0M-5k$H"b#k+FmXL)[KJF((bTGHUUjdQmB
+2rhJIh*9KFKcN)2a,S[1j4"!A+`FS`,"UDdjk#Vb!AG&GIqSf[GYjQ4%#3H$&9Z%
+Q@C8DH3"6R',K-(RBfL45RkMffHSpNi&Rj#5"U-Z[Xa%#+aQVhXZQM@U@Le$5F!%
+`X0V(UXZBQ%a&mKS!)@e,*cVrJ1,-0[kpXl(cX6aBqh'i8-+S2AD#Q5)q$JP6lVM
+a('m1#F&a*C!!&Q'0J`M)#"%1(j%40a'2Ld3kVK4[*)*b!q(R18pamFIi+5T1dXH
+ZiZAm8A9cN9GAJ4AmUC69GHVML3p4qM#5q+$4KkR%Kc"pU%KmL0#(h&K!cF#N@kT
+,9'-Xi)kbb09Q6#-d6H@B!IZG@)CUqk[,(0dQM-4AK"4[@F%")[qi%GM5#D0crIU
+qP)SbhF'&Ac$GH6*P#i@lmapf6!DCk@[VQ*4S@J!9h(B5)'Rm9-06XkaQFp,AE-3
+j[HeNjR$(MpQ9C[Z40k"'ZdL00Pq@1V-"pjS`Em3MeffL$8PC#e'dXR,d*'REIi1
+ZA#j#G#&8#,Z-K6dPmjVEqN*L642E!)PYR-3fPFC1pj,BqNKXGdPXa53d"`RY,JP
+0*C(eUSk%X%iPa$53!"$3bS4SXJQK&#!8Vb+8RS43c)433N)S6ZTQMpVJ`*iT"2V
+E0pb#BeqhTp@J)[*Zh2+Aaeq+p4lrGe-f[A'N(X8`ll6iZh`6U9[X$$XYM[NEI**
+bVE(4BH&ZM`BkfK8TZV*DbY!j+Hm,h)N%K!E9`1aLf0'aiYEY&bR3L95Ah*j3)"G
+!&&qTF6h!%9D!IKS61H(5$BFFZ+fabRQqN`&SE('XZZEd1GXj5dYeVG-5YF4UBc(
+Fe$NY)$GjRGc`PP3VUBci`EVr8'#DA)M*)Bb9'J8(GMM"el%6[(FlXdZ+iJZMZl&
+`adLiB4,VM(SCM[*),C!!`cSj,A#&AMU9ZDT!F#2'H3Ch%JqN"#-L1aA)VZ+S"`"
+KbC[LYA+)p@!AHAQrIK&2r$[i6%9RrrAC@"@U$f))8*@,f-k!eXX@e`-#J!4!q&Z
+#!p05+bD4BqjbIU3N2-2IC('NA$Vm#QD!K!@)DA*HE"L`&Aqd'VfRQJTAe@M43`5
+c$3*Q(%5KU4'DQ*35G'ED'"llNZ5iYT5#MS[dZNJ2PQ)M#QaV3"QVkI!8IXCNTYJ
+#&UCS%ZRKM@Yak@fR'MiriRS!"5#eA9!TGlNVdir9iaS,UR1&M9[Zk`ac`86k-6Z
+,"")RG!%'$cME,dBqk@BA&,R0F2NcN6@qD2m&abdd5(+ZDTrqQ3MmN@$$"c6hH3M
+Jf#+FUakHH9YFr,%qQ#B[CM8`JUB4eq3U)qQC`!-3i'-VAHbL[c$c0P6H#-bk'"m
+,p2%f(KQ0Y1"$-hfB4I'-FN,0akD4iHA90Zi1XC%lqq9$e+$RSEi(r0,J`c+bp&6
+$UfIjmV%40RAH['F-afCNckQ'4CYijEdQHiar`J0)0H%RqHZc-LHEmC19#2liq"r
+`6I)(r!)2SB2TRqh5Kjq`21Z(dIXQ%KY-Z2M([R9RIf30b$BlqSfiNd5f9p20"0h
+Xbr"0mrI&!h(kH+$!0k@2d-HP%VN+(p[SJ@*kJ0Ar#*(pl6`P0VHF([$4!h[%`NL
+,B"(``LYBAVSTd%f0mY#(LV24L2ZQD#4&0fIT"R"r0%aL,49-5f2lJTf-c43334m
+-"#PP*aECr+CR!!c&DQD$86clM(Ka[ZdF%b!$`(RX30X&h0K20HcIVK!M'GPRf"Q
+10H`J%qpRQ#Lprq-,B)Zr4H*GcXIK6aZ1[-D1KJJAeQ*a$bef`r5AiF,EF@&RB6l
+DcZ!#!dF!"q`mL8T25J!6!QM!`q@8$0T$4jHGDMKFbQ![HR%AUBjLVMSD6hKCDGf
+HCIJA4FD15rX-9jDGJfUb&K$LDh"!fZ'1+bT59,f9'e8CGR5D&A##H,qTidJ6"a"
++aBkkG-QD)CFH)-0"QYkcmNVNUXB,$&0D3,NN#Lfa8,K!Ebl#iZDFr0j!E"NGm&Z
+IKKX9+3H!$,&PRPjP8a1N%1`!F9BFDH)NC'beNkX8rh%695Tq*9*5IlJH@q8(icb
+*lF%MGFSM9H)Ma#dQTU)D6&a+VYX[,SiT,aVaMk*VTC!!("MPV[AdfK(U@NTA6d'
+S#p`pRliqmJ!hY`HlqY0Ak01Xk1K2h`4lqDa3'dqr0[+!#5SUTAV#4%jrUcBVV!T
+9cYrN%f4f*bQd*#NLQ#Zf(f)PP1DFP4A0DmCh0j1E2a*G%dA'X[ECB5DCM9fqdG(
+iFed0lG24'qf&`*El(%j"!F4"c!,2Gh+3!2GG&)6XG(`J33kdDfQ0'8c&6AU#'ka
+aXJ'X8iAED,$-cQAQYhFA'5Y`l1[Y61`TL-M)6RCDpeP&Xc0LNYKP"5PUF[5`L)C
+SiE3'4kC44-PICrX2lY%'`QN[D303aDQrrj,8(RR$Q#mb'R(*[hm$Ki3(djY@DfE
+33541#D#*Cc3NVK6f)6E-$$XDeV(UQ[@Ip!fMfe94`Z9aN!![NafCIRU'(bT)Af&
+QrNGSM#!Mq!%`KTpe-UKbZP(M,LijeCNX5(qlccSjIqbPUMNa1X%Nd'SpaN%JA$(
+'5Aj1XcTlNA#b&rcZeNGXCj!!(1UhF)*q0,MhVkMJRN*aei)"l5`%GYpR)#)EEcb
+pB1HNCH2Tk43p9)Z(RP*R%3)'$hq*#YpX2(fle0KiZ*k,R'mA6#1J(#fIZlAhVd!
++"ar2m''cl)C8SbbK6p-6B"j[SDP$$5h4q$)3fP-q'EZ%5DeReJMXeSA+B&eGe-+
+Y[cc*U!)iUhHc)8k5H`1ldaU`['japX+PXij-!LCA-*NN4pYTXFN"I06#"e$6'[Y
+EJ#4r9akVSZ+U3i96XDmEh""%T21VdKJhJ[&cl-J20JrLGk+S-d@!Fc)`0TP&aaQ
+618URel#,$l1&,#`3J%SiR$@l)iIbGhmb%"M[([m*LTc*[HP!NNDiET%l@DAH,)J
+J`&D`b42rF4P3HQe"G0YN38m#Rk",ISf0LeNddE"$jR4fl96$lZZ80TFqPCPF-0m
+paMahE+rCH!l13Naq@N&f!%RhAq#+(MP*f`HdM5kI8`h$hQYTl&KJ!TAVEC%j"1f
+e[5G9hCNUkAL$33k%l#Yj+lk#DLD10*r[j'19#kF',caE6JbElLb`Kmee$)@*JXa
+G4N(L`B`K#T06mlG3P([SXp0JKbB8*c8iCRBj[&5LfCR-3Z8hXmT2G`d#+1R9LjH
+D!j4C*32I@j4N1aV[h'-(N!!E&kL4&N&p-$*XR"0UKAafAN#`F(B+XH)D4B0iRj1
+FQ1`NN!"G#&PfAB`UbV53!02&dK#RCL!QZmmGG5bUN!!Ta+PkflLCX0+)BJqDNl*
+b[-pZ1+FDYZa8b2VMh''1A%"")*'3!-QV6LSHXkflmGCYSFCrSBlcaamfUGVL$hr
+6M8e@+BAH5S9Q*J5H5JLR(H,'5dH6H+5a4DDQCI@1)3&+RD*'#M2h&TNC(Xffc`3
+a'62E[iF`'5KM@%mMX!1Aai(+0R0#K!'bBH%i'fPVjk"9pK6b*N2i86LqLG6Ulj!
+!a+rbik0(I(J8(dV`8"##UX[1d`8YHJU%R%T,5@@Bl+cPEkF'kR!bBrHULNppcBY
+SCLqpaRerVqH5)VM(93FlJje$9d9aTml)8UQkR1Glckrme)cM-Ym@jX$'m-NY0S%
+0&PpKX9Xjk)iR*`lbT-a4'D'+@e6V$'"C0DiNJ1l$50#!'qk(pIjHA`&'D",EBAG
+(&bed%$8J%je@F91*$R&1UPH-RaXbCU"-XTFPQGB+-[LF3HS$C,m9C,r9i1CRF+8
+[0Srm"BbqhXL$i@4JDj1DT!#b(Rmf+@j$9LL3!%CX[3G9I3pEkb%(!XfGa4C8I2a
+(&-Sf&$klUMPam2ZX`+Kl+Fhj5A(e#-8&aY8(mM1M'k`bm%!j15f-a6EK6lfHp!I
+lmBpS`Y,))5'kR[fUU6M#MZEJ-J(3SLEf(X$,lA"4h4-VKi2ZVPJCZqR'5[$bj9J
+0f+'N`SM*5*9KGeJDEmd1i2LAm@FrrZcL)3pqbD9,KPakN5q0#QiRd[*b-lU6G5c
+fhJE00q%2`S`1E-"R6&E2h2&V(ZX'c@-I$MMZL+B,B%qAIAFCR*8N6+R'-m`rM9M
+Zb3$JMX4Uf)d+k-4E8"!m'GZ'TF+*PTB#pJ6S9VChR"[EUXc8P[F#p-bD"hm3,Z*
+P-+EYG$'[FV'A2GD$E@K'!+I,1&6KTU0m#BJ[9iMV6G$L,1$&`F!pp[lNFP*#jF3
+%!kMmr9NpG*!!c&lA3FdX&dT+(5$c-p'`S8`db)5+F#B8MXU[p3Z"'6B(UcCRqie
+SiPIQfim0Y8)0@BR-'!N9C%!&'8)&aDT!8$L-UN6cRKV(bB*p`keTZHl$)BTS[Hj
+5C6`K@c2X[-*KcRSLe@ZSZf`U%YfPRC4Mqr#l`UN3$p3,4JR&p,iaTA5A&3IT$XZ
+S1mMJ0k"8XNUAD&4Pm%0UG00b@4),Y*U"GcB[dl`LV9*a'8&3SUXp&'1p8(Qa&B9
+m(1T05B$fL)DX"0m8#*SE*9$Z&E@2M[i%!PfYhTd*3V9qJMqV9EqZ*S1R&*AIKDi
+!8MCGUVZQ",FGmiT0I,8i8%fSe5#cr*piU%XiZL#DPYqc3EEmjGPBLh!lj)*591p
+2m2"UX&kY-mG"a&Td)SB3'!`8%KIA$6L`JqR0ir8[P1B!qq!iCcjL3rT@3i1&I4X
+'&PVK%"4U(*LfM`+f351"fN-YXI@F''L`$$E@Mahb5jrQlrIp$'`bh(*@FR&&'[+
+HN!!lfT!!plh'54iBAj!!8P-(k#0BUpL"jcPaH`"QN!$LVA$D5R`qdN+JJ#eVNYT
+'#[&-0#Z)cK*-[-er$F4'bReR0'Dl10Pm*BK8FjJE[h068re)*d1UqmM"%P85,TC
+E,)rD'1S&djI(SY"rM-6DI1&A@Z'@B91C69d'*i#IS&)lZF%Kh2A+e@h1UGkTPDe
+%DRkH4QT%dS1*6IL9!"f`65%R*c)-dEG"$E6"AEp8A8AE$f$lFGiFQJqeR)QLdc-
+-BI-Ipa@iUB$(MNqEq01C+$'a[ifY89-dI3K6'8NTDQ&M3LR-k+!he%!M&'H@e)+
+0e),Y9-2[qK4heM9`E)H#*&$lJZJBR%k8@I@dSKifTLN(FG&Im%APkk3J0JVe`%+
+"FV"ab#qcB#+c@FY[MU-#Za3&BHKQh'pj)88K-lrMJdUJ,Mj34bPT)EVe(ZV-3aQ
+r-Jc,BG8"'MkD1SHXj*6SQU&0jke@8KdQUBk8![Cp&Q#IMm#qciR3qDGZKM""MKS
+iRHNCS2"iJ1#q9c*"e9R3&,L20k`$INk&UE5#r@YhG$#iKp"eam("[BL2R@5,)VC
+f6cK*),@d$i*c2&3-Eq4M$!$%`"q5@dq!AABC`Yh45QV&6r$q4C(FPjYB99ep9hk
+UZ15P&-$EcS35Je`i#4)#Umm'-)NNjlpRQ&"QZ#P!bjpPB9eH@9Md*er'$1krD9J
+iKS@[r0N@IU9@@DLiQa)-R3CJC!i1B'J#`,"Dd`%-3'&+8bmDI'58e%NE&b'%E@F
+(cI'AC$Lf"i6KFXE2!fYFPK`bCi,p(HSB!YlMYbFbJIk18Hfj,NFhJYFH*%2[+iR
+4D12afHCF`0(&VrIqPIjU@FId*dEJF#HlDfIR'im[b1"elZL0akGPd&*JKBP%!"T
+)6,$#K*U3!-'EV%jTm+9682$PLU,#8$&UR*4pZ6VQI`,$L'9B$G1KYFU4*FU"GFU
+"G6K`KhS)#UXFPBVV4c&l4"FK94PpAA4GhEemY`@UG6YB3!ZP6c5S2M!-Fra3F)p
+PTBcH3C[GB(3!VFF#5T-K(#U#(Q@M5Aqr4dEAmJDa*@T3TQbT#P[DbqkMM3-,cf'
+5"0RBHFc'&"8H93JZe(*ik0BLZfKV3GUDM4S6J3%Qi9@#Y0JJ@V2YHL&r8HD#Hpm
+C)Vj3IdG1+qpfG1ep"q),(EkIJ#SJ2NkTmqZplqL['L#q3ZL+aT!!"S%N%'$N%-%
+N%'$%eZFhiMI$B*phB&ZZ`8FC&P1UY%-ThVLSa&3&H3bQ8"9He%T9L9*99JmYj)T
+Jp,5-qHrif,#6k!0fGB`V1iIUEEL$MFaJ)r('1pM)SK#&)*pL8"-XX2T[XGX2,hV
+dIeq8'ArIP'T0-mE6#f%bR01cB8Hh%@rXAYM,2h!-+'%JlQD5dbm-PkZAq%1L3U&
+dFaP5)H&B'%&e9LDfHTbEl0*@8@6b(9%FBU[kBYk`fbkJHF@PlP(eF6K*Y,N$'ba
+J%$5B$6IJhBld@Ta6C@S&$a#@M6-B0fG"f"2p%4c+-!PL%X3NJ)Q'54L6!#BIriK
+Gb0#3!!+6M3`8BUJ@FDRbS5%D1DaEP449#Xd&0$!e@Xiq0VrXPQF#UKPZ@-BU$2e
+dbqGFd8fI!1dCQhJ`+&qm`)!I$"EE6VTM'bb$3cGCdq!N0"jSQ'KJ`-M)CeaZmrZ
+f+h!0-"RXUJ,c@$$bklr$c,,6K35e2eDT`ap`VlXXNJ`&[lV)MU*b"d'4$%#HG['
+`AUe+dTMFJerYj%%fh(Z1f)``(UjhTakaJ65"I'hP4qla!(fT$SJJ-,d#MU$0HX+
+`HM-IjV1c#S4T))4$LKS!+iDl+NqrR4k('+S+MZ1[bJYJl&ja4qBBV+reMKHPI[k
+41iX"q4#1H-IlN!!3j4Xi#q+e%43[M1kC[1&!X[B#0m6!N!"I1'cpU*&+Dea4ai@
+e8M6%QVJLM43A+)EmZi1'0@Y20Ic4,JE[jJ)m,06KFkLbLpQ%RCf&*E$h5GrM8*0
+*hpG)D9BjR`$""j4Za!FX2lBi,'$6UNb'GKL8UAb'did3p13m"U&l6lMrC!2MYX-
+@fUU,3r#fcN,q@6`X8`MrF0ak2m--(R(c(53m*abiS-'IS0#3!,E3"UXLQJ+`8qB
+6+l(a-@HHKq$#m3lpD0kX4q[($fhE6P@B!'Z6%V"[FR2IJl3QLj8kG)dZ(!G$a!`
+fZjNJ9B"!@+*#!*+V9`NJfGI$K*CHM9&PQr&bVAM*d&`iV5(Ni#"A$#UP(imEkmd
+i+TL"HdSP&lGKCLaUcb4IY&8j'XRLkR(PXKH9bqS[NGLScLN[AjZNl54HSL&#YDQ
+mR%'RJL#qejHjQJ!k+bkjLphFe6DbqjH*aeSTl4aL!D'l3,3B(,"1DMrJT(5B!-H
+%UkT)%+GA*P&%[Vi(DBA5erFJN5)qD"(63UlN@')K9mY)h(*&iVcpeKZ&UmUf-Bc
+DaN1Z"i-&ME38JmCK0!PPKM#P0K2XijV*2jfAeKQ!1"cX3J5IBIDPli(H1-*F0)6
+*m@,"6*TJ*RYK(Sqc1['cQQ5PYNTjYG,Yr$Y[BGaBlN[pjX%V+k,'h0AaMj!!31I
+8JT42'[h'-QClNG!&UpAc*+@C`mEp6$qRRRN3SCiA+A&F+C,dl!Vck4S-k!J'e$H
+$3+6@H)lrrc+lKRckamU3!)qIqSfVNe)I!2,6Zh`lmcB1Ua+$([,#YmC4E@dQ4k`
+Jf-V0*AdBSY")qJ63r+,DDb5&UZ%1dY3jGCQ6HG,i$VYQq,e6F,&)3Bf!KF-R0+N
+4$BJQdEM&hFS66TD4qbA5,Hc3!,&Flq28'&Id0"*MB,b4b0H-mqXrck*6UTY$fLh
+)K5IF#ic2Z"lSL5pK$%AbfAZ4$r(RKPXqQirmqFblNE@r4,$EK'!Tj9e+iS8M!Qk
++D2#QHV$hIU5R(q)1[Z9Zhi1$L,f-aFkN#0Xp9["l6M@%,h'MlU-%r`NeE2rNllb
+CF50e-1&(1SaH%[jD%[N*%MJ'i,5q4!+[%Ph`bbX8BFmDjr@K'VhEMGjrJX!MDdM
+J+,B[IbdKF,lek3,rFTJ%AJ23[-DGrcZ[YrIcih!8#"qp)EL)XcRfcX#p!%"S,j`
+)HPK896YTF0%bER#Y')D8KcJ-GZE4UDlS+Kp094)Q`XXMhd#&B&C@Ja`8bVbpp`j
+(hL16`5f)9`UEb8G@'5C2j#'i@P-+L6jr-21XXjI*,P`L9NdQ3E)UXEaPmQ0aibl
+qZ3dh%0RQ0NiN&b6-#KIl85fEP@m8LEHEN4Cd,6"XkB(Uri&6dMFIL'D&J#Php!N
+M"%NcTXJ)Ui3)IP4rF#-NK54JXH@HZ,1IL*R$-,NCb-E2HE5LKp6XUBE3,!KT#Qb
+!Jj0RVhBD[B,!F%-L([acmj-`Z[leRqG%&6H#Ci26,p5AGL&QJ("3[0$,6[+SMVM
+3@VV3+aK-YT+l+bk%LNDqJ3XjMVQ3!!dGZTq5fL(MTZc"8-+pI0R-#eb@`94*Jl5
+3!$XF*5K!l"p5SA)#66!!`DbYBQCYF)$4eX33@ma!K9D,S@ap)@+0GSNKDIN(AG!
++NGB4)mA`Bjdl*j`i-[hZDpqhUF1$)6dHZ)F0G'1!!3VSQ8Ncc-1#PDT9@+RV#6D
+UCLJEG5@LTM!dFEI(C,E1d8''S$Cfc1lATp0j(Y59Q+BQ-%ec#Y08-XJQSD-0hT3
+BJJ(V8*LPTJ5c9(X`CSN,S`L&S@@B08)hi'&ZHi35aqF0c')URcAk[%k%iV%kU-K
+0J$eJ2QQGE@HUqp,CErd,!2TZ*Q@HX*T#mmX8r8bSS5*1IV9J'!*jd`S"QJ$A",a
+LS5-H`HZQV+D`89@$E"3DIbCT8)8TBRC1%iY@I4!@VGTjRPd)`DK9HjUT`@)BlVG
+36C%*SGae9JaGcdRX&fmMb3bBf)K"3bdE1H'`KL'cfch@9$Zb`!mK*CcbT(#FF*%
+EG6e3#!'+`ZiNT`S86U`+YmhF*G1+QS%NX2$4eDb'JJXdQ'h58da&#F@qEPB8T%G
+PFTfb+%9S8BV36d@SF4(k"jkSQ0-89K$+TDfTN!$RS2NBCY#D+,!dKP$ZCiD`GFL
+3!!8F$R(AaS#d*bZZBS[[S*YL@dUJGEVY3LE[QX*J`LPf4RErd3H1P9IG-3#Y8-P
+[rQ,akMJ$hTh2"0jmAIrJ'b%`LSGD-AQ`k)+&1f0'L$HIH'`15X8r1IrQ"Ik%SF5
+MEmE`k3F&+93p244(N`@)lUG9$+j"lE%DLLh,Hl4R3QqqhR!DNm#E0p)1d!C6aVU
+,Rrm0$,)EaY*4r2R6"+YQmN!2r-!h-CaVE"dZmQ,K+SJFZr1X!k06r4X-8fZ4NaA
+69bkGRAN@$eh%RmYZ@Ipj$'j,EL58A$L"Y06&f)F!A@l-m)#0Ri@cr%USM!Y)A9e
+'JQZjCmikM`&EcR[pJ-,4)'(p'$m'KXDb0S9%$KV%rHVDi`ZapA"LECNqHlXSYXE
+(%$d0MHa"9qI"V&4RiM%cm9L)(i06!Pd)3``P$[AXT-8J-1B&pk1#UD"YEU1(jpM
+P0YD+alG"R4QS&SK,"+Ba*mFrmS"G0NGdG5Z'bGA9,9l0L+'%XH!%+I-3Na0@X)Q
+KJ[QP1r%5L@hRCa+,qZK&@"#DSjDYe&rrQThlY,5&4YV#m&%,Sd-@TPe3PU3Y6"f
+l8"iDXM$P6$5*SpHEKV`fdikpN!"fV2fSBbm0@@JI2*D(EPqqh[J-[iK5&p3r'4P
+m5!`q`Z5XJ"3dI$lRLc!SEMDHbNIJj1$b1pShG%cAEZLBeBaNqZ!M2$!d@-2hL"P
+Qm+#C@-9'"#CjBJ(I&F903d%VF%*im8T-'ECB$*p+d(cX-4j!0V,e0i,T!)YM+Te
+qmHScQZML2+!i%`U!$U%V-6aH$c*33X1(B#Mii@@4V#!@%pX&#D'"H'p+F`50(m%
+-9ARrZ1p2K4X,G`C&J8*P6T4"C8,T"+qp2B3&j3[bpX9&d88AQA9DGa)ZTjK%bSR
+G%kqDh9PL"'IjS+6jYPF-irC#4mPGJ[eFGkC2B85$e`D2Nk[F,L+X,V"l+@+1MEH
+("%C((AK#$#!+GJN9p[BMi$LpGJc$b[HM+5H8&c[$mN'Df&VY#fjY6S4"kiLp*h$
+%jE@iml39$B(+FR,K3I@M04cB3M3hC[*UMJ-6CU)VGqN9NKG%-FRAF&4X"5Y12-c
+$%d04QZP"Uc!lYiQQ-*AN!PYC-08H)LTT"'6c"hd2qYZ*h,6lpUB(-@b%a'Mf1c&
+)2&5eRiH"&a[kDJR"%2+A22cja-02TMr-$%VT)VNdir+T,K&X&P`mp2Yr6[pUpTN
++D9(q13+!B))NVEc+,P14Xi*pS%'m1C@D("83)Ija!`SlUNjpmFPPZDY'k1h5c,J
+3!brek!-ZM9&i!m0-QF+3!2P!VmQ$E'#iM5NMP'kmUFc)Jm+*)ZIh2c*5GbeA+Qd
+GQ6aFac9h(`qVIGGLkh$Q-i"pfdimQaG0P'K+rc3)68d15fPU*b#DTeC-l64YaG4
++8`269TSk-69SQX(85G-FTKQDCM(0dA3ETPQD,Q+kMDB9Q#l50)pT"8d(--h6G"c
+6!CT1B6T18aHQ8c6YaG4&dcj-HfNk!ZFcEbC!cBAN[fUC`%$(X`25a"mlrPMaTa9
+r$#-`K$`R5BbqiPm*-6SrSc$bepNSm)m9A0$9MDj%UbmPKM6LCL,FA3j-,YI0)mK
+*TP3"E!+BF[d&M&qV6AqKNrA9PkD[%&PILcpVQ+acD1NTaQdEEmJG`I"`AhbbQMI
+"Vp#pZr6&rr+YflmkHV&[PVG8c3hqfY#pSb#jDf-KFJe)dB#i"TTke,SrAUXbSIA
+0iD1"41LfJbeca`kq$-SmL&#p!bQZ)QGHZ2*rl#B$CBLNcHXSG[lm,q)-JJmUf&T
+kV'Z%S)*U#eqLqMUDa,h$c%9eda)0JeRGaCHVjQ4`mhqFVEiH'k(,[mD[%FB[i0"
+kFHMD-F%UmM$iF&T2%!K5-%LDki4#+EBECk5c9fP!A6FDai"'LhhXr&QT-jJZ#a'
+2UIA1`4!Ij!M#BQ8&j[)#P$T$U"Sf-e))6&9NHA56deY2HZm*&3Z&U,$NN3Sah)m
+[kVLPI'BeqG,JCk3hNND[!b%4Af+3!*PFFGS6T`ZQdSMF!9%SMV0F60@AL,Q5eA[
+CP@"SL[LUG8`-f4`A`iBJNGYmq(l'[V@MF)r9T6'3!12K`*U45Q&RC3a43qQXXaa
+i1,VjNBDZkE+'VPPf4qiaZP@IdFX$r#cVm#f1DQlM13ZR"YdQKUbE-S*k85REV'5
+5J8+k)c9+3Cd8&bf!qAVfZ05qJ-ZJ)5XhD%Nb!%9K6Sr4aF9JN!$EFhUDi5SjVA,
+A[(4YYMK0`6*3#!GD'-L(6"EAq`A89J!$!4H*MQPY3mGYmB#E(KM+b11I!CP8KKM
+AFNULI$aaK%P-JQ2VPc"bd,YbYV%G$X"q)hLiXrKDfcQpZXT"FE"@pq5X$MD'LXR
+mkh3e%&UJ$prQ`d(3l$T"BdJ0CUJL+,qHbA-!6m'HDj6GNLU4q$)jm$6Q!F&$4!`
+CcYall*i-i`q5-SqKf1!-%[CNb%f+$F[%i%i9(+CaFQIGCSCe-[)a$0`28q[`RD*
+&%eL82'S4`lZmk*1d440Be&0N2[)45!LT38Fp#Q0MrbeQ,')hViS")e(K`#S+-lm
+YUKYS(#&5rqERdSG2%S16kS,mck'#,0%&'Eh"8!%*XN34C#KGN!$45r6!-B+-[ND
+#"1J8R4@#M%iPMV!R"-N*VC3Zb&FlLmeM"4PY*N'QG""4qf#S),8E#8'@+&#-5'R
+9*)3CIP8)dca+Q(DBBC166@#Um"cr6kD@)H!hKF4Y$i4McZ6a%bG"fHGJ!*l4SB,
+kcd[rqLX@9'9TQU$X%"6qS5jDeXc(BQRm)%[*,,jDPVDdQCCUY05U,,8IY46NN!#
+@IT!!YY6+5q8K@YUM,'dqb0,EY05GYV5(PME4dPCPUI9BJm45XGfjY+@Y@(UA&TD
+qm-,r5CIFA*ffX"3,5`'RYiKrBL4Kc'(GQ+YeBfB6HM,GQ+0PC-`P3ieC$&"5),M
+1##D'H463hPE9%1B!5+GRZq@El@",[iiYF"!8%Sm-(AcNkL+$INpf%Y3bbUcaNpH
+9-+N9c'l8d`a!L!HJ#T[,S-N)@JI"cI1R'B6*6jiLX+[9EBJJaF1##9,3SG&aeMi
++BZ4*B[%Vq4r6N[@!GrfZmf2abac1c5[Kh(NdBlmeAE[XPZme1#*S'fljA+2"hQi
+Sq%"4F(Hpbc+N`a3jHhm!"Fp$*V+6JZYmEU-DRlNherk&Hq`qb-`Q(GNp[4m2GBU
+(jK#-15j3qP%6JkI3jYBJM!Pl6%ia249(B$$!(r43K!#G-,e%ZJV$b98`NI#-FYF
+bA(!bYLGBG[f6QIi*2e1#PAmUKF,3&0Lf5JF5H*!!-E`-8CJ-)*!!QC1R3SS3T2a
+c%S18(`,))XFm'2$e$"aAU,!YTaTU-l68cJ[rIB#6)H*bYD-i[Z'IGp,VP2ljRm[
+TFiF)bQQ4K6kpN[CT"XId$UPDlj!!DNda#-e&6-1GLH4J8[a$6)"U**cYrH[r'iF
+)0(`U,rS1TGc#4P`-CFC`6"Um%#6BfYU-KhL`9`$"BrKA*6K&Kd2AM`i1b-B2&[r
+8GUkijrPk(M!RHSlp9bkC@pkdB&KNDI)(0#q'kb25NX*P+68)M2-rIX309r$a'-J
+mDJR'T#`fqCml1GKVYT,LRU0ISbY+rZI`Z0PI,-C'm[,A1G4R)$5M,%E6*1R9dVB
+'m8[V-FI`-+NTdA8"$5""4QiQ*KU*S!%``486-1GfT*Zim@2*B'2Jp''i!*!$)+p
+"4%05!`"-hJp9$@C8%J!KiZj%ll9R2HUY1CVLA*UL2mTj(+Af#X-iRG,&pK3j6h0
+hR-EFZPfSYRGAaEBhE@NkV*ZTY%S4PURJ1!l$ZLc,%M(8EG4TQPZA03PK@%1Bq[e
+K$"'R)ieT3)dMrIkMYIIhrll[lhHrkrG+R1GjpYRR+aeP2K3"m3-!!C!$!#%'Le%
+Z$3EmNAXrTd"+d#&0H+j-qN2(dPmPd!!FIRG4qUXKljmL)e8UPB$,CVCI@l9B1J*
+JcN@Kc*QZPLECjplL3#JarG13!2I48BK!2`h`ma%Q*#GATRmd15$lQrdSbM(h2dk
+Z0+`Ma"jh1T&Z`eQbThZ2$9R%J,'$`MlX@Xbpj6c#S3iCr'jS'F)rjp`P-cJbI35
+GYHM`6blZ+A*E3TP6Jbc8[ZGAZI[6M&hi#@HjRCQc[1BXGkNm'XUFF#IGLYpP3qJ
+@fE+Jb@9lfMR,Qa9NNlVe5@&p%M)RecGKdN&-dJqGT6Td@(9Sb5a[F)8F*NFipXc
+bKVah(Q$Lh`A8QP$QABZCNpEJjad-9cUkBC5KJ1Xlq(N43Hj2(BHa,!aj(kH*KIK
+C&r)qI!@2J#"0p`)a"aFAi')2ZcJ(2lH([,%q@Y!MG+cbmcD%JGY1b%"SNCM`dcA
+XUMIF`CpX+)eHkMBBq28*2U$(jr!"TJh2j30XU#@E$l$0+c%qS%3-m!%PE`C1@*+
+&h!F%I#CpfqjZQCDeM`h@NA10,3R(Y(q[&3Y#@fc'rNY`K11iYR&rD&'',BK16qD
+[FUe$UIKMELYFPR@1(M2X3a(HKq-flTB3[B,#19PGk1`T*'F-!"6VR9I01jdjb1U
+)Uh,l#$YqTqTiDE'*M6241XF(%&E(#TiJ%Q6*1b$XZaqpG$9+$#2'#aM+q,d9C9A
+YlEl5'Tqe$,A8[IIqSX*ArR&L,'AG8bJFibJ3i@9MZk-@ahBRFrGi$2N3[MiN&Ge
+!lSCB4KfeE0##EI5ML!AF@iT*K$-R,#kEiN63Q)IK(%-NG%M%KT!!9hCD)+C!q('
+9K$'!K6NX1HVS5"UH-p8N)GJK'%rFEJX&f0&efX,%@lS5iSe3mATk'X4(`'hYN!"
+#,2'3!$HkNd+aQ&3V!Y-9CH8RLSa+6A%4PXr9P"@AYbY&bVY+bDR5,bY1[1LVa$8
+-FD$BH+,Q5epjHA'jM[)9'FXDG*`)b00KHU$AF84cAh-BjJIPL,&rreYQ%h0PZ32
+'@R+3!-9@QF2#ZXX'p'H5fe!KV*0fBMi`j66$lAB9-d$`2Cafk+#dCp@+!q#D!9h
+XiTlXG(r6a#Sa'#`)G!5i9j1jf,S*4&8J6-i+d$%4$eK#+CKXjXccG!b+3a)G[3b
+)r@!qQ60,D(,@6Q4*DCK0K`)i3mcpY)h,a)L`q*lL8I,F*6Z'G$3"#FY5%TLXQ&U
+%e"Z(3'[ZG*I-qX*GXRdq&Mm-C@l[&%p2d"-"62S'USB'QNJ'h-P91`EDFZq$-%J
+lrTJ!K'[k3mjY-,d2XbQBfTE,h9mJa)i"3!-LKBe0@YLB*A*Z+XJ1Pkf+a()6K$#
+GLH9kG-dABKQY6BLPZ*+0+a4%*&-Pc!6p%-U@X%Pd#L%hCa#B59LG+2l'N!$M@qK
+d1m&%M-')jiHEc9f+%mcVXL-J#Q(%3e@E-3E(9eS%(3AXL8H5Z4CEPZA[If0QC&$
+`Zfc+E4H)T3fa!mX`r8T@8r!TMUM#JMEQ4FM54'$b5hCTL`j)ZU!iGF#F2&@"3L'
++9([l+D[99e5P@)XVP1,RbT4LXe*qUXMSZqN#K9YI&TZrC,Id!Q@0kS!MX,54bH5
+6e1bU,LVS8#e)J1Sa-Z`6U%Mii1TG#&&D'B1K""b)&hCb8MdL[J#ZDZ,JUe6%)FS
+(i`5m92%%NH'VAT5Cdh56jJa-3#c)68S%E2,4-C!!$aUVHbF&UeZZ%LSkH*U%`pa
+rJ5V`!KLr#EQH*@`R'pc$(M`R"Q%jNJ14lAV`fC%Fhf+(+)5p,"P6L3,TPL)K5Jj
+$"ZN`",PM+3%Y'*r#B0HN+"iIq#Eae$LSR`%E0AbK'@[J)!Ti-LHKX(!RSH$eR'G
+1fTSSH$e(98jL&l,cL-J9UJi!XRHl0f)5lTl(LYh*B6(-2SZ*Ar",1FL`If(4J0(
+6c3kk)`'-RP#+Jh)kclC+(6!3STh8-El65aY'YN!YI''hcPkEMML1k-)A%F,ALSl
+E(FIC8eNN@Uc!kb*iQ!d66&B63#DD'UYeRU8,aMi)4mc4TAF+KMY1c,e!E,YYD&0
+1pLdL@X961hi[a%"F%F-'%SV[39$'%`qjQ+#%,kS)!R*'M*%%Jj8cT15cB&qj$(d
+NCH()1P$(PQSEE5Qr85*V8bB5Qjj1G,KdiEk)S)a6ciE%Lh@jchVJ9)d[*IrkLKP
+Bj3HSLmqC%4ZS#MrL9H*[UUN5Cc0#K"&#6IG-VYS8T%V[2VH-%HZm&m&i%r*4UX&
+eI6#+QT)'b$)SI$(-&b'qm2"&NLmLlP)l($hKiSFd0d+da"&(1QPdRVB&&DdB#+)
+NTQGK%H',CVjSS8A35&988jQSX+NLUT6%4"CpQ$&A-TJ85ZYlhV55,Q[-QeEXCY9
+#jNbVb"c*ZeR4KS,"H!-+q`T42E1UI"YRZjfLU(1b'e0R9Z,JFj&@U4K2@pmEBdq
+2LDGl98q2X+FRm241r[5%%(EYkG5iTc&eCKNpl9dRPH,GM9hKK0J@+c$ZI4'f1iM
+SFm&K5FF3AdE#pJHI*C8XX'YQ4Me49(MU`)NUTFMh-qANJH+DPj4U#0XiFPqrjLX
+p89&'r&aeYrkVb(i[B'TaA+N""IdH99Bfi(KDlLEJ*I-Y0UKd[3[%ZmLk,%"KlBX
+m,CA#k0HqM8VXDGQ1E*B&QDcKd+*Q#9+U'fSpdRUTEIi(Gi$SrEB--@)*JQB`N!#
+b66SUqHQGY+#-m*ihHCD)d$&-l3XZSk13!,AXDaebfF##E[FZ1`PJT@p)!#XkRi#
+9$Z$HG9)!+aeLN!!qN`"@p'ieX'MUKJ%#PRMmU8&'TSAjm0@`M$8CT$-2b00+[fH
+CmT+-I*,MPr[cc1ZcJRcDME"%@%&#I8@U*l&VTSr4pH6[qpFC$2X[ipVd`qF08P`
+mj-'Qa4-$l&KTD1(E)QIf+edC0U(#"3@KD-q3!2eief(rH`9(![prjeG0Rp4qUrq
+"+hmGqfRIMiFI2RG"ZEIY[Z5Km&14CeUIEYl6j'Kjr0'rHq*[Grp0ajqfhpRpEpk
+p0$SC[(Vqiq[[Zkmj$qlp5FKQqF#crr3[M[hFpAq2rSq-rrEKPeQR6YC8qFc'KK2
+lAMT38P4XrD2bLV,R#Rp@qZF[rUmErr0lIjCfkmfmR)YRhmjprI+cErcAeriLHp%
+lEbhlebAr-[XIA[LRjrrlQ[rhbVppp6prrPmqrHk+cpCpqi[-EImap6ZcPLlrqj%
+IM2h3qhrQrBH2r[f@lrrSplIriECr[1-rVIl0)lpkl)mlGfcD[2A*MEqHrlZlIc[
+RSEPr0ILA#alXrH@ZE`jmlCllekjDqIAerlcKVTRakDQ*EbaHQ,mph5#NYlJ3(21
+j)UAU1CETUe)(EQ@GBTe3'L($Ul092S'UR8Jf+U$H"k!'@5M*H"U9M(&i)qYed36
+ajVfV$*Qq*-LA!,)F!4*G'"rQppP,CHc(qmpHX%-*6)Jl3L'HG@#RVG+cGapHZqk
+mP@%c"jJa!F@Qe@ka0D&61FbkRFjECY1HpaP,Q@%6,PYX#0dG(i2LB@%dUmL6"k@
+FY")c&!P`N!!bY$m25K$(E[l!CjCCE+edi((9J4qV$Z`MCN22QYF95ZGCXc3dFdD
+'C'pB``G`b&26JSM8`kF,A`&c9K(T#cZK)2LjBmrQ"K%8@0J,YlD"II6V'9Y'@03
+#e8I6UCJIBUUUb1J5Qp`0p"K%re%DS2-06"e@A6BC#9LlkH+&NaBEVV8$dBjVbh%
+YM1Pq3L6B6NbQ42B4dKk2,(q[meBBkM%QHrPNkLdb1CL[%"$++dM4drVH#+XD4PM
+9X2"9&E[C4ZaQi5-KlmSC`@i@2S+I,e6XCTZDhE#T,c*fJ`bD&S3bK4Dp[h*Klr[
+hfrf4JmKfZ&6ELi8@l8rlqCEcmS&4q346MNeFl!mY3RKP5)4Z0$5Z4#KBB9FKN8J
+FQiarf!Q#eVL-K"`G(Qa[5mLlrM9DN!"J4(ViTJNp'm3Ue!GC5%BmJ-2K5#AHN@(
+*`*ijXjaPK*Z-j,"A9&AT4maKmd,H9EGcKmh$cqHUUR4eR-0SUT-jM)R%IDYj"`&
+Fi3-5'5kb*(+e'rJ!iPKlR8+m%&P@N4B9PbQRLT6*mJTIdBND4@FH[LS&4*h[9%P
+G,15UjkT5dq#VHDRLZ4+Pj%4&bDQbQSBlLEUdJX#X1P9f5MP4SI#+Ydjfa!Lq4cM
+"plYU#,iaX+f9LH#Arh13!&H2L%!($'iQ`dT'i&&)a-6*0MrBNmPL-lYC8#lKHV0
+1(UeeZNY3G!9jK#*H%1'ZcfP-(YhIb9`2P9S9fHIR"r@c$,cl[JESLJCd8["&AhQ
+a8P`18X9iUZa%S8mjqCcCl#YR9!FmS`6Cf&GeV3JZfmqmVSlFeHZdDcDe"q1)cPC
+b5c)A3X*#2S+d2,a')bd,+L-YQH)Q)bh"1Nd,FX1YXRmNl@3-"DU993TiE,cRd$j
++))%%C')r6Fh1F8J&D*D93G#2Llq*a0pUB))I-0Tr[8lfkpRYa'DG3*YVQB*@'Jh
+)R'%eC2A[a`#2"X$)!bD68'P9Eh4B$bp!!9(e5,IU%3qBI,mhTbUXf,-[1U3)R,T
+5E(%fVV#XVTdP8`4TFhk(Jrm"A4Yck1(dAQ@)f+e1J(*K[CX,kcHV%GE"H'(YbTj
+FYGRb&3PVJbkXAeX6,kb(Eh"Kc@dXV&p,9LHXDL&ParHrA('eX4*HLEbHJF"ZYM3
+@f10REeCJ)BSQ*UijaJM!RHFJ-2[M33h"49)6iKXRM!a!KQhN#+Mjfa-X[4*aCBB
+V`j[BLLkJ)(p)B#[C@*2Bf&KHMF+ZlD9Q(+``UEC'ST89FHDC#pLN#%Mj2QeLR$J
+fhML%Ei!,iAMP3VJ3TN13!$C3*!rcF&-iVe3Q$`DK!ZV--4j9l0"@!a@%!0'%0BV
+3d)6a1K1Jc2&h'3PH3-ER"ENr5-[U%NXHk*h!P!ifaIi$S8ikX5!YmBcCL`BSqG,
+ZZZc*#H63%59[X)S9T!T85&'T#hAd41J6SKL`fc@(Xp"R-Q+h+cf$Z9#M$9clIU4
+RD8j2$V'#5-YHqhGblMe[YdFZD&G3K#-mK%U16cEEl8KLQl,AP@[kkE8YE6hIZG9
+cLkl6NfdY`h*T@P,Zcc%[H#C)$d@qM!Hf3i3Z[B&XaHPZ)**Y(&RjcGjN,[f"`65
+*V'PrX"@K"UU3!!2*,e0NrGdT,i$)MJR6TbRTXU%"K(MF1f353KpSd)3q8'RfIc%
+&Q3!!Ja"Ddh`iI6&cqQ,"D-(k#NMe@$"0P9%JB"`QpQ+m`SbL'PXbLI!EQKkSa'T
+DL0A5S@V%UL1PSiidD)jb6UlDkUD%EhAIP+0#+5m`4qeN""X[LQThqG1%Zikdeqm
+ZQ8J8FjZ@k'fUSNp&E#i,bV("Z-@P'qfmTV1UL@UR&5@FYG61RI9*0Fl+9MQV3)M
+4eYA*h%2-H+-iAEC+A++)55+CFNBN-m0@H5)EXDf!LQhaE6HDBQV-f0M'!,BRKq[
+H'%d5'qYDA2r',U3mqQ9Y6MGN2HQZfj!!T4%&!B6&6+$$#ia0D+,C@NJ00G[S5Q)
+,%C!!*@3q-"BmN!$6)6ej)aGpFb0$LMfqHPpDb`&lS4V!$ZS#a-fjfl"9VpKUTB&
+!FTkA1bpcCNApcR-FSDH)D'R,4R9YPrE`#@CJlI'mT9`,Ud$M'(+AM'd"!0ISKZA
+af@+liqq-T&PX9Ah-A%Q)0hM(f55DY)(-f)YLX9-9b+S0IMIi&*!!c#4Q+'A'&Zl
+Zm64ff8YKZC6284@Q1--Ae&@JU52&aXTS3ck6-Z4*FqM))Qj1TF(*T*X-Ic!8+'3
++'-p!0[F)EBbT+"cK)'3+#Vb`(N[QZQ`*)kTK!6P%L$5Bj'*-HB`eZ9Y)SI,a(l&
+-Fm#)d!%-%G-#bC1aeB-NQVX4B1KJjN2UR-Fl4c48USXDr@@1Vh0+)NZ-GKlQAm"
+8(iD-!@hUjaPFbB&Yi`l&Q@&61kJqdrRii-fCcL9YjHj+L[+,-1(#I&V9bJSC3k&
+*4Z!G!L)cdib[G3R$S6GkP*%IMkS[eL6M*Q@1li+a0%"QKS"N$'Pf2#1RjPj8p8*
+KU*`"VL`L8I"JNM2Z"R!$$,4-j)`+Hl!H`+)ij[KBTPEC#fD262EF$"UbCcE%XIX
+!GmRH42-[FJ-9'UL,QXc#K(U8#pGD#,N6jRq6iPq3!$DB5rq[cHh-l59'8#XU-A)
+ANYI#P)QiXN$Mk95d&kf3!%5HU+XbGI@3!$PGS'VUdm&$p3L148p5mUH(UIRlTSZ
+cF26*N!"`04abX,,MD(2ZLJ`5&a*iEj3CejKb`R'1Z[*EU%b`+K`483%Z)S(HZN0
+j6rABkleT6DaBMcH%,5#AlI-[XQ'kBQ*&)U!23AbLZ@#c$(H0RDf"3A8Xlq4L')Z
+(f0EYSN"-Qk!+QbqH8iMi1m*#88F&#T0-bZ&IjMC,jH#1,4%SY4$4Phih[f$CF4Z
+*8SC%eY(ZVS"))4RTmm3'k,)`S1Q(M8q`-)e)-RZL$8"hrp%0U$(+2M4DY[1YjiN
+-QKk+%p8L#@iEK6E6d&KrN3XUDHD*DS"f4FAk&Flkpe61q[1PZRVDH*29%mX5-0)
+8K6i*dP5K3J)6hk0-Q8G939%Kb,$jGUP*IGAfQ[MflUaQHbCG5350VJ,P#1)jhc6
+fBD0CRDR$dX1*i),(CG3[8prdlDUFl*hD1lRUYlHKZPV(P(*-q2%V6NXe4!'EbSL
+#UIEk+cCX[*XRi&Se#@K4J3G9cPfM1TRJEV!$-39#C8k'b0$D665`j2+K[p++Yjd
+Q(G)QBqNAT#4lVNe8b00YGC'5#A,'VJSdAp#)`VZFPC%fr"J6NGkXU2A(Nj*hAHG
+*ephMj1ljH6AZXB+aT#-T5i6BSB**e`-&iN"8(Gk(0L8f`-3l)Sk6abTed@jk-*R
+,f+k6AI(kcfP$2$KrIPhZqB901mlVhqfbAC)F!6DpBE$P3Yb%+kS*8!rBX+Z&Cq2
+59cL'Y'5!,%Fc*CP!%'P1"M22k`K&``MeDP23b)`4T1Ukh"TGjd'cIba"a"5P,lE
+fV22X[Q$FLm%+95JP5cH(c6m09kGH'Z)'-DKF+VP-HB#Q(@eX%[[e4JURA'T+Aja
+)b1%2HH#!%30#qDlQ9"&&9BZK++5B6aaJBC2V@-"i$Yc,#*!!r1486H1!5IVXVpJ
+pAXdpAQXA,CPLVpI4I3Rra"p+V0@Z1Hd&PG1f-+H0`!f+jV34SE*jiE6QY)rLR)E
+T'emPTiQM'&"598#Ch6J)$V9HlmBYfJ'cm20mb(YZ4M[!'hF!63pbS+3QJ(*mY3$
++pJ-TJ&+$F&@CVa&B"2C-!&-pb-rmFDC3bNPDpcj+Q(dG#lS8`Ud#XCS+%`V4BlX
+[F06ccUZBXTHEqR8RKr33iT-CZT0C)!GUUJpRDdkf0!iMETe,6ZC93%!RBA@A(LL
+ZS!46Y,p4fURV$*1q9Nmk#jEQJf!)C'-MB8N0V!q`"P&1,)ZKmUblBfJHZB-CK9J
+'BF0@L*Z,2Z%35--h#Rl(h,*@j4D2VXL`pEVQ&M)%VS3#pSZD@kih9QEBI!HjK3*
+L1l!P@ZLZ!FbVK1T,`KZ%2%0Rc0'G`3)j8ZjLS4`TjbVGIiD8N@0)EE-UK!h195A
+`0Mf"QmdXJGf'@cb*pi5m2jkY*A'XF4)hlD)N#YIVlZhjX*&llaD&Q96AY50AF08
+qlkBCcDAd#CY"("M4$R`KlN#DAUKf+3[@DZ)'a@8KAb`1,CckXr)6CEicF#TlJ%2
+U6qC*J'P$JK&&HjJ#Bq0!rR@p'1lB'"r)rrTb(XJIE9`%Gf3`eiL2E368kLraCDj
+Z&CL8!AJ3'Lj1F2LU)6Lb0@*k@m+XT4(!YI@6[3VlC%KUpM'BDe9%6MP)N9S5*Nk
+@A&&I`+GFHR5%H*iGRkCk!-+FAdVKC2'Bi8-,hcJ3KG5*LUpNkC[S1UrU1LZZ)4"
+BX[3G#V5V1TI`cKi-d1$!%,!NA0(#AI'+&NJXMG+L*d('bI,*93pee"rmHDK$#qL
+9eNNNImV"XV3DX+6'NH`aPN%5QAh[m3%FYSB(mN63e93jf8l6Z+NP[miY,HGEqRi
+e@pUL28rU8Aj5MF2L#!mJH3d@&EU(CG1TU!bMLj3TlEc,VR9eS'YBeHAAZNkMUdI
+9CG+kV-K+$M!`LLj&khS$ABqTZNDeVKAS@Ll!bVV5Y#idcNPrJBP`&"ql'q3QZPk
+fL-J"hZMLP8UFLiqKD13c2C-JVHQi&l8KEHZ!0U6YIkJ0NFadLcD%1p+$fK"Z5hq
+#K8A)10QU%HFYPCS-0R$M9DXF-0Y4MIGUBI8BKG8$C#JS1#QMNCBlHlT##p'i58%
+E8CFm+@r)*6*92L)(SMhbLY@!ci30)XcJ2N3IZ-+Rl0L6-YV"!NQ2N3*DY*PepQL
+G`kac&ZXd@D2mL5j8+-1*6Ca1S`kQ`,B@A4fUl5@k0U(VG+,,NZJD3jFed99ZkVb
+PG6k2cMG8RBUU-`fG+e5GSeTR&ETZ6h4eNB[d!aZcp&'GT6pL9bPCUY6VL-L)CqQ
+rZ8`XA3")CqB9IejbX[J!XA1ZMC&SJPYFrT26ehp5A18ld0jZp*AGK&TA[KB-p-S
+f4M#DpZb6[BCm!Mp9XQKBd#S(idd)U&jk2e3cDQl%C)$[,B`q3"pl(%$`D*!!'I5
+LjLkBp(Zc6'cBBrBV3`rQS[,ZII"C1RKlEQ)U0R#(Q'EF!N23!)bQ[HVJKRkm1F!
+VM"9b82p`PBS&rBLcS$qZKJA0Ep`mk@DV+&4YTRZ&fH0PAYF8*QVhTj9(rr+c3j-
+LA!+eZ9V&[Mm(JDGKPE%A!B21[)eTSJ[N3HqKUdbTS,)`6bG2lN19*hHlbS!19Vj
+40pcJ6cpp!T!!QI@aq9rQ1L4ASr9V"4mEU6kB3ipa3hb@5,kV(X-6I3"XE`3&a!3
+Q'B"bPEq0M$R4rEH3!2K!f`$)BcB`cc3bE6`M!jfI5G0pZ+DF%+'kbI8"L3l6MQc
+U6[e-pYFd"6m$)BJ*EFpScrBThm+RXR,$DHb4If*2L%0f*8,Mp'$*6Md)#*'bPk3
+8UERFbIGAiq3XQMLjDUipCG@ZKrrdc[S&K5Z!$1,#pIV*K,RA0I2D(I99bSc0)23
+c[9Fc9fC1Fp2pG,XU(!4#IIU*aL*IfB!Pk9&@b55Z0V&U4M`rUJS#9GkBE)*-V*5
+"i&H)-'YLfBemM[*SlLr53Uq&ZQ)l)85fGAS@rh`R$6j&3aiaT-34dEb@Ghh)ZYE
+bVK[-+"-c1RN$+8)ZBq&S6HaC3'5!GqE@mG5`H846p86bp@hUlZ%G'e9ElBcEkQV
+9!GDi!mBUfHVYp@ceScUHLYpUNlTK*DPp*!9BeP)6PqNUl3'SF%blf'H+U1-,eM%
+J+Lr@-F%(Er,Y5MQ2Sej3,0p"Sfck[!V2hZAc5l4iM9r1eblhSc'R31KAKkZG($"
+[CHUEiX1RkmPid(-2%E%dj"YBS0VH((E0C$l(%DqPf(S!#VaZ9I23pETMR'mCL3`
+JYGq%DfC8VPQ[FXek96,MYa`cdLG5mV8NXDC3lTFS+$FpN!"bZRP6m+hN3GIP3dj
+T6ek1faJ[9Y1,pj-UcASaR++!arT%Jbd4`SaV20H3!'L`*CTL*F+#dc-`I+&51'5
+K#S!EZ6+RQHUC*jXKU+#6dV%LQ-X"Y)jSEcp4K-E5CI&YHFkJ`GYmhHRZNVP(pDD
+(8lZC8KifUK`8fjeU5EL'!JYLHe1Y$!4c"'LQ5,&Y'!CF!Y9m2Z8FQc*IZ(SUQA$
+l9*F3%'13!#0LHS1bU9U1#U5BhQrHK%E'p&Qd6Gc!1mLD1"j8J5XG3#kCHbaK3TV
+DcBYc1XLZCSXk)*mje8dXANmDccVdaeHPM8h$e*!!PMAVBd)1ikQ*8"aJ,LK&Ca&
+J(5B"dUQJkX+E20'Np'AL5#'B4d$D-X(Frdk+#c&cCr`4DP-cUXQe[,Vm4MA9C5k
+[,Uhe9*I@QkSZ0I*eG4+A&P2M+C!!9FHU88TTeLH"E$Q@D%LeqNEGkS1*KP6-[1K
+GMHBYe%3*cC'DpHHF&d%!RD2'5BTG48iGSq('Y%-I5m@PDTV%cEiYL3CD8"0X$UC
+fk`XlArMj)X!A*VlSjiXBA`aEmJ*j6)&ZK#Qci201NH-Ij&MphM4mNqF&6)XJi%m
+0EA$"NaU3!"SUQJ,9N`)eP!*P6i%kRJ,9P3*e@%GCb)![$IY',PE&8Qk1+GX-B0J
+5c#k-3['KKEU8[q[1ldcYcRm+Rm"8)5@3!"*)Z`TT"p)1T&q&p!2T"c+J3JD!$!"
+T8L&03*U!l&FKqi(X"c+Q3XD!M!(*A5mR5U6KQ!$#JA19EGUMJfL"!&(dYDEM(l`
+Y3"5p3@iBKK2JLUi)ZD+PECmmeYB5N!$hj3dcK#GeVq66SU3FJdrDG%@LqY3N9"A
+[5fYZ2,9('6TpFe1(P+&M0cI9VJbjEQlUF@ASk-e0l9+'-ZUD1[4K'Nh(0)K5p4-
+KA'rlC(TU9MJK@SeFHMEK8NpHma$%E5X3akLaIaJ6EZ#613"4#-THe23RL+BrEEc
+KiaA4P!40'JY9c5'[d'Fek$LPbh-@ab5rPGS"$@*k00`#d1H-AI608VUJc$U4B*A
+,H`5VA2l9DPMPLRJfpiGh*eIpeHbkfCbB&-rQrV$NjE1j2mbVRmdp'-IQ(Ub8c5f
+Fd0NF0I&[BSViIk+X,SGBAD[pJiY@rpMrVUcZ)Q0e1G@`ZTarYeNG'QMP8`,$!Z3
+Y6eRalA3lArUPRbm$-X#Ae-a",2YCi`jDaQ5-,iIPm2[h3bMe)ci[P&QY#FHfSN(
+T`R`(#V&34TSk63K2DJBf488,lYl8HKLI%+$18&JbY8)fD*B3HhkTG5MFjAfENAL
+$VILS-"T&`GLe[SqVUef(L1Z-JCV[XIpX`cqEm4LDD!X&T#PhNq6,%&T*JbeJNmP
+2h[BcN!$6dci[Efk&Tlqq864CM@-2*XiH(Uk'2BbP9-GjFXRNUN&R-[G[aDGHUJh
+Hd#6"'*im@eG)IrNj[T'Re4YalPRq1-XdBC[,d6apkZL2%IKErVM,*VCR5)@Jr2A
+9VejprIc%j,(*i166SdY'e`DhMpT'XdEriRc(k-A4kk2AJT1M2aZGGI9IJ[mDr1U
+S6I*r!!!Vkd&%3e)$!(*Q%&8,,DF!d@b6YpfPAXY+PPSlHjJ+elSXDbeY8j!!0!6
+eERRrbd,DG9Zd1KahDEZl&2Vq0Qf"kM$M3JY@3+9!##E%'*1ML-TJK&,IEcE!1-5
+3!%53!#MQ-!QT)*8!ib(%k6%-qrYrhlehllEEpa22R2-mjhN['fdh58Z3!!""%!"
+"S"VrEY!#4L0q0&-G"9*-QKT584p-a4kT8%CkHBJ-cRq'CI`'8k,FLS"J21bTm)P
+j6@*XEANF`F'E$-0hD1(KSXicBYlJ"%m6+U$)[m'k(Gdk$TreP6e'il"Mm#1Mm@X
+'rP$TT5'ZU36+dS[rR*Flj*Sqh+&&"Mr5Y04f20VPac"rl!ID"!a8YBe&),ZBQ0`
+KdD1'D,lRGUHdZ0f2Y5pSD%RTc@aXF"HFE!MZZXVFbl,K#m0&T-SjZ"FYdGQK,EL
+&ZTK3mCT$$@AG)QMYcjkh&b*XZe)E-58KH'h&ScKlb&JCD09dYQNJ(K$eh#(IHb!
+B4JHbbYi'N81UVB*M(He"`q92d)+2T`p6!(NdhH5Xm!iaCCICP$ehA"0G4G59`&l
+HlX&'rL5q+'`DaSH1$`Fql2KS`dF%(pd*Gpa0kNl,V-f-SUiAqUV"69Ce,&!@HQ+
+ZVjFU5VcJfjFhdhr`P6eDcR!A@rJmcQ+e8K+ccU9VB5fX$#m-c@3XCLKKrXMY2YN
+JlpV[$JAp@aZ[e,B%8l`YGFVl(chVGUFhTTj-$lScXdcZ(kRM&l5lmc*VIAKIh8$
+hVY$@"dSfBm[d&H5#2,0,rXdr%XJUU3fmSfQE0JDb(Qc(lAQUUNI#AR3A-ADdrKd
+USq6I#1&`j0IXL%%qFKDh[iTkj0Imb-,GG'4KPhaN2Ql&D%F@lPD1I*XG5@&("[L
+b&YE4NHmZchINfmU4kpL4pq8M@0E#Z9'2A-H2P$e,4mUXmK%XUqa5Y#0Pcl*ZVGR
+VfN1[VQ[hQ2eDiH3GipGG!UKf'cjZKdZJJV'-@-I3UBM%h"9Q"6Z*)AA9dI(Vc#J
+Qkr#a!XK%"cB6ipL"#h6JP[25!mI',h+J%CL'MbSi$MS`LpM'$ML+(l#-ArFq3+I
+cF4f0j8CfS&8q%)Yk`0b6YHl5h3&Y%VpCj+!E%3q@+UdI`LVIp4UR``Ah'DH$eYC
+%EACJ1J'aPIeQjIMlr2LL%)DlV$SDM!eXk`08A@aVjV$D"1HY&ih$JCdG1KV[pHb
+!3*A&$KbK!rrM-qF$*9BFX)lSXhFCjl%$#DSUGL!TfS&&06MJk00R(cA1C3GdqF$
+e83q-JrSK44RFP&Jj+dUX#L['J"@M'5Y'bkaB!9D-)9D`ic9d""dhVA!h3!2aLaj
+[6bBFGkRmmPI&Abi8SlbXLr*bE['ACCGX,k&1J,S*e'CaR0ZG5JjaJC0$R(3-ER+
+AkK3pQj!!1+"Tdr1!dL$JDJ*Ckmc-#CB&J!,UilVhq5-e@lLP6EGT1VE9"dZ9PfE
+f-LapZFK4r1@kpk8[-@JF9FA!5V$'UMiZUZ'2LTK3mHd@M5XZZX3DC3NedTI%)0j
+N0L,NS64He'##D3V$8ZTM'"T(q`F'p0lLd%4"#kQ(c6pX#,B8A2(,$[Ll1*bCk[C
+RTJITr6A9%8p+hADbcYe5Gc+cT3'[hEZmep+M#qp-Ur$8U-*65AJU&dl"-EJZ#!a
+XdlUG'Q!*X-%f#f4Q&9`*URY0qK(IUk'P,RJbUhP0e+EU%QpSZ&)FF$*rYq'GfY6
+N5&8CV`KkVf&Eil@XNlA[*&FD#8-+KT',Ze+E%UccTcGHHa6LKSZ'Bi415N'd$TC
+HdJLmGX"&')fj3rkN5pM30CABR`!LCkp#&dPAIbbq1m(!&[2q+ipb#6D&6!8R8rI
+k6fDQ*dIFYAcLhQfmQRcZA$[8L&FpPMH(H'P"Q1T&+``fT4eGkK9@(&hLf+!%U3r
+qm&@MbkkL53KSJUkE,M(YL**Q4G+!*Y8,bf395jep0Q"kZaBTAB0ZK!!kZ[60)+2
+6Nik1-SjfKBq1dZcaZaSlHVCVEH)*-9BREMiG$$rHjjU+MV5LRKZljZ@CrIIh@'i
+#12r`NZrK+"SNHq1Z5$H%YMfa4SZNG0&M#!2L!A[&@pV"Ze`$)#c$`f#P`X6H`G)
+1c6YN-RjQpMRb)#$84'*U2a0MD!TlZG+Y$DBV,EA*dGLlPE`S9cSL9GS"TIAS5PY
+*k4-BT)[KkT4qH2($)'Jq9T8@D$K8GU4-"D'K3f9#J,YFGPR4%8+@h#&#&epAr%4
+SbN!68lH#U@X3`bVCChkhYF%A6+DkUA*c"$904L6TV3)a4',4'!EhQKSENL1AIr%
+G2jh2c0r%pMDDJV9CM5R"kVEH5eXhq[h*f6SphflI)@%TQAA0,L)kJS[kKR,k0kV
+mY[)D-hAM4N(f(K4`"`M)0R*hTPiaGPqj99Y+#,kB%*`4(3c*Hfe)EUI(E)ENr4A
+llh*e[4+@S[GqlF!3QT3M[%P*2T)h!i4X[GB-NYH[Z*88$d0YR4-P8$amAhPFHpK
+`Ni,NXZ)lC84h%+*$EIe52M5r4'JZ0k'%l0P6,NQ4rG1-)(ZD3+q-)h[eFKpSC+p
+qkq3Kqcf"YICq$aELkk(QaeZH@dj*UchPK!MH8lQRH*!!bc,q,r[C6`pp$8*(TaY
+jq'-pjDcamY+VdPZ4*,ZIAT!!B[`,0(Y618QXM8EBCK+!J%VqiZh@Kl,+6KR[f6f
+ll"5pCX6'jRJ!@BVLm!8&-ES(5`Fd"YDc)6M@HmY@VCH%!lPkN!$b`B(PE3V9i`3
+UCh,f0HIi-ZaD-XDm'KIl#GLB9a-iC-bE`jJh4fA0RTrQBaiV9-l-HcE$c'ZQ)'8
+B9I-aEapRRT4eqC!!ETE#Z$$G4'1FM@er[kM@q%#K@JX&kUb%&NMmXS`bhK-UYqU
+GGRV-,NF!GJU&RX5mZ"h*APDYh4qD[8fEK"3,q[QVMlViCh'b'J4[hSKGh-@'&E%
+8fAYFQ[DCZ1ZKE9Ulm4p05-rUkM2qieRcEL@`mZEL!d-B-NhFbSCX8SCXBN0LmT!
+!Uf+Hk%@ST,e2ImKVr0e$YFEI'8Z3!+453UR"(Xdr)"l&&kqDFYMa9mqD%CLTX*m
+@mfCl%3cc-Z'2ipMMaR8)UUc!L`A'43$fN!"m`)iX@Qj'q&i*ek"bbRLB'&dKRfS
+jBMC86D"6PAlH4RVj)"Me@c"P)k8pf+S@cGFh6%CdSRi$),H(UIpE9kHB63[[d-8
+G@1),bK*I`"*h'-Zaa'bfQ)9BbN*+8N15XQdCYbR"DQb(3-Um42C$fk()DiU3!0I
+1QQqaD1d)C5Im"pPAUpJAUmkD43pY#J#baAiDAbd`VQ3$hQ!UVf6$hQ!U)pN2eGa
++S+CPr-3ek#3GhB0#mH2lq5-&fA2,U@2C-RlM[)#A+Q4bH3JN"C+U+F54LdH@Z%f
+hpe[j-2i#3pr+C8&12"C3#26hfbK%Md&M5448f`#NljkGKfjLUUJUTD*Hab*IVcY
+L1)h8PSrp(9K%eE[EY(lMCJ6(0KHbi"JkHVV%RHKH)Z5E)L2I#68mCHleTepTf&C
+G#DU(l%fEqe$FVX(Q2QS-Mp*p2+$1Y['"FVDEL&h%(#,)!p[c%H1EE-5i6Ge&(d$
+G+8cG+DSblhA(!qLQ'E%T5"eB8+b0#IUj8mI9L05Kj[+YhVF0J91eb1cBj86qTch
+#&CAiaj3DP[*j0DFeKiUHVqmY63'flDRGJ9Cd[8R!ka%3aTqDd8P9q&D1jiLrX&A
+cK2eG8)"e@Qf[p""aARK9mm63+8D*edJD$lHbCAp('YC+qkU[DR,hIVqD3Yb(0$b
+f@,XT3S9ILicN82(h!cb-Qc[Id-*``EG+f"SKXMHh@$$PDM1U@U&U'92eDJl8+C*
+&Qdaf`d@iY4i2TS(jZMfAdb-F#ABi20M%EaZkUr0PeX@YX#GVJmG-S,e%@#*I9ef
+EdPdA33HM%!IiIZDS"[$G`Cf!1aqJRABZCJ$-jSN8+UZGQ4L2`X51'+Z+)L)fI(C
+28kfN%R,DcMI$BL3I'EpL,$kIidRb55Y[[3QeM'N@EIiN*MM"Q,h2dj4qd)RCdN1
+VU$(3f[)31+#2`fCI`K9[e9`MV6RiBU"1Cih42KZK9JV4VUQYK5jEK44JLm+hY1'
+`H!5*`U`,16`IiC2UUl#rZ5T8$kBA@)Ai&$U3!$XNZr6-I-4,fUXcHD6,1V9L@31
+EK1+T&Gi'aREkRXDV0Rqf6'bf`dRVq#KNNfU@bCA@0PL+aR8CT@)",*J!9YJ93H@
+XJHj(`p#'$cZl&I!BB4h5!VDa!-bS3iFq8S@e&b0Y)'F6"m1"bi&rB@M"1[-D2r-
+!(E,)F9M&1c4VhKZD&@%JZlKA5i6Hd",fbkML)bi(ZZ*CPpHf)Zm34b)r(3T6U#Y
+NpZqFM@f-mciLT'XRp#YG*ZTSrZH**kS,,f'BRBC4k)%8bLN,6B'B0Z-BL'N,DNB
+['c)+#4E+)"$e$ZTq3*2q"`!GTakUeAjJA)0$#6D&DNh!($!!I,UAUDGdidX8l#9
+!""08V(QVQ*)4HS(1P`4#QBQZ6FB('@$c)%Kp(-E([DV#%,UHJ@6VQG**E1#DN!$
+j#f8a!+eS39@NKME@ZIMLF+95J0IC#R!FU4+B&,Te0ffQ0'G#*AId,!fMNc&dEXP
++QD&,'%2RLPZECHJ5QD(E3Nf-REG$5&Y`PX,-frN!J*kV180pmGepfJqNbm#50c"
+e0l#P*$%3G$@8A-fD&cXrb#B,KLN43bjF2m`IMNplkFU8%b!L[-'KC#08V(L"X6b
+ALScIbP#kKm+,l(8RN!#5!IHq!h,$JDpG(8UK#KI3X1kmP640#5(**2V#hU3)32)
+)KDBF2%LcTeM)181VPcD@V(JAS(MVrJ0TEpCpV&"Vmk6Z6#lJBIP4PamGY)@[6aC
+T9CdlGHJ`B90)B5!VTSP4X&Dmi'SP"mPF%E&Q1f1S[I--VrSIMSNMM1F+1#1`08V
+cikR!P+%c#+HaJe[,iKT2$&*&GHiN8A*&F8BV)2@9j'%)"kNrMH*1Yc''ec+'E`0
+LVj9CRXM2FU$fcaPUraaXjiLp&SLpPM1rF&rDQ8q-42(5M6@fB#(F53fa'kjX,Q2
+Y355-eC!!NpLYU5bQLDYJmVCL6U*+BI1R0MBM,Dh+1-D$G,*'N5E2+k*SFSI#H",
+(@"q4$&#UJ'r&e,fGXbVR2C!!VRmdrK0$(#eR4'Q8`c591kkEl*[,rIUjlFJ'lEm
+D$M9*'E"d#3E0`iYKaSCDGX-B`BV8*JJPK9YFVUJ05d,5X%a9'aE'UL)qf(m!C"H
+@JfNMj,6#aY&SY-)2,m%NIk4q)C8KI'iA(Np`Tq#"+&qkb9jL$Nj`TB""BaSr",2
+')#f[%bK)5B8+JlKE)"EjpV!0+T30+R%EAVUN3qrM@e4LLk0ih-&85P!M!FDY##D
+aE9C5SUMXj[B8kf6,)"UcN!#UhK0!j6YQ9S'K0h,"a6S#-baBGCqmH*4ZJ4-`C`$
+F$Z2))!2k"T`!2[VL%J1126,4FCD)$PrKphk*`P)Y3#dHPaeXEfTkBd-`Z39rT8S
+F@XEIepEM33*d0FPf$'fl+4$"N[`B%*!!aM5rPEDLKfeQF'+GUZT1PRbSK$ZYl-'
+U#5`&JJ#Y6TS#cC-eC**dV%+5MP&*8LE)4TD1b8H@rXbf13h&a2*ST1Pbjf%63Cl
+bC"U&40dDM@"23`S'rqCCpkjM*hCSb5E'hiIU6c*Lr%Q9'(rPe#%PaKp,)c'H`35
+3!',%q#4*Xph$dQ!PK@B2T8iNmBkI!iHF*+m[c53C*2PY'5,*LbRF5`U(E3Sh3jK
+lTB5jCr#3!",QhJ`6jSHNqqZ3!",QmI20-2SpB[6e0NBA)mqVST!!jeiTHDk`A(T
+SA6(b[0r9$[+meiNmliMHMIU!NqVH4d@U(qT14QG5ADFN)jF@)r!bj$[!L282C'"
+[8JD)G9A8[LMNZPFQelhBk$'!C58+ZEkXPj(V0*AjN!!3kdPX'BApC*`"+-B4c9m
+J)GX(9E*GLJ5B!T%Q)Ylj%*'BA1e#DlBc8GpK)qU,(k,%9Fh"&bFKp#HrLm*RV1+
+%2NYZVD+T(-NNmpFbmRfY61C[M%,QFhD&D5XT`j`*rTaqVQ61cM56r*T@,Qjp48,
+dlqU3!$BSM1!ZN!#3!2k$+ZPIV&,5%!LSVP+d@GR5d)"QV,8&"iSI!NPeRl4LI#1
+B1Z53!+V`,J8-U&Sf506Jj09pB09p2Xl1EUNB[blLTDC4-+8r3d'%qK,kU%(R4Kl
+ffi))I!NY9*MprDbSG9#kLP8,U88M&i8Qc)-*20d0`1))qqSp1Cc!KrBGTS##,GQ
+&K4Ak,pYHbFU4'BFMUU'(0)3BkNPm4'",-46"R0*f4[+QC"4Bm5N159Z4`9"$Vc6
+8)'fZd1LS3UF4-bJCRj*Q+"dI,b[)eA15K!fVBa9J#cZdAfSZl("[G@'(`*K,qF)
+14pqka013!*5d(0RTa96$&I@%(qVVd$0%Db)+Cl(UZ-UU`i6LmU"F)4hj+`4&TBB
+9P4Uj8RK"H4!&j8'eDJSl-a5)m,*!a%DjF5S5b@`%K5(ZCkbQ--4'Tc"%1aPeL4U
+'@+1`hH!8KPM$`K"VmS8KeUJ93H+LKb'1[X@hBNU29BZ(iMB2B,VK@1-'*4cK8F-
+4FAh$(2ShDXi0j690Q#)b$k'**KDD1)(34+&6D!+TD`K2d%6FpAMCTi3ReN[$%c!
+NXi%aSY@9mZM#%c!`dd4E5N)8KQC#&&GCm'#+UjD&+,Da%-8Se`PTL#)`4JTHXd#
+&`,DUN!"XaB-9KRU#&D18B-@Ea1S-"#[U6Gh1(kb3!*Z)jf[-D3aFe,Y*P-$&a3`
+6*@Vi`UZ',a5!@!eIH"q`m%9pMN-5[YMi2b9mXA&F2H%,Vabq#$Q&,cJ42eBKiXH
+S42`$&,ji,1hKLhV6$56K#iC3ST+QVJ5"LaAk$K6kP8UK4c&#J&`Yp%9USBpVeKJ
+&b*5'*1'K5DIGLSS*YHXK4+##Y+P48!CC$bNrbVJq"3q)#R5NKbP`-+S#FTJq6FZ
+[2TC8S+ESlZZ&m4lGmfVCTrkLd+YP6pf49IC8fDIaf@@ILMZXhJ35l6HM%+6dL,(
+90+&k0%r+I6-JHTFLC6FH515*45LmQVE&0S8h`DI`fLhMEiJR@#'bM&pGN5JAGm5
+pqEFD`9E@*$&T-iM+)+C-VZi@Nd*QN!#UI0V[E@bDC&MCR,Rj2lRijYC!r)3e6h4
+JUhMHDfKN4V5`2bbHF"@@EV(U[Liq@9""F%cC1M!%eSIMTe49a"h$p[c++"1HH3"
+SPpYp"Fl%Ic)ef+*1bNeYHFF8*!4`ZqP&rN#9`Zpf&*&YMI"%GCJG@ic9Lb8-@!a
+@,miJUaFABl8$)4Z'6)G(B0L$XpPT'l"jmIqLE2jQF6B$Ad(YTejY!DiLD64Mh-l
+2lLd54Q`"ZlFF1RCRhbZcffNEX([,rilX[TBmGUmJGP-k+Far18b16mfT[&Yc"CQ
+F#Ac!$)mL#40'+#IL`aj)ekc$)h,6iaJXMF#X(&aLM-bM`%hZ9m*J5IM3AEe-f*[
+RFf"'GB`&%`53!!jC$8(YFL#S`mchcY`bFL1#ZKFEACKB-#D4VL8LG`8U!SZMZQL
+Va%AE94GYVk#%#B4SLMLj5B'($SdQ"M%R2$8d*p48FM(VVba`CjFC[2pDA@C,X$d
+CIG2F6-XDeD6D@eSVM!NLP"M@FS#'kimapBer$*Ahk5B(1Q`jNkFRpMkDKJF33*J
+kYa9aQd06a&LSLGJiX8)RJlCVKUr(cara-@VB%6$PDS'pU,ilj1V$91&Z,8+*&Q'
+PqZ+SYUP+pE@j)T38S&6,U*PE1Qjd*6e%!2BIZ@S`6cH*0AGpeTLRb8HL%hN9G-$
+H(p!S6B356jfD[b*2KAmH#`hpdCEq5FhJJZ3fJfZU3H!a$)81U#MdD0MF%@DS``@
+2'kK3d'F9X9JT))c*T(V!Y%eM,jd,LVeB3BP)#NS5"ApG!QFZ@'VhpF@6X(`5NFK
+ViLcYVBkP6E8fPR*%rLka0$PiA-#G3UA+e+X`)1Z)-53fB"Q9ZH8M1Md`i*R-BbG
+4Ke-qCGX)($dBSb!T!Dp3YNZ#9ZQZl8J+U82&9)V(BAaTG-V69%%$IaGS#Lc*3"&
+[)QDb)Kj6LcM[D'9**ed,)6Vi)TCrK#(U#6*0V"Ec+l80fc,p,FRY*LhZ-YA!c+K
+L6V-V68jcM`3CLPcl&A&[RLq8h@CK"YaQ`32J0MRSl9"3rr(q$,M0kU(`c'[0ZXd
+Da@f1c9EGTKV8+$a%MP1YZ*p@icV(CX"e@P&jGU85"e`(HEM6fAQq5`9mV1`mqjM
+cl'I1Xk-HjmNV3)Il[-%Tp0#mmkb(!)VL2&@@9$*8q[!3ZNp9p0Zb!he4iN$(CYL
+"(R3#0"a-[-"Cc&aS2h1K(I@i8*@a6E8UBp2L3T["kImRZ0$k3M@,B@cR"Ep*6@!
+i8@3CAlB1,&R-Q*&9YSi(C!M8CN'0$C*8L+bb&fPkbYZp#-iXjLCjLL8qG,&M@fc
+(Q0'H&fJECKiU0IeN!bhBl33NUjhr#"Z#E,"(*aZq+)%TS#*ek4m)-0*BbDIhV9j
+Z-SE-RSMrIM+-6H&(HSN*0[cJ3CE%S4JEqGUUBS[ZiC2l[j9eFQr3AId+HGM#6KF
++B8Cli6ME%PY,TU4d[0+P"TL'jSUHdL8pqSERkGqSjqHAejcq@h0%bckeD0Q"SH!
+0E1S0$`GG5QR%[$jhIJTj+dd%T[qm-rG(rI`ECJ8Pkf6$APY!%3[S3Y"YkX*E8j'
+3!"l"XU3,'G!)b3`9(Sf#m&M!,i-EL+"4!RllXAe$kXRDk'ZSCR1qY13X`9Gm#6p
+8Pe$Ef*,a04#k6&I#MQ5dcllSPbPpPlV8cT%F,4MZMlQS`a9KCX[ifq[H0HQDF6T
+ef8`bXmA-Cq&2AKNp@%a,ia@6#H4CP"T4eFl)PU25XLALeXe[#@-9C,U$)4a#RQe
+2,%XTXNF#jRE$%mZ#piJRV0`XaGd3Gbdc*9JE&Cp5kImeC`0X+JS2,&U@dSd%kEC
+A$NT-BNb#'c3X@ZBG#QjN+-X0HCc$0V8RkqTX`ICLD*[U6C8hfNfALA$B'*3L-fG
+&AAqrVP&b"L81`68QQA3!&bh0$)kTJkRE2+)e-c4*1[3J($Pef&$cda81R!lmKK+
+)X'%10JcEMp!AICVK)Pi98QUl2D`10cb$Pj4Lm[0Q0K0P&3id-m`Z8E5IdTDE'5c
+)Jm-QPmYPhk1pkASkM3F%9lpNk)$c8(D*$,1k%!Jfmk3YMCZTiRl2rdk8UP94TiF
+&q'q)pj6IMB*2`FQUXHc'SHPh!Ch3MISkZJJGF,k,DATejb-)eaaMU0-Z$AdVXP2
+*j%%eaEcJF,TUUN8amcL*YNZ8Sr[$iD-d*4jDFL&)8q4,iJ&6aDb8Na&'lYUG66$
++qpZFZV43@`HkU$QANl[*K'E--[i2G8K!kdGh88kE186&H9kD(%JUP3dUJ4RCE%h
+pQd9c(F8ffdHG@ffPC"6$UG-4Vd@mlZl3VE(lTTcA2UY)XCr2L4qTQB0P&,TfdQX
+b`iZ"pZU0Tl$153aC5P-l)k`cTR[TBY`NHXVY58!Y$V)X`))EVmMmcamfflSVP-Q
+G4iKqi8&#6Nl%TS)Tap$NS`@fU!TBp3e6k0qS+I2+DbSkBNJrJmQ,2Qec8iVMI%l
+(pI(Vr6TAU-DQd*&U&5*PPLM+K1rM#KNN#R(![jdDlYVQpD&D#$'hki9HULYRD5@
+mH6bm#JKpUkd6Ld6r59T+mJ[H*4F*U4J!1QY(T8P-UV-BeZP*jN8QETk3!*j%6B`
+VV)UBQ3Ap-QhKc%cmMq)#(-`&(-$@[*!!@k8lYbp`(`h@"ZX!59@M5(&KDb[5,-a
+*(8`A8)bS*MDalXB`TTb2aS@aHJ&-KTf-Sq*L4R%c%RE$Z"5%a05S2*'m5TR1lP(
+0QCU[1EQZ3fpDe&[0GdS4S-jdT*3U`1[pZFUNk8aQd-Y"aZUD3@IZ-"iMcqk6-IE
+ClmUcPV'ikN-ZDYckC$SYV+@a6MA%G&JaCcHG-jdP[6*dr+T@lID&!Fpp$&%C!*l
+E"pDLdhDe)H"9c*!!-D1'pdH8#GQLBPa,G-,Gr#b48BI-ia#"CqAQQZd`q6Y#h3,
++9(X3$Spi02f4R9VB@K%2Jd!$mBl+ea-cFdrP0INVCE-e2j6DUPh3khCI$DD5TUE
+'&2IKG(8K#f`X`&YD4fMVBG9S$BLLbB&hL*!!8%a"[Xf*%j[48K"FbiLFmLFa8QJ
+CA[aDZINeERkPh2`+0cp4ERk#QpZ8QpY`Xe5j@BUEqFV0I0aFTpaFKjZjbXeFh2a
+BZINaEQj3EQl!c8h+c8hb4DYDBD1"#&D3!*Kh#'Ace"I228j$,TmXD+aV88a8[PS
+fchm*2qXE$qEK4jaGYRieJ)Z29SJ!Ff&D'5pVfA6#m#EFE239L9PP'`FRG1*'4C!
+!jjJ$V3LfCVCSXYJ061!'#0a!!XYX!MI8hSZI+LDULSQUHRd-LEMSGNZ%U)AI&$1
+Mq--d-K8,acNN(ZL9FBphMRG1jmY%3TUUB)MF`6Z601e!0Rq"!lUTdN"T#Mr94j-
+`q[T[2'4`3A8#,h8#!IE#qG5Ld&a*EC'6m"JDdL9F)1)e)'1,2TUQmb%GiqR%mDZ
+9lmqdaNSZTqa,)1%&Yj2,QP)+VE&&[r36FZSB0URNFV"'M%fiA1G&)AB-(q(E(pJ
+%3fT-j#1NaQL%#9JRfpqX%6hH)GA8e&0m@3eA#YL6CL03V8Sb0bh"p1qrQ5NHAlS
+N%6"pl6F6cZ'##PadiX52$FqGLRIjHX@YCf$U$N$@ATB#i6J6)X2-H036Fl"e&fh
+pr`F6jI,0cbMTee@8Q(-'Jr!"pF@3!'&#A0[mQUDRKKrCbSbI-ZGcLLmb2E0@A5$
+-FPf`+Se2AHAb8P2Kk9*6q236!1Nj%drFC(KZcJ[AqF2aec8(([61QCd3M-X$`1R
+GQFQ@LKmm1M$Fc3QJ+AbM+l@5VFK9QR+!&2DlF9(9RNh-p&8EQS$`k9)m4RaGY$N
+KLqArk"TH6h$TG(Zh@4p03LIR+Db9eV`+@,'JkIP+keh,+Nb&KJU9D)KVLH-r(J@
+@6$HJ#a1A+BbTAh9S`pM%8$&-,#$AU+!K+[d)5,bN#4`j13*N-d2P9Yr!ZEfN*L9
+-h3QAGSiBlX%,Z9[b+AQ4$DEd60X#p3K62f`Sp6qGH!59AQJik`Z,aeb$m@2I@fk
+krMFc6CA%r[PRPjZECZ,VQIkLeXSYTI21RUN)M'B%TrHMAk!$&99LBlb9QKfidcY
+2d#AZN!"1FHc%Rb0f"M,)#mN+e[Q#EPa'33DZ`a(eXRLSiTNG@Xrak`bQ`X4%`eP
+r#)Xi1rmbAj!!iI4T[T6`QG14dHa4"p+q%+%8f["T2-5c&f*4eMH!'(2pKCfcSU%
+%PL4'@e*YX,A&KKLH9crTaT6pV%qkHbD)Mpej6![IM4Yd'q0(I2k1BjpdZiVSTqI
+jZipaNf!98L5q3#Vel0A#,rc5AcMc&`[(Ip,Y$p-"m8DIhM16Lk4NrmkCiM(Z4-V
+GcZK*S6qki'a5NkECrlD`b@LmAA-dJ@l68T*`SDFFZK3MFmeY#)-9+8PH%CLeBbM
+bp"lqm''k5+l+SCURI)UfJ,,Ah!A16U'I0N1Prf"qdh*c2-IN,6'R&&leLV2"L#4
+5fk@%)MmFLk5D31+iiXJ'N8#Y&pJfAJG!kS)AiC`l2$Jd!YF@AN6Uce125jEE*6f
+'$[rMhR+9L2QHdUDL3lfZ-FYpp53eZShT$C)&Jm@2cH%&#CG2NKfcUC!!dX`063J
+JGh((6CH2"5)erG5XQXZRS+h#S%e+3,DI(#IIr118B$hEmq+0k6L1-d6@dK6`0QU
+F(ZaCDNJ%cRMaC9GZ%ejhpc#eMi34i`ACd+U*4r,S8VNAcrrRqXYdJi[PR8l0KE0
+GBTd$S#4Xp4bD4fp&fFAJ+YULc*`b)0dJ9-&I"pGBjp$#kaam#SYPr'FVPKTbb`%
+FHF&51%$9L8cHPGPDRD2VlVfUlB$LVR$ZU4#TV'qHA$!'*N5Ga-B$ZHA@J'H#(j0
+MIr!QIHAq8)))ZEMFVZHjmJlG-%&eKeB03&Z4Z%2d)VP6Gl%Qf&MjQ,PZc'fRKc9
+-ah-!HHiLN!#+9k"V5[`8%$f5b,B#a%6k+K+%Fm[9T["Mj`VeClB'8jbV0**I%3F
+T3Q$$FkIbUf-PGI4cB*1i8cb&C",G,bDb%@DJk5T+DVCV+K84+,J#EQKRj`39T2a
+kIZ3UYTKKQMLP-mCB66YKCN!2fP8!kH5-4)"5#G8Aa%CE%10L&T1Y14F5Q+rI!`B
+II`j9DjL!a2b3!-c50iLP52AI@@)ZQ!U'XLDRi%1N8bTT[kkTZA+aU2$A"B-5N!!
++l'V[hj0M-%$T&3'IdUfdr5cFJ`I&rS6R$QfU6fR'8YZal)1&HkHrJJXdl08-B&d
+4*SKeB!Lj`40LNAqG#Nc0!Bc2-NfKMFd9XZU4EQKA0UcNDDaAME3T"+fhQH+&+'k
+l5KC&VTdDVaklQ*0hQP)UfLDL%k93ZpQIe28TdVFGl,E)(mEYcD(Rq6$rcj33%I!
+I-c0DH-h"LF+C"K[U%9h%40qXL,kCL5jb&[epQqL@aRb#@GSTM$*V#Ib)5&keDK(
+$+QfN&)QXH"9")"BLRR46LfTbShr((kbcXBe0Af@-5UNdjC!!19!bM)!dFSK#L#b
+!JN32hF0N[RI2)%!d8f'*Q8hC)M,0kL(M'%`aN@i4A"&MVKlUX-+dQ!JZ4Kr6M[M
+YUKLfdCX!66@e#TiN#ZeN5Y5&89FANYflilS[qpa@c4T9h#k3!%Rj&bV33QPTY0"
+LbfY6PbFVMZ4EZIP688*GNCaSbJK9%Y1"5R,B%%e*,&PX4d"aM4l4B1`A&kb&)Bf
+TTPl!E1&lG6)ejlHc#@`hN`KfB*BT9Q,1kV1(ml3rk,KQmiE#$X`)d%ph%"P#+8D
+SK(j8Cq`,-`*jlIT%-FIe)4qNd5AqGAlK!+j%X*dCP`#"L14`Ucp1#r!lE&Zkl2`
+SHq93&Q'R,N9TakqDf(V+lBBP9MF4mjT6P6LJ(+Pj)@ShCCfLGKJr1M0rSV1!j01
+N8,S)KDcXiM0@@3dA-ih-4,T%rK#+rH&#B8aPac-GYL(%LPXfD4IdL8K6Gl$8V`Y
+UY9fm8SXPTqCE,V[BTH&pUUEMFY@&28f+SBF)SE+I'8DX[CeARcq!9)hHj94Y0mB
+Tb0m,!,M*"j-!0)Q4Uba2hd6k!#Tb[Ub1D#Y+Z80F),qN0+8@j+[qFDBN3SiDCFK
+KT3ZHd"h*r+*IP&6ZVF4Lhe3R%8p,+mm1YUJ#"c4CC$r5rA96%DZ)qJ3@X3FRTJ)
+0B)AB#3hJC1%NA[e+p0-&[8(+il'2-a#ATL*$H`k2N!#0-)QTm!lK+p(9CIP[G&Q
+Q1`*P943Fq%UmQN21PaAme'e""9jS9+HB-b+FT9"Q&RM-E"-VAIL&Zr&KkKCNcDa
+Q6CL"B*098)#U3bkqe20[NeZGi'k*Z(h1iVa$A0K,EMI,M(&H*$G(rj,D"$PpUES
+*0$+%q&k*Nb#`8P!ET,M'h061`3Qi&[PfD[)k*m1jK@(`F)Ke6(5V65+3!*8Z4Q@
+E(-m+k%8rfeh,jbk,r'b$e0%dREdD0e@Q1L890IdFMGq8)LaerQLaS%2UEU3$$TZ
+jmmq(j%Am!!4kf8A2P+hc1&#Y02rT"C4`A`mk+Zi+6Mr#%9-Zk(lQR5ANH6Y8A*k
+*MBlCFr)dL3)j"8QH4l5E-FRkEU"H!Q,lfKl"JY(FLSpS%CF)JLp4qL!!m%Hd5I2
+,@H-E#j)KS-,$jXPQ-BH(LI`Y`A3e8+F#9A[(XY#@mTfN5dDh-Gc'B+S+6&&APk(
+Pp$JccQmYaSi"#6[NJpSDhN$lfcVa``rX(4[AEN*$"c2EKI5PVmkjJVm`qeam1iP
+Md&P+5mbrL`'aD!K6LN!365U"S&5GXpl96ep1D!+DS[X#Nm3S@5JbJ3HlV&,%F#A
+a@m@"GJ,!l39!18+0-S@G!f33S'Y`*R1DGPpE&0AXj0$CTFZ8kPB"5V#IjU6Ef'q
+AGPbNRqI9`-G%'e,ES3D`,fB&Xh$T&9[`K5%2JVpd'ABBpM+*)(G!G*PL(6IZ[(`
+V,Mm`lE*i,25m[5R[X[mH!!i$BL`JG!SpXCE)kYGKmMAfPh,ckB[QM[#D*dH1q#D
+*ah+I&j[5rJ1abplDI@[&4MTH*,qmaa6EBQCN$Gqm`Rq2fJ8'GicdR(5%)V)80FL
+j'ZI"Z@j8A"m#cCQ0EY!0YX!QN9ZrhkH!ZJh[0,J9q&m&(0rFV3LR,bAJZdcZSdR
+25M)PPG!Ii3#Qa#M9h6,q+ra4,Ck$UH+%ej5cb1!Vl*c*(SV)"6(3J`Vm!0ef[Xa
+$`6"0'aZF6)#@@VQAd8R3%*4FZSKG-)-9S'fbbmbQPkCqd(T(UR5@,[BH2LkjpK0
+`emMqf!@&9ZdRfK'!&U*fa$9!Ak6EREk`Df5%`H&+UX-I3D(1b![fC6pP1MJ$jY3
+4FPpjY9dKV&2TQ@ZSJ&36%TM`pd1Kmq9r+KF16rRqU5m[@m*VkDqPYUUUDJNq,1k
+[I8eS%CSXHhEHE(R@mY$RA`S"I*3q-mh5mFrVa`Q,KFFY'baZi3A,+X%rIRQ*-)Y
+Hri2`IcY[Y[aHq-5bQ,ffp,iS[24ABHCIGbckhHSTclcmfM1GIhkU-qQPTX[#0`A
+I'jp-#EMK$65Y`r,PfVA#IkeGHh6mei@QV`[R[bk8rV2`m2F[0`P2I9diB"Qrii$
+`AjE41qke[2Mj0li5r[[Rici9rSc2(CrYFPKL@pm4(RZ$,S#VrDY!kbkiD,QHba-
+1#i'U+L',r4Mah8H@2ChAK21@(`K[6aBZ@rlK2jCECN`@2[aBH%IiI),`iLIM,$%
+m62LmA,JGkRj,q0fiji8T`X,268m*PKR#XLF&pm8RK*52KI2#f3R#ki*PR1A1caZ
+%9crIDfRrr%r#,i3b(*JPr-[R"8m*hj`KV1F(JM0Q,C`adh+AX&$iq63KEiE`JA"
+dKR"#q2BdBI)d)AZ'N!!V"'B)JhMaTI$"-pm[%AB+PUd[rFk5KfAPPVmKl(VTAkG
+mH9&iiVH@LA-UK-"I9Ui@K'N93YNU)I"'qFU,(mpj9CLelZAI#`9I#UNc5S@KH8+
+SiUr2Arc@UE*Cii5KFZ(T9kF*re%U,!B!N!-B!!!Kq!!!8c!!N!-)!*!$)!!!2c`
+!"kR`!*!$#PM!!&h!!!"G`!#3!aTZ!*!$!AB!6R&+JfBL3Hd!)#!m2c`!!#)mUI!
+!!8T"CJ4+3'F+5%")35#!)8%!"%+R3IVrcY$m!3![##mm!!!CELm$B3!#V&52Cd"
+#1!TH3UF[2%4"9%%r2!69U"p`!4(!#Pj+RfFB6R%`2+P`TdC$qJ!U)SK"qJ!J-$b
+TF+C(5S0R"(!"6R91l3!L6R&+JfB#UI4`!%jeB!B!N!8"6R%I1[rf5KpQ%NMRi1"
+"q[rU80"1ZJ@Z60m("bmkrpj1G@"b38a"4%4$69!!!`#30&"b3@e)jf$`G&#I`Lp
+)!#!J6b*8-@N!&!!B)8!!*$&m!!%!,0+4)8%!,U!#hm*-h`m'6R9+1!THC``J+J!
+)C``J3#!3C`B[1[q%6R9)jam'3IVrRR!-)LS!"-+i!aTKT'B!!6j)H[q16VS(EPK
+2X(Vr@QB!!3kK'Li)##S!3!!%C`BJH!+QS"XX+J!%+LS!#"JU!!5Ae*A8)$Vr9U%
+H2cJ#)'B!!1a86ba))$Vr4#)'`VJ$'PK"B3$r6#!krcc!Z!-D3IVr1##!5S9Q"+%
+LB!3J4D!RCJ!!Y#T))!j3J%(kr`JJJ#!kr`T4J%(kr`!JJ%*R5(S![#m95(Vr!Lm
+krZ)[1[lL,cVqbLmkrXS[1[l+B3!06M!ICb!r!%U&C`JJ6D!US#YJ"#"0S#-J6U!
+I)%HJ'c(I!L"JB#"1S"mJ4k!EFJ!5"1F*iaRN%3!"!#!#!3$J)%fJD3)!!"q!!5"
+0S'V9e0I83IVqGNU3!'F)F!'JQ(!$S*JJ659)!!K`!%cIB2K1G8cIB2KJ!2kq2`!
+J6U!I)%HJ'c(I!L$9e0I8-$J#)$(!#Q#4b#9)!!K-hf$i6R919J!!51F!1#KZ!!a
+(q[iU4IVq+L!8X**Y"#!5+)"+J'm5)&-LEJ!)SLiJ&0'6NC*`!'!%-$crf8cI(!"
+1ANje6PErb%MR(MJQ,J!)+#i!$#KZ!"""q[fk,8Mre%)ZrmLK'Le)rma96kJF-"m
+k!!a&!!"[A%KZrq``"90&2`#S$e92,blrl+J0-"mm!!a'!!"[h%)RUCYC6bmZrq`
+`"P0'2`#S$L!I,8$rm()"(`'TQb"Zrr"+N!"R%&92,`LTTM!I5-"b"-#"Cm3[,[r
+`UD0J["!Z!"4R#PP2,VJ#TL"IS"Xr2+$m6VS%KP42,8$rd%U!C`!"RLm!6VS$ePK
+25J"R#R!"(8!!&Nlk!KK)E[rN5'lri%KZrpK1ZJ9U6qm!$#!Zrq#K(Le)rp`J#'F
+!!@3J,[rNS4iY52rS)!KR!!&8,blrj#m)6VS&Z&"2)!0Q!!#Q@8m[2%024%9#CkJ
+I)"mY32r`5S"R!!#1)%!L8()Bdm%[#8kk",4B6h)$X%&QGL!0)%"`+0(!,8Mrp#*
+Zrr!N8A!BeF!Y5[ri,`T1ZJ5k@%mY32rm)'lrm+!T8%SQE[r8*dS!+&P2,blrm%k
+k&F`J(h,Sd)&4J#G!!#a96dKkrM)[,[rd5'lrr#m-,`3[,[rF,blri#mZrqK1ZJV
+'9%m[,[r`UD-NE[r8*@lrd!!-*@lrh!!3*@lri!!8*@lrk!!B2cbKQ%kk!eC86bC
+!2cbSRdkk!dT86b)!)!Z`J@B%F!"J!R!")!!P3!!F*83!)#9-!#4)H[[-2cbJr$m
+mS2a1ZJ,i9%mI!%kk&9)r2+'B6VS$$&425S"R"(!"S*JJI!!!!9S`%%M!i)"b"V#
+"CJa"qJ#Z)R`!!!-m)SJGI!!"rmJJE[r-S"Y96kJF-"mk!!a&!!"[G%KZrq``"90
+&2`#S$e92,blrl+J0-"mm!!a'!!"[h%)RUCYC6bmZrq``"P0'2`#S$L!I,8$rm()
+"(`'TQe92,blrm+QQ-"p)`()%`)&R##mZrr#TSQ$#*'lrm%U5Ca"96bm+UDB`(dM
+!FJ6!J@HU,`UTSf#N%#lrb"e!!"C-haai6PiJAdr[!!j1d%j@rra)j`!`3Llrr$m
+mS2a1ZJ)X9%mN3%U!Ce`[!%kk!B"B6dS!Ce!J#LC!)%![+!!-2cbJr$mmS2a1ZJ(
+H9%mI!%kk&$JJ5b"S!"#J(b",)'J!'+!I)(`!!!&D-"")`1#!FJD`J@B+F!!JI!!
+!!c`JJ"em!!(rr"!Zrra-h``!6Pj1G8j@rqK)jami@8qTG5!I+J")E[rSU(3J$5"
+!)""bKY#",8$rr#"!A%K$l[rX)YJLf&P2,ca%394"2c`%eDQJ)"mS3#"!*&!b+J!
+)NQS!"$`"0#S!"T4U!!)q!MBZrr*)`cJZrqj)a*D%1!&)a*D%DJ*5Jq+$282rpMB
+Zrr")`cJZrqa)a*D%1!*)a*D%DJ*5Jq+$282rp$BZrrE@36e$rrSb,[rddN)p3Ir
+i@8p#TdKZrr4)HJ"QFJ%I!A)"2`&brbm"3LG#TkN6)"mQ3#m!U(-'K3#3!hJ[$#"
+,F"$4`#m)U2CC6kPe)"q`K@3#B2496kPd%"pQ!Q$fF2mr!%*R)"qJ-Lm,U43[$+Q
+M,blrk+Kc60mFq%jH6R8!!J!!6PB!!%MR!$!NEJ!))!SQ3#"!)LJ!!Jb"38a"4'B
+@)LJ!"Jb"4%008'B+-#J!#R)$X%&R"(!!B!*`!8cI$!"1ANje,`TC6cmmU'j`!4m
+!6VS5H#"I*%KC6cmmUQj`!4m!6VS5CL*I)%Uab@B'-$`#!'!%-$`%!#4I6R919J!
+!,`-f,J!)-!0)`!+!!!!)!%U!E`4`!@!#F!!Q(djH6R919[rm51FF!$BZ!!Jr!dk
+krma86ae!rrab!E!"CK!#3`Ir6VVrJ,"$EJ4`!'!S@8mr2+LIF!%I!%kk%I!J(bS
+!@8mr!amZrra1ZK(J)"mS!,#&CJ*`!%cI!$K1ANje6PB!!%MR'$!i,J!)*'i!#L"
++)"!Q3#"!-K!-38&%CLJb+!!#$%&$8QBH0J4brlC"CaSJ+!!%FKMLU!+!!*!$rc)
+$5-'`J@F%F!"J!R!"(8!!$NcI$"K1AL"IA%p1d%j@!!"96dKZ!!K`rcm!6VVrNK!
+ICa)JEJ!))#J!"()BiUJ#3!$rB!*`rdjH6R919J!!98p)EJ!)F2mr!%kkrf33(fF
+3)'i!##!S!!3#J!$rN!0J!R$r6Pj1G8j@!!")jaJi*Qi!##KZ!!`J5c#m!`&`!#4
+-*)!Q2!!!!56ANJD5!!!#5!D5!*!$)#Jm!*!$J0Q5fC)S2!!!"*!!fC,ANYQ5"T)
+!N!0m"T)!!)!!F!!NEJ!3*)!'NJ#3!b3'NJ#3!b!'NJ#3!dJ'NJ#3!cj#3%cI("K
+1ANje6PErj%MR(cJQEJ!)+Li!$#!,+%!Y32rSF#6C`#e-rqa`)0R!,8crm(")fF!
+Y62rdF$lC`#!-N!#,X)9M"R"P6[S!XN*!2J"#3$e!rq3f"h!NYN"N5(!%YN"N"(!
+!B!a`!$!$@B"U!PD!j)"i!$J$,86rq0LZrqJN4"5!)#lrq0#!d+lrm#"!-+lrj(!
+"&"*b!")#if$4E[rN8NGJX%*!2J"`!6`!0JG`(lC!C%4`!EC!C!4`!'!-F!!`!e1
+!DJ*5J1+!H!!i!be%rrcBV[rX*%38J#!Zrrc3J0#Zrr3J3$#'F!%8%R)!%J,MB0a
+!8NGJY%*!60mFq%jH6R919[r`51FI1#4Z!!JQEJ!-1Li!%#KZ!"*#3$`!-J9`!$!
+"d)!d"R)!-J+`J@m83N!d"R)!-J,5JG+-)%%`J&*'B0T#3$`!F!)p32rb0JDf4@3
+!!,K#3$i!3N!p32r`F!!`!q@!d)SJ3#!3,8$rp$)'F!!`!G#,)%!B%(B!&J5f4f-
+!!))`,[rfFJ(!3G&Zrr"`!$!$8i!d"h)!-J+`J@mq1#lrm(B!0J3Y3rrmeS2@M#"
+$5P"Q%L!Zrrc3J0#-)%!`V[rb9'lrmM)Zrr"`!$!"d)$3M#"!-"!p32r`B"B`"G"
+!d%Bd,[r`FJ!b!Y+"dS`J36#!8NFJ,[rdiSJY32rdB!$rE&*'B!$r4%cI(2K1ANj
+e6PErr%MR($!NEJ!)0Li!$#CZ!!ib!h!!-!(QJ$J!-!0b"m""1J"`!#e!rr`d"()
+!-J,5LL""%K"`!"!"0!9b!$)#iU"b!F#"dDlrr#)ZrrcMLG+,)%%b%(!!-!%Y32r
+m8N8`"A))X%&Q"N*!1J"54$)Z!"*`!$!"d)#`V[rmB`*JUK!Zrrm5,J!6dJ'3!!&
+-h``i6Pj1G8j@rra)jamJ*'i!#$JZ!!`k,J!1-J4`!$!"jS!m!$)%G!I#3Mi"GJ!
+f!0D+)%-3%(3!&!!Y3[rmF!!`!63&FJ!b!Y#"jS"b!V#"C`ab!E#"Cb"+J'FdB$)
+d"R)!-J*8JG++)%%5%(!!%!&b%11SJDlrr$3'FJ!b!P+"dSSJ34)3F!!3!H')JDl
+rr#!Zrr`d"h)!-J,LU#e!rra`rh)J0J9d!$3$NS,LU-"Zrrj-h`6i6Pj1G8j@rpK
+)jami*Qi!##KZ!!iJ2!!!!564VJ!5)$`!!!*)dDi!%L!Z!")Y32rXFL$6VJ!5)Li
+!%Le"rr!N2!#3!i$9VJ!5*#i!%Le#rr3N5aJ5GJ!@"#e$rrMQJhS(aN953ce$rp`
+Q,[riiS0k!mC&9%-p3rrQGJ%k,[rQkf-p3rrSIN$)"h`!(!3p4[rLH!(VC&0%286
+ri#SZrrKq!FU(C`Kk!$S%8i9J!RVr28ArhRJ)286rj%T'CdB[,J!5,`!r!e*+,`T
+1Z[mk6qm!$ZG!d@lrj#mZ!")[,[r`2`-[,[rX6VS,#%r[!!i[,[rd2`-[,[rX,bl
+rm%kkr+a2l`!13N!p32rB-#lrf,"Z!!aN!!%k-#lriQFk*%!r,[rS,blrp$mZrq3
+[#dkkrBj2l`!-%J!J#R!!%!%p32rDG!!d!05Zrq`J3K!3FJ!5!00Zrq4J($mZrqB
+r,[rN,`Y1Z[h`8%mp32rD-#lrjY&Zrq3`,[rDX'lrhQB@-Llrf&*ZrpK`!$!"d)`
+J3%)3B!$rHM!ZrpU`E[rJCJ!!P$!Zrq*R1L4!2blrk#mZrr3r,[rN,`Y1Z[d'6qm
+!$")!)!T`!"!"28$rfR3!0!$8V[rX)%)3%()!%J$6E[rNB"`r,[rQ2blrj#m,6VV
+pD&"228$rfM!ZrqE4E[rN9QlrfM!ZrpT6E[rD5N"R!2m!1#lrf(B!0J3Y3rrm8i2
+@M#"$%"!L,[rmdS`J34#!8Qlrf'$1%#lrhG!ZrpXd,[rB8Qlrf()!-J,5M#""%)"
+J!2kq-Llrj(!!-!&HJ1D!60mFq%jH6R919[q-51FI1#CZ!!JU,J!-+'i!%#`Z!"3
+Y5rr)F#6A`#e,rq"`)0I!,8[rc(")em!Y5rrN,8crP#Bm!!!"*0HZrj3J2!!!!NM
+4V[q8F#$4V[q8+$`!N!1!fDlrP0QZrj3YE[q8rl3S2!!!"*!!fDlrP#eZrj6rZ0H
+Zrj3YE[q8rlcCV[q8,@lrP2r8F(c4V[q8,@lrP2qN)$`!!)!!dDlrP#!Zrj53!)b
+`K@-+F'8p3!!S6[S'HR!!,J"#3$e!ri`NE[qNeI`!!)!!,8VrU#eZrk6rN!!YI!!
+!J!$rk%KZrqJ[,[qN)'i!*%k3!&"2)#lrk'B+F'Fp3!!S6[S'0#4Zrj!!8NUel[q
+SBfJJE[q3!&*)NHlrU#e)rr3JE[q3!*(Zrk3Y52r`)'lrU*(Zrj!!,8Mrl#!)C`i
+JE[q3!#*Zrk3J,[rXSLiNE[qNeHlrl#e+rj!!5'lrm#mZrk3JEJ!N6T!!8%mJ,[r
+`X+lrp'3+F'Fp3!!S6[S&`#"Zrj!!8UlrN!!3%"e!rk"b!")!dN&636e"rp!`,[r
+3d%!p32r5)'i!(#!3d+i!)#e!rl!N3#m-,blrZ$mm!53[,[q3!%kkqr*2l`!1-J!
+J#R!!-!(4V[q3!#m-,blrY$mm!53[,[qi6VS(ZNr[!!i[,[qm2c`"*#mZrlJ[,[q
+d6VVjA%r[!!iN3#m-,blrZ$mZrp![,[q3!%kkqk"2l`!1-J!J#R!!-!(4V[q3!#m
+-,blrY$mZrp![,[qi6VS(D%r[!!i[,[r82blrd#mZrlJ[,[qd6VVj#Nr[!!j`!#i
+!3N!p32q-,@i!)2qX)'lrV,(Zrl"N!!5S3N!p32qB$'i#52qBC!!!`M!ZriaQ!!#
+-*'lrN!"55VAZrkKMD#"Zrj!!8NL4l[qS,8Mrp#"Zrj!!NHlrT#e)rr!JE[qSNHl
+rN!!Y52rX)!KR$L"Zrj!!)QlrT#!ZrqbL,L4Zrk69l[rX,8VrN!")E[r`,blrT#"
+Z!#41N!"36b!Zrr#`V[rdC!T`Cce!!#K1qJ4#)'lrN!"5V[q3!")3F!!3!5i!F!J
+p32q--!Gb!F""d@lrQ$)ZrjK`!$!"d)$3V[qm)%!`%$e!rjJJ"q+),J"6E[q-B!$
+r1!4Z!NMrQ!aZ!3$rQ'33)'lrV&+Zrk`3V[qCB!$r#!4Z!3$rQ$JZrjKf!$B%,82
+rq0D$eUlrc#"$-"!p32qD)Llrq0+ZrmJJ34)3F!!3!6e!rja+3'F!!-)-EJ!Bria
+L!!#B*'lrN!"55VAZrkKMD#"Zrj!!8NL4l[qS,8Mrp#"Zrj!!NHlrT#e)rr!JE[q
+SNHlrN!!Y52rX)!KR$L"Zrj!!)QlrT#!ZrqbL,L4Zrk69l[rX,8VrN!")E[r`,bl
+rT#"Z!#41N!"36b!Zrr#`V[rdC!T`Cce!!#K1qJ-S)'lrN!"5V[q3!")3F!!3!63
+Zriab!$)#ikL1J&"ZriaJ!2pLF2pb)$JZrjaf!$B%NS2LU-"(d@lrQL!(jUJZ!*P
+Zria#3$e!rjJ`,[qBX'lrdQ3!!-)`,[q-CJ!!M#4Zrj!!8NUel[qSBfJJE[q3!&*
)NHlrU#e)rr3JE[q3!*(Zrk3Y52r`)'lrU*(Zrj!!,8Mrl#!)C`iJE[q3!#*Zrk3
J,[rXSLiNE[qNeHlrl#e+rj!!5'lrm#mZrk3JEJ!N6T!!8%mJ,[r`X+lrp'3+F'F
-p3!!S6[S&`#"Zrj!!8UlrN!!3%"e!rk"b!")!dN&636e"rp!`,[r3d%!p32r5)'i
-!(#!3d+i!)#e!rl!N3#m-,blrZ$mm!53[,[q3!%kkqr*2l`!1-J!J#R!!-!(4V[q
-3!#m-,blrY$mm!53[,[qi6VS(ZNr[!!i[,[qm2c`"*#mZrlJ[,[qd6VVjA%r[!!i
-N3#m-,blrZ$mZrp![,[q3!%kkqk"2l`!1-J!J#R!!-!(4V[q3!#m-,blrY$mZrp!
-[,[qi6VS(D%r[!!i[,[r82blrd#mZrlJ[,[qd6VVj#Nr[!!j`!#i!3N!p32q-,@i
-!)2qX)'lrV,(Zrl"N!!5S3N!p32qB$'i#52qBC!!!`M!ZriaQ!!#-*'lrN!"55VA
-ZrkKMD#"Zrj!!8NL4l[qS,8Mrp#"Zrj!!NHlrT#e)rr!JE[qSNHlrN!!Y52rX)!K
-R$L"Zrj!!)QlrT#!ZrqbL,L4Zrk69l[rX,8VrN!")E[r`,blrT#"Z!#41N!"36b!
-Zrr#`V[rdC!T`Cce!!#K1qJ4#)'lrN!"5V[q3!")3F!!3!5i!F!Jp32q--!Gb!F"
-"d@lrQ$)ZrjK`!$!"d)$3V[qm)%!`%$e!rjJJ"q+),J"6E[q-B!$r1!4Z!NMrQ!a
-Z!3$rQ'33)'lrV&+Zrk`3V[qCB!$r#!4Z!3$rQ$JZrjKf!$B%,82rq0D$eUlrc#"
-$-"!p32qD)Llrq0+ZrmJJ34)3F!!3!6e!rja+3'F!!-)-EJ!BriaL!!#B*'lrN!"
-55VAZrkKMD#"Zrj!!8NL4l[qS,8Mrp#"Zrj!!NHlrT#e)rr!JE[qSNHlrN!!Y52r
-X)!KR$L"Zrj!!)QlrT#!ZrqbL,L4Zrk69l[rX,8VrN!")E[r`,blrT#"Z!#41N!"
-36b!Zrr#`V[rdC!T`Cce!!#K1qJ-S)'lrN!"5V[q3!")3F!!3!63Zriab!$)#ikL
-1J&"ZriaJ!2pLF2pb)$JZrjaf!$B%NS2LU-"(d@lrQL!(jUJZ!*PZria#3$e!rjJ
-`,[qBX'lrdQ3!!-)`,[q-CJ!!M#4Zrj!!8NUel[qSBfJJE[q3!&*)NHlrU#e)rr3
-JE[q3!*(Zrk3Y52r`)'lrU*(Zrj!!,8Mrl#!)C`iJE[q3!#*Zrk3J,[rXSLiNE[q
-NeHlrl#e+rj!!5'lrm#mZrk3JEJ!N6T!!8%mJ,[r`X+lrp'3+F'Fp3!!S6[S#@#"
-Zrj!!8UlrN!!5%(!!%!%Z!(!)28$rM$!(FJ(!3G&ZrjJb,[qBF!!`!G#!d+lre#"
-!-"!p32qB)!ILL#i!8flrM'!!rcB`,[r5N@lrQ$JZrjKf!$B%,82rr0D$eUlrj#"
-$-"!p32qH)Llrr0+Zrq!J34)3F!!3!6e!rja+3'F!!-)-EJ!BriaL!!#B*'lrN!"
-55VAZrkKMD#"Zrj!!8NL4l[qS,8Mrp#"Zrj!!NHlrT#e)rr!JE[qSNHlrN!!Y52r
-X)!KR$L"Zrj!!)QlrT#!ZrqbL,L4Zrk69l[rX,8VrN!")E[r`,blrT#"Z!#41N!"
-36b!Zrr#`V[rdC!T`Cce!!#K1qJ&D)'lrN!"5V[q3!")3F!!3!63Zriab!$)#ikL
-1J&"ZriaJ!2pLF2pb)$JZrjaf!$B%NS2LU-"(d@lrRL!(jUJZ!*PZri`JE[qX-Ll
-rRR!!-!'4`#e)rj5alJ!JC@!JE[q88UlrP"!3)'lrV&+Zrk`3J#"Zrj45V[q8%"!
-JE[qX8UlrV"#!)'lrP&+Zrj33%#"Zrka5V[qX%)!`,[qD8flrQNT!C`$lhL"Zrj4
-5V[q8%"!JE[qX8UlrV"#!B0a@E[qD)'i!'0('-LlrRR!!-!%LE[qXNqi!)*!!LC(
-!,8MrP$!ZrjTR*L"Z!"M4aV(Zrj4M'L"Zrj45V[q8%"!JE[qX8UlrV"#!8flrQQ$
-8,@i!)2q8-#lrQP0ZrjT+3'F!qfBJE[q88UlrP"!3)'lrV&+Zrk`3J'$F)'lrV,(
-Zrl"R#("R28!!+'!8)'lrV*(Z!#!LEJ!F)SK#3$e!!#K-haci6PiJAdr[!#"1d!"
-`2!!q)!!!H#!q-#!Q*L"i)$`p-c)!!$T$Efe`FQ9cFfP[EMT%C@0[EA"bCA0cD@p
-Z-$-`-5jM!!!m!$iJ!!"i)$i`)#BQ)(JJ2$dc-J!!1N0[EA"bCA0cD@pZ1N4PBfp
-YF(*PFh0TEfi`-c!a,Q-!!%j@rqK)jami2Li!##KZ!!`f,J!+F!!`!cJ(FJ!b"*!
-!JA)"X)&[!!'d286rk$e$rqT5E[rS-#lrk,"Z!!TN(()!-J$5M#""%"!d"h)!-J,
-5M#""%K#`!@3#B0C6E[rU-#lrkV"(Baab!$)!dS`J34!30!Gb!$)#dS`J34)3X!&
-M!Q$B-#lrk,"ZrqTP!Q"b1#lrk(B!0J3Y3rr`eS`N3a)5F!!3!6e!rq`k,[rUH!!
-i"5e%rr6BM#C%%"-8J"DZrqdJ,[r`d)$3VJ!3)%!`%$e!rq`L,[rddS(5VJ!3)%%
-b%#3Zrr$8JY5Z!"!J3M#")Llrp0+"dUi!%#""-)"J!2mb-#lrkV"(CJC54f!!r`3
-i"hB!0J3Y3rrieS`N3a)5F!!3!6e!rq`m,[rUHJ!k"Le&rrcDM#C&%"-8J"DZrqd
-J,[rid)$3VJ!3)%!`%$e!rq`L,[rmdS(5VJ!3)%%b%#3ZrrM8JY5Z!"!J3M#")Ll
-rr0+"dUi!%#""-)!J,[rm)Llrq*!!J63Z!!Tb!$)#*#lrr&+#NS+`J@`H,bi!%#m
--2`Br"%kkrPa2l`!--#lrkP*!2J"J!2jF,bi!%#m-2bi!#M!ZrqT53$m!6VVq0Nr
-[!!`pE[rU!!TJ!2ii60mFq%jH6R919[rN51FI1#4Z!!Jk,J!-*Qi!$LKZ!")Y62r
-`)$`!!!%NfF!Y62rd3N!m!$B'YN9N,(J!1!-Y42rif)SJ4"!3)Llrq0+Zrr!J34#
-!)#lrq0#!d+lrp#"!-)054Q$1,blrp#mZrr!r"8*R6VVpXNr[!!a#3$`!0JDf4@3
-5F!!`!p#Zrr!J3%S3CJ454Q$SF!!Y32rN0JDf4@3!!+K+3fFb)#lrj(J!1!-Y42r
-mf+lrm#"%&""b!")#*Llrr&1$eUlrm#"$&K"d!"3$NS,MU#e!rq3d"R)!-J,5V[r
-`)%%5%(!!%!%q!#eZrq6rl(!!,8$rk$!(8dG+3'FJ)#lrk11))Llrl(3"`S+!J5e
-!rqJJ,[rXiSJY32rXB0Jd"R)!-J,5JG+Zrr3J36)3F!!`!H@!d)XJ3##ZrqK54P+
-Zrq4J!2p860mFq%jH6R8LAb"IS#8ZJ'S#3TG1d5*I%Km`(dS"C`5R4Q!#SdBZL%l
-4)Pm5(c!I)&p+!@F%TNGJ!U*(6Y%!N!-+!$LJ!3!&!*!'!3!!!C!!Y`!"MlF!!!4
-B"Y-he!0D!*!$(!1q!"0%594-!!d!SN&-8P3!#J&+8e45)!!"!Fj3Ff9d!!!"jN4
--6dF!!J(b8e45)`!!!KC35808!!!#)RCPFR-!!3)ZBfPMEJ!!!NC*3dp1!!!#8NP
-$6L-!"!*H4P*&4J!%!TT#6N4-!!%#eN&9Fc)!!!,ZBA9cG!!"![TTBf`i!!!$%N0
-24%8!"`-H4%&833!!!hj659T&!!!$LNCPBA3!!!1@"!(rrb!!N!L&rrmN!!#!"Y-
-h"!#(rrm!N!2@!*!&K[rr*!!"*JE60``!J2rr!!!"T`#3"EArrb!!!J8!N!@#rrm
-!!!*h!*!%!qMrrb!!!Y8!N!@)rrm!!!-"!*!%!J$rr`!!!pN!N!3#!Irr!!!%&`#
-3"!4,!#J%!"5!"Y-h*!5[rrm!!"63!*!%!3F!0#!!&3i!N!3%!Irr)!!%B`#3"B,
-rrb!!"(-!N!@&rrmN!!5$"Y-h#!#(rrmJ!!56!*!&K[rr*!!%S`E60bJ!J2rr)!!
-%X`#3"B(rrb!!"--!N!@)rrmJ!!66!*!%!J$rrb!!"18!N!3#!Irr)!!%p3#3"!5
-[rrm!!"@m!*!%!J#3!b!!"38!N!3#!3!()!!&&3#3"B$rr`!!"5%!N!3$k2rr)!!
-*@!#3"!4,!"!%!"+U"Y-h&!%(!"`J!",$!*!&J2rr!!!*G!#3"!2Srrm!!!Qd!*!
-&![rr)!!5HJ#3"3(rrb!!%TJ!N!3%5rrr"!!5h`E60aJ%5rrr"!!8"3E60a`!J2r
-r!!!9c!#3"B(rr`!!&Y!!N!@#rrm!!"I8!*!&Jrrr!!!Bf!#3"B6rr`!!'G`!N!@
-!rrm!!"VJ!*!&JIrr!!!Dk`#3"B,rr`!!'[B!N!@$rrm!!"X"!*!&K2rr!!!E$!#
-3"!%!rrm!!"XA!*!&J2rr!!!E0`#3"d!!!"Y[!*!&K2rr!!!EN`#3"dm!!"ZA!*!
-&K2rr!!!EmJ#3"3%!AK`!(rB'dcFJ!!)!D"`!NEm'dcG!!!-!FK`!VG3'dcFX!!3
-!I"`!p8)'dcF`!!8!KK`"*Xm'dcFd!!B!N!!F!8RZ"Y-h2!!!rrmS!A80!*!&"rr
-r!!&e0`#3"[rr+!"KZ!#3"2q3"!!"G5N!N!Err`!"MkN!N!3'F(*[EA"d#-3JFh9
-QCQPi#dPZFf9bG#"%DA0V#d9iDA0dD@jR)&"A#dPZFf9bG#"%DA0V#d9iDA0dD@j
-R)&"A$NphEQ9b)(*PFfpeFQ0P$NphEQ9b)(*PFfpeFQ0P#90PCfePER3J-3P6C@G
-YC@jd)$)*8f9RE@9ZG#!c#90PCfePER3J03P6C@GYC@jd)$B*8f9RE@9ZG#!f[f3:
+p3!!S6[S#@#"Zrj!!8UlrN!!5%(!!%!%Z!(!)28$rM$!(FJ(!3G&ZrjJb,[qBF!!
+`!G#!d+lre#"!-"!p32qB)!ILL#i!8flrM'!!rcB`,[r5N@lrQ$JZrjKf!$B%,82
+rr0D$eUlrj#"$-"!p32qH)Llrr0+Zrq!J34)3F!!3!6e!rja+3'F!!-)-EJ!Bria
+L!!#B*'lrN!"55VAZrkKMD#"Zrj!!8NL4l[qS,8Mrp#"Zrj!!NHlrT#e)rr!JE[q
+SNHlrN!!Y52rX)!KR$L"Zrj!!)QlrT#!ZrqbL,L4Zrk69l[rX,8VrN!")E[r`,bl
+rT#"Z!#41N!"36b!Zrr#`V[rdC!T`Cce!!#K1qJ&D)'lrN!"5V[q3!")3F!!3!63
+Zriab!$)#ikL1J&"ZriaJ!2pLF2pb)$JZrjaf!$B%NS2LU-"(d@lrRL!(jUJZ!*P
+Zri`JE[qX-LlrRR!!-!'4`#e)rj5alJ!JC@!JE[q88UlrP"!3)'lrV&+Zrk`3J#"
+Zrj45V[q8%"!JE[qX8UlrV"#!)'lrP&+Zrj33%#"Zrka5V[qX%)!`,[qD8flrQNT
+!C`$lhL"Zrj45V[q8%"!JE[qX8UlrV"#!B0a@E[qD)'i!'0('-LlrRR!!-!%LE[q
+XNqi!)*!!LC(!,8MrP$!ZrjTR*L"Z!"M4aV(Zrj4M'L"Zrj45V[q8%"!JE[qX8Ul
+rV"#!8flrQQ$8,@i!)2q8-#lrQP0ZrjT+3'F!qfBJE[q88UlrP"!3)'lrV&+Zrk`
+3J'$F)'lrV,(Zrl"R#("R28!!+'!8)'lrV*(Z!#!LEJ!F)SK#3$e!!#K-haci6Pi
+JAdr[!#"1d!"`2!!q)!!!H#!q-#!Q*L"i)$`p-c)!!$T$Efe`FQ9cFfP[EMT%C@0
+[EA"bCA0cD@pZ-$-`-5jM!!!m!$iJ!!"i)$i`)#BQ)(JJ2$dc-J!!1N0[EA"bCA0
+cD@pZ1N4PBfpYF(*PFh0TEfi`-c!a,Q-!!%j@rqK)jami2Li!##KZ!!`f,J!+F!!
+`!cJ(FJ!b"*!!JA)"X)&[!!'d286rk$e$rqT5E[rS-#lrk,"Z!!TN(()!-J$5M#"
+"%"!d"h)!-J,5M#""%K#`!@3#B0C6E[rU-#lrkV"(Baab!$)!dS`J34!30!Gb!$)
+#dS`J34)3X!&M!Q$B-#lrk,"ZrqTP!Q"b1#lrk(B!0J3Y3rr`eS`N3a)5F!!3!6e
+!rq`k,[rUH!!i"5e%rr6BM#C%%"-8J"DZrqdJ,[r`d)$3VJ!3)%!`%$e!rq`L,[r
+ddS(5VJ!3)%%b%#3Zrr$8JY5Z!"!J3M#")Llrp0+"dUi!%#""-)"J!2mb-#lrkV"
+(CJC54f!!r`3i"hB!0J3Y3rrieS`N3a)5F!!3!6e!rq`m,[rUHJ!k"Le&rrcDM#C
+&%"-8J"DZrqdJ,[rid)$3VJ!3)%!`%$e!rq`L,[rmdS(5VJ!3)%%b%#3ZrrM8JY5
+Z!"!J3M#")Llrr0+"dUi!%#""-)!J,[rm)Llrq*!!J63Z!!Tb!$)#*#lrr&+#NS+
+`J@`H,bi!%#m-2`Br"%kkrPa2l`!--#lrkP*!2J"J!2jF,bi!%#m-2bi!#M!ZrqT
+53$m!6VVq0Nr[!!`pE[rU!!TJ!2ii60mFq%jH6R919[rN51FI1#4Z!!Jk,J!-*Qi
+!$LKZ!")Y62r`)$`!!!%NfF!Y62rd3N!m!$B'YN9N,(J!1!-Y42rif)SJ4"!3)Ll
+rq0+Zrr!J34#!)#lrq0#!d+lrp#"!-)054Q$1,blrp#mZrr!r"8*R6VVpXNr[!!a
+#3$`!0JDf4@35F!!`!p#Zrr!J3%S3CJ454Q$SF!!Y32rN0JDf4@3!!+K+3fFb)#l
+rj(J!1!-Y42rmf+lrm#"%&""b!")#*Llrr&1$eUlrm#"$&K"d!"3$NS,MU#e!rq3
+d"R)!-J,5V[r`)%%5%(!!%!%q!#eZrq6rl(!!,8$rk$!(8dG+3'FJ)#lrk11))Ll
+rl(3"`S+!J5e!rqJJ,[rXiSJY32rXB0Jd"R)!-J,5JG+Zrr3J36)3F!!`!H@!d)X
+J3##ZrqK54P+Zrq4J!2p860mFq%jH6R8LAb"IS#8ZJ'S#3TG1d5*I%Km`(dS"C`5
+R4Q!#SdBZL%l4)Pm5(c!I)&p+!@F%TNGJ!U*(6Y%!N!-+!$LJ!3!&!*!'!3!!!D1
++!!'LLJ!!"8Y66e*8"Vi!J!!F"()!&N&-8P3!#J#k399c-J!!!6j#6N4-!!%"5N0
+19%`!!!&L3dp%43!(!@j%394"!!!"cN4*9%`!$`(D4%a24`!%!TT'8N9'!!3#eNC
+PBA3!!!-55801)`!%!aj*3dp1!!!$@P"*3e3!"!0Q8(0PG!!!!k*659T&!!!$VP0
+88L!!!31k8e45)`!!!p*KGA0d!!%$hQ0TBfi!!!2fC'0dBJ!""!*NE'Gi!!%%'QP
+ME$J!!!3bGQ9bF`!""$i!J2rr)!#3#)(rrb!!!"!!N!@#rrmJ!!!J!*!&KIrr*!!
+!-!%[)M3!K[rr*!!!3!&!B)`!Krrr)!!!8!#3"BMrrb!!!'!!N!3#!2rr)!!!FJ#
+3"!)"rrmJ!!##!*!%"!(rrb!!!*)!N!3%Vrrr!!!B@!#3"ai!!"KS!*!&J2rr!!!
+BM!#3"!%!rrm!!"M%!*!%!3Mrrb!!'13!N!ErrbJ"Kq!!N!8"!*dF!#D[!8$8@!!
+#!+FF!,"m!51ZQ!!$!,%F!-fI!8$81!!%!,XF!3Qa!8$8-!!&!-8F!6Xq!5+0"!!
+'!-mF!9[a!8$85!!(rrm!!BJ+!*!'rrmS!)(X!*!&J2rr!*!$SJ#3"B,rr`!!!3#
+3"SArrb3!!9i"3'6J!)Errb3!!E3"31*m!)Irr`!!!M8!N!@)rrm!!!+&!*!&YIr
+r)!!$A3#3"!%&rrmJ!!22!*!%!3Irrb!!'2m!N!3"#2rr)!!CS!#3"!)!rrm!!!4
+m!*!%!J(rr`!!",S!N!3$k2rr)!!&"J#3"!3"rrmJ!!8b!*!%"%X!,33!'N-"303
+!"+rrr`!!'T-!N!3""3!!)!!&XJ#3"!%(!$NJ!"V4!*!%!3J!5L!!'Zd!N!3$k2r
+r)!!&e!#3"!4,!'B%!"X*!8$8T!#!rrm!!"XL!*!&JIrr!!!E,3#3"B,rr`!!'cJ
+!N!@$rrm!!"Y$!*!&K2rr!!!E6J#3"[rr!!'LI!#3"B$rr`!!'eN!N!@"rrm!!"a
+G!*!&J[rr!!!GB3#3"B2rr`!!(Q8!N!@%rrm!!"pT!*!%"%[rr`3!)'d"304`!),
+rr`!!"I!!N!3$k2rr!!!(%`#3"!4-rrm!!!iK!*!%"%hrr`!!$pS!N!3%6[rr!!!
+4N`#3"B$rr`!!%b%!N!6rN!3!!BIm!*!%!J!!"b!!&eJ!N!3#!3!1)!!AD!#3"B$
+rr`!!&h3!N!Gb!!!Jk!#3"B6rr`!!)8-!N!3%5rrr"!!K4`&!e(3""Irr!!!AY!#
+3"!%)rrm!!#*Y!*!%!38!&`!!&q8!N!3"#!#"!!!LS3#3"B6rr`!!)UX!N!8"rrm
+J!"I[!*!&![rr)!!B-J#3"!C6G'&dGA-'F(*[EA"d#-3JFh9QCQPi"P0dBA4eF`j
+2GfjPFL"bCA0[GA*MC3Y*ER0PFR3J4'PcDa"&H'PcG'PZCe"KFh0hEh*N'd9iDA0
+dD@jR8'&cFhG[FQ3Y3A"`C@&bB@jMC3Y*ER0PFR3J4'PcD`j2GfjPFL"bCA0[GA*
+MC4Y&H'PcG'PZCe"KFh0hEh*N,8&`F'9KFQ&ZBf8*8f9RE@9ZG#!a#90PCfePER3
+J-JP6C@GYC@jd)$-*8f9RE@9ZG#!e#90PCfePER3J0JP6C@GYC@jd)$E@I3:
diff --git a/tcl/mac/tclMacResource.c b/tcl/mac/tclMacResource.c
index a28c03088ca..e8935c585bb 100644
--- a/tcl/mac/tclMacResource.c
+++ b/tcl/mac/tclMacResource.c
@@ -149,7 +149,7 @@ Tcl_ResourceObjCmd(
char macPermision;
int mode;
- static char *switches[] = {"close", "delete" ,"files", "list",
+ static CONST char *switches[] = {"close", "delete" ,"files", "list",
"open", "read", "types", "write", (char *) NULL
};
@@ -158,7 +158,7 @@ Tcl_ResourceObjCmd(
RESOURCE_OPEN, RESOURCE_READ, RESOURCE_TYPES, RESOURCE_WRITE
};
- static char *writeSwitches[] = {
+ static CONST char *writeSwitches[] = {
"-id", "-name", "-file", "-force", (char *) NULL
};
@@ -167,7 +167,7 @@ Tcl_ResourceObjCmd(
RESOURCE_WRITE_FILE, RESOURCE_FORCE
};
- static char *deleteSwitches[] = {"-id", "-name", "-file", (char *) NULL};
+ static CONST char *deleteSwitches[] = {"-id", "-name", "-file", (char *) NULL};
enum {RESOURCE_DELETE_ID, RESOURCE_DELETE_NAME, RESOURCE_DELETE_FILE};
@@ -496,7 +496,7 @@ resourceRef? resourceType");
return TCL_OK;
case RESOURCE_OPEN: {
Tcl_DString ds, buffer;
- char *str, *native;
+ CONST char *str, *native;
int length;
if (!((objc == 3) || (objc == 4))) {
@@ -954,8 +954,7 @@ Tcl_MacSourceObjCmd(
}
if (objc == 2) {
- string = Tcl_GetStringFromObj(objv[1], &length);
- return Tcl_EvalFile(interp, string);
+ return Tcl_FSEvalFile(interp, objv[1]);
}
/*
@@ -1236,10 +1235,10 @@ SetSoundVolume(
int
Tcl_MacEvalResource(
Tcl_Interp *interp, /* Interpreter in which to process file. */
- char *resourceName, /* Name of TEXT resource to source,
+ CONST char *resourceName, /* Name of TEXT resource to source,
NULL if number should be used. */
int resourceNumber, /* Resource id of source. */
- char *fileName) /* Name of file to process.
+ CONST char *fileName) /* Name of file to process.
NULL if application resource. */
{
Handle sourceText;
@@ -1249,20 +1248,22 @@ Tcl_MacEvalResource(
short saveRef, fileRef = -1;
char idStr[64];
FSSpec fileSpec;
- Tcl_DString buffer;
- char *nativeName;
+ Tcl_DString ds, buffer;
+ CONST char *nativeName;
saveRef = CurResFile();
if (fileName != NULL) {
OSErr err;
- nativeName = Tcl_TranslateFileName(interp, fileName, &buffer);
- if (nativeName == NULL) {
+ if (Tcl_TranslateFileName(interp, fileName, &buffer) == NULL) {
return TCL_ERROR;
}
+ nativeName = Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&buffer),
+ Tcl_DStringLength(&buffer), &ds);
err = FSpLocationFromPath(strlen(nativeName), nativeName,
&fileSpec);
+ Tcl_DStringFree(&ds);
Tcl_DStringFree(&buffer);
if (err != noErr) {
Tcl_AppendResult(interp, "Error finding the file: \"",
@@ -1294,9 +1295,12 @@ Tcl_MacEvalResource(
* Load the resource by name or ID
*/
if (resourceName != NULL) {
- strcpy((char *) rezName + 1, resourceName);
- rezName[0] = strlen(resourceName);
+ Tcl_DString ds;
+ Tcl_UtfToExternalDString(NULL, resourceName, -1, &ds);
+ strcpy((char *) rezName + 1, Tcl_DStringValue(&ds));
+ rezName[0] = (unsigned) Tcl_DStringLength(&ds);
sourceText = GetNamedResource('TEXT', rezName);
+ Tcl_DStringFree(&ds);
} else {
sourceText = GetResource('TEXT', (short) resourceNumber);
}
@@ -1383,20 +1387,24 @@ Tcl_MacConvertTextResource(
{
int i, size;
char *resultStr;
+ Tcl_DString dstr;
size = GetResourceSizeOnDisk(resource);
- resultStr = ckalloc(size + 1);
+ Tcl_ExternalToUtfDString(NULL, *resource, size, &dstr);
+
+ size = Tcl_DStringLength(&dstr) + 1;
+ resultStr = (char *) ckalloc((unsigned) size);
+
+ memcpy((VOID *) resultStr, (VOID *) Tcl_DStringValue(&dstr), (size_t) size);
+
+ Tcl_DStringFree(&dstr);
for (i=0; i<size; i++) {
- if ((*resource)[i] == '\r') {
+ if (resultStr[i] == '\r') {
resultStr[i] = '\n';
- } else {
- resultStr[i] = (*resource)[i];
}
}
-
- resultStr[size] = '\0';
return resultStr;
}
@@ -1421,10 +1429,10 @@ Handle
Tcl_MacFindResource(
Tcl_Interp *interp, /* Interpreter in which to process file. */
long resourceType, /* Type of resource to load. */
- char *resourceName, /* Name of resource to find,
+ CONST char *resourceName, /* Name of resource to find,
* NULL if number should be used. */
int resourceNumber, /* Resource id of source. */
- char *resFileRef, /* Registered resource file reference,
+ CONST char *resFileRef, /* Registered resource file reference,
* NULL if searching all open resource files. */
int *releaseIt) /* Should we release this resource when done. */
{
@@ -1463,15 +1471,19 @@ Tcl_MacFindResource(
resource = GetResource(resourceType, resourceNumber);
}
} else {
- c2pstr(resourceName);
+ Str255 rezName;
+ Tcl_DString ds;
+ Tcl_UtfToExternalDString(NULL, resourceName, -1, &ds);
+ strcpy((char *) rezName + 1, Tcl_DStringValue(&ds));
+ rezName[0] = (unsigned) Tcl_DStringLength(&ds);
if (limitSearch) {
resource = Get1NamedResource(resourceType,
- (StringPtr) resourceName);
+ rezName);
} else {
resource = GetNamedResource(resourceType,
- (StringPtr) resourceName);
+ rezName);
}
- p2cstr((StringPtr) resourceName);
+ Tcl_DStringFree(&ds);
}
if (*resource == NULL) {
@@ -1973,7 +1985,7 @@ TclMacRegisterResourceFork(
if (tokenPtr != NULL) {
char *tokenVal;
int length;
- tokenVal = (char *) Tcl_GetStringFromObj(tokenPtr, &length);
+ tokenVal = Tcl_GetStringFromObj(tokenPtr, &length);
if (length > 0) {
nameHashPtr = Tcl_FindHashEntry(&nameTable, tokenVal);
if (nameHashPtr == NULL) {
@@ -2190,7 +2202,7 @@ BuildResourceForkList()
Tcl_SetStringObj(nameObj, "ROM Map", -1);
} else {
p2cstr((StringPtr) fileName);
- if (strcmp(fileName,(char *) appName) == 0) {
+ if (strcmp(fileName,appName) == 0) {
Tcl_SetStringObj(nameObj, "application", -1);
} else {
Tcl_SetStringObj(nameObj, fileName, -1);
diff --git a/tcl/mac/tclMacResource.r b/tcl/mac/tclMacResource.r
index 8a58c84c5ca..18a32d96861 100644
--- a/tcl/mac/tclMacResource.r
+++ b/tcl/mac/tclMacResource.r
@@ -26,35 +26,6 @@
#define RESOURCE_INCLUDED
#include "tcl.h"
-#if (TCL_RELEASE_LEVEL == 0)
-# define RELEASE_LEVEL alpha
-#elif (TCL_RELEASE_LEVEL == 1)
-# define RELEASE_LEVEL beta
-#elif (TCL_RELEASE_LEVEL == 2)
-# define RELEASE_LEVEL final
-#endif
-
-#if (TCL_RELEASE_LEVEL == 2)
-# define MINOR_VERSION (TCL_MINOR_VERSION * 16) + TCL_RELEASE_SERIAL
-#else
-# define MINOR_VERSION TCL_MINOR_VERSION * 16
-#endif
-
-resource 'vers' (1) {
- TCL_MAJOR_VERSION, MINOR_VERSION,
- RELEASE_LEVEL, 0x00, verUS,
- TCL_PATCH_LEVEL,
- TCL_PATCH_LEVEL ", by Ray Johnson & Jim Ingham © Scriptics Inc."
-};
-
-resource 'vers' (2) {
- TCL_MAJOR_VERSION, MINOR_VERSION,
- RELEASE_LEVEL, 0x00, verUS,
- TCL_PATCH_LEVEL,
- "Simple Tcl Shell " TCL_PATCH_LEVEL " © 1996 - 1999"
-};
-
-
/*
* The mechanisim below loads Tcl source into the resource fork of the
* application. The example below creates a TEXT resource named
@@ -67,24 +38,7 @@ resource 'vers' (2) {
* will load the TEXT resource named "Init".
*/
+#ifndef TCLTK_NO_LIBRARY_TEXT_RESOURCES
#include "tclMacTclCode.r"
-
-/*
- * The following resource is used when creating the 'env' variable in
- * the Macintosh environment. The creation mechanisim looks for the
- * 'STR#' resource named "Tcl Environment Variables" rather than a
- * specific resource number. (In other words, feel free to change the
- * resource id if it conflicts with your application.) Each string in
- * the resource must be of the form "KEYWORD=SOME STRING". See Tcl
- * documentation for futher information about the env variable.
- *
- * A good example of something you may want to set is: "TCL_LIBRARY=My
- * disk:etc."
- */
-
-resource 'STR#' (128, "Tcl Environment Variables") {
- { "SCHEDULE_NAME=Agent Controller Schedule",
- "SCHEDULE_PATH=Lozoya:System Folder:Tcl Lib:Tcl-Scheduler"
- };
-};
+#endif
diff --git a/tcl/mac/tclMacSock.c b/tcl/mac/tclMacSock.c
index b8904ebfd6b..19eef1f9c98 100644
--- a/tcl/mac/tclMacSock.c
+++ b/tcl/mac/tclMacSock.c
@@ -75,7 +75,7 @@ typedef struct TcpState {
* TCL_WRITABLE as set by an asynchronous
* event handler. */
int watchMask; /* OR'ed combination of TCL_READABLE and
- * TCL_WRITABLE as set by Tcl_WatchFile. */
+ * TCL_WRITABLE as set by TcpWatch. */
Tcl_TcpAcceptProc *acceptProc; /* Proc to call on accept. */
ClientData acceptProcData; /* The data for the accept proc. */
wdsEntry dataSegment[2]; /* List of buffers to be written async. */
@@ -138,14 +138,14 @@ static pascal void CleanUpExitProc _ANSI_ARGS_((void));
static void ClearZombieSockets _ANSI_ARGS_((void));
static void CloseCompletionRoutine _ANSI_ARGS_((TCPiopb *pb));
static TcpState * CreateSocket _ANSI_ARGS_((Tcl_Interp *interp,
- int port, char *host, char *myAddr, int myPort,
- int server, int async));
+ int port, CONST char *host, CONST char *myAddr,
+ int myPort, int server, int async));
static pascal void DNRCompletionRoutine _ANSI_ARGS_((
struct hostInfo *hostinfoPtr,
DNRState *dnrStatePtr));
static void FreeSocketInfo _ANSI_ARGS_((TcpState *statePtr));
static long GetBufferSize _ANSI_ARGS_((void));
-static OSErr GetHostFromString _ANSI_ARGS_((char *name,
+static OSErr GetHostFromString _ANSI_ARGS_((CONST char *name,
ip_addr *address));
static OSErr GetLocalAddress _ANSI_ARGS_((unsigned long *addr));
static void IOCompletionRoutine _ANSI_ARGS_((TCPiopb *pb));
@@ -171,12 +171,12 @@ static int TcpClose _ANSI_ARGS_((ClientData instanceData,
static int TcpGetHandle _ANSI_ARGS_((ClientData instanceData,
int direction, ClientData *handlePtr));
static int TcpGetOptionProc _ANSI_ARGS_((ClientData instanceData,
- Tcl_Interp *interp, char *optionName,
+ Tcl_Interp *interp, CONST char *optionName,
Tcl_DString *dsPtr));
static int TcpInput _ANSI_ARGS_((ClientData instanceData,
char *buf, int toRead, int *errorCodePtr));
static int TcpOutput _ANSI_ARGS_((ClientData instanceData,
- char *buf, int toWrite, int *errorCodePtr));
+ CONST char *buf, int toWrite, int *errorCodePtr));
static void TcpWatch _ANSI_ARGS_((ClientData instanceData,
int mask));
static int WaitForSocketEvent _ANSI_ARGS_((TcpState *infoPtr,
@@ -196,7 +196,7 @@ pascal void NotifyRoutine (
static Tcl_ChannelType tcpChannelType = {
"tcp", /* Type name. */
- TcpBlockMode, /* Set blocking or
+ (Tcl_ChannelTypeVersion)TcpBlockMode, /* Set blocking or
* non-blocking mode.*/
TcpClose, /* Close proc. */
TcpInput, /* Input proc. */
@@ -1201,7 +1201,7 @@ TcpGetHandle(
static int
TcpOutput(
ClientData instanceData, /* Channel state. */
- char *buf, /* The data buffer. */
+ CONST char *buf, /* The data buffer. */
int toWrite, /* How many bytes to write? */
int *errorCodePtr) /* Where to store error code. */
{
@@ -1346,7 +1346,7 @@ static int
TcpGetOptionProc(
ClientData instanceData, /* Socket state. */
Tcl_Interp *interp, /* For error reporting - can be NULL.*/
- char *optionName, /* Name of the option to
+ CONST char *optionName, /* Name of the option to
* retrieve the value for, or
* NULL to get all options and
* their values. */
@@ -1354,13 +1354,14 @@ TcpGetOptionProc(
* value; initialized by caller. */
{
TcpState *statePtr = (TcpState *) instanceData;
- int doPeerName = false, doSockName = false, doAll = false;
+ int doPeerName = false, doSockName = false, doError = false, doAll = false;
ip_addr tcpAddress;
char buffer[128];
OSErr err;
Tcl_DString dString;
TCPiopb statusPB;
int errorCode;
+ size_t len = 0;
/*
* If an asynchronous connect is in progress, attempt to wait for it
@@ -1385,16 +1386,41 @@ TcpGetOptionProc(
* if optionName is NULL.
*/
- if (optionName == (char *) NULL || optionName[0] == '\0') {
+ if (optionName == (CONST char *) NULL || optionName[0] == '\0') {
doAll = true;
} else {
- if (!strcmp(optionName, "-peername")) {
+ len = strlen(optionName);
+ if (!strncmp(optionName, "-peername", len)) {
doPeerName = true;
- } else if (!strcmp(optionName, "-sockname")) {
+ } else if (!strncmp(optionName, "-sockname", len)) {
doSockName = true;
+ } else if (!strncmp(optionName, "-error", len)) {
+ /* SF Bug #483575 */
+ doError = true;
} else {
return Tcl_BadChannelOption(interp, optionName,
- "peername sockname");
+ "error peername sockname");
+ }
+ }
+
+ /*
+ * SF Bug #483575
+ *
+ * Return error information. Currently we ignore
+ * this option. IOW, we always return the empty
+ * string, signaling 'no error'.
+ *
+ * FIXME: Get a mac/socket expert to write a correct
+ * FIXME: implementation.
+ */
+
+ if (doAll || doError) {
+ if (doAll) {
+ Tcl_DStringAppendElement(dsPtr, "-error");
+ Tcl_DStringAppendElement(dsPtr, "");
+ } else {
+ Tcl_DStringAppend (dsPtr, "", -1);
+ return TCL_OK;
}
}
@@ -1654,8 +1680,8 @@ static TcpState *
CreateSocket(
Tcl_Interp *interp, /* For error reporting; can be NULL. */
int port, /* Port number to open. */
- char *host, /* Name of host on which to open port. */
- char *myaddr, /* Optional client-side address */
+ CONST char *host, /* Name of host on which to open port. */
+ CONST char *myaddr, /* Optional client-side address */
int myport, /* Optional client-side port */
int server, /* 1 if socket should be a server socket,
* else 0 for a client socket. */
@@ -1844,8 +1870,8 @@ Tcl_Channel
Tcl_OpenTcpClient(
Tcl_Interp *interp, /* For error reporting; can be NULL. */
int port, /* Port number to open. */
- char *host, /* Host on which to open port. */
- char *myaddr, /* Client-side address */
+ CONST char *host, /* Host on which to open port. */
+ CONST char *myaddr, /* Client-side address */
int myport, /* Client-side port */
int async) /* If nonzero, attempt to do an
* asynchronous connect. Otherwise
@@ -1898,7 +1924,7 @@ Tcl_OpenTcpServer(
Tcl_Interp *interp, /* For error reporting - may be
* NULL. */
int port, /* Port number to open. */
- char *host, /* Name of local host. */
+ CONST char *host, /* Name of local host. */
Tcl_TcpAcceptProc *acceptProc, /* Callback for accepting connections
* from new clients. */
ClientData acceptProcData) /* Data for the callback. */
@@ -2225,7 +2251,7 @@ TcpAccept(
*----------------------------------------------------------------------
*/
-char *
+CONST char *
Tcl_GetHostName()
{
static int hostnameInited = 0;
@@ -2426,7 +2452,7 @@ CleanUpExitProc()
static OSErr
GetHostFromString(
- char *name, /* Host in string form. */
+ CONST char *name, /* Host in string form. */
ip_addr *address) /* Returned IP address. */
{
OSErr err;
@@ -2449,7 +2475,7 @@ GetHostFromString(
}
dnrState.done = 0;
GetCurrentProcess(&(dnrState.psn));
- err = StrToAddr(name, &dnrState.hostInfo, resultUPP, (Ptr) &dnrState);
+ err = StrToAddr((char*)name, &dnrState.hostInfo, resultUPP, (Ptr) &dnrState);
if (err == cacheFault) {
while (!dnrState.done) {
WaitNextEvent(0, &dummy, 1, NULL);
@@ -2464,7 +2490,7 @@ GetHostFromString(
if (dnrState.hostInfo.rtnCode == cacheFault) {
dnrState.done = 0;
- err = StrToAddr(name, &dnrState.hostInfo, resultUPP, (Ptr) &dnrState);
+ err = StrToAddr((char*)name, &dnrState.hostInfo, resultUPP, (Ptr) &dnrState);
if (err == cacheFault) {
while (!dnrState.done) {
WaitNextEvent(0, &dummy, 1, NULL);
diff --git a/tcl/mac/tclMacTclCode.r b/tcl/mac/tclMacTclCode.r
index c3a0c2280d2..13b23e23667 100644
--- a/tcl/mac/tclMacTclCode.r
+++ b/tcl/mac/tclMacTclCode.r
@@ -29,9 +29,9 @@
* will load the TEXT resource named "Init".
*/
-read 'TEXT' (TCL_LIBRARY_RESOURCES, "Init", purgeable) "::library:init.tcl";
-read 'TEXT' (TCL_LIBRARY_RESOURCES + 1, "Auto", purgeable) "::library:auto.tcl";
-read 'TEXT' (TCL_LIBRARY_RESOURCES + 2, "Package", purgeable,preload) "::library:package.tcl";
-read 'TEXT' (TCL_LIBRARY_RESOURCES + 3, "History", purgeable) "::library:history.tcl";
-read 'TEXT' (TCL_LIBRARY_RESOURCES + 4, "Word", purgeable,preload) "::library:word.tcl";
-read 'TEXT' (TCL_LIBRARY_RESOURCES + 5, "Parray", purgeable,preload) "::library:parray.tcl";
+read 'TEXT' (TCL_LIBRARY_RESOURCES, "init", purgeable) "::library:init.tcl";
+read 'TEXT' (TCL_LIBRARY_RESOURCES + 1, "auto", purgeable) "::library:auto.tcl";
+read 'TEXT' (TCL_LIBRARY_RESOURCES + 2, "package", purgeable,preload) "::library:package.tcl";
+read 'TEXT' (TCL_LIBRARY_RESOURCES + 3, "history", purgeable) "::library:history.tcl";
+read 'TEXT' (TCL_LIBRARY_RESOURCES + 4, "word", purgeable,preload) "::library:word.tcl";
+read 'TEXT' (TCL_LIBRARY_RESOURCES + 5, "parray", purgeable,preload) "::library:parray.tcl";
diff --git a/tcl/mac/tclMacTest.c b/tcl/mac/tclMacTest.c
index a376e329bdd..56164200161 100644
--- a/tcl/mac/tclMacTest.c
+++ b/tcl/mac/tclMacTest.c
@@ -13,7 +13,7 @@
*/
#define TCL_TEST
-
+#define USE_COMPAT_CONST
#include "tclInt.h"
#include "tclMacInt.h"
#include "tclMacPort.h"
diff --git a/tcl/mac/tclMacThrd.c b/tcl/mac/tclMacThrd.c
index eb5886524ea..3fdafe3b61b 100644
--- a/tcl/mac/tclMacThrd.c
+++ b/tcl/mac/tclMacThrd.c
@@ -51,6 +51,12 @@ static int keyCounter = 0;
TclMacThrdData *GetThreadDataStruct(Tcl_ThreadDataKey keyVal);
TclMacThrdData *RemoveThreadDataStruct(Tcl_ThreadDataKey keyVal);
+
+/*
+ * Note: The race evoked by the emulation layer for joinable threads
+ * (see ../win/tclWinThrd.c) cannot occur on this platform due to
+ * the cooperative implementation of multithreading.
+ */
/*
*----------------------------------------------------------------------
@@ -112,7 +118,6 @@ Tcl_CreateThread(idPtr, proc, clientData, stackSize, flags)
int flags; /* Flags controlling behaviour of
* the new thread */
{
-
if (!TclMacHaveThreads()) {
return TCL_ERROR;
}
@@ -124,7 +129,7 @@ Tcl_CreateThread(idPtr, proc, clientData, stackSize, flags)
#if TARGET_CPU_68K && TARGET_RT_MAC_CFM
{
ThreadEntryProcPtr entryProc;
- entryProc = NewThreadEntryProc(proc);
+ entryProc = NewThreadEntryUPP(proc);
NewThread(kCooperativeThread, entryProc, (void *) clientData,
stackSize, kCreateIfNeeded, NULL, (ThreadID *) idPtr);
@@ -136,6 +141,10 @@ Tcl_CreateThread(idPtr, proc, clientData, stackSize, flags)
if ((ThreadID) *idPtr == kNoThreadID) {
return TCL_ERROR;
} else {
+ if (flags & TCL_THREAD_JOINABLE) {
+ TclRememberJoinableThread (*idPtr);
+ }
+
return TCL_OK;
}
@@ -144,6 +153,37 @@ Tcl_CreateThread(idPtr, proc, clientData, stackSize, flags)
/*
*----------------------------------------------------------------------
*
+ * Tcl_JoinThread --
+ *
+ * This procedure waits upon the exit of the specified thread.
+ *
+ * Results:
+ * TCL_OK if the wait was successful, TCL_ERROR else.
+ *
+ * Side effects:
+ * The result area is set to the exit code of the thread we
+ * waited upon.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_JoinThread(id, result)
+ Tcl_ThreadId id; /* Id of the thread to wait upon */
+ int* result; /* Reference to the storage the result
+ * of the thread we wait upon will be
+ * written into. */
+{
+ if (!TclMacHaveThreads()) {
+ return TCL_ERROR;
+ }
+
+ return TclJoinThread (id, result);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclpThreadExit --
*
* This procedure terminates the current thread.
@@ -168,6 +208,8 @@ TclpThreadExit(status)
}
GetCurrentThread(&curThread);
+ TclSignalExitThread ((Tcl_ThreadId) curThread, status);
+
DisposeThread(curThread, NULL, false);
}
diff --git a/tcl/mac/tclMacTime.c b/tcl/mac/tclMacTime.c
index f4d236def00..334aea0eafa 100644
--- a/tcl/mac/tclMacTime.c
+++ b/tcl/mac/tclMacTime.c
@@ -14,18 +14,103 @@
#include "tclInt.h"
#include "tclPort.h"
+#include "tclMacInt.h"
#include <OSUtils.h>
#include <Timer.h>
#include <time.h>
/*
- * Static variables used by the TclpGetTime function.
+ * Static variables used by the Tcl_GetTime function.
*/
static int initalized = false;
static unsigned long baseSeconds;
static UnsignedWide microOffset;
+static int gmt_initialized = false;
+static long gmt_offset;
+static int gmt_isdst;
+TCL_DECLARE_MUTEX(gmtMutex)
+
+static int gmt_lastGetDateUseGMT = 0;
+
+typedef struct _TABLE {
+ char *name;
+ int type;
+ time_t value;
+} TABLE;
+
+
+#define HOUR(x) ((time_t) (3600 * x))
+
+#define tZONE 0
+#define tDAYZONE 1
+
+
+/*
+ * inverse timezone table, adapted from tclDate.c by removing duplicates and
+ * adding some made up names for unusual daylight savings
+ */
+static TABLE invTimezoneTable[] = {
+ { "Z", -1, HOUR( 36) }, /* Unknown */
+ { "GMT", tZONE, HOUR( 0) }, /* Greenwich Mean */
+ { "BST", tDAYZONE, HOUR( 0) }, /* British Summer */
+ { "WAT", tZONE, HOUR( 1) }, /* West Africa */
+ { "WADST", tDAYZONE, HOUR( 1) }, /* West Africa Daylight*/
+ { "AT", tZONE, HOUR( 2) }, /* Azores Daylight*/
+ { "ADST", tDAYZONE, HOUR( 2) }, /* Azores */
+ { "NFT", tZONE, HOUR( 7/2) }, /* Newfoundland */
+ { "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 */
+ { "NT", tZONE, HOUR(11) }, /* Nome */
+ { "NST", tDAYZONE, HOUR(11) }, /* Nome Daylight*/
+ { "IDLW", tZONE, HOUR(12) }, /* International Date Line West */
+ { "CET", tZONE, -HOUR( 1) }, /* Central European */
+ { "CEST", tDAYZONE, -HOUR( 1) }, /* Central European Summer */
+ { "EET", tZONE, -HOUR( 2) }, /* Eastern Europe, USSR Zone 1 */
+ { "EEST", tDAYZONE, -HOUR( 2) }, /* Eastern Europe, USSR Zone 1 Daylight*/
+ { "BT", tZONE, -HOUR( 3) }, /* Baghdad, USSR Zone 2 */
+ { "BDST", tDAYZONE, -HOUR( 3) }, /* Baghdad, USSR Zone 2 Daylight*/
+ { "IT", tZONE, -HOUR( 7/2) }, /* Iran */
+ { "IDST", tDAYZONE, -HOUR( 7/2) }, /* Iran Daylight*/
+ { "ZP4", tZONE, -HOUR( 4) }, /* USSR Zone 3 */
+ { "ZP4S", tDAYZONE, -HOUR( 4) }, /* USSR Zone 3 */
+ { "ZP5", tZONE, -HOUR( 5) }, /* USSR Zone 4 */
+ { "ZP5S", tDAYZONE, -HOUR( 5) }, /* USSR Zone 4 */
+ { "IST", tZONE, -HOUR(11/2) }, /* Indian Standard */
+ { "ISDST", tDAYZONE, -HOUR(11/2) }, /* Indian Standard */
+ { "ZP6", tZONE, -HOUR( 6) }, /* USSR Zone 5 */
+ { "ZP6S", tDAYZONE, -HOUR( 6) }, /* USSR Zone 5 */
+ { "WAST", tZONE, -HOUR( 7) }, /* West Australian Standard */
+ { "WADT", tDAYZONE, -HOUR( 7) }, /* West Australian Daylight */
+ { "JT", tZONE, -HOUR(15/2) }, /* Java (3pm in Cronusland!) */
+ { "JDST", tDAYZONE, -HOUR(15/2) }, /* Java (3pm in Cronusland!) */
+ { "CCT", tZONE, -HOUR( 8) }, /* China Coast, USSR Zone 7 */
+ { "CCST", tDAYZONE, -HOUR( 8) }, /* China Coast, USSR Zone 7 */
+ { "JST", tZONE, -HOUR( 9) }, /* Japan Standard, USSR Zone 8 */
+ { "JSDST", tDAYZONE, -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 */
+ { "NZT", tZONE, -HOUR(12) }, /* New Zealand */
+ { "NZDT", tDAYZONE, -HOUR(12) }, /* New Zealand Daylight */
+ { NULL }
+};
+
/*
* Prototypes for procedures that are private to this file:
*/
@@ -36,6 +121,43 @@ static void SubtractUnsignedWide _ANSI_ARGS_((UnsignedWide *x,
/*
*-----------------------------------------------------------------------------
*
+ * TclpGetGMTOffset --
+ *
+ * This procedure gets the offset seconds that needs to be _added_ to tcl time
+ * in seconds (i.e. GMT time) to get local time needed as input to various
+ * Mac OS APIs, to convert Mac OS API output to tcl time, _subtract_ this value.
+ *
+ * Results:
+ * Number of seconds separating GMT time and mac.
+ *
+ * Side effects:
+ * None.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+long
+TclpGetGMTOffset()
+{
+ if (gmt_initialized == false) {
+ MachineLocation loc;
+
+ Tcl_MutexLock(&gmtMutex);
+ ReadLocation(&loc);
+ gmt_offset = loc.u.gmtDelta & 0x00ffffff;
+ if (gmt_offset & 0x00800000) {
+ gmt_offset = gmt_offset | 0xff000000;
+ }
+ gmt_isdst=(loc.u.dlsDelta < 0);
+ gmt_initialized = true;
+ Tcl_MutexUnlock(&gmtMutex);
+ }
+ return (gmt_offset);
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
* TclpGetSeconds --
*
* This procedure returns the number of seconds from the epoch. On
@@ -57,21 +179,9 @@ unsigned long
TclpGetSeconds()
{
unsigned long seconds;
- MachineLocation loc;
- long int offset;
-
- ReadLocation(&loc);
- offset = loc.u.gmtDelta & 0x00ffffff;
- if (offset & 0x00800000) {
- offset = offset | 0xff000000;
- }
- if (ReadDateTime(&seconds) == noErr) {
- return (seconds - offset);
- } else {
- panic("Can't get time.");
- return 0;
- }
+ GetDateTime(&seconds);
+ return (seconds - TclpGetGMTOffset() + tcl_mac_epoch_offset);
}
/*
@@ -123,22 +233,15 @@ int
TclpGetTimeZone (
unsigned long currentTime) /* Ignored on Mac. */
{
- MachineLocation loc;
- long int offset;
-
- ReadLocation(&loc);
- offset = loc.u.gmtDelta & 0x00ffffff;
- if (offset & 0x00700000) {
- offset |= 0xff000000;
- }
+ long offset;
/*
* Convert the Mac offset from seconds to minutes and
* add an hour if we have daylight savings time.
*/
- offset = -offset;
+ offset = -TclpGetGMTOffset();
offset /= 60;
- if (loc.u.dlsDelta < 0) {
+ if (gmt_isdst) {
offset += 60;
}
@@ -148,7 +251,7 @@ TclpGetTimeZone (
/*
*----------------------------------------------------------------------
*
- * TclpGetTime --
+ * Tcl_GetTime --
*
* Gets the current system time in seconds and microseconds
* since the beginning of the epoch: 00:00 UCT, January 1, 1970.
@@ -163,7 +266,7 @@ TclpGetTimeZone (
*/
void
-TclpGetTime(
+Tcl_GetTime(
Tcl_Time *timePtr) /* Location to store time information. */
{
UnsignedWide micro;
@@ -172,24 +275,11 @@ TclpGetTime(
#endif
if (initalized == false) {
- MachineLocation loc;
- long int offset;
-
- ReadLocation(&loc);
- offset = loc.u.gmtDelta & 0x00ffffff;
- if (offset & 0x00800000) {
- offset = offset | 0xff000000;
- }
- if (ReadDateTime(&baseSeconds) != noErr) {
- /*
- * This should never happen!
- */
- return;
- }
+ GetDateTime(&baseSeconds);
/*
* Remove the local offset that ReadDateTime() adds.
*/
- baseSeconds -= offset;
+ baseSeconds -= TclpGetGMTOffset() - tcl_mac_epoch_offset;
Microseconds(&microOffset);
initalized = true;
}
@@ -246,25 +336,16 @@ TclpGetDate(
{
const time_t *tp = (const time_t *)time;
DateTimeRec dtr;
- MachineLocation loc;
- long int offset;
+ unsigned long offset=0L;
static struct tm statictime;
static const short monthday[12] =
{0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334};
-
- ReadLocation(&loc);
-
- if (useGMT) {
- SecondsToDate(*tp, &dtr);
- } else {
- offset = loc.u.gmtDelta & 0x00ffffff;
- if (offset & 0x00700000) {
- offset |= 0xff000000;
- }
+
+ if(useGMT)
+ SecondsToDate(*tp - tcl_mac_epoch_offset, &dtr);
+ else
+ SecondsToDate(*tp + TclpGetGMTOffset() - tcl_mac_epoch_offset, &dtr);
- SecondsToDate(*tp + offset, &dtr);
- }
-
statictime.tm_sec = dtr.second;
statictime.tm_min = dtr.minute;
statictime.tm_hour = dtr.hour;
@@ -277,10 +358,51 @@ TclpGetDate(
if (1 < statictime.tm_mon && !(statictime.tm_year & 3)) {
++statictime.tm_yday;
}
- statictime.tm_isdst = loc.u.dlsDelta;
+ if(useGMT)
+ statictime.tm_isdst = 0;
+ else
+ statictime.tm_isdst = gmt_isdst;
+ gmt_lastGetDateUseGMT=useGMT; /* hack to make TclpGetTZName below work */
return(&statictime);
}
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpGetTZName --
+ *
+ * Gets the current timezone string.
+ *
+ * Results:
+ * Returns a pointer to a static string, or NULL on failure.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TclpGetTZName(int dst)
+{
+ register TABLE *tp;
+ long zonevalue=-TclpGetGMTOffset();
+
+ if (gmt_isdst)
+ zonevalue += HOUR(1);
+
+ if(gmt_lastGetDateUseGMT) /* hack: if last TclpGetDate was called */
+ zonevalue=0; /* with useGMT==1 then we're using GMT */
+
+ for (tp = invTimezoneTable; tp->name; tp++) {
+ if ((tp->value == zonevalue) && (tp->type == dst)) break;
+ }
+ if(!tp->name)
+ tp = invTimezoneTable; /* default to unknown */
+
+ return tp->name;
+}
+
#ifdef NO_LONG_LONG
/*
*----------------------------------------------------------------------
diff --git a/tcl/mac/tclMacUnix.c b/tcl/mac/tclMacUnix.c
index 3d51b7d9b9a..08d0075009e 100644
--- a/tcl/mac/tclMacUnix.c
+++ b/tcl/mac/tclMacUnix.c
@@ -206,7 +206,7 @@ Tcl_LsObjCmd(
resultObjPtr = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(resultObjPtr);
- if (Tcl_ListObjGetElements(interp, resultObjPtr, &objc, &objv) != TCL_OK) {
+ if (Tcl_ListObjGetElements(interp, resultObjPtr, &objc, (Tcl_Obj ***)&objv) != TCL_OK) {
Tcl_DecrRefCount(resultObjPtr);
return TCL_ERROR;
}
diff --git a/tcl/mac/tclMacUtil.c b/tcl/mac/tclMacUtil.c
index ae45a2f3751..70c122fd632 100644
--- a/tcl/mac/tclMacUtil.c
+++ b/tcl/mac/tclMacUtil.c
@@ -53,7 +53,7 @@
*----------------------------------------------------------------------
*/
-#if defined(THINK_C) || defined(__MWERKS__)
+#if defined(THINK_C)
double hypotd(double x, double y);
double
@@ -178,6 +178,10 @@ FSpFindFolder(
err = FSMakeFSSpecCompat(foundVRefNum, foundDirID, "\p", spec);
return err;
}
+
+static int
+FSpLocationFromPathAlias _ANSI_ARGS_((int length, CONST char *path,
+ FSSpecPtr fileSpecPtr, Boolean resolveLink));
/*
*----------------------------------------------------------------------
@@ -204,13 +208,52 @@ FSpLocationFromPath(
CONST char *path, /* The path to convert. */
FSSpecPtr fileSpecPtr) /* On return the spec for the path. */
{
+ return FSpLocationFromPathAlias(length, path, fileSpecPtr, TRUE);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FSpLLocationFromPath --
+ *
+ * This function obtains an FSSpec for a given macintosh path.
+ * Unlike the More Files function FSpLocationFromFullPath, this
+ * function will also accept partial paths and resolve any aliases
+ * along the path expect for the last path component.
+ *
+ * Results:
+ * OSErr code.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+FSpLLocationFromPath(
+ int length, /* Length of path. */
+ CONST char *path, /* The path to convert. */
+ FSSpecPtr fileSpecPtr) /* On return the spec for the path. */
+{
+ return FSpLocationFromPathAlias(length, path, fileSpecPtr, FALSE);
+}
+
+static int
+FSpLocationFromPathAlias(
+ int length, /* Length of path. */
+ CONST char *path, /* The path to convert. */
+ FSSpecPtr fileSpecPtr, /* On return the spec for the path. */
+ Boolean resolveLink) /* Resolve the last path component? */
+{
Str255 fileName;
OSErr err;
short vRefNum;
long dirID;
int pos, cur;
Boolean isDirectory;
- Boolean wasAlias;
+ Boolean wasAlias=FALSE;
+ FSSpec lastFileSpec;
/*
* Check to see if this is a full path. If partial
@@ -277,6 +320,7 @@ FSpLocationFromPath(
}
err = FSMakeFSSpecCompat(vRefNum, dirID, fileName, fileSpecPtr);
if (err != noErr) return err;
+ lastFileSpec=*fileSpecPtr;
err = ResolveAliasFile(fileSpecPtr, true, &isDirectory, &wasAlias);
if (err != noErr) return err;
FSpGetDirectoryID(fileSpecPtr, &dirID, &isDirectory);
@@ -287,6 +331,9 @@ FSpLocationFromPath(
}
}
+ if(!resolveLink && wasAlias)
+ *fileSpecPtr=lastFileSpec;
+
return noErr;
}
@@ -420,7 +467,7 @@ FSpPathFromLocation(
/*
*----------------------------------------------------------------------
*
- * GetGlobalMouse --
+ * GetGlobalMouseTcl --
*
* This procedure obtains the current mouse position in global
* coordinates.
@@ -435,7 +482,7 @@ FSpPathFromLocation(
*/
void
-GetGlobalMouse(
+GetGlobalMouseTcl(
Point *mouse) /* Mouse position. */
{
EventRecord event;
@@ -444,3 +491,20 @@ GetGlobalMouse(
*mouse = event.where;
}
+pascal OSErr FSpGetDirectoryIDTcl (CONST FSSpec * spec,
+ long * theDirID, Boolean * isDirectory)
+{
+ return(FSpGetDirectoryID(spec, theDirID, isDirectory));
+}
+
+pascal short FSpOpenResFileCompatTcl (CONST FSSpec * spec, SignedByte permission)
+{
+ return(FSpOpenResFileCompat(spec,permission));
+}
+
+pascal void FSpCreateResFileCompatTcl (
+ CONST FSSpec * spec, OSType creator,
+ OSType fileType, ScriptCode scriptTag)
+{
+ FSpCreateResFileCompat (spec,creator,fileType,scriptTag);
+}
diff --git a/tcl/macosx/Makefile b/tcl/macosx/Makefile
new file mode 100644
index 00000000000..fa2404bfc0b
--- /dev/null
+++ b/tcl/macosx/Makefile
@@ -0,0 +1,74 @@
+################################################################################
+#
+# Simple makefile for building on Mac OS X with the
+# Project Builder command line tool 'pbxbuild'
+#
+# RCS: @(#) $Id$
+#
+################################################################################
+
+INSTALL_ROOT =
+
+BUILD_DIR = ../../build
+
+TARGET = Tcl
+
+DEVBUILDSTYLE = Development
+DEPBUILDSTYLE = Deployment
+
+PBXBUILD = /usr/bin/pbxbuild
+
+BUILD = ${PBXBUILD} SYMROOT="${BUILD_DIR}" -target "${TARGET}"
+
+DEVBUILD = ${BUILD} -buildstyle "${DEVBUILDSTYLE}"
+DEPBUILD = ${BUILD} -buildstyle "${DEPBUILDSTYLE}"
+
+INSTALLOPTS = INSTALL_ROOT="${INSTALL_ROOT}"
+
+EMBEDDEDOPTS = DYLIB_INSTALL_PATH="@executable_path/../Frameworks"
+
+################################################################################
+
+all: develop deploy
+
+install: install-develop install-deploy
+
+embedded: embedded-develop embedded-deploy
+
+install-embedded: install-embedded-develop install-embedded-deploy
+
+clean: clean-develop clean-deploy
+
+################################################################################
+
+develop:
+ ${DEVBUILD}
+
+deploy:
+ ${DEPBUILD}
+
+install-develop:
+ ${DEVBUILD} install ${INSTALLOPTS}
+
+install-deploy:
+ ${DEPBUILD} install ${INSTALLOPTS}
+
+embedded-develop:
+ ${DEVBUILD} ${EMBEDDEDOPTS}
+
+embedded-deploy:
+ ${DEPBUILD} ${EMBEDDEDOPTS}
+
+install-embedded-develop:
+ ${DEVBUILD} install ${INSTALLOPTS} ${EMBEDDEDOPTS}
+
+install-embedded-deploy:
+ ${DEPBUILD} install ${INSTALLOPTS} ${EMBEDDEDOPTS}
+
+clean-develop:
+ ${DEVBUILD} clean
+
+clean-deploy:
+ ${DEPBUILD} clean
+
+################################################################################
diff --git a/tcl/macosx/Tcl.pbproj/jingham.pbxuser b/tcl/macosx/Tcl.pbproj/jingham.pbxuser
new file mode 100644
index 00000000000..d9145781471
--- /dev/null
+++ b/tcl/macosx/Tcl.pbproj/jingham.pbxuser
@@ -0,0 +1,405 @@
+// !$*UTF8*$!
+{
+ 005751AA02FB00930AC916F0 = {
+ fRef = 005751AB02FB00930AC916F0;
+ isa = PBXTextBookmark;
+ name = "DefaultsDoc.rtf: 30";
+ rLen = 32;
+ rLoc = 2777;
+ rType = 0;
+ vrLen = 1334;
+ vrLoc = 2136;
+ };
+ 005751AB02FB00930AC916F0 = {
+ isa = PBXFileReference;
+ name = DefaultsDoc.rtf;
+ path = "/Developer/Applications/Project Builder.app/Contents/Resources/DefaultsDoc.rtf";
+ refType = 0;
+ };
+ 00E2F845016E82EB0ACA28DC = {
+ activeBuildStyle = 00E2F847016E82EB0ACA28DC;
+ activeTarget = F50DC359017027D801DC9062;
+ addToTargets = (
+ 00E2F84C016E8B780ACA28DC,
+ );
+ breakpoints = (
+ );
+ perUserDictionary = {
+ PBXPerProjectTemplateStateSaveDate = 49920633;
+ "PBXTemplateGeometry-F5314676015831810DCA290F" = {
+ ContentSize = "{789, 551}";
+ LeftSlideOut = {
+ Collapsed = NO;
+ Frame = "{{0, 23}, {789, 528}}";
+ Split0 = {
+ ActiveTab = 2;
+ Collapsed = NO;
+ Frame = "{{0, 0}, {789, 528}}";
+ Split0 = {
+ Frame = "{{0, 204}, {789, 324}}";
+ };
+ SplitCount = 1;
+ Tab0 = {
+ Debugger = {
+ Collapsed = NO;
+ Frame = "{{0, 0}, {952, 321}}";
+ Split0 = {
+ Frame = "{{0, 24}, {952, 297}}";
+ Split0 = {
+ Frame = "{{0, 0}, {468, 297}}";
+ };
+ Split1 = {
+ DebugVariablesTableConfiguration = (
+ Name,
+ 123,
+ Value,
+ 85,
+ Summary,
+ 241.123,
+ );
+ Frame = "{{477, 0}, {475, 297}}";
+ };
+ SplitCount = 2;
+ };
+ SplitCount = 1;
+ Tab0 = {
+ Frame = "{{0, 0}, {100, 50}}";
+ };
+ Tab1 = {
+ Frame = "{{0, 0}, {100, 50}}";
+ };
+ TabCount = 2;
+ TabsVisible = YES;
+ };
+ Frame = "{{0, 0}, {952, 321}}";
+ LauncherConfigVersion = 7;
+ };
+ Tab1 = {
+ Frame = "{{0, 0}, {781, 452}}";
+ LauncherConfigVersion = 3;
+ Runner = {
+ Frame = "{{0, 0}, {781, 452}}";
+ };
+ };
+ Tab2 = {
+ BuildMessageFrame = "{{0, 0}, {791, 191}}";
+ BuildTranscriptFrame = "{{0, 200}, {791, 0}}";
+ Frame = "{{0, 0}, {789, 198}}";
+ };
+ Tab3 = {
+ Frame = "{{0, 0}, {612, 295}}";
+ };
+ TabCount = 4;
+ TabsVisible = NO;
+ };
+ SplitCount = 1;
+ Tab0 = {
+ Frame = "{{0, 0}, {300, 533}}";
+ GroupTreeTableConfiguration = (
+ TargetStatusColumn,
+ 18,
+ MainColumn,
+ 267,
+ );
+ };
+ Tab1 = {
+ ClassesFrame = "{{0, 0}, {280, 398}}";
+ ClassesTreeTableConfiguration = (
+ PBXBookColumnIdentifier,
+ 20,
+ PBXClassColumnIdentifier,
+ 237,
+ );
+ Frame = "{{0, 0}, {278, 659}}";
+ MembersFrame = "{{0, 407}, {280, 252}}";
+ MembersTreeTableConfiguration = (
+ PBXBookColumnIdentifier,
+ 20,
+ PBXMethodColumnIdentifier,
+ 236,
+ );
+ };
+ Tab2 = {
+ Frame = "{{0, 0}, {200, 100}}";
+ };
+ Tab3 = {
+ Frame = "{{0, 0}, {200, 100}}";
+ TargetTableConfiguration = (
+ ActiveObject,
+ 16,
+ ObjectNames,
+ 202.296,
+ );
+ };
+ Tab4 = {
+ BreakpointsTreeTableConfiguration = (
+ breakpointColumn,
+ 197,
+ enabledColumn,
+ 31,
+ );
+ Frame = "{{0, 0}, {250, 100}}";
+ };
+ TabCount = 5;
+ TabsVisible = NO;
+ };
+ StatusViewVisible = YES;
+ Template = F5314676015831810DCA290F;
+ ToolbarVisible = YES;
+ WindowLocation = "{7, 385}";
+ };
+ PBXWorkspaceContents = (
+ {
+ LeftSlideOut = {
+ Split0 = {
+ Split0 = {
+ NavContent0 = {
+ bookmark = 005751AA02FB00930AC916F0;
+ history = (
+ F5BFE56402F8B7A901DC9062,
+ F5BFE56702F8B7A901DC9062,
+ 00F4D9CE02F9BA490AC916F0,
+ );
+ prevStack = (
+ F5BFE56A02F8B7A901DC9062,
+ );
+ };
+ NavCount = 1;
+ NavGeometry0 = {
+ Frame = "{{0, 0}, {571, 548}}";
+ NavBarVisible = YES;
+ };
+ };
+ SplitCount = 1;
+ Tab0 = {
+ Debugger = {
+ Split0 = {
+ SplitCount = 2;
+ };
+ SplitCount = 1;
+ TabCount = 2;
+ };
+ LauncherConfigVersion = 7;
+ };
+ Tab1 = {
+ LauncherConfigVersion = 3;
+ Runner = {
+ };
+ };
+ TabCount = 4;
+ };
+ SplitCount = 1;
+ Tab1 = {
+ OptionsSetName = "Default Options";
+ };
+ TabCount = 5;
+ };
+ },
+ );
+ PBXWorkspaceGeometries = (
+ {
+ ContentSize = "{855, 571}";
+ LeftSlideOut = {
+ ActiveTab = 0;
+ Collapsed = NO;
+ Frame = "{{0, 23}, {855, 548}}";
+ Split0 = {
+ Collapsed = NO;
+ Frame = "{{284, 0}, {571, 548}}";
+ Split0 = {
+ Frame = "{{0, 0}, {571, 548}}";
+ };
+ SplitCount = 1;
+ Tab0 = {
+ Debugger = {
+ Collapsed = NO;
+ Frame = "{{0, 0}, {681, 289}}";
+ Split0 = {
+ Frame = "{{0, 24}, {681, 265}}";
+ Split0 = {
+ Frame = "{{0, 0}, {333, 265}}";
+ };
+ Split1 = {
+ DebugVariablesTableConfiguration = (
+ Name,
+ 82.80298,
+ Value,
+ 104.074,
+ Summary,
+ 126.123,
+ );
+ Frame = "{{342, 0}, {339, 265}}";
+ };
+ SplitCount = 2;
+ };
+ SplitCount = 1;
+ Tab0 = {
+ Frame = "{{0, 0}, {100, 50}}";
+ };
+ Tab1 = {
+ Frame = "{{0, 0}, {100, 50}}";
+ };
+ TabCount = 2;
+ TabsVisible = YES;
+ };
+ Frame = "{{0, 0}, {681, 289}}";
+ LauncherConfigVersion = 7;
+ };
+ Tab1 = {
+ Frame = "{{0, 0}, {681, 120}}";
+ LauncherConfigVersion = 3;
+ Runner = {
+ Frame = "{{0, 0}, {681, 120}}";
+ };
+ };
+ Tab2 = {
+ BuildMessageFrame = "{{0, 0}, {683, 127}}";
+ BuildTranscriptFrame = "{{0, 136}, {683, 100}}";
+ Frame = "{{0, 0}, {681, 234}}";
+ };
+ Tab3 = {
+ Frame = "{{0, 0}, {681, 238}}";
+ };
+ TabCount = 4;
+ TabsVisible = NO;
+ };
+ SplitCount = 1;
+ Tab0 = {
+ Frame = "{{0, 0}, {260, 548}}";
+ GroupTreeTableConfiguration = (
+ SCMStatusColumn,
+ 22,
+ TargetStatusColumn,
+ 18,
+ MainColumn,
+ 205,
+ );
+ };
+ Tab1 = {
+ ClassesFrame = "{{0, 0}, {250, 333}}";
+ ClassesTreeTableConfiguration = (
+ PBXBookColumnIdentifier,
+ 20,
+ PBXClassColumnIdentifier,
+ 207,
+ );
+ Frame = "{{0, 0}, {248, 554}}";
+ MembersFrame = "{{0, 342}, {250, 212}}";
+ MembersTreeTableConfiguration = (
+ PBXBookColumnIdentifier,
+ 20,
+ PBXMethodColumnIdentifier,
+ 206,
+ );
+ };
+ Tab2 = {
+ Frame = "{{0, 0}, {217, 554}}";
+ };
+ Tab3 = {
+ Frame = "{{0, 0}, {239, 548}}";
+ TargetTableConfiguration = (
+ ActiveObject,
+ 16,
+ ObjectNames,
+ 206,
+ );
+ };
+ Tab4 = {
+ BreakpointsTreeTableConfiguration = (
+ breakpointColumn,
+ 197,
+ enabledColumn,
+ 31,
+ );
+ Frame = "{{0, 0}, {250, 554}}";
+ };
+ TabCount = 5;
+ TabsVisible = YES;
+ };
+ StatusViewVisible = YES;
+ Template = 64ABBB4501FA494900185B06;
+ ToolbarVisible = YES;
+ WindowLocation = "{77, 330}";
+ },
+ );
+ PBXWorkspaceStateSaveDate = 49920633;
+ };
+ perUserProjectItems = {
+ 005751AA02FB00930AC916F0 = 005751AA02FB00930AC916F0;
+ 00F4D9CE02F9BA490AC916F0 = 00F4D9CE02F9BA490AC916F0;
+ F5BFE56402F8B7A901DC9062 = F5BFE56402F8B7A901DC9062;
+ F5BFE56702F8B7A901DC9062 = F5BFE56702F8B7A901DC9062;
+ F5BFE56A02F8B7A901DC9062 = F5BFE56A02F8B7A901DC9062;
+ };
+ projectwideBuildSettings = {
+ OBJROOT = "/Volumes/TheCloset/jingham/tcl-tk/source/tcl-merge/Objects";
+ SYMROOT = "/Volumes/TheCloset/jingham/tcl-tk/source/tcl-merge/Products";
+ };
+ wantsIndex = 1;
+ wantsSCM = 1;
+ };
+ 00E2F84B016E8A830ACA28DC = {
+ activeExec = 0;
+ };
+ 00E2F84C016E8B780ACA28DC = {
+ activeExec = 0;
+ };
+ 00E2F84E016E92110ACA28DC = {
+ activeExec = 0;
+ };
+ 00F4D9CE02F9BA490AC916F0 = {
+ fRef = 00F4D9CF02F9BA4A0AC916F0;
+ isa = PBXTextBookmark;
+ name = "DefaultsDoc.rtf: 30";
+ rLen = 32;
+ rLoc = 2777;
+ rType = 0;
+ vrLen = 1334;
+ vrLoc = 2136;
+ };
+ 00F4D9CF02F9BA4A0AC916F0 = {
+ isa = PBXFileReference;
+ name = DefaultsDoc.rtf;
+ path = "/Developer/Applications/Project Builder.app/Contents/Resources/DefaultsDoc.rtf";
+ refType = 0;
+ };
+ F50DC359017027D801DC9062 = {
+ activeExec = 0;
+ };
+ F5BFE56402F8B7A901DC9062 = {
+ fRef = F5BFE56E02F8B7AA01DC9062;
+ isa = PBXTextBookmark;
+ name = "stat.h: 1";
+ rLen = 0;
+ rLoc = 0;
+ rType = 0;
+ vrLen = 1666;
+ vrLoc = 3618;
+ };
+ F5BFE56702F8B7A901DC9062 = {
+ fRef = F5F24F6E016ECAA401DC9062;
+ isa = PBXTextBookmark;
+ name = "tcl.h: 397";
+ rLen = 6;
+ rLoc = 11199;
+ rType = 0;
+ vrLen = 1293;
+ vrLoc = 10644;
+ };
+ F5BFE56A02F8B7A901DC9062 = {
+ fRef = F5F24F6E016ECAA401DC9062;
+ isa = PBXTextBookmark;
+ name = "tcl.h: 397";
+ rLen = 6;
+ rLoc = 11199;
+ rType = 0;
+ vrLen = 1293;
+ vrLoc = 10644;
+ };
+ F5BFE56E02F8B7AA01DC9062 = {
+ isa = PBXFileReference;
+ name = stat.h;
+ path = /usr/include/sys/stat.h;
+ refType = 0;
+ };
+}
diff --git a/tcl/macosx/Tcl.pbproj/project.pbxproj b/tcl/macosx/Tcl.pbproj/project.pbxproj
new file mode 100644
index 00000000000..27b00dec7d4
--- /dev/null
+++ b/tcl/macosx/Tcl.pbproj/project.pbxproj
@@ -0,0 +1,1313 @@
+// !$*UTF8*$!
+{
+ archiveVersion = 1;
+ classes = {
+ };
+ objectVersion = 38;
+ objects = {
+ 00530A0D0173C8270ACA28DC = {
+ buildActionMask = 12;
+ files = (
+ );
+ generatedFileNames = (
+ );
+ isa = PBXShellScriptBuildPhase;
+ neededFileNames = (
+ );
+ runOnlyForDeploymentPostprocessing = 0;
+ shellPath = /bin/sh;
+ shellScript = "# install to ${INSTALL_ROOT} with optional stripping\ncd ${TEMP_DIR}/..\nif test \"${INSTALL_STRIP}\" = \"YES\"; then\nexport INSTALL_PROGRAM='${INSTALL} ${INSTALL_STRIP_PROGRAM}'\nexport INSTALL_LIBRARY='${INSTALL} ${INSTALL_STRIP_LIBRARY}'\nelse\nexport INSTALL_PROGRAM='${INSTALL}'\nexport INSTALL_LIBRARY='${INSTALL}'\nfi\ngnumake install-binaries install-libraries TCL_LIBRARY=\"@TCL_IN_FRAMEWORK@\" INSTALL_ROOT=\"${INSTALL_ROOT}\" SCRIPT_INSTALL_DIR=\"${INSTALL_ROOT}${LIBDIR}/Resources/Scripts\" INSTALL_PROGRAM=\"${INSTALL_PROGRAM}\" INSTALL_LIBRARY=\"${INSTALL_LIBRARY}\"";
+ };
+ 00530A0E0173CC960ACA28DC = {
+ buildActionMask = 12;
+ files = (
+ );
+ generatedFileNames = (
+ );
+ isa = PBXShellScriptBuildPhase;
+ neededFileNames = (
+ );
+ runOnlyForDeploymentPostprocessing = 0;
+ shellPath = /bin/sh;
+ shellScript = "# fixup Framework structure\ncd \"${INSTALL_ROOT}${LIBDIR}\"\nln -fs Versions/Current/Headers ../..\nmv -f tclConfig.sh Resources\nif [ \"${BUILD_STYLE}\" = \"Development\" ]; then\n\t# keep copy of debug library around, so that\n\t# Deployment build can be installed on top\n\t# of Development build without overwriting\n\t# the debuglibrary\n\tcp -fp \"${PRODUCT_NAME}\" \"${PRODUCT_NAME}_debug\"\nfi";
+ };
+ 00E2F845016E82EB0ACA28DC = {
+ buildStyles = (
+ 00E2F847016E82EB0ACA28DC,
+ 00E2F848016E82EB0ACA28DC,
+ );
+ isa = PBXProject;
+ mainGroup = 00E2F846016E82EB0ACA28DC;
+ productRefGroup = 00E2F84A016E8A830ACA28DC;
+ projectDirPath = "";
+ targets = (
+ 00E2F84E016E92110ACA28DC,
+ 00E2F84B016E8A830ACA28DC,
+ 00E2F84C016E8B780ACA28DC,
+ );
+ };
+ 00E2F846016E82EB0ACA28DC = {
+ children = (
+ F5C88655017D604601DC9062,
+ F5F24FEE016ED0DF01DC9062,
+ 00E2F855016E922C0ACA28DC,
+ 00E2F857016E92B00ACA28DC,
+ 00E2F85A016E92B00ACA28DC,
+ 00E2F84A016E8A830ACA28DC,
+ );
+ isa = PBXGroup;
+ refType = 4;
+ };
+ 00E2F847016E82EB0ACA28DC = {
+ buildRules = (
+ );
+ buildSettings = {
+ EXTRA_CONFIGURE_FLAGS = "--enable-symbols";
+ INSTALL_STRIP = NO;
+ TEMP_DIR = "${OBJROOT}/Development.build/$(PROJECT_NAME).build/$(TARGET_NAME).build";
+ };
+ isa = PBXBuildStyle;
+ name = Development;
+ };
+ 00E2F848016E82EB0ACA28DC = {
+ buildRules = (
+ );
+ buildSettings = {
+ INSTALL_STRIP = YES;
+ TEMP_DIR = "${OBJROOT}/Deployment.build/$(PROJECT_NAME).build/$(TARGET_NAME).build";
+ };
+ isa = PBXBuildStyle;
+ name = Deployment;
+ };
+ 00E2F84A016E8A830ACA28DC = {
+ children = (
+ 00E2F84D016E92110ACA28DC,
+ F53ACC5C031D9D11016F146B,
+ F53ACC73031DA405016F146B,
+ );
+ isa = PBXGroup;
+ name = Products;
+ refType = 4;
+ };
+ 00E2F84B016E8A830ACA28DC = {
+ buildArgumentsString = "-c \"if [ \\\"${ACTION}\\\" != \\\"clean\\\" ]; then if [ -z \\\"`find . -name Makefile -newer \\\"${SRCROOT}/../unix/configure\\\"`\\\" ]; then \\\"${SRCROOT}/../unix/configure\\\" --prefix=/usr --mandir=/usr/share/man --libdir=\\\"${LIBDIR}\\\" --includedir=\\\"${LIBDIR}/Headers\\\" --enable-threads --enable-framework ${EXTRA_CONFIGURE_FLAGS}; mkdir -p Tcl.framework; ln -fs ../Tcl Tcl.framework/Tcl; fi; else rm -f Makefile; fi\"";
+ buildPhases = (
+ );
+ buildSettings = {
+ EXTRA_CONFIGURE_FLAGS = "";
+ FRAMEWORK_VERSION = 8.4;
+ INSTALL_PATH = /Library/Frameworks;
+ LIBDIR = "${INSTALL_PATH}/${PRODUCT_NAME}.framework/Versions/${FRAMEWORK_VERSION}";
+ PRODUCT_NAME = Tcl;
+ };
+ buildToolPath = /bin/sh;
+ buildWorkingDirectory = "${TEMP_DIR}/..";
+ dependencies = (
+ );
+ isa = PBXLegacyTarget;
+ name = Configure;
+ productName = Configure;
+ settingsToExpand = 6;
+ settingsToPassInEnvironment = 287;
+ settingsToPassOnCommandLine = 280;
+ shouldUseHeadermap = 0;
+ };
+ 00E2F84C016E8B780ACA28DC = {
+ buildArgumentsString = "-c \"if [ \\\"${ACTION}\\\" != \\\"clean\\\" ]; then gnumake tclsh tcltest TCL_LIBRARY=\\\"@TCL_IN_FRAMEWORK@\\\" TCL_PACKAGE_PATH=\\\"~/Library/Tcl /Library/Tcl /Network/Library/Tcl /System/Library/Tcl\\\" DYLIB_INSTALL_DIR=\\\"${DYLIB_INSTALL_DIR}\\\" ${EXTRA_MAKE_FLAGS}; else gnumake clean; fi\"";
+ buildPhases = (
+ );
+ buildSettings = {
+ DYLIB_INSTALL_DIR = "${DYLIB_INSTALL_PATH}/${PRODUCT_NAME}.framework/Versions/${FRAMEWORK_VERSION}";
+ DYLIB_INSTALL_PATH = "${INSTALL_PATH}";
+ EXTRA_MAKE_FLAGS = "";
+ FRAMEWORK_VERSION = 8.4;
+ INSTALL_PATH = /Library/Frameworks;
+ PRODUCT_NAME = Tcl;
+ };
+ buildToolPath = /bin/sh;
+ buildWorkingDirectory = "${TEMP_DIR}/..";
+ dependencies = (
+ F5877EB5031F7997016F146B,
+ );
+ isa = PBXLegacyTarget;
+ name = Make;
+ productName = Make;
+ settingsToExpand = 6;
+ settingsToPassInEnvironment = 287;
+ settingsToPassOnCommandLine = 280;
+ shouldUseHeadermap = 0;
+ };
+ 00E2F84D016E92110ACA28DC = {
+ isa = PBXFrameworkReference;
+ path = Tcl.framework;
+ refType = 3;
+ };
+ 00E2F84E016E92110ACA28DC = {
+ buildPhases = (
+ F5877FB6031F97AF016F146B,
+ F50DC36A01703B7301DC9062,
+ F50DC367017033D701DC9062,
+ F50DC3680170344801DC9062,
+ 00E2F84F016E92110ACA28DC,
+ F5BE9BBF02FB5974016F146B,
+ 00530A0D0173C8270ACA28DC,
+ 00530A0E0173CC960ACA28DC,
+ F5877FBB031FA90A016F146B,
+ F59AE5E3017AC67A01DC9062,
+ );
+ buildSettings = {
+ DSTROOT = "${TEMP_DIR}";
+ EXTRA_MAKE_INSTALL_FLAGS = "";
+ FRAMEWORK_VERSION = 8.4;
+ INSTALL_PATH = /Library/Frameworks;
+ LIBDIR = "${INSTALL_PATH}/${PRODUCT_NAME}.${WRAPPER_EXTENSION}/Versions/${FRAMEWORK_VERSION}";
+ PRODUCT_NAME = Tcl;
+ WRAPPER_EXTENSION = framework;
+ };
+ dependencies = (
+ F5877EB6031F79A4016F146B,
+ );
+ isa = PBXFrameworkTarget;
+ name = Tcl;
+ productInstallPath = /Library/Frameworks;
+ productName = TclLibrary;
+ productReference = 00E2F84D016E92110ACA28DC;
+ productSettingsXML = "<?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\">
+<plist version=\"1.0\">
+<dict>
+ <key>CFBundleDevelopmentRegion</key>
+ <string>English</string>
+ <key>CFBundleExecutable</key>
+ <string>Tcl</string>
+ <key>CFBundleGetInfoString</key>
+ <string>Tcl Library 8.4, Copyright © 2002 Tcl Core Team.
+MacOS X Port by Jim Ingham &lt;jingham@apple.com&gt; &amp; Ian Reid, Copyright © 2001-2002, Apple Computer, Inc.</string>
+ <key>CFBundleIconFile</key>
+ <string></string>
+ <key>CFBundleIdentifier</key>
+ <string>com.tcltk.tcllibrary</string>
+ <key>CFBundleInfoDictionaryVersion</key>
+ <string>6.0</string>
+ <key>CFBundleName</key>
+ <string>Tcl Library 8.4</string>
+ <key>CFBundlePackageType</key>
+ <string>FMWK</string>
+ <key>CFBundleShortVersionString</key>
+ <string>8.4.0</string>
+ <key>CFBundleSignature</key>
+ <string>Tcl </string>
+ <key>CFBundleVersion</key>
+ <string>8.4.0</string>
+</dict>
+</plist>
+";
+ shouldUseHeadermap = 0;
+ };
+ 00E2F84F016E92110ACA28DC = {
+ buildActionMask = 2147483647;
+ files = (
+ );
+ isa = PBXHeadersBuildPhase;
+ runOnlyForDeploymentPostprocessing = 0;
+ };
+ 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,
+ 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,
+ );
+ 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
+ F50DC367017033D701DC9062 = {
+ buildActionMask = 2147483647;
+ files = (
+ );
+ isa = PBXFrameworksBuildPhase;
+ runOnlyForDeploymentPostprocessing = 0;
+ };
+ F50DC3680170344801DC9062 = {
+ buildActionMask = 2147483647;
+ files = (
+ );
+ isa = PBXResourcesBuildPhase;
+ runOnlyForDeploymentPostprocessing = 0;
+ };
+ F50DC36A01703B7301DC9062 = {
+ buildActionMask = 2147483647;
+ files = (
+ );
+ isa = PBXSourcesBuildPhase;
+ runOnlyForDeploymentPostprocessing = 0;
+ };
+ F53ACC5C031D9D11016F146B = {
+ isa = PBXExecutableFileReference;
+ name = tclsh8.4;
+ path = ../../build/tclsh8.4;
+ refType = 2;
+ };
+ F53ACC73031DA405016F146B = {
+ isa = PBXExecutableFileReference;
+ name = tcltest;
+ path = ../../build/tcltest;
+ refType = 2;
+ };
+ F5877EB5031F7997016F146B = {
+ isa = PBXTargetDependency;
+ target = 00E2F84B016E8A830ACA28DC;
+ };
+ F5877EB6031F79A4016F146B = {
+ isa = PBXTargetDependency;
+ target = 00E2F84C016E8B780ACA28DC;
+ };
+ F5877FB6031F97AF016F146B = {
+ buildActionMask = 8;
+ files = (
+ );
+ generatedFileNames = (
+ );
+ isa = PBXShellScriptBuildPhase;
+ neededFileNames = (
+ );
+ runOnlyForDeploymentPostprocessing = 1;
+ shellPath = /bin/sh;
+ shellScript = "# ensure we can overwrite a previous install\nif [ -d \"${INSTALL_ROOT}${INSTALL_PATH}/${PRODUCT_NAME}.${WRAPPER_EXTENSION}\" ]; then\n chmod -RH u+w \"${INSTALL_ROOT}${INSTALL_PATH}/${PRODUCT_NAME}.${WRAPPER_EXTENSION}\"\nfi";
+ };
+ F5877FBB031FA90A016F146B = {
+ buildActionMask = 8;
+ files = (
+ );
+ generatedFileNames = (
+ );
+ isa = PBXShellScriptBuildPhase;
+ neededFileNames = (
+ );
+ runOnlyForDeploymentPostprocessing = 1;
+ shellPath = /bin/sh;
+ shellScript = "if [ `echo \"${DYLIB_INSTALL_PATH:-}\" | grep -c \"@executable_path\"` -gt 0 ]; then\n# if we are embedding frameworks, don't install tclsh\nrm -f \"${INSTALL_ROOT}/usr/bin/tclsh${FRAMEWORK_VERSION}\"\nrmdir -p \"${INSTALL_ROOT}/usr/bin\"\necho \"tclsh removed\"\nelse\n# redo prebinding\ncd \"${INSTALL_ROOT}\"\nif [ ! -d usr/lib ]; then mkdir -p usr; ln -fs /usr/lib usr/; RM_USRLIB=1; fi\nif [ ! -d System ]; then ln -fs /System .; RM_SYSTEM=1; fi\nredo_prebinding -r . \"./usr/bin/tclsh${FRAMEWORK_VERSION}\"\nif [ -n \"${RM_USRLIB:-}\" ]; then rm -f usr/lib; rmdir -p usr; fi\nif [ -n \"${RM_SYSTEM:-}\" ]; then rm -f System; fi\nfi";
+ };
+ F59AE5E3017AC67A01DC9062 = {
+ buildActionMask = 8;
+ files = (
+ );
+ generatedFileNames = (
+ );
+ isa = PBXShellScriptBuildPhase;
+ neededFileNames = (
+ );
+ runOnlyForDeploymentPostprocessing = 1;
+ shellPath = /bin/sh;
+ shellScript = "# build html documentation\nif [ \"${BUILD_STYLE}\" = \"Deployment\" ]; then\n cd \"${TEMP_DIR}/..\"\n gnumake html DISTDIR=\"${INSTALL_ROOT}${LIBDIR}/Resources/English.lproj/Documentation/Reference\"\n cd \"${INSTALL_ROOT}${LIBDIR}/Resources/English.lproj/Documentation/Reference\"\n ln -fs contents.htm html/index.html\n rm -f \"${PRODUCT_NAME}\"; ln -fs html \"${PRODUCT_NAME}\"\nfi";
+ };
+ F5A1836F018242A501DC9062 = {
+ isa = PBXFileReference;
+ path = tclMacOSXBundle.c;
+ refType = 4;
+ };
+ F5BE9BBF02FB5974016F146B = {
+ buildActionMask = 2147483647;
+ files = (
+ );
+ generatedFileNames = (
+ );
+ isa = PBXShellScriptBuildPhase;
+ neededFileNames = (
+ );
+ runOnlyForDeploymentPostprocessing = 0;
+ shellPath = /bin/sh;
+ shellScript = "# symolic link hackery to trick\n# 'make install INSTALL_ROOT=${TEMP_DIR}'\n# into building Tcl.framework and tclsh in ${SYMROOT}\ncd \"${TEMP_DIR}\"\nmkdir -p Library\nmkdir -p usr\nrm -f Library/Frameworks; ln -fs \"${SYMROOT}\" Library/Frameworks\nrm -f usr/bin; ln -fs \"${SYMROOT}\" usr/bin\nln -fs \"${TEMP_DIR}/../tcltest\" \"${SYMROOT}\"";
+ };
+ 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 = {
+ isa = PBXFileReference;
+ name = regcustom.h;
+ path = ../generic/regcustom.h;
+ refType = 2;
+ };
+ F5F24F6C016ECAA401DC9062 = {
+ isa = PBXFileReference;
+ name = regerrs.h;
+ path = ../generic/regerrs.h;
+ refType = 2;
+ };
+ F5F24F6D016ECAA401DC9062 = {
+ isa = PBXFileReference;
+ name = regguts.h;
+ path = ../generic/regguts.h;
+ refType = 2;
+ };
+ F5F24F6E016ECAA401DC9062 = {
+ isa = PBXFileReference;
+ name = tcl.h;
+ path = ../generic/tcl.h;
+ refType = 2;
+ };
+ F5F24F6F016ECAA401DC9062 = {
+ isa = PBXFileReference;
+ name = tclCompile.h;
+ path = ../generic/tclCompile.h;
+ refType = 2;
+ };
+ F5F24F70016ECAA401DC9062 = {
+ isa = PBXFileReference;
+ name = tclDecls.h;
+ path = ../generic/tclDecls.h;
+ refType = 2;
+ };
+ F5F24F71016ECAA401DC9062 = {
+ isa = PBXFileReference;
+ name = tclInitScript.h;
+ path = ../generic/tclInitScript.h;
+ refType = 2;
+ };
+ F5F24F72016ECAA401DC9062 = {
+ isa = PBXFileReference;
+ name = tclInt.h;
+ path = ../generic/tclInt.h;
+ refType = 2;
+ };
+ F5F24F73016ECAA401DC9062 = {
+ isa = PBXFileReference;
+ name = tclIntDecls.h;
+ path = ../generic/tclIntDecls.h;
+ refType = 2;
+ };
+ F5F24F74016ECAA401DC9062 = {
+ isa = PBXFileReference;
+ name = tclIntPlatDecls.h;
+ path = ../generic/tclIntPlatDecls.h;
+ refType = 2;
+ };
+ F5F24F75016ECAA401DC9062 = {
+ isa = PBXFileReference;
+ name = tclIO.h;
+ path = ../generic/tclIO.h;
+ refType = 2;
+ };
+ F5F24F76016ECAA401DC9062 = {
+ isa = PBXFileReference;
+ name = tclMath.h;
+ path = ../generic/tclMath.h;
+ refType = 2;
+ };
+ F5F24F77016ECAA401DC9062 = {
+ isa = PBXFileReference;
+ name = tclPlatDecls.h;
+ path = ../generic/tclPlatDecls.h;
+ refType = 2;
+ };
+ F5F24F78016ECAA401DC9062 = {
+ isa = PBXFileReference;
+ name = tclRegexp.h;
+ path = ../generic/tclRegexp.h;
+ refType = 2;
+ };
+ F5F24F87016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = regc_color.c;
+ path = ../generic/regc_color.c;
+ refType = 2;
+ };
+ F5F24F88016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = regc_cvec.c;
+ path = ../generic/regc_cvec.c;
+ refType = 2;
+ };
+ F5F24F89016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = regc_lex.c;
+ path = ../generic/regc_lex.c;
+ refType = 2;
+ };
+ F5F24F8A016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = regc_locale.c;
+ path = ../generic/regc_locale.c;
+ refType = 2;
+ };
+ F5F24F8B016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = regc_nfa.c;
+ path = ../generic/regc_nfa.c;
+ refType = 2;
+ };
+ F5F24F8C016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = regcomp.c;
+ path = ../generic/regcomp.c;
+ refType = 2;
+ };
+ F5F24F8D016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = rege_dfa.c;
+ path = ../generic/rege_dfa.c;
+ refType = 2;
+ };
+ F5F24F8E016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = regerror.c;
+ path = ../generic/regerror.c;
+ refType = 2;
+ };
+ F5F24F8F016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = regexec.c;
+ path = ../generic/regexec.c;
+ refType = 2;
+ };
+ F5F24F90016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = regfree.c;
+ path = ../generic/regfree.c;
+ refType = 2;
+ };
+ F5F24F91016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = regfronts.c;
+ path = ../generic/regfronts.c;
+ refType = 2;
+ };
+ F5F24F92016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclAlloc.c;
+ path = ../generic/tclAlloc.c;
+ refType = 2;
+ };
+ F5F24F93016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclAsync.c;
+ path = ../generic/tclAsync.c;
+ refType = 2;
+ };
+ F5F24F94016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclBasic.c;
+ path = ../generic/tclBasic.c;
+ refType = 2;
+ };
+ F5F24F95016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclBinary.c;
+ path = ../generic/tclBinary.c;
+ refType = 2;
+ };
+ F5F24F96016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclCkalloc.c;
+ path = ../generic/tclCkalloc.c;
+ refType = 2;
+ };
+ F5F24F97016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclClock.c;
+ path = ../generic/tclClock.c;
+ refType = 2;
+ };
+ F5F24F98016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclCmdAH.c;
+ path = ../generic/tclCmdAH.c;
+ refType = 2;
+ };
+ F5F24F99016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclCmdIL.c;
+ path = ../generic/tclCmdIL.c;
+ refType = 2;
+ };
+ F5F24F9A016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclCmdMZ.c;
+ path = ../generic/tclCmdMZ.c;
+ refType = 2;
+ };
+ F5F24F9B016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclCompCmds.c;
+ path = ../generic/tclCompCmds.c;
+ refType = 2;
+ };
+ F5F24F9C016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclCompExpr.c;
+ path = ../generic/tclCompExpr.c;
+ refType = 2;
+ };
+ F5F24F9D016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclCompile.c;
+ path = ../generic/tclCompile.c;
+ refType = 2;
+ };
+ F5F24F9E016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclDate.c;
+ path = ../generic/tclDate.c;
+ refType = 2;
+ };
+ F5F24F9F016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclEncoding.c;
+ path = ../generic/tclEncoding.c;
+ refType = 2;
+ };
+ F5F24FA0016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclEnv.c;
+ path = ../generic/tclEnv.c;
+ refType = 2;
+ };
+ F5F24FA1016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclEvent.c;
+ path = ../generic/tclEvent.c;
+ refType = 2;
+ };
+ F5F24FA2016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclExecute.c;
+ path = ../generic/tclExecute.c;
+ refType = 2;
+ };
+ F5F24FA3016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclFCmd.c;
+ path = ../generic/tclFCmd.c;
+ refType = 2;
+ };
+ F5F24FA4016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclFileName.c;
+ path = ../generic/tclFileName.c;
+ refType = 2;
+ };
+ F5F24FA5016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclGet.c;
+ path = ../generic/tclGet.c;
+ refType = 2;
+ };
+ F5F24FA6016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclHash.c;
+ path = ../generic/tclHash.c;
+ refType = 2;
+ };
+ F5F24FA7016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclHistory.c;
+ path = ../generic/tclHistory.c;
+ refType = 2;
+ };
+ F5F24FA8016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclIndexObj.c;
+ path = ../generic/tclIndexObj.c;
+ refType = 2;
+ };
+ F5F24FA9016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclInterp.c;
+ path = ../generic/tclInterp.c;
+ refType = 2;
+ };
+ F5F24FAA016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclIO.c;
+ path = ../generic/tclIO.c;
+ refType = 2;
+ };
+ F5F24FAB016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclIOCmd.c;
+ path = ../generic/tclIOCmd.c;
+ refType = 2;
+ };
+ F5F24FAC016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclIOGT.c;
+ path = ../generic/tclIOGT.c;
+ refType = 2;
+ };
+ F5F24FAD016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclIOSock.c;
+ path = ../generic/tclIOSock.c;
+ refType = 2;
+ };
+ F5F24FAE016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclIOUtil.c;
+ path = ../generic/tclIOUtil.c;
+ refType = 2;
+ };
+ F5F24FAF016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclLink.c;
+ path = ../generic/tclLink.c;
+ refType = 2;
+ };
+ F5F24FB0016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclListObj.c;
+ path = ../generic/tclListObj.c;
+ refType = 2;
+ };
+ F5F24FB1016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclLiteral.c;
+ path = ../generic/tclLiteral.c;
+ refType = 2;
+ };
+ F5F24FB2016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclLoad.c;
+ path = ../generic/tclLoad.c;
+ refType = 2;
+ };
+ F5F24FB3016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclLoadNone.c;
+ path = ../generic/tclLoadNone.c;
+ refType = 2;
+ };
+ F5F24FB4016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclMain.c;
+ path = ../generic/tclMain.c;
+ refType = 2;
+ };
+ F5F24FB5016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclNamesp.c;
+ path = ../generic/tclNamesp.c;
+ refType = 2;
+ };
+ F5F24FB6016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclNotify.c;
+ path = ../generic/tclNotify.c;
+ refType = 2;
+ };
+ F5F24FB7016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclObj.c;
+ path = ../generic/tclObj.c;
+ refType = 2;
+ };
+ F5F24FB8016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclPanic.c;
+ path = ../generic/tclPanic.c;
+ refType = 2;
+ };
+ F5F24FB9016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclParse.c;
+ path = ../generic/tclParse.c;
+ refType = 2;
+ };
+ F5F24FBA016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclParseExpr.c;
+ path = ../generic/tclParseExpr.c;
+ refType = 2;
+ };
+ F5F24FBB016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclPipe.c;
+ path = ../generic/tclPipe.c;
+ refType = 2;
+ };
+ F5F24FBC016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclPosixStr.c;
+ path = ../generic/tclPosixStr.c;
+ refType = 2;
+ };
+ F5F24FBD016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclPreserve.c;
+ path = ../generic/tclPreserve.c;
+ refType = 2;
+ };
+ F5F24FBE016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclProc.c;
+ path = ../generic/tclProc.c;
+ refType = 2;
+ };
+ F5F24FBF016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclRegexp.c;
+ path = ../generic/tclRegexp.c;
+ refType = 2;
+ };
+ F5F24FC0016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclResolve.c;
+ path = ../generic/tclResolve.c;
+ refType = 2;
+ };
+ F5F24FC1016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclResult.c;
+ path = ../generic/tclResult.c;
+ refType = 2;
+ };
+ F5F24FC2016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclScan.c;
+ path = ../generic/tclScan.c;
+ refType = 2;
+ };
+ F5F24FC3016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclStringObj.c;
+ path = ../generic/tclStringObj.c;
+ refType = 2;
+ };
+ F5F24FC4016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclStubInit.c;
+ path = ../generic/tclStubInit.c;
+ refType = 2;
+ };
+ F5F24FC5016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclStubLib.c;
+ path = ../generic/tclStubLib.c;
+ refType = 2;
+ };
+ F5F24FC6016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclTest.c;
+ path = ../generic/tclTest.c;
+ refType = 2;
+ };
+ F5F24FC7016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclTestObj.c;
+ path = ../generic/tclTestObj.c;
+ refType = 2;
+ };
+ F5F24FC8016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclTestProcBodyObj.c;
+ path = ../generic/tclTestProcBodyObj.c;
+ refType = 2;
+ };
+ F5F24FC9016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclThread.c;
+ path = ../generic/tclThread.c;
+ refType = 2;
+ };
+ F5F24FCA016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclThreadJoin.c;
+ path = ../generic/tclThreadJoin.c;
+ refType = 2;
+ };
+ F5F24FCB016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclThreadTest.c;
+ path = ../generic/tclThreadTest.c;
+ refType = 2;
+ };
+ F5F24FCC016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclTimer.c;
+ path = ../generic/tclTimer.c;
+ refType = 2;
+ };
+ F5F24FCD016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclUniData.c;
+ path = ../generic/tclUniData.c;
+ refType = 2;
+ };
+ F5F24FCE016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclUtf.c;
+ path = ../generic/tclUtf.c;
+ refType = 2;
+ };
+ F5F24FCF016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclUtil.c;
+ path = ../generic/tclUtil.c;
+ refType = 2;
+ };
+ F5F24FD0016ECAFC01DC9062 = {
+ isa = PBXFileReference;
+ name = tclVar.c;
+ path = ../generic/tclVar.c;
+ refType = 2;
+ };
+ F5F24FD1016ECB1E01DC9062 = {
+ isa = PBXFileReference;
+ name = regex.h;
+ path = ../generic/regex.h;
+ refType = 2;
+ };
+ F5F24FD2016ECB1E01DC9062 = {
+ isa = PBXFileReference;
+ name = tclPort.h;
+ path = ../generic/tclPort.h;
+ refType = 2;
+ };
+ F5F24FD3016ECB4901DC9062 = {
+ isa = PBXFileReference;
+ name = tclPkg.c;
+ path = ../generic/tclPkg.c;
+ refType = 2;
+ };
+ F5F24FD6016ECC0F01DC9062 = {
+ isa = PBXFileReference;
+ name = tclUnixPort.h;
+ path = ../unix/tclUnixPort.h;
+ refType = 2;
+ };
+ F5F24FD7016ECC0F01DC9062 = {
+ isa = PBXFileReference;
+ name = tclUnixThrd.h;
+ path = ../unix/tclUnixThrd.h;
+ refType = 2;
+ };
+ F5F24FD8016ECC0F01DC9062 = {
+ isa = PBXFileReference;
+ name = tclAppInit.c;
+ path = ../unix/tclAppInit.c;
+ refType = 2;
+ };
+ F5F24FD9016ECC0F01DC9062 = {
+ isa = PBXFileReference;
+ name = tclLoadDyld.c;
+ path = ../unix/tclLoadDyld.c;
+ refType = 2;
+ };
+ F5F24FDB016ECC0F01DC9062 = {
+ isa = PBXFileReference;
+ name = tclUnixChan.c;
+ path = ../unix/tclUnixChan.c;
+ refType = 2;
+ };
+ F5F24FDC016ECC0F01DC9062 = {
+ isa = PBXFileReference;
+ name = tclUnixEvent.c;
+ path = ../unix/tclUnixEvent.c;
+ refType = 2;
+ };
+ F5F24FDD016ECC0F01DC9062 = {
+ isa = PBXFileReference;
+ name = tclUnixFCmd.c;
+ path = ../unix/tclUnixFCmd.c;
+ refType = 2;
+ };
+ F5F24FDE016ECC0F01DC9062 = {
+ isa = PBXFileReference;
+ name = tclUnixFile.c;
+ path = ../unix/tclUnixFile.c;
+ refType = 2;
+ };
+ F5F24FDF016ECC0F01DC9062 = {
+ isa = PBXFileReference;
+ name = tclUnixInit.c;
+ path = ../unix/tclUnixInit.c;
+ refType = 2;
+ };
+ F5F24FE0016ECC0F01DC9062 = {
+ isa = PBXFileReference;
+ name = tclUnixNotfy.c;
+ path = ../unix/tclUnixNotfy.c;
+ refType = 2;
+ };
+ F5F24FE1016ECC0F01DC9062 = {
+ isa = PBXFileReference;
+ name = tclUnixPipe.c;
+ path = ../unix/tclUnixPipe.c;
+ refType = 2;
+ };
+ F5F24FE2016ECC0F01DC9062 = {
+ isa = PBXFileReference;
+ name = tclUnixSock.c;
+ path = ../unix/tclUnixSock.c;
+ refType = 2;
+ };
+ F5F24FE3016ECC0F01DC9062 = {
+ isa = PBXFileReference;
+ name = tclUnixTest.c;
+ path = ../unix/tclUnixTest.c;
+ refType = 2;
+ };
+ F5F24FE4016ECC0F01DC9062 = {
+ isa = PBXFileReference;
+ name = tclUnixThrd.c;
+ path = ../unix/tclUnixThrd.c;
+ refType = 2;
+ };
+ F5F24FE5016ECC0F01DC9062 = {
+ isa = PBXFileReference;
+ name = tclUnixTime.c;
+ path = ../unix/tclUnixTime.c;
+ refType = 2;
+ };
+ F5F24FE6016ECC0F01DC9062 = {
+ isa = PBXFileReference;
+ name = tclXtNotify.c;
+ path = ../unix/tclXtNotify.c;
+ refType = 2;
+ };
+ F5F24FE7016ECC0F01DC9062 = {
+ 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 = {
+ 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;
+ };
+ };
+ rootObject = 00E2F845016E82EB0ACA28DC;
+}
diff --git a/tcl/macosx/tclMacOSXBundle.c b/tcl/macosx/tclMacOSXBundle.c
new file mode 100644
index 00000000000..07617449e9d
--- /dev/null
+++ b/tcl/macosx/tclMacOSXBundle.c
@@ -0,0 +1,128 @@
+/*
+ * tclMacOSXBundle.c --
+ *
+ * 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.
+ */
+
+ #include <CoreFoundation/CoreFoundation.h>
+ #include "tcl.h"
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_MacOSXOpenBundleResources --
+ *
+ * Given the bundle name for a shared library, this routine
+ * sets libraryPath to the Resources/Scripts directory
+ * in the framework package. If hasResourceFile is
+ * true, it will also open the main resource file for the bundle.
+ *
+ *
+ * Results:
+ * TCL_OK if the bundle could be opened, and the Scripts folder found.
+ * TCL_ERROR otherwise.
+ *
+ * Side effects:
+ * libraryVariableName may be set, and the resource file opened.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp,
+ CONST char *bundleName,
+ int hasResourceFile,
+ int maxPathLen,
+ char *libraryPath)
+{
+ CFBundleRef bundleRef;
+ CFStringRef bundleNameRef;
+
+ libraryPath[0] = '\0';
+
+ bundleNameRef = CFStringCreateWithCString(NULL,
+ bundleName, kCFStringEncodingUTF8);
+
+ bundleRef = CFBundleGetBundleWithIdentifier(bundleNameRef);
+ CFRelease(bundleNameRef);
+
+ if (bundleRef == 0) {
+ return TCL_ERROR;
+ } else {
+ CFURLRef libURL;
+
+ if (hasResourceFile) {
+ short refNum;
+ refNum = CFBundleOpenBundleResourceMap(bundleRef);
+ }
+
+ libURL = CFBundleCopyResourceURL(bundleRef,
+ CFSTR("Scripts"),
+ NULL,
+ NULL);
+
+ if (libURL != NULL) {
+ /*
+ * FIXME: This is a quick fix, it is probably not right
+ * for internationalization.
+ */
+
+ if (CFURLGetFileSystemRepresentation (libURL, true,
+ libraryPath, maxPathLen)) {
+ }
+ CFRelease(libURL);
+ } else {
+ return TCL_ERROR;
+ }
+ }
+
+ return TCL_OK;
+}
+
diff --git a/tcl/tests/README b/tcl/tests/README
index a357195a8fe..4c88826f9ee 100644
--- a/tcl/tests/README
+++ b/tcl/tests/README
@@ -20,78 +20,22 @@ file.
You can run the tests in three ways:
- (a) type "make test" in ../unix; this will run all of the tests.
+ (a) type "make test" in ../unix; this will create the tcltest
+ executable and run all of the tests. At least "make tcltest"
+ must be run to create the tcltest executable for the other
+ options.
(b) type "tcltest <testFile> ?<option> <value>?
- Command line options include:
-
- -help display usage information
-
- -verbose <level> set the level of verbosity to a substring
- of "bps". See the "Test output" section
- of the tcltest man page for an
- explanation of this option.
-
- -match <matchList> only run tests that match one or more of
- the glob patterns in <matchList>
-
- -skip <skipList> do not run tests that match one or more
- of the glob patterns in <skipList>
-
- -file <globPatternList>
- only source test files that match one or
- more of the glob patterns in
- <globPatternList> (relative to the
- "tests" directory). This option only
- applies when you run the test suite with
- the "all.tcl" file.
-
- -notfile <globPatternList>
- do not source test files that match one
- or more of the patterns in
- <globPatternList> (relative to the
- "tests" directory). This option only
- applies when you run the test suite with
- the "all.tcl" file.
-
- -constraints <list> tests with any constraints in <list> will
- not be skipped. Not that elements of
- <list> must exactly match the existing
- constraints.
-
- -limitconstraints <bool>
- If 1, limit test runs to those tests that
- match the constraints listed using the
- -constraints flag. Use of this flag
- requires use of the -constraints flag.
- The default value is 0.
-
- -tmpdir <dirname> put temporary files created by
- ::tcltest::makeFile and
- ::tcltest::makeDirectory in the named
- directory. The default location is
- ::tcltest::workingDirectory.
-
- -preservecore <level>
- check for core files. If level is 0,
- check for core files only when
- cleanupTests is called from an all.tcl
- file. If 1, also check at the end of
- every test command. If 2, also save core
- files in ::tcltest::temporaryDirectory.
- The default level is 0.
+
+ where the options and values are the configuration options
+ of the tcltest package.
(c) start up tcltest in this directory, then "source" the test
file (for example, type "source parse.test"). To run all
of the tests, type "source all.tcl". To use the options in
- interactive mode, you can set their corresponding tcltest
- namespace variables after loading the tcltest package.
- For example, some of the tcltest variables are:
- ::tcltest::match
- ::tcltest::skip
- ::tcltest::testConstraints(nonPortable)
- ::tcltest::testConstraints(knownBug)
- ::tcltest::testConstraints(userInteractive)
+ interactive mode, you can set them with the tcltest::configure
+ command. Set constraints with the tcltest::testConstraints
+ command.
Please see the tcltest man page for more information regarding how to
write and run tests.
@@ -108,25 +52,25 @@ correspond to any Tcl or C code file so they should match the pattern
Be sure your new test file can be run from any working directory.
Be sure no temporary files are left behind by your test file.
+Use [tcltest::makeFile], [tcltest::removeFile], and [tcltest::cleanupTests]
+properly to be sure of this.
Be sure your tests can run cross-platform in both a build environment
as well as an installation environment. If your test file contains
tests that should not be run in one or more of those cases, please use
the constraints mechanism to skip those tests.
-2. Incompatibilities with prior Tcl versions:
----------------------------------------------
-
-1) Global variables such as VERBOSE, TESTS, and testConfig are now
- renamed to use the new "tcltest" namespace.
+2. Incompatibilities of package tcltest 2.1 with
+ testing machinery of very old versions of Tcl:
+------------------------------------------------
- old name new name
- -------- --------
- VERBOSE ::tcltest::verbose
- TESTS ::tcltest::match
- testConfig ::tcltest::testConstraints
+1) Global variables such as VERBOSE, TESTS, and testConfig of the
+ old machinery correspond to the [configure -verbose],
+ [configure -match], and [testConstraint] commands of tcltest 2.1,
+ respectively.
-2) VERBOSE values are no longer numeric.
+2) VERBOSE values were longer numeric. [configure -verbose] values
+ are lists of keywords.
3) When you run "make test", the working dir for the test suite is now
the one from which you called "make test", rather than the "tests"
@@ -135,13 +79,12 @@ the constraints mechanism to skip those tests.
other or with existing files. All tests must now run independently
of their working directory.
-4) The "all" and "visual" files are now called "all.tcl" and
- "visual_bb.test".
+4) The "all" file is now called "all.tcl"
-5) The "defs" file no longer exists.
+5) The "defs" and "defs.tcl" files no longer exist.
6) Instead of creating a doAllTests file in the tests directory, to
run all nonPortable tests, just use the "-constraints nonPortable"
- command line flag. If you are running interactively, you can set
- the ::tcltest::testConstraints(nonPortable) variable to 1 (after
- loading the tcltest package).
+ command line flag. If you are running interactively, you can run
+ [tcltest::testConstraint nonPortable 1] (after loading the tcltest
+ package).
diff --git a/tcl/tests/all.tcl b/tcl/tests/all.tcl
index 9a2b73bdfbe..80c7d6886c0 100644
--- a/tcl/tests/all.tcl
+++ b/tcl/tests/all.tcl
@@ -4,53 +4,22 @@
# tests. Execute it by invoking "source all.test" when running tcltest
# in this directory.
#
-# Copyright (c) 1998-2000 Ajuba Solutions.
-# All rights reserved.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 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$
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
- namespace import -force ::tcltest::*
-}
-
-set ::tcltest::testSingleFile false
-set ::tcltest::testsDirectory [file dir [info script]]
-
-# We need to ensure that the testsDirectory is absolute
-::tcltest::normalizePath ::tcltest::testsDirectory
-
-puts stdout "Tcl $tcl_patchLevel tests running in interp: [info nameofexecutable]"
-puts stdout "Tests running in working dir: $::tcltest::testsDirectory"
-if {[llength $::tcltest::skip] > 0} {
- puts stdout "Skipping tests that match: $::tcltest::skip"
-}
-if {[llength $::tcltest::match] > 0} {
- puts stdout "Only running tests that match: $::tcltest::match"
-}
+set tcltestVersion [package require tcltest]
+namespace import -force tcltest::*
-if {[llength $::tcltest::skipFiles] > 0} {
- puts stdout "Skipping test files that match: $::tcltest::skipFiles"
-}
-if {[llength $::tcltest::matchFiles] > 0} {
- puts stdout "Only sourcing test files that match: $::tcltest::matchFiles"
+if {$tcl_platform(platform) == "macintosh"} {
+ tcltest::singleProcess 1
}
-set timeCmd {clock format [clock seconds]}
-puts stdout "Tests began at [eval $timeCmd]"
-
-# source each of the specified tests
-foreach file [lsort [::tcltest::getMatchingFiles]] {
- set tail [file tail $file]
- puts stdout $tail
- if {[catch {source $file} msg]} {
- puts stdout $msg
- }
-}
+tcltest::testsDirectory [file dir [info script]]
+tcltest::runAllTests
-# cleanup
-puts stdout "\nTests ended at [eval $timeCmd]"
-::tcltest::cleanupTests 1
return
-
-
diff --git a/tcl/tests/append.test b/tcl/tests/append.test
index 584ac09fcf8..eaf9ab0e96a 100644
--- a/tcl/tests/append.test
+++ b/tcl/tests/append.test
@@ -131,6 +131,18 @@ test append-4.17 {lappend command} {
catch {unset x}
lappend x
} {}
+test append-4.18 {lappend command} {
+ catch {unset x}
+ lappend x {}
+} {{}}
+test append-4.19 {lappend command} {
+ catch {unset x}
+ lappend x(0)
+} {}
+test append-4.20 {lappend command} {
+ catch {unset x}
+ lappend x(0) abc
+} {abc}
proc check {var size} {
set l [llength $var]
@@ -146,6 +158,7 @@ proc check {var size} {
return ok
}
test append-5.1 {long lappends} {
+ catch {unset x}
set x ""
for {set i 0} {$i < 300} {set i [expr $i+1]} {
lappend x "item $i"
@@ -173,6 +186,42 @@ test append-7.1 {lappend-created var and error in trace on that var} {
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}
+ 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}
+ 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}
+ 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}
+ trace variable myvar r foo
+ proc foo {args} {append ::result $args}
+ append myvar a
+ info exists ::result
+} {0}
+
catch {unset i x result y}
catch {rename foo ""}
@@ -181,16 +230,3 @@ catch {rename check ""}
# cleanup
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tcl/tests/appendComp.test b/tcl/tests/appendComp.test
new file mode 100644
index 00000000000..0a37e23c7bc
--- /dev/null
+++ b/tcl/tests/appendComp.test
@@ -0,0 +1,362 @@
+# 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.
+#
+# 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$
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+catch {unset x}
+
+test appendComp-1.1 {append command} {
+ catch {unset x}
+ proc foo {} {append ::x 1 2 abc "long string"}
+ list [foo] $x
+} {{12abclong string} {12abclong string}}
+test appendComp-1.2 {append command} {
+ proc foo {} {
+ set x ""
+ list [append x first] [append x second] [append x third] $x
+ }
+ foo
+} {first firstsecond firstsecondthird firstsecondthird}
+test appendComp-1.3 {append command} {
+ proc foo {} {
+ set x "abcd"
+ append x
+ }
+ foo
+} abcd
+
+test appendComp-2.1 {long appends} {
+ proc foo {} {
+ set x ""
+ for {set i 0} {$i < 1000} {set i [expr $i+1]} {
+ append x "foobar "
+ }
+ set y "foobar"
+ set y "$y $y $y $y $y $y $y $y $y $y"
+ set y "$y $y $y $y $y $y $y $y $y $y"
+ set y "$y $y $y $y $y $y $y $y $y $y "
+ expr {$x == $y}
+ }
+ foo
+} 1
+
+test appendComp-3.1 {append errors} {
+ proc foo {} {append}
+ list [catch {foo} msg] $msg
+} {1 {wrong # args: should be "append varName ?value value ...?"}}
+test appendComp-3.2 {append errors} {
+ 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} {
+ proc foo {} {
+ catch {unset x}
+ append x
+ }
+ list [catch {foo} msg] $msg
+} {1 {can't read "x": no such variable}}
+
+test appendComp-4.1 {lappend command} {
+ proc foo {} {
+ global x
+ catch {unset x}
+ lappend x 1 2 abc "long string"
+ }
+ list [foo] $x
+} {{1 2 abc {long string}} {1 2 abc {long string}}}
+test appendComp-4.2 {lappend command} {
+ proc foo {} {
+ set x ""
+ list [lappend x first] [lappend x second] [lappend x third] $x
+ }
+ foo
+} {first {first second} {first second third} {first second third}}
+test appendComp-4.3 {lappend command} {
+ proc foo {} {
+ global x
+ set x old
+ unset x
+ lappend x new
+ }
+ set result [foo]
+ rename foo {}
+ set result
+} {new}
+test appendComp-4.4 {lappend command} {
+ proc foo {} {
+ set x {}
+ lappend x \{\ abc
+ }
+ foo
+} {\{\ abc}
+test appendComp-4.5 {lappend command} {
+ proc foo {} {
+ set x {}
+ lappend x \{ abc
+ }
+ foo
+} {\{ abc}
+test appendComp-4.6 {lappend command} {
+ proc foo {} {
+ set x {1 2 3}
+ lappend x
+ }
+ foo
+} {1 2 3}
+test appendComp-4.7 {lappend command} {
+ proc foo {} {
+ set x "a\{"
+ lappend x abc
+ }
+ foo
+} "a\\\{ abc"
+test appendComp-4.8 {lappend command} {
+ proc foo {} {
+ set x "\\\{"
+ lappend x abc
+ }
+ foo
+} "\\{ abc"
+test appendComp-4.9 {lappend command} {
+ proc foo {} {
+ set x " \{"
+ list [catch {lappend x abc} msg] $msg
+ }
+ foo
+} {1 {unmatched open brace in list}}
+test appendComp-4.10 {lappend command} {
+ proc foo {} {
+ set x " \{"
+ list [catch {lappend x abc} msg] $msg
+ }
+ foo
+} {1 {unmatched open brace in list}}
+test appendComp-4.11 {lappend command} {
+ proc foo {} {
+ set x "\{\{\{"
+ list [catch {lappend x abc} msg] $msg
+ }
+ foo
+} {1 {unmatched open brace in list}}
+test appendComp-4.12 {lappend command} {
+ proc foo {} {
+ set x "x \{\{\{"
+ list [catch {lappend x abc} msg] $msg
+ }
+ foo
+} {1 {unmatched open brace in list}}
+test appendComp-4.13 {lappend command} {
+ proc foo {} {
+ set x "x\{\{\{"
+ lappend x abc
+ }
+ foo
+} "x\\\{\\\{\\\{ abc"
+test appendComp-4.14 {lappend command} {
+ proc foo {} {
+ set x " "
+ lappend x abc
+ }
+ foo
+} "abc"
+test appendComp-4.15 {lappend command} {
+ proc foo {} {
+ set x "\\ "
+ lappend x abc
+ }
+ foo
+} "{ } abc"
+test appendComp-4.16 {lappend command} {
+ proc foo {} {
+ set x "x "
+ lappend x abc
+ }
+ foo
+} "x abc"
+test appendComp-4.17 {lappend command} {
+ proc foo {} { lappend x }
+ foo
+} {}
+test appendComp-4.18 {lappend command} {
+ proc foo {} { lappend x {} }
+ foo
+} {{}}
+test append-4.19 {lappend command} {
+ proc foo {} { lappend x(0) }
+ foo
+} {}
+test append-4.20 {lappend command} {
+ proc foo {} { lappend x(0) abc }
+ 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\""
+ }
+ }
+ return ok
+}
+test appendComp-5.1 {long lappends} {
+ catch {unset x}
+ set x ""
+ for {set i 0} {$i < 300} {set i [expr $i+1]} {
+ lappend x "item $i"
+ }
+ check $x 300
+} ok
+
+test appendComp-6.1 {lappend errors} {
+ proc foo {} {lappend}
+ list [catch {foo} msg] $msg
+} {1 {wrong # args: should be "lappend varName ?value value ...?"}}
+test appendComp-6.2 {lappend errors} {
+ proc foo {} {
+ set x ""
+ lappend x(0) 44
+ }
+ list [catch {foo} msg] $msg
+} {1 {can't set "x(0)": variable isn't array}}
+
+test appendComp-7.1 {lappendComp-created var and error in trace on that var} {
+ 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}
+ proc foo {args} {global x; unset x}
+ info exists x
+ set x
+ lappend x 1
+ 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} {
+ 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
+ }
+ bar
+} {0 {myvar {} r}}
+test appendComp-7.3 {lappend var triggers read trace, stack var} {
+ 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
+ }
+ 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.
+ 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
+ }
+ 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.
+ 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
+ }
+ bar
+} {0 {myvar b r}}
+test appendComp-7.6 {lappend var triggers read trace, array var exists} {
+ 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
+ }
+ bar
+} {0 {myvar b r}}
+test appendComp-7.7 {lappend var triggers read trace, array stack var} {
+ 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
+ }
+ bar
+} {0 {::myvar b r}}
+test appendComp-7.8 {lappend var triggers read trace, array stack var} {
+ 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
+ }
+ bar
+} {0 {::myvar b r}}
+test appendComp-7.9 {append var does not trigger read trace} {
+ 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}
+
+catch {unset i x result y}
+catch {rename foo ""}
+catch {rename bar ""}
+catch {rename check ""}
+catch {rename bar {}}
+
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/assocd.test b/tcl/tests/assocd.test
index 8f8ed242bbf..85f45e1e9c9 100644
--- a/tcl/tests/assocd.test
+++ b/tcl/tests/assocd.test
@@ -76,4 +76,3 @@ return
-
diff --git a/tcl/tests/async.test b/tcl/tests/async.test
index 81d60d141e5..49498b39ccc 100644
--- a/tcl/tests/async.test
+++ b/tcl/tests/async.test
@@ -149,4 +149,3 @@ return
-
diff --git a/tcl/tests/autoMkindex.test b/tcl/tests/autoMkindex.test
index 5aba965fe0c..23e75fc49b7 100644
--- a/tcl/tests/autoMkindex.test
+++ b/tcl/tests/autoMkindex.test
@@ -12,17 +12,94 @@
# RCS: @(#) $Id$
if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+ package require tcltest 2
namespace import -force ::tcltest::*
}
-# temporarily copy the autoMkindex.tcl file from testsDirectory to
-# temporaryDirectory
-set origMkindexFile [file join $::tcltest::testsDirectory autoMkindex.tcl]
-set newMkindexFile [file join $::tcltest::temporaryDirectory autoMkindex.tcl]
-if {![catch {file copy $origMkindexFile $newMkindexFile}]} {
- set removeAutoMkindex 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:
+#
+# namespace eval foo {
+# proc test {x y} { ... }
+# namespace eval bar {
+# proc another {args} { ... }
+# }
+# }
+#
+# 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.
+
+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.
+#
+namespace eval buried {
+ proc inside {args} {return "inside: $args"}
+
+ namespace export pub_*
+ proc pub_one {args} {return "one: $args"}
+ proc pub_two {args} {return "two: $args"}
}
+proc buried::within {args} {return "within: $args"}
+
+namespace eval buried {
+ namespace eval under {
+ proc neath {args} {return "neath: $args"}
+ }
+ namespace eval ::buried {
+ proc relative {args} {return "relative: $args"}
+ proc ::top {args} {return "top: $args"}
+ proc ::buried::explicit {args} {return "explicit: $args"}
+ }
+}
+
+# With proper hooks, we should be able to support other commands
+# that create procedures
+
+proc buried::myproc {name body args} {
+ ::proc $name $body $args
+}
+namespace eval ::buried {
+ proc mycmd1 args {return "mycmd"}
+ myproc mycmd2 args {return "mycmd"}
+}
+::buried::myproc mycmd3 args {return "another"}
+
+proc {buried::my proc} {name body args} {
+ ::proc $name $body $args
+}
+namespace eval ::buried {
+ proc mycmd4 args {return "mycmd"}
+ {my proc} mycmd5 args {return "mycmd"}
+}
+{::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.
+#
+namespace eval ::parent::child {
+ namespace import ::parent::*
+}
+proc ::parent::child::test {} {}
+
+} autoMkindex.tcl
+
# Save initial state of auto_mkindex_parser
@@ -42,7 +119,7 @@ proc AutoMkindexTestReset {} {
set result ""
set origDir [pwd]
-cd $::tcltest::testsDirectory
+cd $::tcltest::temporaryDirectory
test autoMkindex-1.1 {remove any existing tclIndex file} {
file delete tclIndex
@@ -70,7 +147,7 @@ test autoMkindex-1.3 {examine tclIndex} {
}
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} {indented $element} {normal $element} {top $element}"
+} "{::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} {
@@ -138,7 +215,7 @@ test autoMkindex-3.2 {auto_mkindex_parser::command} {
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} {indented $element} {mycmd3 $element} {normal $element} {top $element}"
+} "{::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} {
@@ -176,6 +253,37 @@ test autoMkindex-3.3 {auto_mkindex_parser::command} {knownBug} {
list [lvalue $::result *mycmd4*] [lvalue $::result *mycmd5*] [lvalue $::result *mycmd6*]
} "{::buried::mycmd4 $element} {::buried::mycmd5 $element} {mycmd6 $element}"
+
+makeDirectory pkg
+makeFile {
+package provide football 1.0
+
+namespace eval ::pro:: {
+ #
+ # export only public functions.
+ #
+ namespace export {[a-z]*}
+}
+namespace eval ::college:: {
+ #
+ # export only public functions.
+ #
+ namespace export {[a-z]*}
+}
+
+proc ::pro::team {} {
+ puts "go packers!"
+ return true
+}
+
+proc ::college::team {} {
+ puts "go badgers!"
+ return true
+}
+
+} [file join pkg samename.tcl]
+
+
test autoMkindex-4.1 {platform indenpendant source commands} {
file delete tclIndex
auto_mkindex . pkg/samename.tcl
@@ -187,6 +295,17 @@ test autoMkindex-4.1 {platform indenpendant source commands} {
set result
} {{set auto_index(::college::team) [list source [file join $dir pkg samename.tcl]]} {set auto_index(::pro::team) [list source [file join $dir pkg samename.tcl]]}}
+removeFile [file join pkg samename.tcl]
+
+makeFile {
+set dollar1 "this string contains an unescaped dollar sign -> \\$foo"
+set dollar2 "this string contains an escaped dollar sign -> \$foo \\\$foo"
+set bracket1 "this contains an unescaped bracket [NoSuchProc]"
+set bracket2 "this contains an escaped bracket \[NoSuchProc\]"
+set bracket3 "this contains nested unescaped brackets [[NoSuchProc]]"
+proc testProc {} {}
+} [file join pkg magicchar.tcl]
+
test autoMkindex-5.1 {escape magic tcl chars in general code} {
file delete tclIndex
set result {}
@@ -198,6 +317,13 @@ test autoMkindex-5.1 {escape magic tcl chars in general code} {
}
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 []} {
file delete tclIndex
set res {}
@@ -211,6 +337,9 @@ test autoMkindex-5.2 {correctly locate auto loaded procs with []} {
set res
} 0
+removeFile [file join pkg magicchar2.tcl]
+removeDirectory pkg
+
# Clean up.
unset result
@@ -220,9 +349,7 @@ if {[info exist saveCommands]} {
}
rename AutoMkindexTestReset ""
-if {[info exists removeAutoMkindex]} {
- catch {file delete $newMkindexFile}
-}
+removeFile autoMkindex.tcl
if {[file exists tclIndex]} {
file delete -force tclIndex
}
@@ -230,4 +357,3 @@ if {[file exists tclIndex]} {
cd $origDir
::tcltest::cleanupTests
-
diff --git a/tcl/tests/basic.test b/tcl/tests/basic.test
index cd2b030ae9c..0edb593e9f2 100644
--- a/tcl/tests/basic.test
+++ b/tcl/tests/basic.test
@@ -18,10 +18,17 @@
# RCS: @(#) $Id$
#
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
- namespace import -force ::tcltest::*
-}
+package require tcltest 2
+namespace import -force ::tcltest::*
+
+testConstraint testcmdtoken [llength [info commands testcmdtoken]]
+testConstraint testcmdtrace [llength [info commands testcmdtrace]]
+testConstraint testcreatecommand [llength [info commands testcreatecommand]]
+testConstraint exec [llength [info commands exec]]
+
+# This variable needs to be changed when the major or minor version number for
+# Tcl changes.
+set tclvers 8.4
catch {namespace delete test_ns_basic}
catch {interp delete test_interp}
@@ -198,24 +205,19 @@ test basic-13.2 {Tcl_ExposeCommand, invalidate cached refs to cmd now being expo
[p]
} {42 {} {} Hello {} {} 42}
-if {[info commands testcreatecommand] == ""} {
- puts "This application hasn't been compiled with the testcreatecommand"
- puts "command. Skipping affected tests."
-} else {
-test basic-14.1 {Tcl_CreateCommand, new cmd goes into a namespace specified in its name, if any} {
+test basic-14.1 {Tcl_CreateCommand, new cmd goes into a namespace specified in its name, if any} {testcreatecommand} {
catch {eval 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} {
+test basic-14.2 {Tcl_CreateCommand, namespace code ignore single ":"s in middle or end of names} {testcreatecommand} {
catch {eval namespace delete [namespace children :: test_ns_*]}
catch {rename value:at: ""}
list [testcreatecommand create2] \
[value:at:] \
[testcreatecommand delete2]
} {{} {CreatedCommandProc2 in ::} {}}
-}
test basic-15.1 {Tcl_CreateObjCommand, new cmd goes into a namespace specified in its name, if any} {
catch {eval namespace delete [namespace children :: test_ns_*]}
@@ -300,11 +302,7 @@ test basic-18.6 {TclRenameCommand, check for command shadowing by newly renamed
test basic-19.1 {Tcl_SetCommandInfo} {emptyTest} {
} {}
-if {[info commands testcmdtoken] == {}} {
- puts "This application hasn't been compiled with the \"testcmdtoken\""
- puts "command, so I can't test Tcl_GetCommandInfo."
-} else {
-test basic-20.1 {Tcl_GetCommandInfo, names for commands created inside namespaces} {
+test basic-20.1 {Tcl_GetCommandInfo, names for commands created inside namespaces} {testcmdtoken} {
catch {eval namespace delete [namespace children :: test_ns_*]}
catch {rename p ""}
catch {rename q ""}
@@ -317,14 +315,13 @@ test basic-20.1 {Tcl_GetCommandInfo, names for commands created inside namespace
[rename ::p q] \
[testcmdtoken name $x]
} {{p ::p} {} {q ::q}}
-test basic-20.2 {Tcl_GetCommandInfo, names for commands created outside namespaces} {
+test basic-20.2 {Tcl_GetCommandInfo, names for commands created outside namespaces} {testcmdtoken} {
catch {rename q ""}
set x [testcmdtoken create test_ns_basic::test_ns_basic2::p]
list [testcmdtoken name $x] \
[rename test_ns_basic::test_ns_basic2::p q] \
[testcmdtoken name $x]
} {{p ::test_ns_basic::test_ns_basic2::p} {} {q ::q}}
-}
test basic-21.1 {Tcl_GetCommandName} {emptyTest} {
} {}
@@ -423,12 +420,13 @@ test basic-26.1 {Tcl_EvalObj: preserve object while evaling it} {
# message.
proc bgerror {args} {set ::x $::errorInfo}
- set f [open test1 w]
+ set fName [makeFile {} test1]
+ set f [open $fName w]
fileevent $f writable "fileevent $f writable {}; error foo"
set x {}
vwait x
close $f
- file delete test1
+ removeFile test1
rename bgerror {}
set x
} "foo\n while executing\n\"error foo\""
@@ -485,22 +483,61 @@ test basic-37.1 {Tcl_ExprString: see expr.test} {emptyTest} {
test basic-38.1 {Tcl_ExprObj} {emptyTest} {
} {}
-if {[info commands testcmdtrace] == {}} {
- puts "This application hasn't been compiled with the \"testcmdtrace\""
- puts "command, so I can't test Tcl_CreateTrace."
-} else {
-test basic-39.1 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {
+test basic-39.1 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {testcmdtrace} {
testcmdtrace tracetest {set stuff [expr 14 + 16]}
} {{expr 14 + 16} {expr 14 + 16} {set stuff [expr 14 + 16]} {set stuff 30}}
-test basic-39.2 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {
+test basic-39.2 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {testcmdtrace} {
testcmdtrace tracetest {set stuff [info tclversion]}
-} [list {info tclversion} {info tclversion} {set stuff [info tclversion]} "set stuff $::tcltest::version"]
-test basic-39.3 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {
+} [list {info tclversion} {info tclversion} {set stuff [info tclversion]} "set stuff $tclvers"]
+test basic-39.3 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {testcmdtrace} {
testcmdtrace deletetest {set stuff [info tclversion]}
-} $::tcltest::version
-}
+} $tclvers
+test basic-39.4 {Tcl_CreateTrace, check that tracing doesn't cause memory faults} {testcmdtrace} {
+ # Note that the proc call is the same as the variable name, and that
+ # the call can be direct or indirect by way of another procedure
+ proc tracer {args} {}
+ proc tracedLoop {level} {
+ incr level
+ tracer
+ foreach tracer [expr {$level==1 ? {1 2} : {}}] {tracedLoop $level}
+ }
+ testcmdtrace tracetest {tracedLoop 0}
+} {{tracedLoop 0} {tracedLoop 0} {incr level} {incr level} tracer {tracer} {expr {$level==1 ? {1 2} : {}}} {expr {$level==1 ? {1 2} : {}}} {foreach tracer [expr {$level==1 ? {1 2} : {}}] {tracedLoop $level}} {foreach tracer {1 2} {tracedLoop $level}} {tracedLoop $level} {tracedLoop 1} {incr level} {incr level} tracer {tracer} {expr {$level==1 ? {1 2} : {}}} {expr {$level==1 ? {1 2} : {}}} {foreach tracer [expr {$level==1 ? {1 2} : {}}] {tracedLoop $level}} {foreach tracer {} {tracedLoop $level}} {tracedLoop $level} {tracedLoop 1} {incr level} {incr level} tracer {tracer} {expr {$level==1 ? {1 2} : {}}} {expr {$level==1 ? {1 2} : {}}} {foreach tracer [expr {$level==1 ? {1 2} : {}}] {tracedLoop $level}} {foreach tracer {} {tracedLoop $level}}}
+catch {rename tracer {}}
+catch {rename tracedLoop {}}
+
+test basic-39.5 {Tcl_CreateObjTrace, status return TCL_ERROR} {testcmdtrace} {
+ proc Error { args } { error "Shouldn't get here" }
+ set x 1;
+ list [catch {testcmdtrace resulttest {Error $x}} result] [set result]
+} {1 {Error $x}}
+
+test basic-39.6 {Tcl_CreateObjTrace, status return TCL_RETURN} {testcmdtrace} {
+ proc Return { args } { error "Shouldn't get here" }
+ set x 1;
+ list [catch {testcmdtrace resulttest {Return $x}} result] [set result]
+} {2 {}}
+
+test basic-39.7 {Tcl_CreateObjTrace, status return TCL_BREAK} {testcmdtrace} {
+ proc Break { args } { error "Shouldn't get here" }
+ set x 1;
+ list [catch {testcmdtrace resulttest {Break $x}} result] [set result]
+} {3 {}}
+
+test basic-39.8 {Tcl_CreateObjTrace, status return TCL_CONTINUE} {testcmdtrace} {
+ proc Continue { args } { error "Shouldn't get here" }
+ set x 1;
+ list [catch {testcmdtrace resulttest {Continue $x}} result] [set result]
+} {4 {}}
+
+test basic-39.9 {Tcl_CreateObjTrace, status return unknown} {testcmdtrace} {
+ proc OtherStatus { args } { error "Shouldn't get here" }
+ set x 1;
+ list [catch {testcmdtrace resulttest {OtherStatus $x}} result] [set result]
+} {6 {}}
test basic-40.1 {Tcl_DeleteTrace} {emptyTest} {
+ # the above tests have tested Tcl_DeleteTrace
} {}
test basic-41.1 {Tcl_AddErrorInfo} {emptyTest} {
@@ -518,8 +555,89 @@ test basic-44.1 {Tcl_GlobalEval} {emptyTest} {
test basic-45.1 {Tcl_SetRecursionLimit: see interp.test} {emptyTest} {
} {}
-test basic-46.1 {Tcl_AllowExceptions} {emptyTest} {
-} {}
+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}
+ puts $f continue
+ puts $f {puts $errorInfo}
+ puts $f {puts DONE}
+ set newMsg {}
+ set msg {}
+ while {$newMsg != "DONE"} {
+ set newMsg [gets $f]
+ append msg "${newMsg}\n"
+ }
+ close $f
+ } error]
+ list $res $msg
+} {1 {invoked "continue" outside of a loop
+ while executing
+"continue
+"
+DONE
+}}
+
+test basic-46.2 {Tcl_AllowExceptions: exception return not allowed} {exec} {
+ set fName [makeFile {
+ puts hello
+ break
+ } BREAKtest]
+ set res [list [catch {exec [interpreter] $fName} msg] $msg]
+ removeFile BREAKtest
+ regsub {"[^ ]*BREAKtest"} $res {"BREAKtest"} res
+ set res
+} {1 {hello
+invoked "break" outside of a loop
+ while executing
+"break"
+ (file "BREAKtest" line 3)}}
+
+test basic-46.3 {Tcl_AllowExceptions: exception return not allowed} {exec} {
+ set fName [makeFile {
+ interp alias {} patch {} info patchlevel
+ patch
+ break
+ } BREAKtest]
+ set res [list [catch {exec [interpreter] $fName} msg] $msg]
+ removeFile BREAKtest
+ regsub {"[^ ]*BREAKtest"} $res {"BREAKtest"} res
+ set res
+} {1 {invoked "break" outside of a loop
+ while executing
+"break"
+ (file "BREAKtest" line 4)}}
+
+test basic-46.4 {Tcl_AllowExceptions: exception return not allowed} {exec} {
+ set fName [makeFile {
+ foo [set a 1] [break]
+ } BREAKtest]
+ set res [list [catch {exec [interpreter] $fName} msg] $msg]
+ removeFile BREAKtest
+ regsub {"[^ ]*BREAKtest"} $res {"BREAKtest"} res
+ set res
+} {1 {invoked "break" outside of a loop
+ while executing
+"break"
+ invoked from within
+"foo [set a 1] [break]"
+ (file "BREAKtest" line 2)}}
+
+test basic-46.5 {Tcl_AllowExceptions: exception return not allowed} {exec} {
+ set fName [makeFile {
+ return -code return
+ } BREAKtest]
+ set res [list [catch {exec [interpreter] $fName} msg] $msg]
+ removeFile BREAKtest
+ regsub {"[^ ]*BREAKtest"} $res {"BREAKtest"} res
+ set res
+} {1 {command returned bad code: 2
+ while executing
+"return -code return"
+ (file "BREAKtest" line 2)}}
+
# cleanup
catch {eval namespace delete [namespace children :: test_ns_*]}
@@ -532,16 +650,3 @@ catch {rename value:at: ""}
catch {unset x}
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tcl/tests/binary.test b/tcl/tests/binary.test
index cf048c9df6b..0e451fc72f0 100644
--- a/tcl/tests/binary.test
+++ b/tcl/tests/binary.test
@@ -17,7 +17,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
namespace import -force ::tcltest::*
}
-test binary-2.1 {DupByteArrayInternalRep} {
+test binary-0.1 {DupByteArrayInternalRep} {
set hdr [binary format cc 0 0316]
set buf hellomatt
@@ -42,7 +42,6 @@ test binary-1.4 {Tcl_BinaryObjCmd: format} {
} {}
-
test binary-2.1 {Tcl_BinaryObjCmd: format} {
list [catch {binary format a } msg] $msg
} {1 {not enough arguments for all format specifiers}}
@@ -1461,19 +1460,32 @@ test binary-42.1 {Tcl_BinaryObjCmd: bad arguments} {} {
set result
} {bad option "": must be format or scan}
+# Wide int (guaranteed at least 64-bit) handling
+test binary-43.1 {Tcl_BinaryObjCmd: format wide int} {} {
+ binary format w 7810179016327718216
+} HelloTcl
+test binary-43.2 {Tcl_BinaryObjCmd: format wide int} {} {
+ binary format W 7810179016327718216
+} lcTolleH
+
+test binary-44.1 {Tcl_BinaryObjCmd: scan wide int} {} {
+ binary scan HelloTcl W x
+ set x
+} 5216694956358656876
+test binary-44.2 {Tcl_BinaryObjCmd: scan wide int} {} {
+ binary scan lcTolleH w x
+ set x
+} 5216694956358656876
+
+test binary-45.1 {Tcl_BinaryObjCmd: combined wide int handling} {
+ binary scan [binary format sws 16450 -1 19521] c* x
+ set x
+} {66 64 -1 -1 -1 -1 -1 -1 -1 -1 65 76}
+test binary-45.2 {Tcl_BinaryObjCmd: combined wide int handling} {
+ binary scan [binary format sWs 16450 0x7fffffff 19521] c* x
+ set x
+} {66 64 0 0 0 0 127 -1 -1 -1 65 76}
+
# cleanup
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tcl/tests/case.test b/tcl/tests/case.test
index 4c8089a55fa..3b2f022f20a 100644
--- a/tcl/tests/case.test
+++ b/tcl/tests/case.test
@@ -101,4 +101,3 @@ return
-
diff --git a/tcl/tests/clock.test b/tcl/tests/clock.test
index 5ce3bdd612a..524fbd5b2a5 100644
--- a/tcl/tests/clock.test
+++ b/tcl/tests/clock.test
@@ -12,6 +12,8 @@
#
# RCS: @(#) $Id$
+set env(LC_TIME) POSIX
+
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
@@ -38,16 +40,16 @@ test clock-2.2 {clock clicks tests} {
test clock-2.3 {clock clicks tests} {
list [catch {clock clicks foo} msg] $msg
} {1 {bad switch "foo": must be -milliseconds}}
-test clock-2.3 {clock clicks tests} {
+test clock-2.4 {clock clicks tests} {
expr [clock clicks -milliseconds]+1
concat {}
} {}
-test clock-2.2 {clock clicks tests, millisecond timing test} {
+test clock-2.5 {clock clicks tests, millisecond timing test} {
set start [clock clicks -milli]
after 10
set end [clock clicks -milli]
- # assume, even with slow interp'ing, the diff is less than 60 msecs
- expr {($end > $start) && (($end - $start) < 60)}
+ # 60 msecs seems to be the max time slice under Windows 95/98
+ expr {($end > $start) && (($end - $start) <= 60)}
} {1}
# clock format
@@ -112,6 +114,14 @@ test clock-3.11 {clock format tests} {
test clock-3.12 {clock format tests} {
clock format 123 -format ""
} ""
+test clock-3.13 {clock format with non-ASCII character in the format string} {
+ set oldenc [encoding system]
+ encoding system iso8859-1
+ set res [clock format 0 -format \u00c4]
+ encoding system $oldenc
+ unset oldenc
+ set res
+} "\u00c4"
# clock scan
test clock-4.1 {clock scan tests} {
@@ -418,8 +428,32 @@ test clock-7.3 {clock scan next monthname} {
-format %m.%Y
} "05.2001"
+# We use 5am PST, 31-12-1999 as the base for these scans because irrespective
+# of your local timezone it should always give us times on December 31
+set 5amPST 946645200
+test clock-8.1 {clock scan midnight/gmt range bug 413397} {
+ set fmt "%m/%d"
+ list [clock format [clock scan year -base $5amPST -gmt 0] -format $fmt] \
+ [clock format [clock scan year -base $5amPST -gmt 1] -format $fmt]
+} {12/31 12/31}
+
+set ::tcltest::testConstraints(needPST) [expr {
+ [regexp {^(Pacific.*|P[DS]T)$} [clock format 1 -format %Z]]
+ && ([clock format 1 -format %s] != "%s")
+}]
+test clock-9.1 {%s gmt testing} {needPST} {
+ # We need PST to guarantee the difference value below, and %s isn't
+ # valid on all OSes (like Solaris).
+ set s 100000
+ set a [clock format $s -format %s -gmt 0]
+ set b [clock format $s -format %s -gmt 1]
+ # This should be the offset in seconds between current locale and GMT.
+ # This didn't seem to be correctly on Windows until the fix for
+ # Bug #559376, which fiddled with env(TZ) when -gmt 1 was used.
+ # It's hard-coded to check P[SD]T now. (8 hours)
+ set c [expr {$b-$a}]
+} {28800}
+
# cleanup
::tcltest::cleanupTests
return
-
-
diff --git a/tcl/tests/cmdAH.test b/tcl/tests/cmdAH.test
index d4dcfae40f8..c1f6e1b70d9 100644
--- a/tcl/tests/cmdAH.test
+++ b/tcl/tests/cmdAH.test
@@ -13,10 +13,12 @@
# RCS: @(#) $Id$
if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+ package require tcltest 2.1
namespace import -force ::tcltest::*
}
+tcltest::testConstraint testchmod [string equal testchmod [info commands testchmod]]
+
global env
set cmdAHwd [pwd]
catch {set platform [testgetplatform]}
@@ -40,13 +42,14 @@ test cmdAH-1.2 {Tcl_CatchObjCmd, errors} {
test cmdAH-2.1 {Tcl_CdObjCmd} {
list [catch {cd foo bar} msg] $msg
} {1 {wrong # args: should be "cd ?dirName?"}}
+set foodir [file join [temporaryDirectory] foo]
test cmdAH-2.2 {Tcl_CdObjCmd} {
- file delete -force foo
- file mkdir foo
- cd foo
+ file delete -force $foodir
+ file mkdir $foodir
+ cd $foodir
set result [file tail [pwd]]
cd ..
- file delete foo
+ file delete $foodir
set result
} foo
test cmdAH-2.3 {Tcl_CdObjCmd} {
@@ -54,12 +57,12 @@ test cmdAH-2.3 {Tcl_CdObjCmd} {
set oldpwd [pwd]
set temp $env(HOME)
set env(HOME) $oldpwd
- file delete -force foo
- file mkdir foo
- cd foo
+ file delete -force $foodir
+ file mkdir $foodir
+ cd $foodir
cd ~
- set result [string match [pwd] $oldpwd]
- file delete foo
+ set result [string equal [pwd] $oldpwd]
+ file delete $foodir
set env(HOME) $temp
set result
} 1
@@ -68,12 +71,12 @@ test cmdAH-2.4 {Tcl_CdObjCmd} {
set oldpwd [pwd]
set temp $env(HOME)
set env(HOME) $oldpwd
- file delete -force foo
- file mkdir foo
- cd foo
+ file delete -force $foodir
+ file mkdir $foodir
+ cd $foodir
cd
- set result [string match [pwd] $oldpwd]
- file delete foo
+ set result [string equal [pwd] $oldpwd]
+ file delete $foodir
set env(HOME) $temp
set result
} 1
@@ -166,11 +169,13 @@ test cmdAH-5.1 {Tcl_FileObjCmd} {
} {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, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
+} {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"}}
-
+test cmdAH-5.4 {Tcl_FileObjCmd} {
+ list [catch {file exists ""} msg] $msg
+} {0 0}
#volume
@@ -194,13 +199,25 @@ test cmdAH-6.4 {Tcl_FileObjCmd: volumes} {pcOnly} {
list [catch {lsearch $volumeList "c:/"} element] [expr $element != -1] [catch {list glob -nocomplain [lindex $volumeList $element]*}]
} {0 1 0}
+test cmdAH-6.5 {cd} {unixOnly nonPortable} {
+ set dir [pwd]
+ cd /
+ set res [pwd]
+ cd $dir
+ set res
+} {/}
+
# attributes
test cmdAH-7.1 {Tcl_FileObjCmd - file attrs} {
- catch {file delete -force foo.file}
- close [open foo.file w]
- list [catch {file attributes foo.file}] [file delete -force foo.file]
-} {0 {}}
+ set foofile [makeFile abcde foo.file]
+ catch {file delete -force $foofile}
+ close [open $foofile w]
+ set res [catch {file attributes $foofile}]
+ # We used [makeFile] so we undo with [removeFile]
+ removeFile $foofile
+ set res
+} {0}
# dirname
@@ -1000,105 +1017,107 @@ testsetplatform $platform
# readable
+set gorpfile [makeFile abcde gorp.file]
+set dirfile [makeDirectory dir.file]
+
if {[info commands testchmod] == {}} {
puts "This application hasn't been compiled with the \"testchmod\""
puts "command, so I can't test Tcl_FileObjCmd etc."
} else {
-makeFile abcde gorp.file
-makeDirectory dir.file
-
-test cmdAH-16.1 {Tcl_FileObjCmd: readable} {
+test cmdAH-16.1 {Tcl_FileObjCmd: readable} {testchmod} {
list [catch {file readable a b} msg] $msg
} {1 {wrong # args: should be "file readable name"}}
-testchmod 444 gorp.file
-test cmdAH-16.2 {Tcl_FileObjCmd: readable} {
- file readable gorp.file
+testchmod 0444 $gorpfile
+test cmdAH-16.2 {Tcl_FileObjCmd: readable} {testchmod} {
+ file readable $gorpfile
} 1
-testchmod 333 gorp.file
-test cmdAH-16.3 {Tcl_FileObjCmd: readable} {unixOnly notRoot} {
- file reada gorp.file
+testchmod 0333 $gorpfile
+test cmdAH-16.3 {Tcl_FileObjCmd: readable} {unixOnly notRoot testchmod} {
+ file reada $gorpfile
} 0
# writable
-test cmdAH-17.1 {Tcl_FileObjCmd: writable} {
+test cmdAH-17.1 {Tcl_FileObjCmd: writable} {testchmod} {
list [catch {file writable a b} msg] $msg
} {1 {wrong # args: should be "file writable name"}}
-testchmod 555 gorp.file
-test cmdAH-17.2 {Tcl_FileObjCmd: writable} {notRoot} {
- file writable gorp.file
+testchmod 0555 $gorpfile
+test cmdAH-17.2 {Tcl_FileObjCmd: writable} {notRoot testchmod} {
+ file writable $gorpfile
} 0
-testchmod 222 gorp.file
-test cmdAH-17.3 {Tcl_FileObjCmd: writable} {
- file writable gorp.file
+testchmod 0222 $gorpfile
+test cmdAH-17.3 {Tcl_FileObjCmd: writable} {testchmod} {
+ file writable $gorpfile
} 1
+}
# executable
-file delete -force dir.file gorp.file
-file mkdir dir.file
-makeFile abcde gorp.file
+removeFile $gorpfile
+removeDirectory $dirfile
+set dirfile [makeDirectory dir.file]
+set gorpfile [makeFile abcde gorp.file]
-test cmdAH-18.1 {Tcl_FileObjCmd: executable} {
+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} {
- file executable gorp.file
+test cmdAH-18.2 {Tcl_FileObjCmd: executable} {testchmod} {
+ file executable $gorpfile
} 0
-test cmdAH-18.3 {Tcl_FileObjCmd: executable} {unixOnly} {
+test cmdAH-18.3 {Tcl_FileObjCmd: executable} {unixOnly testchmod} {
# Only on unix will setting the execute bit on a regular file
# cause that file to be executable.
- testchmod 775 gorp.file
- file exe gorp.file
+ testchmod 0775 $gorpfile
+ file exe $gorpfile
} 1
-test cmdAH-18.4 {Tcl_FileObjCmd: executable} {macOnly} {
+test cmdAH-18.4 {Tcl_FileObjCmd: executable} {macOnly testchmod} {
# On mac, the only executable files are of type APPL.
- set x [file exe gorp.file]
- file attrib gorp.file -type APPL
- lappend x [file exe gorp.file]
+ set x [file exe $gorpfile]
+ file attrib $gorpfile -type APPL
+ lappend x [file exe $gorpfile]
} {0 1}
-test cmdAH-18.5 {Tcl_FileObjCmd: executable} {pcOnly} {
+test cmdAH-18.5 {Tcl_FileObjCmd: executable} {pcOnly testchmod} {
# On pc, must be a .exe, .com, etc.
- set x [file exe gorp.file]
- makeFile foo gorp.exe
- lappend x [file exe gorp.exe]
- file delete gorp.exe
+ set x [file exe $gorpfile]
+ set gorpexe [makeFile foo gorp.exe]
+ lappend x [file exe $gorpexe]
+ removeFile $gorpexe
set x
} {0 1}
-test cmdAH-18.6 {Tcl_FileObjCmd: executable} {
+test cmdAH-18.6 {Tcl_FileObjCmd: executable} {testchmod} {
# Directories are always executable.
- file exe dir.file
+ file exe $dirfile
} 1
-file delete -force dir.file
-file delete gorp.file
-file delete link.file
-}
+removeDirectory $dirfile
+removeFile $gorpfile
+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.2 {Tcl_FileObjCmd: exists} {file exists gorp.file} 0
+test cmdAH-19.2 {Tcl_FileObjCmd: exists} {file exists $gorpfile} 0
test cmdAH-19.3 {Tcl_FileObjCmd: exists} {
- file exists [file join dir.file gorp.file]
+ file exists [file join [temporaryDirectory] dir.file gorp.file]
} 0
catch {
- makeFile abcde gorp.file
- makeDirectory dir.file
- makeFile 12345 [file join dir.file gorp.file]
+ set gorpfile [makeFile abcde gorp.file]
+ set dirfile [makeDirectory dir.file]
+ set subgorp [makeFile 12345 [file join $dirfile gorp.file]]
}
test cmdAH-19.4 {Tcl_FileObjCmd: exists} {
- file exists gorp.file
+ file exists $gorpfile
} 1
test cmdAH-19.5 {Tcl_FileObjCmd: exists} {
- file exists [file join dir.file gorp.file]
+ file exists $subgorp
} 1
# nativename
@@ -1133,15 +1152,15 @@ test cmdAH-19.10 {Tcl_FileObjCmd: ~ : nativename} {
# NFS file systems won't do the stuff below correctly.
test cmdAH-19.11 {Tcl_FileObjCmd: exists} {unixOnly notRoot} {
- removeFile /tmp/tcl.foo.dir/file
- removeDirectory /tmp/tcl.foo.dir
+ file delete -force /tmp/tcl.foo.dir/file
+ file delete -force /tmp/tcl.foo.dir
makeDirectory /tmp/tcl.foo.dir
makeFile 12345 /tmp/tcl.foo.dir/file
- exec chmod 000 /tmp/tcl.foo.dir
+ file attributes /tmp/tcl.foo.dir -permissions 0000
set result [file exists /tmp/tcl.foo.dir/file]
- exec chmod 775 /tmp/tcl.foo.dir
+ file attributes /tmp/tcl.foo.dir -permissions 0775
removeFile /tmp/tcl.foo.dir/file
removeDirectory /tmp/tcl.foo.dir
set result
@@ -1150,9 +1169,9 @@ test cmdAH-19.11 {Tcl_FileObjCmd: exists} {unixOnly notRoot} {
# Stat related commands
catch {testsetplatform $platform}
-file delete gorp.file
-makeFile "Test string" gorp.file
-catch {exec chmod 765 gorp.file}
+removeFile $gorpfile
+set gorpfile [makeFile "Test string" gorp.file]
+catch {file attributes $gorpfile -permissions 0765}
# atime
@@ -1163,9 +1182,9 @@ test cmdAH-20.1 {Tcl_FileObjCmd: atime} {
} {1 {wrong # args: should be "file atime name ?time?"}}
test cmdAH-20.2 {Tcl_FileObjCmd: atime} {
catch {unset stat}
- file stat gorp.file stat
- list [expr {[file mtime gorp.file] == $stat(mtime)}] \
- [expr {[file atime gorp.file] == $stat(atime)}]
+ file stat $gorpfile stat
+ list [expr {[file mtime $gorpfile] == $stat(mtime)}] \
+ [expr {[file atime $gorpfile] == $stat(atime)}]
} {1 1}
test cmdAH-20.3 {Tcl_FileObjCmd: atime} {
string tolower [list [catch {file atime _bogus_} msg] \
@@ -1174,7 +1193,7 @@ test cmdAH-20.3 {Tcl_FileObjCmd: atime} {
test cmdAH-20.4 {Tcl_FileObjCmd: atime} {
list [catch {file atime $file notint} msg] $msg
} {1 {expected integer but got "notint"}}
-test cmdAH-20.5 {Tcl_FileObjCmd: atime touch} {
+test cmdAH-20.5 {Tcl_FileObjCmd: atime touch} {unixOrPc} {
if {[string equal $tcl_platform(platform) "windows"]} {
set old [pwd]
cd $::tcltest::temporaryDirectory
@@ -1189,19 +1208,21 @@ test cmdAH-20.5 {Tcl_FileObjCmd: atime touch} {
set atime [file atime $file]
after 1100; # pause a sec to notice change in atime
set newatime [clock seconds]
- expr {$newatime==[file atime $file $newatime]}
+ set modatime [file atime $file $newatime]
+ expr {$newatime == $modatime ? 1 : "$newatime != $modatime"}
} 1
+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 gorp.file
+ file isdirectory $gorpfile
} 0
test cmdAH-21.3 {Tcl_FileObjCmd: isdirectory} {
- file isd dir.file
+ file isd $dirfile
} 1
# isfile
@@ -1209,13 +1230,13 @@ test cmdAH-21.3 {Tcl_FileObjCmd: isdirectory} {
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.2 {Tcl_FileObjCmd: isfile} {file isfile gorp.file} 1
-test cmdAH-22.3 {Tcl_FileObjCmd: isfile} {file isfile dir.file} 0
+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
-catch {exec ln -s gorp.file link.file}
+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"}}
@@ -1224,12 +1245,12 @@ test cmdAH-23.2 {Tcl_FileObjCmd: lstat} {
} {1 {wrong # args: should be "file lstat name varName"}}
test cmdAH-23.3 {Tcl_FileObjCmd: lstat} {unixOnly nonPortable} {
catch {unset stat}
- file lstat link.file stat
+ 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} {unixOnly nonPortable} {
catch {unset stat}
- file lstat link.file stat
+ file lstat $linkfile stat
list $stat(nlink) [expr $stat(mode)&0777] $stat(type)
} {1 511 link}
test cmdAH-23.5 {Tcl_FileObjCmd: lstat errors} {nonPortable} {
@@ -1239,10 +1260,45 @@ test cmdAH-23.5 {Tcl_FileObjCmd: lstat errors} {nonPortable} {
test cmdAH-23.6 {Tcl_FileObjCmd: lstat errors} {
catch {unset x}
set x 44
- list [catch {file lstat gorp.file x} msg] $msg $errorCode
+ list [catch {file lstat $gorpfile x} msg] $msg $errorCode
} {1 {can't set "x(dev)": variable isn't array} NONE}
catch {unset stat}
+# mkdir
+
+set dirA [file join [temporaryDirectory] a]
+set dirB [file join [temporaryDirectory] a]
+test cmdAH-23.7 {Tcl_FileObjCmd: mkdir} {
+ catch {file delete -force $dirA}
+ file mkdir $dirA
+ set res [file isdirectory $dirA]
+ file delete $dirA
+ set res
+} {1}
+test cmdAH-23.8 {Tcl_FileObjCmd: mkdir} {
+ catch {file delete -force $dirA}
+ file mkdir $dirA/b
+ set res [file isdirectory $dirA/b]
+ file delete -force $dirA
+ set res
+} {1}
+test cmdAH-23.9 {Tcl_FileObjCmd: mkdir} {
+ catch {file delete -force $dirA}
+ file mkdir $dirA/b/c
+ set res [file isdirectory $dirA/b/c]
+ file delete -force $dirA
+ set res
+} {1}
+test cmdAH-23.10 {Tcl_FileObjCmd: mkdir} {
+ catch {file delete -force $dirA}
+ catch {file delete -force $dirB}
+ file mkdir $dirA/b $dirB/a/c
+ set res [list [file isdirectory $dirA/b] [file isdirectory $dirB/a/c]]
+ file delete -force $dirA
+ file delete -force $dirB
+ set res
+} {1 1}
+
# mtime
set file [makeFile "data" touch.me]
@@ -1250,20 +1306,35 @@ 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} {
- set old [file mtime gorp.file]
+ set f [open $gorpfile w]
+ puts $f "More text"
+ set localOld [clock seconds]
+ close $f
+ set old [file mtime $gorpfile]
after 2000
- set f [open gorp.file w]
+ set f [open $gorpfile w]
puts $f "More text"
+ set localNew [clock seconds]
close $f
- set new [file mtime gorp.file]
- expr {($new > $old) && ($new <= ($old+5))}
+ set new [file mtime $gorpfile]
+ expr {
+ ($new > $old) && ($localNew > $localOld) &&
+ (abs(($new-$old) - ($localNew-$localOld)) <= 1)
+ }
} {1}
test cmdAH-24.3 {Tcl_FileObjCmd: mtime} {
catch {unset stat}
- file stat gorp.file stat
- list [expr {[file mtime gorp.file] == $stat(mtime)}] \
- [expr {[file atime gorp.file] == $stat(atime)}]
+ file stat $gorpfile stat
+ list [expr {[file mtime $gorpfile] == $stat(mtime)}] \
+ [expr {[file atime $gorpfile] == $stat(atime)}]
} {1 1}
test cmdAH-24.4 {Tcl_FileObjCmd: mtime} {
string tolower [list [catch {file mtime _bogus_} msg] $msg \
@@ -1274,9 +1345,9 @@ test cmdAH-24.5 {Tcl_FileObjCmd: mtime} {
# On other platforms, just use a file in the local directory.
if {[string equal $tcl_platform(platform) "unix"]} {
- set name /tmp/tcl.test
+ set name /tmp/tcl.test.[pid]
} else {
- set name tf
+ set name [file join [temporaryDirectory] tf]
}
# Make sure that a new file's time is correct. 10 seconds variance
@@ -1295,9 +1366,10 @@ test cmdAH-24.8 {Tcl_FileObjCmd: mtime touch} {
set mtime [file mtime $file]
after 1100; # pause a sec to notice change in mtime
set newmtime [clock seconds]
- expr {$newmtime==[file mtime $file $newmtime]}
+ set modmtime [file mtime $file $newmtime]
+ expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"}
} 1
-
+removeFile touch.me
# owned
@@ -1305,7 +1377,7 @@ 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.2 {Tcl_FileObjCmd: owned} {
- file owned gorp.file
+ file owned $gorpfile
} 1
test cmdAH-25.3 {Tcl_FileObjCmd: owned} {unixOnly notRoot} {
file owned /
@@ -1317,8 +1389,8 @@ 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.2 {Tcl_FileObjCmd: readlink} {unixOnly nonPortable} {
- file readlink link.file
-} gorp.file
+ file readlink $linkfile
+} $gorpfile
test cmdAH-26.3 {Tcl_FileObjCmd: readlink errors} {unixOnly nonPortable} {
list [catch {file readlink _bogus_} msg] [string tolower $msg] \
[string tolower $errorCode]
@@ -1338,12 +1410,12 @@ 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.2 {Tcl_FileObjCmd: size} {
- set oldsize [file size gorp.file]
- set f [open gorp.file a]
+ set oldsize [file size $gorpfile]
+ set f [open $gorpfile a]
fconfigure $f -translation lf -eofchar {}
puts $f "More text"
close $f
- expr {[file size gorp.file] - $oldsize}
+ expr {[file size $gorpfile] - $oldsize}
} {10}
test cmdAH-27.3 {Tcl_FileObjCmd: size} {
string tolower [list [catch {file size _bogus_} msg] $msg \
@@ -1353,8 +1425,9 @@ test cmdAH-27.3 {Tcl_FileObjCmd: size} {
# stat
catch {testsetplatform $platform}
-makeFile "Test string" gorp.file
-catch {exec chmod 765 gorp.file}
+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
@@ -1364,17 +1437,17 @@ test cmdAH-28.2 {Tcl_FileObjCmd: stat} {
} {1 {wrong # args: should be "file stat name varName"} NONE}
test cmdAH-28.3 {Tcl_FileObjCmd: stat} {
catch {unset stat}
- file stat gorp.file stat
+ file stat $gorpfile stat
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}
- file stat gorp.file stat
+ file stat $gorpfile stat
list $stat(nlink) $stat(size) $stat(type)
} {1 12 file}
test cmdAH-28.5 {Tcl_FileObjCmd: stat} {unixOnly} {
catch {unset stat}
- file stat gorp.file stat
+ file stat $gorpfile stat
expr $stat(mode)&0777
} {501}
test cmdAH-28.6 {Tcl_FileObjCmd: stat} {
@@ -1384,15 +1457,15 @@ test cmdAH-28.6 {Tcl_FileObjCmd: stat} {
test cmdAH-28.7 {Tcl_FileObjCmd: stat} {
catch {unset x}
set x 44
- list [catch {file stat gorp.file x} msg] $msg $errorCode
+ 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.
- close [open foo.test w]
- file stat foo.test stat
+ set filename [makeFile "" foo.text]
+ file stat $filename stat
set x [expr {$stat(mode) > 0}]
- file delete foo.test
+ removeFile $filename
set x
} 1
test cmdAH-28.9 {Tcl_FileObjCmd: stat} {pcOnly} {
@@ -1433,30 +1506,55 @@ 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.
- close [open foo.test w]
- file stat foo.test stat
- file delete foo.test
+ set filename [makeFile "" foo.test]
+ file stat $filename stat
+ removeFile $filename
expr {$stat(mode) > 0}
} 1
catch {unset stat}
# type
-file delete link.file
-
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.2 {Tcl_FileObjCmd: type} {
- file type dir.file
+ file type $dirfile
} directory
+test cmdAH-29.3.0 {Tcl_FileObjCmd: delete removes link not file} {unixOnly nonPortable} {
+ set exists [list [file exists $linkfile] [file exists $gorpfile]]
+ file delete $linkfile
+ set exists2 [list [file exists $linkfile] [file exists $gorpfile]]
+ list $exists $exists2
+} {{1 1} {0 1}}
test cmdAH-29.3 {Tcl_FileObjCmd: type} {
- file type gorp.file
+ file type $gorpfile
} file
-test cmdAH-29.4 {Tcl_FileObjCmd: type} {unixOnly nonPortable} {
- exec ln -s a/b/c link.file
- set result [file type link.file]
- file delete link.file
+test cmdAH-29.4 {Tcl_FileObjCmd: type} {unixOnly} {
+ catch {file delete $linkfile}
+ # Unlike [exec ln -s], [file link] requires an existing target
+ file link -symbolic $linkfile $gorpfile
+ set result [file type $linkfile]
+ file delete $linkfile
+ set result
+} link
+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
+ } else {
+ tcltest::testConstraint linkDirectory 0
+ }
+} else {
+ tcltest::testConstraint linkDirectory 1
+}
+test cmdAH-29.4.1 {Tcl_FileObjCmd: type} {linkDirectory} {
+ set tempdir [makeDirectory temp]
+ set linkdir [file join [temporaryDirectory] link.dir]
+ file link -symbolic $linkdir $tempdir
+ set result [file type $linkdir]
+ file delete $linkdir
+ removeDirectory $tempdir
set result
} link
test cmdAH-29.5 {Tcl_FileObjCmd: type} {
@@ -1467,47 +1565,102 @@ test cmdAH-29.5 {Tcl_FileObjCmd: type} {
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, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
+} {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, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
+} {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, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
+} {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, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
+} {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, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
+} {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, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
+} {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, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
+} {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}}
# channels
+# 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
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.2 {Tcl_FileObjCmd: channels, too many args} {
- file chan
-} {stderr stdout stdin}
-test cmdAH-31.3 {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}]
+test cmdAH-31.3 {Tcl_FileObjCmd: channels, globbing} {
string equal [file channels] [file channels *]
} {1}
-test cmdAH-31.4 {Tcl_FileObjCmd: channels} {
- set old [file channels gorp.file]
- set f [open gorp.file w]
- set new [file channels file*]
- close $f
- string equal $f $new
+test cmdAH-31.4 {Tcl_FileObjCmd: channels, globbing} {
+ lsort [file channels std*]
+} [lsort {stdout stderr stdin}]
+
+set newFileId [open $gorpfile w]
+
+test cmdAH-31.5 {Tcl_FileObjCmd: channels} {
+ set res [file channels $newFileId]
+ string equal $newFileId $res
} {1}
+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\""]
+
+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] \
+ [safeInterp eval [list file channels $newFileId]]
+} [list $newFileId $newFileId]
+test cmdAH-31.9 {Tcl_FileObjCmd: channels in other interp} {
+ lsort [safeInterp eval [list file channels]]
+} [lsort [list stdout $newFileId]]
+test cmdAH-31.10 {Tcl_FileObjCmd: channels in other interp} {
+ # we can now write to $newFileId from slave
+ 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] \
+ [safeInterp eval [list file channels $newFileId]]
+} [list {} $newFileId]
+test cmdAH-31.12 {Tcl_FileObjCmd: channels in other interp} {
+ lsort [safeInterp eval [list file channels]]
+} [lsort [list stdout $newFileId]]
+test cmdAH-31.13 {Tcl_FileObjCmd: channels in other interp} {
+ safeInterp eval [list close $newFileId]
+ safeInterp eval [list file channels]
+} {stdout}
+
+# This shouldn't work, but just in case a test above failed...
+catch {close $newFileId}
+
+interp delete safeInterp
+interp delete simpleInterp
# cleanup
catch {testsetplatform $platform}
@@ -1515,26 +1668,13 @@ catch {unset platform}
# Tcl_ForObjCmd is tested in for.test
-catch {exec chmod 777 dir.file}
-file delete -force dir.file
-file delete gorp.file
-file delete link.file
+catch {file attributes $dirfile -permissions 0777}
+removeDirectory $dirfile
+removeFile $gorpfile
+# No idea how well [removeFile] copes with links...
+file delete $linkfile
cd $cmdAHwd
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tcl/tests/cmdIL.test b/tcl/tests/cmdIL.test
index 0009885af88..bd26d612f44 100644
--- a/tcl/tests/cmdIL.test
+++ b/tcl/tests/cmdIL.test
@@ -82,6 +82,28 @@ test cmdIL-1.23 {Tcl_LsortObjCmd procedure, unique sort with index} {
# lsort -unique should return the last unique item
lsort -unique -index 0 {{a b} {c b} {a c} {d a}}
} {{a c} {c b} {d a}}
+test cmdIL-1.24 {Tcl_LsortObjCmd procedure, order of -index and -command} {
+ catch {rename 1 ""}
+ proc testcmp {a b} {return [string compare $a $b]}
+ set l [list [list a b] [list c d]]
+ set result [list [catch {lsort -command testcmp -index 1 $l} msg] $msg]
+ rename testcmp ""
+ set result
+} [list 0 [list [list a b] [list c d]]]
+test cmdIL-1.25 {Tcl_LsortObjCmd procedure, order of -index and -command} {
+ catch {rename 1 ""}
+ proc testcmp {a b} {return [string compare $a $b]}
+ set l [list [list a b] [list c d]]
+ set result [list [catch {lsort -index 1 -command testcmp $l} msg] $msg]
+ rename testcmp ""
+ set 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...
+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}}
# Can't think of any good tests for the MergeSort and MergeLists
# procedures, except a bunch of random lists to sort.
@@ -337,4 +359,3 @@ test cmdIL-4.33 {DictionaryCompare procedure, chars between Z and a in ASCII} {
# cleanup
::tcltest::cleanupTests
return
-
diff --git a/tcl/tests/cmdInfo.test b/tcl/tests/cmdInfo.test
index 2f3e0a20b89..3ddbc38b56f 100644
--- a/tcl/tests/cmdInfo.test
+++ b/tcl/tests/cmdInfo.test
@@ -16,58 +16,57 @@
# RCS: @(#) $Id$
if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+ package require tcltest 2
namespace import -force ::tcltest::*
}
-if {[info commands testcmdinfo] == {}} {
- puts "This application hasn't been compiled with the \"testcmdinfo\""
- puts "command, so I can't test Tcl_GetCommandInfo etc."
- ::tcltest::cleanupTests
- return
-}
+::tcltest::testConstraint testcmdinfo \
+ [llength [info commands testcmdinfo]]
+::tcltest::testConstraint testcmdtoken \
+ [llength [info commands testcmdtoken]]
-test cmdinfo-1.1 {command procedure and clientData} {
+test cmdinfo-1.1 {command procedure and clientData} {testcmdinfo} {
testcmdinfo create x1
testcmdinfo get x1
} {CmdProc1 original CmdDelProc1 original :: stringProc}
-test cmdinfo-1.2 {command procedure and clientData} {
+test cmdinfo-1.2 {command procedure and clientData} {testcmdinfo} {
testcmdinfo create x1
x1
} {CmdProc1 original}
-test cmdinfo-1.3 {command procedure and clientData} {
+test cmdinfo-1.3 {command procedure and clientData} {testcmdinfo} {
testcmdinfo create x1
testcmdinfo modify x1
testcmdinfo get x1
} {CmdProc2 new_command_data CmdDelProc2 new_delete_data :: stringProc}
-test cmdinfo-1.4 {command procedure and clientData} {
+test cmdinfo-1.4 {command procedure and clientData} {testcmdinfo} {
testcmdinfo create x1
testcmdinfo modify x1
x1
} {CmdProc2 new_command_data}
-test cmdinfo-2.1 {command deletion callbacks} {
+test cmdinfo-2.1 {command deletion callbacks} {testcmdinfo} {
testcmdinfo create x1
testcmdinfo delete x1
} {CmdDelProc1 original}
-test cmdinfo-2.2 {command deletion callbacks} {
+test cmdinfo-2.2 {command deletion callbacks} {testcmdinfo} {
testcmdinfo create x1
testcmdinfo modify x1
testcmdinfo delete x1
} {CmdDelProc2 new_delete_data}
-test cmdinfo-3.1 {Tcl_Get/SetCommandInfo return values} {
+test cmdinfo-3.1 {Tcl_Get/SetCommandInfo return values} {testcmdinfo} {
testcmdinfo get non_existent
} {??}
-test cmdinfo-3.2 {Tcl_Get/SetCommandInfo return values} {
+test cmdinfo-3.2 {Tcl_Get/SetCommandInfo return values} {testcmdinfo} {
testcmdinfo create x1
testcmdinfo modify x1
} 1
-test cmdinfo-3.3 {Tcl_Get/SetCommandInfo return values} {
+test cmdinfo-3.3 {Tcl_Get/SetCommandInfo return values} {testcmdinfo} {
testcmdinfo modify non_existent
} 0
-test cmdinfo-4.1 {Tcl_GetCommandName/Tcl_GetCommandFullName procedures} {
+test cmdinfo-4.1 {Tcl_GetCommandName/Tcl_GetCommandFullName procedures} \
+ {testcmdtoken} {
set x [testcmdtoken create x1]
rename x1 newName
set y [testcmdtoken name $x]
@@ -78,7 +77,8 @@ test cmdinfo-4.1 {Tcl_GetCommandName/Tcl_GetCommandFullName procedures} {
catch {rename newTestCmd {}}
catch {rename newTestCmd2 {}}
-test cmdinfo-5.1 {Names for commands created when inside namespaces} {
+test cmdinfo-5.1 {Names for commands created when inside namespaces} \
+ {testcmdtoken} {
# create namespace cmdInfoNs1
namespace eval cmdInfoNs1 {} ;# creates namespace cmdInfoNs1
# create namespace cmdInfoNs1::cmdInfoNs2 and execute a script in it
@@ -91,7 +91,8 @@ test cmdinfo-5.1 {Names for commands created when inside namespaces} {
eval lappend y [testcmdtoken name $x]
} {testCmd ::testCmd newTestCmd ::newTestCmd}
-test cmdinfo-6.1 {Names for commands created when outside namespaces} {
+test cmdinfo-6.1 {Names for commands created when outside namespaces} \
+ {testcmdtoken} {
set x [testcmdtoken create cmdInfoNs1::cmdInfoNs2::testCmd]
set y [testcmdtoken name $x]
rename cmdInfoNs1::cmdInfoNs2::testCmd newTestCmd2
@@ -103,16 +104,3 @@ catch {namespace delete cmdInfoNs1::cmdInfoNs2 cmdInfoNs1}
catch {rename x1 ""}
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tcl/tests/cmdMZ.test b/tcl/tests/cmdMZ.test
index f1926b833fa..234aedf1f72 100644
--- a/tcl/tests/cmdMZ.test
+++ b/tcl/tests/cmdMZ.test
@@ -17,6 +17,8 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
+set tcltest::testConstraints(nonLinuxOnly) \
+ [expr {![string equal Linux $tcl_platform(os)]}]
# Tcl_PwdObjCmd
@@ -29,15 +31,19 @@ test cmdMZ-1.2 {Tcl_PwdObjCmd: simple pwd} {
test cmdMZ-1.3 {Tcl_PwdObjCmd: simple pwd} {
expr [string length pwd]>0
} 1
-test cmdMZ-1.4 {Tcl_PwdObjCmd: failure} {unixOnly} {
- file delete -force foo
- file mkdir foo
+test cmdMZ-1.4 {Tcl_PwdObjCmd: failure} {unixOnly nonLinuxOnly} {
+ # We don't want this test to run on Linux because they do a
+ # permissions caching trick which causes this to fail. The
+ # caching is incorrect, but we have no control over that.
+ set foodir [file join [temporaryDirectory] foo]
+ file delete -force $foodir
+ file mkdir $foodir
set cwd [pwd]
- cd foo
+ cd $foodir
file attr . -permissions 000
set result [list [catch {pwd} msg] $msg]
cd $cwd
- file delete -force foo
+ file delete -force $foodir
set result
} {1 {error getting working directory name: permission denied}}
@@ -73,29 +79,33 @@ test cmdMZ-3.1 {Tcl_SourceObjCmd: error conditions} {macOnly} {
} {1 {wrong # args: should be "source fileName" or "source -rsrc name ?fileName?" or "source -rsrcid id ?fileName?"}}
test cmdMZ-3.2 {Tcl_SourceObjCmd: error conditions} {macOnly} {
list [catch {source a b} msg] $msg
-} {1 {wrong # args: should be "source fileName" or "source -rsrc name ?fileName?" or "source -rsrcid id ?fileName?"}}
+} {1 {bad argument: should be "source fileName" or "source -rsrc name ?fileName?" or "source -rsrcid id ?fileName?"}}
test cmdMZ-3.3 {Tcl_SourceObjCmd: error conditions} {unixOrPc} {
list [catch {source} msg] $msg
} {1 {wrong # args: should be "source fileName"}}
test cmdMZ-3.4 {Tcl_SourceObjCmd: error conditions} {unixOrPc} {
list [catch {source a b} msg] $msg
} {1 {wrong # args: should be "source fileName"}}
-test cmdMZ-3.5 {Tcl_SourceObjCmd: error in script} {
- makeFile {
+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
- list [catch {source source.file} msg] $msg $errorInfo
-} {1 {error in sourced file} {error in sourced file
+ } source.file]
+ set result [list [catch {source $file} msg] $msg $errorInfo]
+ removeFile source.file
+ set result
+} -match glob -result {1 {error in sourced file} {error in sourced file
while executing
"error "error in sourced file""
- (file "source.file" line 3)
+ (file "*" line 3)
invoked from within
-"source source.file"}}
+"source $file"}}
test cmdMZ-3.6 {Tcl_SourceObjCmd: simple script} {
- makeFile {list result} source.file
- source source.file
+ set file [makeFile {list result} source.file]
+ set result [source $file]
+ removeFile source.file
+ set result
} result
# Tcl_SplitObjCmd
@@ -156,11 +166,36 @@ test cmdMZ-4.13 {Tcl_SplitObjCmd: basic split commands} {
# The tests for Tcl_StringObjCmd are in string.test
# The tests for Tcl_SubstObjCmd are in subst.test
# The tests for Tcl_SwitchObjCmd are in switch.test
-# There are no tests for Tcl_TimeObjCmd
+
+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.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.6 {Tcl_TimeObjCmd: slower commands take longer} {
+ expr {[lindex [time {after 2}] 0] < [lindex [time {after 1000}] 0]}
+} 1
+test cmdMZ-5.7 {Tcl_TimeObjCmd: errors generate right trace} {
+ list [catch {time {error foo}} msg] $msg $::errorInfo
+} {1 foo {foo
+ while executing
+"error foo"
+ invoked from within
+"time {error foo}"}}
+
# The tests for Tcl_TraceObjCmd and TraceVarProc are in trace.test
# The tests for Tcl_WhileObjCmd are in while.test
# cleanup
::tcltest::cleanupTests
return
-
diff --git a/tcl/tests/compExpr-old.test b/tcl/tests/compExpr-old.test
index 0766f0409b5..9bf180d1b53 100644
--- a/tcl/tests/compExpr-old.test
+++ b/tcl/tests/compExpr-old.test
@@ -2,7 +2,7 @@
#
# This file contains the original set of tests for the compilation (and
# indirectly execution) of Tcl's expr command. A new set of tests covering
-# the new implementation are in the files "parseExpr.test and
+# the new implementation are in the files "parseExpr.test" and
# "compExpr.test". Sourcing this file into Tcl runs the tests and generates
# output for errors. No output means no errors were found.
#
@@ -76,393 +76,393 @@ proc do_twelve_days {} {
catch {unset a b i x}
-test expr-1.1 {TclCompileExprCmd: no expression} {
+test compExpr-old-1.1 {TclCompileExprCmd: no expression} {
list [catch {expr } msg] $msg
} {1 {wrong # args: should be "expr arg ?arg ...?"}}
-test expr-1.2 {TclCompileExprCmd: one expression word} {
+test compExpr-old-1.2 {TclCompileExprCmd: one expression word} {
expr -25
} -25
-test expr-1.3 {TclCompileExprCmd: two expression words} {
+test compExpr-old-1.3 {TclCompileExprCmd: two expression words} {
expr -8.2 -6
} -14.2
-test expr-1.4 {TclCompileExprCmd: five expression words} {
+test compExpr-old-1.4 {TclCompileExprCmd: five expression words} {
expr 20 - 5 +10 -7
} 18
-test expr-1.5 {TclCompileExprCmd: quoted expression word} {
+test compExpr-old-1.5 {TclCompileExprCmd: quoted expression word} {
expr "0005"
} 5
-test expr-1.6 {TclCompileExprCmd: quoted expression word} {
+test compExpr-old-1.6 {TclCompileExprCmd: quoted expression word} {
catch {expr "0005"zxy} msg
set msg
} {extra characters after close-quote}
-test expr-1.7 {TclCompileExprCmd: expression word in braces} {
+test compExpr-old-1.7 {TclCompileExprCmd: expression word in braces} {
expr {-0005}
} -5
-test expr-1.8 {TclCompileExprCmd: expression word in braces} {
+test compExpr-old-1.8 {TclCompileExprCmd: expression word in braces} {
expr {{-0x1234}}
} -4660
-test expr-1.9 {TclCompileExprCmd: expression word in braces} {
+test compExpr-old-1.9 {TclCompileExprCmd: expression word in braces} {
catch {expr {-0005}foo} msg
set msg
} {extra characters after close-brace}
-test expr-1.10 {TclCompileExprCmd: other expression word in braces} {
+test compExpr-old-1.10 {TclCompileExprCmd: other expression word in braces} {
expr 4*[llength "6 2"]
} 8
-test expr-1.11 {TclCompileExprCmd: expression word terminated by ;} {
+test compExpr-old-1.11 {TclCompileExprCmd: expression word terminated by ;} {
expr 4*[llength "6 2"];
} 8
-test expr-1.12 {TclCompileExprCmd: inlined expr (in "catch") inside other catch} {
+test compExpr-old-1.12 {TclCompileExprCmd: inlined expr (in "catch") inside other catch} {
set a xxx
catch {
# Might not be a number
set a [expr 10*$a]
}
} 1
-test expr-1.13 {TclCompileExprCmd: second level of substitutions in expr not in braces with single var reference} {
+test compExpr-old-1.13 {TclCompileExprCmd: second level of substitutions in expr not in braces with single var reference} {
set a xxx
set x 27; set bool {$x}; if $bool {set a foo}
set a
} foo
-test expr-1.14 {TclCompileExprCmd: second level of substitutions in expr with comparison as top-level operator} {
+test compExpr-old-1.14 {TclCompileExprCmd: second level of substitutions in expr with comparison as top-level operator} {
set a xxx
set x 2; set b {$x}; set a [expr $b == 2]
set a
} 1
-test expr-2.1 {TclCompileExpr: are builtin functions registered?} {
+test compExpr-old-2.1 {TclCompileExpr: are builtin functions registered?} {
expr double(5*[llength "6 2"])
} 10.0
-test expr-2.2 {TclCompileExpr: error in expr} {
+test compExpr-old-2.2 {TclCompileExpr: error in expr} {
catch {expr 2**3} msg
set msg
-} {syntax error in expression "2**3"}
-test expr-2.3 {TclCompileExpr: junk after legal expr} {
+} {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"}
-test expr-2.4 {TclCompileExpr: numeric expr string rep == formatted int rep} {
+} {syntax error in expression "7*2foo": extra tokens at end of expression}
+test compExpr-old-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} {
+test compExpr-old-3.1 {CompileCondExpr: just lor expr} {expr 3||0} 1
+test compExpr-old-3.2 {CompileCondExpr: error in lor expr} {
catch {expr x||3} msg
set msg
-} {syntax error in expression "x||3"}
-test expr-3.3 {CompileCondExpr: test true arm} {expr 3>2?44:66} 44
-test expr-3.4 {CompileCondExpr: error compiling true arm} {
+} {syntax error in expression "x||3": variable references require preceding $}
+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"}
-test expr-3.5 {CompileCondExpr: test false arm} {expr 2>3?44:66} 66
-test expr-3.6 {CompileCondExpr: error compiling false arm} {
+} {syntax error in expression "3>2?2**3:66": unexpected operator *}
+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"}
-test expr-3.7 {CompileCondExpr: long arms & nested cond exprs} {nonPortable} {
- puts "Note: doing test expr-3.7 which can take several minutes to run"
+} {syntax error in expression "2>3?44:2**3": unexpected operator *}
+test compExpr-old-3.7 {CompileCondExpr: long arms & nested cond exprs} {nonPortable} {
+ puts "Note: doing test compExpr-old-3.7 which can take several minutes to run"
hello_world
} {Hello world}
catch {unset xxx}
-test expr-3.8 {CompileCondExpr: long arms & nested cond exprs} {nonPortable} {
- puts "Note: doing test expr-3.8 which can take several minutes to run"
+test compExpr-old-3.8 {CompileCondExpr: long arms & nested cond exprs} {nonPortable} {
+ puts "Note: doing test compExpr-old-3.8 which can take several minutes to run"
do_twelve_days
} 2358
catch {unset xxx}
-test expr-4.1 {CompileLorExpr: just land expr} {expr 1.3&&3.3} 1
-test expr-4.2 {CompileLorExpr: error in land expr} {
+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} {
catch {expr x&&3} msg
set msg
-} {syntax error in expression "x&&3"}
-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} {
+} {syntax error in expression "x&&3": variable references require preceding $}
+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"}
-test expr-4.7 {CompileLorExpr: error compiling lor arm} {
+} {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"}
-test expr-4.8 {CompileLorExpr: error compiling lor arms} {
+} {syntax error in expression "1.3||2**3": unexpected operator *}
+test compExpr-old-4.8 {CompileLorExpr: error compiling lor arms} {
list [catch {expr {"a"||"b"}} msg] $msg
} {1 {expected boolean value but got "a"}}
-test expr-4.9 {CompileLorExpr: long lor arm} {
+test compExpr-old-4.9 {CompileLorExpr: long lor 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 expr-5.1 {CompileLandExpr: just bitor expr} {expr 7|0x13} 23
-test expr-5.2 {CompileLandExpr: error in bitor expr} {
+test compExpr-old-5.1 {CompileLandExpr: just bitor expr} {expr 7|0x13} 23
+test compExpr-old-5.2 {CompileLandExpr: error in bitor expr} {
catch {expr x|3} msg
set msg
-} {syntax error in expression "x|3"}
-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} {
+} {syntax error in expression "x|3": variable references require preceding $}
+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"}
-test expr-5.8 {CompileLandExpr: error compiling land arm} {
+} {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"}
-test expr-5.9 {CompileLandExpr: error compiling land arm} {
+} {syntax error in expression "1.3&&2**3": unexpected operator *}
+test compExpr-old-5.9 {CompileLandExpr: error compiling land arm} {
list [catch {expr {"a"&&"b"}} msg] $msg
} {1 {expected boolean value but got "a"}}
-test expr-5.10 {CompileLandExpr: long land arms} {
+test compExpr-old-5.10 {CompileLandExpr: long land arms} {
set a "abcdefghijkl"
set i 7
expr {[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]] && [string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]] && [string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]] && [string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]^[string compare [format %c 103] [string index $a $i]]^[string compare [format %c 105] [string index $a $i]]}
} 1
-test expr-6.1 {CompileBitXorExpr: just bitand expr} {expr 7&0x13} 3
-test expr-6.2 {CompileBitXorExpr: error in bitand expr} {
+test compExpr-old-6.1 {CompileBitXorExpr: just bitand expr} {expr 7&0x13} 3
+test compExpr-old-6.2 {CompileBitXorExpr: error in bitand expr} {
catch {expr x|3} msg
set msg
-} {syntax error in expression "x|3"}
-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} {
+} {syntax error in expression "x|3": variable references require preceding $}
+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"}
-test expr-6.8 {CompileBitXorExpr: error compiling bitxor arm} {
+} {syntax error in expression "2**3|6": unexpected operator *}
+test compExpr-old-6.8 {CompileBitXorExpr: error compiling bitxor arm} {
catch {expr 2^x} msg
set msg
-} {syntax error in expression "2^x"}
-test expr-6.9 {CompileBitXorExpr: runtime error in bitxor arm} {
+} {syntax error in expression "2^x": variable references require preceding $}
+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 "^"}}
-test expr-6.10 {CompileBitXorExpr: runtime error in bitxor arm} {
+test compExpr-old-6.10 {CompileBitXorExpr: runtime error in bitxor arm} {
list [catch {expr {"a"^"b"}} msg] $msg
} {1 {can't use non-numeric string as operand of "^"}}
-test expr-7.1 {CompileBitAndExpr: just equality expr} {expr 3==2} 0
-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} {
+test compExpr-old-7.1 {CompileBitAndExpr: just equality expr} {expr 3==2} 0
+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} {
catch {expr x==3} msg
set msg
-} {syntax error in expression "x==3"}
-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} {
+} {syntax error in expression "x==3": variable references require preceding $}
+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"}
-test expr-7.11 {CompileBitAndExpr: error compiling bitand arm} {
+} {syntax error in expression "2**3&6": unexpected operator *}
+test compExpr-old-7.11 {CompileBitAndExpr: error compiling bitand arm} {
catch {expr 2&x} msg
set msg
-} {syntax error in expression "2&x"}
-test expr-7.12 {CompileBitAndExpr: runtime error in bitand arm} {
+} {syntax error in expression "2&x": variable references require preceding $}
+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 "&"}}
-test expr-7.13 {CompileBitAndExpr: runtime error in bitand arm} {
+test compExpr-old-7.13 {CompileBitAndExpr: runtime error in bitand arm} {
list [catch {expr {"a"&"b"}} msg] $msg
} {1 {can't use non-numeric string as operand of "&"}}
-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} {
+test compExpr-old-8.1 {CompileEqualityExpr: just relational expr} {expr 3>=2} 1
+test compExpr-old-8.2 {CompileEqualityExpr: just relational expr} {expr 2<=2.1} 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} {
catch {expr x>3} msg
set msg
-} {syntax error in expression "x>3"}
-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} {
+} {syntax error in expression "x>3": variable references require preceding $}
+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"}
-test expr-8.11 {CompileEqualityExpr: error compiling equality arm} {
+} {syntax error in expression "2**3==6": unexpected operator *}
+test compExpr-old-8.11 {CompileEqualityExpr: error compiling equality arm} {
catch {expr 2!=x} msg
set msg
-} {syntax error in expression "2!=x"}
+} {syntax error in expression "2!=x": variable references require preceding $}
-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 compExpr-old-9.1 {CompileRelationalExpr: just shift expr} {expr 3<<2} 12
+test compExpr-old-9.2 {CompileRelationalExpr: just shift expr} {expr 0xff>>2} 63
+test compExpr-old-9.3 {CompileRelationalExpr: just shift expr} {expr -1>>2} -1
+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
if {0x80000000 > 0} {
- test expr-9.5 {CompileRelationalExpr: shift expr producing LONG_MIN} {nonPortable} {
+ test compExpr-old-9.5 {CompileRelationalExpr: shift expr producing LONG_MIN} {nonPortable} {
expr {1<<63}
} -9223372036854775808
} else {
- test expr-9.5 {CompileRelationalExpr: shift expr producing LONG_MIN} {nonPortable} {
+ test compExpr-old-9.5 {CompileRelationalExpr: shift expr producing LONG_MIN} {nonPortable} {
expr {1<<31}
} -2147483648
}
-test expr-9.6 {CompileRelationalExpr: error in shift expr} {
+test compExpr-old-9.6 {CompileRelationalExpr: error in shift expr} {
catch {expr x>>3} msg
set msg
-} {syntax error in expression "x>>3"}
-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} {
+} {syntax error in expression "x>>3": variable references require preceding $}
+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"}
-test expr-9.10 {CompileRelationalExpr: error compiling relational arm} {
+} {syntax error in expression "2**3>6": unexpected operator *}
+test compExpr-old-9.10 {CompileRelationalExpr: error compiling relational arm} {
catch {expr 2<x} msg
set msg
-} {syntax error in expression "2<x"}
+} {syntax error in expression "2<x": variable references require preceding $}
-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.5 {CompileShiftExpr: error in add expr} {
+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.5 {CompileShiftExpr: error in add expr} {
catch {expr x+3} msg
set msg
-} {syntax error in expression "x+3"}
-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} {
+} {syntax error in expression "x+3": variable references require preceding $}
+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"}
-test expr-10.9 {CompileShiftExpr: error compiling shift arm} {
+} {syntax error in expression "2**3>>6": unexpected operator *}
+test compExpr-old-10.9 {CompileShiftExpr: error compiling shift arm} {
catch {expr 2<<x} msg
set msg
-} {syntax error in expression "2<<x"}
-test expr-10.10 {CompileShiftExpr: runtime error} {
+} {syntax error in expression "2<<x": variable references require preceding $}
+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 ">>"}}
-test expr-10.11 {CompileShiftExpr: runtime error} {
+test compExpr-old-10.11 {CompileShiftExpr: runtime error} {
list [catch {expr {"a"<<"b"}} msg] $msg
} {1 {can't use non-numeric string as operand of "<<"}}
-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.5 {CompileAddExpr: error in multiply expr} {
+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.5 {CompileAddExpr: error in multiply expr} {
catch {expr x*3} msg
set msg
-} {syntax error in expression "x*3"}
-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} {
+} {syntax error in expression "x*3": variable references require preceding $}
+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"}
-test expr-11.9 {CompileAddExpr: error compiling add arm} {
+} {syntax error in expression "2**3+6": unexpected operator *}
+test compExpr-old-11.9 {CompileAddExpr: error compiling add arm} {
catch {expr 2-x} msg
set msg
-} {syntax error in expression "2-x"}
-test expr-11.10 {CompileAddExpr: runtime error} {
+} {syntax error in expression "2-x": variable references require preceding $}
+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 "+"}}
-test expr-11.11 {CompileAddExpr: runtime error} {
+test compExpr-old-11.11 {CompileAddExpr: runtime error} {
list [catch {expr {"a"-"b"}} msg] $msg
} {1 {can't use non-numeric string as operand of "-"}}
-test expr-11.12 {CompileAddExpr: runtime error} {
+test compExpr-old-11.12 {CompileAddExpr: runtime error} {
list [catch {expr {3/0}} msg] $msg
} {1 {divide by zero}}
-test expr-11.13 {CompileAddExpr: runtime error} {
+test compExpr-old-11.13 {CompileAddExpr: runtime error} {
list [catch {expr {2.3/0.0}} msg] $msg
} {1 {divide by zero}}
-test expr-12.1 {CompileMultiplyExpr: just unary expr} {expr ~4} -5
-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} {
+test compExpr-old-12.1 {CompileMultiplyExpr: just unary expr} {expr ~4} -5
+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} {
catch {expr ~x} msg
set msg
-} {syntax error in expression "~x"}
-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} {
+} {syntax error in expression "~x": variable references require preceding $}
+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"}
-test expr-12.9 {CompileMultiplyExpr: error compiling multiply arm} {
+} {syntax error in expression "2*3%%6": unexpected operator %}
+test compExpr-old-12.9 {CompileMultiplyExpr: error compiling multiply arm} {
catch {expr 2*x} msg
set msg
-} {syntax error in expression "2*x"}
-test expr-12.10 {CompileMultiplyExpr: runtime error} {
+} {syntax error in expression "2*x": variable references require preceding $}
+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 "*"}}
-test expr-12.11 {CompileMultiplyExpr: runtime error} {
+test compExpr-old-12.11 {CompileMultiplyExpr: runtime error} {
list [catch {expr {"a"/"b"}} msg] $msg
} {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.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} {
+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.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} {
catch {expr ~x} msg
set msg
-} {syntax error in expression "~x"}
-test expr-13.9 {CompileUnaryExpr: error compiling unary expr} {
+} {syntax error in expression "~x": variable references require preceding $}
+test compExpr-old-13.9 {CompileUnaryExpr: error compiling unary expr} {
catch {expr !1.x} msg
set msg
-} {syntax error in expression "!1.x"}
-test expr-13.10 {CompileUnaryExpr: runtime error} {
+} {syntax error in expression "!1.x": extra tokens at end of expression}
+test compExpr-old-13.10 {CompileUnaryExpr: runtime error} {
list [catch {expr {~"xx"}} msg] $msg
} {1 {can't use non-numeric string as operand of "~"}}
-test expr-13.11 {CompileUnaryExpr: runtime error} {
+test compExpr-old-13.11 {CompileUnaryExpr: runtime error} {
list [catch {expr ~4.0} msg] $msg
} {1 {can't use floating-point value as operand of "~"}}
-test expr-13.12 {CompileUnaryExpr: just primary expr} {expr 0x123} 291
-test expr-13.13 {CompileUnaryExpr: just primary expr} {
+test compExpr-old-13.12 {CompileUnaryExpr: just primary expr} {expr 0x123} 291
+test compExpr-old-13.13 {CompileUnaryExpr: just primary expr} {
set a 27
expr $a
} 27
-test expr-13.14 {CompileUnaryExpr: just primary expr} {
+test compExpr-old-13.14 {CompileUnaryExpr: just primary expr} {
expr double(27)
} 27.0
-test expr-13.15 {CompileUnaryExpr: just primary expr} {expr "123"} 123
-test expr-13.16 {CompileUnaryExpr: error in primary expr} {
+test compExpr-old-13.15 {CompileUnaryExpr: just primary expr} {expr "123"} 123
+test compExpr-old-13.16 {CompileUnaryExpr: error in primary expr} {
catch {expr [set]} msg
set msg
} {wrong # args: should be "set varName ?newValue?"}
-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.5 {CompilePrimaryExpr: literal primary} {expr 62.0} 62.0
-test expr-14.6 {CompilePrimaryExpr: literal primary} {
+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.5 {CompilePrimaryExpr: literal primary} {expr 62.0} 62.0
+test compExpr-old-14.6 {CompilePrimaryExpr: literal primary} {
expr 3.1400000
} 3.14
-test expr-14.7 {CompilePrimaryExpr: literal primary} {expr {{abcde}<{abcdef}}} 1
-test expr-14.8 {CompilePrimaryExpr: literal primary} {expr {{abc\
+test compExpr-old-14.7 {CompilePrimaryExpr: literal primary} {expr {{abcde}<{abcdef}}} 1
+test compExpr-old-14.8 {CompilePrimaryExpr: literal primary} {expr {{abc\
def} < {abcdef}}} 1
-test expr-14.9 {CompilePrimaryExpr: literal primary} {expr {{abc\tde} > {abc\tdef}}} 0
-test expr-14.10 {CompilePrimaryExpr: literal primary} {expr {{123}}} 123
-test expr-14.11 {CompilePrimaryExpr: var reference primary} {
+test compExpr-old-14.9 {CompilePrimaryExpr: literal primary} {expr {{abc\tde} > {abc\tdef}}} 0
+test compExpr-old-14.10 {CompilePrimaryExpr: literal primary} {expr {{123}}} 123
+test compExpr-old-14.11 {CompilePrimaryExpr: var reference primary} {
set i 789
list [expr {$i}] [expr $i]
} {789 789}
-test expr-14.12 {CompilePrimaryExpr: var reference primary} {
+test compExpr-old-14.12 {CompilePrimaryExpr: var reference primary} {
set i {789} ;# test expr's aggressive conversion to numeric semantics
list [expr {$i}] [expr $i]
} {789 789}
-test expr-14.13 {CompilePrimaryExpr: var reference primary} {
+test compExpr-old-14.13 {CompilePrimaryExpr: var reference primary} {
catch {unset a}
set a(foo) foo
set a(bar) bar
@@ -472,45 +472,45 @@ test expr-14.13 {CompilePrimaryExpr: var reference primary} {
catch {unset a}
set result
} {123 1}
-test expr-14.14 {CompilePrimaryExpr: var reference primary} {
+test compExpr-old-14.14 {CompilePrimaryExpr: var reference primary} {
set i 123 ;# test "$var.0" floating point conversion hack
list [expr $i] [expr $i.0] [expr $i.0/12.0]
} {123 123.0 10.25}
-test expr-14.15 {CompilePrimaryExpr: var reference primary} {
+test compExpr-old-14.15 {CompilePrimaryExpr: var reference primary} {
set i 123
catch {expr $i.2} msg
set msg
} 123.2
-test expr-14.16 {CompilePrimaryExpr: error compiling var reference primary} {
+test compExpr-old-14.16 {CompilePrimaryExpr: error compiling var reference primary} {
catch {expr {$a(foo}} msg
set errorInfo
} {missing )
while compiling
"expr {$a(foo}"}
-test expr-14.17 {CompilePrimaryExpr: string primary that looks like var ref} {
+test compExpr-old-14.17 {CompilePrimaryExpr: string primary that looks like var ref} {
expr $
} $
-test expr-14.18 {CompilePrimaryExpr: quoted string primary} {
+test compExpr-old-14.18 {CompilePrimaryExpr: quoted string primary} {
expr "21"
} 21
-test expr-14.19 {CompilePrimaryExpr: quoted string primary} {
+test compExpr-old-14.19 {CompilePrimaryExpr: quoted string primary} {
set i 123
set x 456
expr "$i+$x"
} 579
-test expr-14.20 {CompilePrimaryExpr: quoted string primary} {
+test compExpr-old-14.20 {CompilePrimaryExpr: quoted string primary} {
set i 3
set x 6
expr 2+"$i.$x"
} 5.6
-test expr-14.21 {CompilePrimaryExpr: error in quoted string primary} {
+test compExpr-old-14.21 {CompilePrimaryExpr: error in quoted string primary} {
catch {expr "[set]"} msg
set msg
} {wrong # args: should be "set varName ?newValue?"}
-test expr-14.22 {CompilePrimaryExpr: subcommand primary} {
+test compExpr-old-14.22 {CompilePrimaryExpr: subcommand primary} {
expr {[set i 123; set i]}
} 123
-test expr-14.23 {CompilePrimaryExpr: error in subcommand primary} {
+test compExpr-old-14.23 {CompilePrimaryExpr: error in subcommand primary} {
catch {expr {[set]}} msg
set errorInfo
} {wrong # args: should be "set varName ?newValue?"
@@ -518,28 +518,28 @@ test expr-14.23 {CompilePrimaryExpr: error in subcommand primary} {
"set"
while compiling
"expr {[set]}"}
-test expr-14.24 {CompilePrimaryExpr: error in subcommand primary} {
+test compExpr-old-14.24 {CompilePrimaryExpr: error in subcommand primary} {
catch {expr {[set i}} msg
set errorInfo
} {missing close-bracket
while compiling
"expr {[set i}"}
-test expr-14.25 {CompilePrimaryExpr: math function primary} {
+test compExpr-old-14.25 {CompilePrimaryExpr: math function primary} {
format %.6g [expr exp(1.0)]
} 2.71828
-test expr-14.26 {CompilePrimaryExpr: math function primary} {
+test compExpr-old-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} {
+test compExpr-old-14.27 {CompilePrimaryExpr: error in math function primary} {
catch {expr sinh::(2.0)} msg
set errorInfo
-} {syntax error in expression "sinh::(2.0)"
+} {syntax error in expression "sinh::(2.0)": expected parenthesis enclosing function arguments
while compiling
"expr sinh::(2.0)"}
-test expr-14.28 {CompilePrimaryExpr: subexpression primary} {
+test compExpr-old-14.28 {CompilePrimaryExpr: subexpression primary} {
expr 2+(3*4)
} 14
-test expr-14.29 {CompilePrimaryExpr: error in subexpression primary} {
+test compExpr-old-14.29 {CompilePrimaryExpr: error in subexpression primary} {
catch {expr 2+(3*[set])} msg
set errorInfo
} {wrong # args: should be "set varName ?newValue?"
@@ -547,79 +547,79 @@ test expr-14.29 {CompilePrimaryExpr: error in subexpression primary} {
"set"
while compiling
"expr 2+(3*[set])"}
-test expr-14.30 {CompilePrimaryExpr: missing paren in subexpression primary} {
+test compExpr-old-14.30 {CompilePrimaryExpr: missing paren in subexpression primary} {
catch {expr 2+(3*(4+5)} msg
set errorInfo
-} {syntax error in expression "2+(3*(4+5)"
+} {syntax error in expression "2+(3*(4+5)": looking for close parenthesis
while compiling
"expr 2+(3*(4+5)"}
-test expr-14.31 {CompilePrimaryExpr: just var ref in subexpression primary} {
+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 expr-14.32 {CompilePrimaryExpr: unexpected token} {
+test compExpr-old-14.32 {CompilePrimaryExpr: unexpected token} {
catch {expr @} msg
set errorInfo
-} {syntax error in expression "@"
+} {syntax error in expression "@": character not legal in expressions
while compiling
"expr @"}
-test expr-15.1 {CompileMathFuncCall: missing parenthesis} {
+test compExpr-old-15.1 {CompileMathFuncCall: missing parenthesis} {
catch {expr sinh2.0)} msg
set errorInfo
-} {syntax error in expression "sinh2.0)"
+} {syntax error in expression "sinh2.0)": variable references require preceding $
while compiling
"expr sinh2.0)"}
-test expr-15.2 {CompileMathFuncCall: unknown math function} {
+test compExpr-old-15.2 {CompileMathFuncCall: unknown math function} {
catch {expr whazzathuh(1)} msg
set errorInfo
} {unknown math function "whazzathuh"
while compiling
"expr whazzathuh(1)"}
-test expr-15.3 {CompileMathFuncCall: too many arguments} {
+test compExpr-old-15.3 {CompileMathFuncCall: too many arguments} {
catch {expr sin(1,2,3)} msg
set errorInfo
} {too many arguments for math function
while compiling
"expr sin(1,2,3)"}
-test expr-15.4 {CompileMathFuncCall: ')' found before last required arg} {
+test compExpr-old-15.4 {CompileMathFuncCall: ')' found before last required arg} {
catch {expr sin()} msg
set errorInfo
} {too few arguments for math function
while compiling
"expr sin()"}
-test expr-15.5 {CompileMathFuncCall: too few arguments} {
+test compExpr-old-15.5 {CompileMathFuncCall: too few arguments} {
catch {expr pow(1)} msg
set errorInfo
} {too few arguments for math function
while compiling
"expr pow(1)"}
-test expr-15.6 {CompileMathFuncCall: missing ')'} {
+test compExpr-old-15.6 {CompileMathFuncCall: missing ')'} {
catch {expr sin(1} msg
set errorInfo
-} {syntax error in expression "sin(1"
+} {syntax error in expression "sin(1": missing close parenthesis at end of function call
while compiling
"expr sin(1"}
if $gotT1 {
- test expr-15.7 {CompileMathFuncCall: call registered math function} {
+ test compExpr-old-15.7 {CompileMathFuncCall: call registered math function} {
expr 2*T1()
} 246
- test expr-15.8 {CompileMathFuncCall: call registered math function} {
+ test compExpr-old-15.8 {CompileMathFuncCall: call registered math function} {
expr T2()*3
} 1035
- test expr-15.9 {CompileMathFuncCall: call registered math function} {
+ test compExpr-old-15.9 {CompileMathFuncCall: call registered math function} {
expr T3(21, 37)
} 37
- test expr-15.10 {CompileMathFuncCall: call registered math function} {
+ test compExpr-old-15.10 {CompileMathFuncCall: call registered math function} {
expr T3(21.2, 37)
} 37.0
- test expr-15.11 {CompileMathFuncCall: call registered math function} {
+ test compExpr-old-15.11 {CompileMathFuncCall: call registered math function} {
expr T3(-21.2, -17.5)
} -17.5
}
-test expr-16.1 {GetToken: checks whether integer token starting with "0x" (e.g., "0x$") is invalid} {
+test compExpr-old-16.1 {GetToken: checks whether integer token starting with "0x" (e.g., "0x$") is invalid} {
catch {unset a}
set a(VALUE) ff15
set i 123
@@ -628,13 +628,13 @@ test expr-16.1 {GetToken: checks whether integer token starting with "0x" (e.g.,
}
set i
} {}
-test expr-16.2 {GetToken: check for string literal in braces} {
+test compExpr-old-16.2 {GetToken: check for string literal in braces} {
expr {{1}}
} {1}
# Check "expr" and computed command names.
-test expr-17.1 {expr and computed command names} {
+test compExpr-old-17.1 {expr and computed command names} {
set i 0
set z expr
$z 1+2
@@ -644,7 +644,7 @@ test expr-17.1 {expr and computed command names} {
# an integer, convert to integer. Otherwise, if the string looks like a
# double, convert to double.
-test expr-18.1 {expr and conversion of operands to numbers} {
+test compExpr-old-18.1 {expr and conversion of operands to numbers} {
set x [lindex 11 0]
catch {expr int($x)}
expr {$x}
@@ -653,7 +653,7 @@ test expr-18.1 {expr and conversion of operands to numbers} {
# Check "expr" and interpreter result object resetting before appending
# an error msg during evaluation of exprs not in {}s
-test expr-19.1 {expr and interpreter result object resetting} {
+test compExpr-old-19.1 {expr and interpreter result object resetting} {
proc p {} {
set t 10.0
set x 2.0
@@ -676,16 +676,3 @@ if {[info exists a]} {
}
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tcl/tests/compExpr.test b/tcl/tests/compExpr.test
index 679c56f9743..e71ada53b99 100644
--- a/tcl/tests/compExpr.test
+++ b/tcl/tests/compExpr.test
@@ -30,7 +30,7 @@ test compExpr-1.1 {TclCompileExpr procedure, successful expr parse and compile}
} 3
test compExpr-1.2 {TclCompileExpr procedure, error parsing expr} {
list [catch {expr 1+2+} msg] $msg
-} {1 {syntax error in expression "1+2+"}}
+} {1 {syntax error in expression "1+2+": premature end of expression}}
test compExpr-1.3 {TclCompileExpr procedure, error compiling expr} {
list [catch {expr "foo(123)"} msg] $msg
} {1 {unknown math function "foo"}}
@@ -46,7 +46,7 @@ test compExpr-2.1 {CompileSubExpr procedure, TCL_TOKEN_WORD parse token} {
} 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+"}}
+} {1 {syntax error in expression "1+": premature end of expression}}
test compExpr-2.3 {CompileSubExpr procedure, TCL_TOKEN_TEXT parse token} {
expr {{12345}}
} 12345
@@ -89,7 +89,7 @@ test compExpr-2.13 {CompileSubExpr procedure, error in TCL_TOKEN_SUB_EXPR parse
catch {unset a}
set a 15
list [catch {expr {27 || "$a[expr 1+]00"}} msg] $msg
-} {1 {syntax error in expression "1+"}}
+} {1 {syntax error in expression "1+": premature end of expression}}
test compExpr-2.14 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, op found} {
expr {5*6}
} 30
@@ -157,16 +157,16 @@ test compExpr-2.34 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special
} 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+"}}
+} {1 {syntax error in expression "1+": premature end of expression}}
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+"}}
+} {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+"}}
+} {1 {syntax error in expression "1+": premature end of expression}}
test compExpr-2.39 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} {
expr {-2}
} -2
@@ -182,7 +182,7 @@ test compExpr-2.42 {CompileSubExpr procedure, error in TCL_TOKEN_SUB_EXPR parse
catch {unset a}
set a 15
list [catch {expr {27 || "$a[expr 1+]00"}} msg] $msg
-} {1 {syntax error in expression "1+"}}
+} {1 {syntax error in expression "1+": premature end of expression}}
test compExpr-2.43 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} {
catch {unset a}
set a false
@@ -197,7 +197,7 @@ test compExpr-2.45 {CompileSubExpr procedure, error in TCL_TOKEN_SUB_EXPR parse
catch {unset a}
set a 15
list [catch {expr {1? 54 : "$a[expr 1+]00"}} msg] $msg
-} {1 {syntax error in expression "1+"}}
+} {1 {syntax error in expression "1+": premature end of expression}}
test compExpr-3.1 {CompileLandOrLorExpr procedure, numeric 1st operand} {
catch {unset a}
@@ -211,7 +211,7 @@ test compExpr-3.2 {CompileLandOrLorExpr procedure, nonnumeric 1st operand} {
} 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"}}
+} {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}
@@ -241,7 +241,7 @@ test compExpr-3.8 {CompileLandOrLorExpr procedure, nonnumeric 2nd operand} {
} 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"}}
+} {1 {syntax error in expression "%2": unexpected operator %}}
test compExpr-3.10 {CompileLandOrLorExpr procedure, long lor/land arm} {
set a "abcdefghijkl"
set i 7
@@ -260,7 +260,7 @@ test compExpr-4.2 {CompileCondExpr procedure, complex test, convert to numeric}
} -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"}}
+} {1 {syntax error in expression "*2": unexpected operator *}}
test compExpr-4.4 {CompileCondExpr procedure, simple "true" clause} {
catch {unset a}
set a no
@@ -273,7 +273,7 @@ test compExpr-4.5 {CompileCondExpr procedure, convert "true" clause to numeric}
} 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"}}
+} {1 {syntax error in expression "*2": unexpected operator *}}
test compExpr-4.7 {CompileCondExpr procedure, simple "false" clause} {
catch {unset a}
set a no
@@ -286,7 +286,7 @@ test compExpr-4.8 {CompileCondExpr procedure, convert "false" clause to numeric}
} 83
test compExpr-4.9 {CompileCondExpr procedure, error in "false" clause} {
list [catch {expr {1? 15 : [expr *2]}} msg] $msg
-} {1 {syntax error in expression "*2"}}
+} {1 {syntax error in expression "*2": unexpected operator *}}
test compExpr-5.1 {CompileMathFuncCall procedure, math function found} {
format %.6g [expr atan2(1.0, 2.0)]
@@ -310,7 +310,7 @@ test compExpr-5.6 {CompileMathFuncCall procedure, complex argument} {
} 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.*)"}}
+} {1 {syntax error in expression "sinh(2.*)": unexpected close parenthesis}}
test compExpr-5.8 {CompileMathFuncCall procedure, too many arguments} {
list [catch {expr {sinh(2.0, 3.0)}} msg] $msg
} {1 {too many arguments for math function}}
@@ -320,23 +320,10 @@ test compExpr-5.9 {CompileMathFuncCall procedure, too many arguments} {
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"}}
+} {1 {syntax error in expression "(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+012...": extra tokens at end of expression}}
# cleanup
catch {unset a}
catch {unset b}
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tcl/tests/compile.test b/tcl/tests/compile.test
index efbca87fb9e..b92b08b7282 100644
--- a/tcl/tests/compile.test
+++ b/tcl/tests/compile.test
@@ -1,4 +1,5 @@
-# This file contains tests for the file tclCompile.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
@@ -12,10 +13,8 @@
#
# RCS: @(#) $Id$
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
- namespace import -force ::tcltest::*
-}
+package require tcltest 2
+namespace import -force ::tcltest::*
# The following tests are very incomplete, although the rest of the
# test suite covers this file fairly well.
@@ -44,8 +43,7 @@ test compile-1.1 {TclCompileString: look up cmds in proc ns, not current ns} {
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 {no value given for parameter "x" to "p"}}
-
+} {1 {wrong # args: should be "p x"}}
test compile-2.1 {TclCompileDollarVar: global scalar name with ::s} {
catch {unset x}
set x 123
@@ -72,6 +70,15 @@ test compile-2.4 {TclCompileDollarVar: global scalar name with ::s} {
}
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)}} {
+ catch {unset a}
+ 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}
test compile-3.1 {TclCompileCatchCmd: only catch cmds with scalar vars are compiled inline} {
catch {unset a}
@@ -90,6 +97,23 @@ test compile-3.2 {TclCompileCatchCmd: non-local variables} {
catch-test
set ::foo
} 3
+test compile-3.3 {TclCompileCatchCmd: overagressive compiling [bug 219184]} {
+ proc catch-test {str} {
+ catch [eval $str GOOD]
+ error BAD
+ }
+ catch {catch-test error} ::foo
+ set ::foo
+} {GOOD}
+test compile-3.4 {TclCompileCatchCmd: bcc'ed [return] is caught} {
+ proc foo {} {
+ set fail [catch {
+ return 1
+ }] ; # {}
+ return 2
+ }
+ foo
+} {2}
test compile-4.1 {TclCompileForCmd: command substituted test expression} {
set i 0
@@ -190,6 +214,124 @@ test compile-10.1 {BLACKBOX: exception stack overflow} {
}
} {}
+test compile-11.1 {Tcl_Append*: ensure Tcl_ResetResult is used properly} {
+ proc p {} {
+ # 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 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 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 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"}}
+test compile-11.7 {Tcl_Append*: ensure Tcl_ResetResult is used properly} {
+ proc p {} { set r [list foobar] ; expr !a }
+ list [catch {p} msg] $msg
+} {1 {syntax error in expression "!a": variable references require preceding $}}
+test compile-11.8 {Tcl_Append*: ensure Tcl_ResetResult is used properly} {
+ proc p {} { set r [list foobar] ; expr {!a} }
+ list [catch {p} msg] $msg
+} {1 {syntax error in expression "!a": variable references require preceding $}}
+test compile-11.9 {Tcl_Append*: ensure Tcl_ResetResult is used properly} {
+ proc p {} { set r [list foobar] ; llength "\{" }
+ list [catch {p} msg] $msg
+} {1 {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
+#
+# Special test for leak on interp delete [Bug 467523].
+::tcltest::testConstraint exec [llength [info commands exec]]
+::tcltest::testConstraint memDebug [llength [info commands memory]]
+
+test compile-12.1 {testing literal leak on interp delete} {memDebug} {
+ proc getbytes {} {
+ set lines [split [memory info] "\n"]
+ lindex [lindex $lines 3] 3
+ }
+
+ set end [getbytes]
+ for {set i 0} {$i < 5} {incr i} {
+ interp create foo
+ foo eval {
+ namespace eval bar {}
+ }
+ interp delete foo
+ set tmp $end
+ set end [getbytes]
+ }
+ rename getbytes {}
+ set leak [expr {$end - $tmp}]
+} 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.
+test compile-12.2 {testing error on literal deletion} {memDebug exec} {
+ makeFile {
+ for {set i 0} {$i < 5} {incr i} {
+ namespace eval bar {}
+ namespace delete bar
+ }
+ puts 0
+ } source.file
+ set res [catch {
+ exec [interpreter] source.file
+ }]
+ catch {removeFile source.file}
+ set res
+} 0
+# Test to catch buffer overrun in TclCompileTokens from buf 530320
+test compile-12.3 {check for a buffer overrun} {
+ proc crash {} {
+ puts $array([expr {a+2}])
+ }
+ list [catch crash msg] $msg
+} {1 {syntax error in expression "a+2": variable references require preceding $}}
+
+# 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} {
+ append body " $i"
+ }
+ append body {]; puts OK}
+ regsub BODY {proc crash {} {BODY}; crash} $body script
+ list [catch {exec [interpreter] << $script} msg] $msg
+} {0 OK}
+
+# 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
+ list $msg1 $msg2
+} {{wrong # args: should be "error message ?errorInfo? ?errorCode?"} {can't read "abba": no such variable}}
+
+
# cleanup
@@ -200,17 +342,3 @@ catch {unset y}
catch {unset a}
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tcl/tests/concat.test b/tcl/tests/concat.test
index 80199c193e8..b2f8eafcc97 100644
--- a/tcl/tests/concat.test
+++ b/tcl/tests/concat.test
@@ -64,4 +64,3 @@ return
-
diff --git a/tcl/tests/dcall.test b/tcl/tests/dcall.test
index 5a5091cdefa..a757095fab4 100644
--- a/tcl/tests/dcall.test
+++ b/tcl/tests/dcall.test
@@ -59,4 +59,3 @@ return
-
diff --git a/tcl/tests/dstring.test b/tcl/tests/dstring.test
index 9e52b8a8c11..ce6c3c88075 100644
--- a/tcl/tests/dstring.test
+++ b/tcl/tests/dstring.test
@@ -266,4 +266,3 @@ return
-
diff --git a/tcl/tests/encoding.test b/tcl/tests/encoding.test
index 4cd5255176f..a0852846f12 100644
--- a/tcl/tests/encoding.test
+++ b/tcl/tests/encoding.test
@@ -10,10 +10,8 @@
#
# RCS: @(#) $Id$
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
- namespace import -force ::tcltest::*
-}
+package require tcltest 2
+namespace import -force ::tcltest::*
proc toutf {args} {
global x
@@ -25,10 +23,8 @@ proc fromutf {args} {
}
# Some tests require the testencoding command
-
-set ::tcltest::testConstraints(testencoding) \
- [expr {[info commands testencoding] != {}}]
-
+testConstraint testencoding [llength [info commands testencoding]]
+testConstraint exec [llength [info commands exec]]
# TclInitEncodingSubsystem is tested by the rest of this file
# TclFinalizeEncodingSubsystem is not currently tested
@@ -88,10 +84,10 @@ test encoding-3.2 {Tcl_GetEncodingName, non-null} {
} {jis0208}
test encoding-4.1 {Tcl_GetEncodingNames} {testencoding} {
- file mkdir tmp/encoding
- close [open tmp/encoding/junk.enc w]
- close [open tmp/encoding/junk2.enc w]
- cd tmp
+ 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 {}
catch {unset encodings}
@@ -106,8 +102,11 @@ test encoding-4.1 {Tcl_GetEncodingNames} {testencoding} {
}
}
testencoding path $path
- cd ..
- file delete -force tmp
+ 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}
@@ -156,15 +155,15 @@ test encoding-7.2 {Tcl_UtfToExternalDString: big buffer} {
} "512 \u4e4e"
test encoding-8.1 {Tcl_ExternalToUtf} {
- set f [open dummy w]
+ set f [open [file join [temporaryDirectory] dummy] w]
fconfigure $f -translation binary -encoding iso8859-1
puts -nonewline $f "ab\x8c\xc1g"
close $f
- set f [open dummy r]
+ set f [open [file join [temporaryDirectory] dummy] r]
fconfigure $f -translation binary -encoding shiftjis
set x [read $f]
close $f
- file delete dummy
+ file delete [file join [temporaryDirectory] dummy]
set x
} "ab\u4e4eg"
@@ -184,18 +183,30 @@ test encoding-9.2 {Tcl_UtfToExternalDString: big buffer} {
} "1024 8C"
test encoding-10.1 {Tcl_UtfToExternal} {
- set f [open dummy w]
+ set f [open [file join [temporaryDirectory] dummy] w]
fconfigure $f -translation binary -encoding shiftjis
puts -nonewline $f "ab\u4e4eg"
close $f
- set f [open dummy r]
+ set f [open [file join [temporaryDirectory] dummy] r]
fconfigure $f -translation binary -encoding iso8859-1
set x [read $f]
close $f
- file delete dummy
+ file delete [file join [temporaryDirectory] dummy]
set x
} "ab\x8c\xc1g"
+proc viewable {str} {
+ set res ""
+ foreach c [split $str {}] {
+ if {[string is print $c] && [string is ascii $c]} {
+ append res $c
+ } else {
+ append res "\\u[format %4.4x [scan $c %c]]"
+ }
+ }
+ return "$str ($res)"
+}
+
test encoding-11.1 {LoadEncodingFile: unknown encoding} {testencoding} {
set system [encoding system]
set path [testencoding path]
@@ -216,21 +227,28 @@ test encoding-11.4 {LoadEncodingFile: multi-byte} {
encoding convertfrom shiftjis \x8c\xc1
} "\u4e4e"
test encoding-11.5 {LoadEncodingFile: escape file} {
- encoding convertto iso2022 \u4e4e
-} "\x1b(B\x1b$@8C"
+ viewable [encoding convertto iso2022 \u4e4e]
+} [viewable "\x1b\$B8C\x1b(B"]
+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} {
set system [encoding system]
set path [testencoding path]
encoding system identity
+ cd [temporaryDirectory]
testencoding path tmp
- file mkdir tmp/encoding
- set f [open tmp/encoding/splat.enc w]
+ 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]
- file delete -force tmp
- catch {file delete encoding}
+ file delete [file join [temporaryDirectory] tmp encoding splat.enc]
+ removeDirectory [file join tmp encoding]
+ removeDirectory tmp
+ cd [workingDirectory]
testencoding path $path
encoding system $system
set x
@@ -262,8 +280,8 @@ test encoding-12.5 {LoadTableEncoding: symbol encoding} {
} "\x67\x67\u3b3"
test encoding-13.1 {LoadEscapeTable} {
- set x [encoding convertto iso2022 ab\u4e4e\u68d9g]
-} "\x1b(Bab\x1b$@8C\x1b$\(DD%\x1b(Bg"
+ viewable [set x [encoding convertto iso2022 ab\u4e4e\u68d9g]]
+} [viewable "ab\x1b\$B8C\x1b\$\(DD%\x1b(Bg"]
test encoding-14.1 {BinaryProc} {
encoding convertto identity \x12\x34\x56\xff\x69
@@ -295,24 +313,110 @@ 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
+\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
+\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
+\u3057\u3087\u3046\u304b\uff1f"
+
+cd [temporaryDirectory]
+set fid [open iso2022.txt w]
+fconfigure $fid -encoding binary
+puts -nonewline $fid $::iso2022encData
+close $fid
+
+test encoding-23.2 {iso2022-jp escape encoding test} {
+ string equal $::iso2022uniData $::iso2022uniData2
+} 1
+test encoding-23.2 {iso2022-jp escape encoding test} {
+ # This checks that 'gets' isn't resetting the encoding inappropriately.
+ # [Bug #523988]
+ set fid [open iso2022.txt r]
+ fconfigure $fid -encoding iso2022-jp
+ set out ""
+ set count 0
+ while {[set num [gets $fid line]] >= 0} {
+ if {$count} {
+ incr count 1 ; # account for newline
+ append out \n
+ }
+ append out $line
+ incr count $num
+ }
+ close $fid
+ if {[string compare $::iso2022uniData $out]} {
+ return -code error "iso2022-jp read in doesn't match original"
+ }
+ list $count $out
+} [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
+cd [workingDirectory]
+
+test encoding-24.1 {EscapeFreeProc on open channels} -constraints {
+ exec
+} -setup {
+ # Bug #524674 input
+ set file [makeFile {
+ 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 {
+ # Bug #524674 output
+ set file [makeFile {
+ fconfigure stdout -encoding iso2022-jp
+ puts ab\u4e4e\u68d9g
+ 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)"
+
+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
+ set file [makeFile {
+ encoding system iso2022-jp
+ set a "\u4e4e\u4e5e\u4e5f"; # 3 Japanese Kanji letters
+ puts $a
+ } iso2022.tcl]
+ set f [open "|[list [interpreter] $file]"]
+ fconfigure $f -encoding iso2022-jp
+ set count [gets $f line]
+ close $f
+ removeFile iso2022.tcl
+ list $count [viewable $line]
+} [list 3 "\u4e4e\u4e5e\u4e5f (\\u4e4e\\u4e5e\\u4e5f)"]
+
+file delete [file join [temporaryDirectory] iso2022.txt]
+
# EscapeFreeProc, GetTableEncoding, unilen
# are fully tested by the rest of this file
# cleanup
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tcl/tests/env.test b/tcl/tests/env.test
index adadfc6f411..48e770f62e3 100644
--- a/tcl/tests/env.test
+++ b/tcl/tests/env.test
@@ -13,10 +13,8 @@
#
# RCS: @(#) $Id$
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
- namespace import -force ::tcltest::*
-}
+package require tcltest 2
+namespace import -force ::tcltest::*
#
# These tests will run on any platform (and indeed crashed
@@ -58,10 +56,9 @@ test env-1.3 {reflection of env by "array names"} {
# Some tests require the "exec" command.
# Skip them if exec is not defined.
-set ::tcltest::testConstraints(execCommandExists) [expr {[info commands exec] != ""}]
+testConstraint exec [llength [info commands exec]]
-set f [open printenv w]
-puts $f {
+set printenvScript [makeFile {
proc lrem {listname name} {
upvar $listname list
set i [lsearch $list $name]
@@ -85,12 +82,13 @@ puts $f {
puts "$p=$env($p)"
}
exit
-}
-close $f
+} printenv]
+# [exec] is required here to see the actual environment received
+# by child processes.
proc getenv {} {
- global printenv tcltest
- catch {exec $::tcltest::tcltest printenv} out
+ global printenvScript tcltest
+ catch {exec [interpreter] $printenvScript} out
if {$out == "child process exited abnormally"} {
set out {}
}
@@ -113,30 +111,30 @@ foreach name {TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH DISPLAY SHLIB_PATH} {
}
}
-test env-2.1 {adding environment variables} {execCommandExists} {
+test env-2.1 {adding environment variables} {exec} {
getenv
} {}
set env(NAME1) "test string"
-test env-2.2 {adding environment variables} {execCommandExists} {
+test env-2.2 {adding environment variables} {exec} {
getenv
} {NAME1=test string}
set env(NAME2) "more"
-test env-2.3 {adding environment variables} {execCommandExists} {
+test env-2.3 {adding environment variables} {exec} {
getenv
} {NAME1=test string
NAME2=more}
set env(XYZZY) "garbage"
-test env-2.4 {adding environment variables} {execCommandExists} {
+test env-2.4 {adding environment variables} {exec} {
getenv
} {NAME1=test string
NAME2=more
XYZZY=garbage}
set env(NAME2) "new value"
-test env-3.1 {changing environment variables} {execCommandExists} {
+test env-3.1 {changing environment variables} {exec} {
set result [getenv]
unset env(NAME2)
set result
@@ -144,28 +142,28 @@ test env-3.1 {changing environment variables} {execCommandExists} {
NAME2=new value
XYZZY=garbage}
-test env-4.1 {unsetting environment variables} {execCommandExists} {
+test env-4.1 {unsetting environment variables} {exec} {
set result [getenv]
unset env(NAME1)
set result
} {NAME1=test string
XYZZY=garbage}
-test env-4.2 {unsetting environment variables} {execCommandExists} {
+test env-4.2 {unsetting environment variables} {exec} {
set result [getenv]
unset env(XYZZY)
set result
} {XYZZY=garbage}
-test env-4.3 {setting international environment variables} {execCommandExists} {
+test env-4.3 {setting international environment variables} {exec} {
set env(\ua7) \ub6
getenv
} "\ua7=\ub6"
-test env-4.4 {changing international environment variables} {execCommandExists} {
+test env-4.4 {changing international environment variables} {exec} {
set env(\ua7) \ua7
getenv
} "\ua7=\ua7"
-test env-4.5 {unsetting international environment variables} {execCommandExists} {
+test env-4.5 {unsetting international environment variables} {exec} {
set env(\ub6) \ua7
unset env(\ua7)
set result [getenv]
@@ -244,7 +242,7 @@ foreach name [array names env2] {
}
# cleanup
-file delete printenv
+removeFile $printenvScript
::tcltest::cleanupTests
return
@@ -259,4 +257,3 @@ return
-
diff --git a/tcl/tests/error.test b/tcl/tests/error.test
index 6b2e5e302f1..bc4b569bd27 100644
--- a/tcl/tests/error.test
+++ b/tcl/tests/error.test
@@ -44,6 +44,8 @@ test error-1.2 {simple errors from commands} {
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
} {wrong # args: should be "string index string charIndex"
while executing
"string index"}
@@ -179,4 +181,3 @@ test error-6.1 {catch must reset error state} {
catch {rename p ""}
::tcltest::cleanupTests
return
-
diff --git a/tcl/tests/eval.test b/tcl/tests/eval.test
index 1b417831de0..1d17587bc6e 100644
--- a/tcl/tests/eval.test
+++ b/tcl/tests/eval.test
@@ -73,4 +73,3 @@ return
-
diff --git a/tcl/tests/event.test b/tcl/tests/event.test
index 95b2c418322..8d84bb1e03d 100644
--- a/tcl/tests/event.test
+++ b/tcl/tests/event.test
@@ -11,17 +11,12 @@
#
# RCS: @(#) $Id$
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
- namespace import -force ::tcltest::*
-}
+package require tcltest 2
+namespace import -force ::tcltest::*
-set ::tcltest::testConstraints(testfilehandler) \
- [expr {[info commands testfilehandler] != {}}]
-set ::tcltest::testConstraints(testexithandler) \
- [expr {[info commands testexithandler] != {}}]
-set ::tcltest::testConstraints(testfilewait) \
- [expr {[info commands testfilewait] != {}}]
+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} {
testfilehandler close
@@ -170,6 +165,7 @@ test event-5.1 {Tcl_BackgroundError, HandleBgErrors procedures} {
set x {}
update idletasks
rename bgerror {}
+ regsub -all [file join {} non_existent] $x "non_existent" x
set x
} {{{a simple error} {a simple error
while executing
@@ -196,10 +192,12 @@ test event-5.2 {Tcl_BackgroundError, HandleBgErrors procedures} {
test event-6.1 {BgErrorDeleteProc procedure} {
catch {interp delete foo}
interp create foo
+ set erroutfile [makeFile Unmodified err.out]
+ foo eval [list set erroutfile $erroutfile]
foo eval {
proc bgerror args {
- global errorInfo
- set f [open err.out r+]
+ global errorInfo erroutfile
+ set f [open $erroutfile r+]
seek $f 0 end
puts $f "$args $errorInfo"
close $f
@@ -207,14 +205,13 @@ test event-6.1 {BgErrorDeleteProc procedure} {
after 100 {error "first error"}
after 100 {error "second error"}
}
- makeFile Unmodified err.out
after 100 {interp delete foo}
after 200
update
- set f [open err.out r]
+ set f [open $erroutfile r]
set result [read $f]
close $f
- removeFile err.out
+ removeFile $erroutfile
set result
} {Unmodified
}
@@ -275,6 +272,22 @@ test event-7.4 {tkerror is nothing special anymore to tcl} {
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 {
+ after 1000 error hello
+ after 2000 set a 0
+ vwait a
+ }
+
+ list [catch {exec [interpreter] << $script} errMsg] $errMsg
+} {1 {hello
+ while executing
+"error hello"
+ ("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
@@ -287,7 +300,7 @@ catch {rename bgerror {}}
test event-8.1 {Tcl_CreateExitHandler procedure} {stdio testexithandler} {
- set child [open |[list [info nameofexecutable]] r+]
+ set child [open |[list [interpreter]] r+]
puts $child "testexithandler create 41; testexithandler create 4"
puts $child "testexithandler create 6; exit"
flush $child
@@ -300,7 +313,7 @@ odd 41
}
test event-9.1 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
- set child [open |[list [info nameofexecutable]] r+]
+ set child [open |[list [interpreter]] r+]
puts $child "testexithandler create 41; testexithandler create 4"
puts $child "testexithandler create 6; testexithandler delete 41"
puts $child "testexithandler create 16; exit"
@@ -313,7 +326,7 @@ even 6
even 4
}
test event-9.2 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
- set child [open |[list [info nameofexecutable]] r+]
+ set child [open |[list [interpreter]] r+]
puts $child "testexithandler create 41; testexithandler create 4"
puts $child "testexithandler create 6; testexithandler delete 4"
puts $child "testexithandler create 16; exit"
@@ -326,7 +339,7 @@ even 6
odd 41
}
test event-9.3 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
- set child [open |[list [info nameofexecutable]] r+]
+ set child [open |[list [interpreter]] r+]
puts $child "testexithandler create 41; testexithandler create 4"
puts $child "testexithandler create 6; testexithandler delete 6"
puts $child "testexithandler create 16; exit"
@@ -339,7 +352,7 @@ even 4
odd 41
}
test event-9.4 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
- set child [open |[list [info nameofexecutable]] r+]
+ set child [open |[list [interpreter]] r+]
puts $child "testexithandler create 41; testexithandler delete 41"
puts $child "testexithandler create 16; exit"
flush $child
@@ -350,7 +363,7 @@ test event-9.4 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
}
test event-10.1 {Tcl_Exit procedure} {stdio} {
- set child [open |[list [info nameofexecutable]] r+]
+ set child [open |[list [interpreter]] r+]
puts $child "exit 3"
list [catch {close $child} msg] $msg [lindex $errorCode 0] \
[lindex $errorCode 2]
@@ -388,42 +401,45 @@ foreach i [after info] {
}
test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} {socket} {
- set f1 [open test1 w]
+ set test1file [makeFile "" test1]
+ set f1 [open $test1file w]
proc accept {s args} {
puts $s foobar
close $s
}
- catch {set s1 [socket -server accept 5001]}
+ catch {set s1 [socket -server accept 0]}
after 1000
- catch {set s2 [socket 127.0.0.1 5001]}
+ catch {set s2 [socket 127.0.0.1 [lindex [fconfigure $s1 -sockname] 2]]}
close $s1
set x 0
set y 0
set z 0
- fileevent $s2 readable { incr z }
+ fileevent $s2 readable {incr z}
vwait z
- fileevent $f1 writable { incr x; if { $y == 3 } { set z done } }
- fileevent $s2 readable { incr y; if { $x == 3 } { set z done } }
+ fileevent $f1 writable {incr x; if {$y == 3} {set z done}}
+ fileevent $s2 readable {incr y; if {$x == 3} {set z done}}
vwait z
close $f1
close $s2
- file delete test1 test2
+ removeFile $test1file
list $x $y $z
} {3 3 done}
test event-11.6 {Tcl_VwaitCmd procedure: round robin scheduling, same source} {
- file delete test1 test2
- set f1 [open test1 w]
- set f2 [open test2 w]
+ set test1file [makeFile "" test1]
+ set test2file [makeFile "" test2]
+ set f1 [open $test1file w]
+ set f2 [open $test2file w]
set x 0
set y 0
set z 0
update
- fileevent $f1 writable { incr x; if { $y == 3 } { set z done } }
- fileevent $f2 writable { incr y; if { $x == 3 } { set z done } }
+ fileevent $f1 writable {incr x; if {$y == 3} {set z done}}
+ fileevent $f2 writable {incr y; if {$x == 3} {set z done}}
vwait z
close $f1
close $f2
- file delete test1 test2
+ removeFile $test1file
+ removeFile $test2file
list $x $y $z
} {3 3 done}
@@ -576,16 +592,3 @@ foreach i [after info] {
}
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tcl/tests/exec.test b/tcl/tests/exec.test
index f77710fe310..3e0bce07002 100644
--- a/tcl/tests/exec.test
+++ b/tcl/tests/exec.test
@@ -13,28 +13,23 @@
#
# RCS: @(#) $Id$
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
- namespace import -force ::tcltest::*
-}
+package require tcltest 2
+namespace import -force ::tcltest::*
# All tests require the "exec" command.
# Skip them if exec is not defined.
-set ::tcltest::testConstraints(execCommandExists) [expr {[info commands exec] != ""}]
+testConstraint exec [llength [info commands exec]]
-set f [open echo w]
-puts $f {
+set path(echo) [makeFile {
puts -nonewline [lindex $argv 0]
foreach str [lrange $argv 1 end] {
puts -nonewline " $str"
}
puts {}
exit
-}
-close $f
+} echo]
-set f [open cat w]
-puts $f {
+set path(cat) [makeFile {
if {$argv == {}} {
set argv -
}
@@ -53,22 +48,18 @@ puts $f {
}
}
exit
-}
-close $f
+} cat]
-set f [open wc w]
-puts $f {
+set path(wc) [makeFile {
set data [read stdin]
set lines [regsub -all "\n" $data {} dummy]
set words [regsub -all "\[^ \t\n]+" $data {} dummy]
set chars [string length $data]
puts [format "%8.d%8.d%8.d" $lines $words $chars]
exit
-}
-close $f
+} wc]
-set f [open sh w]
-puts $f {
+set path(sh) [makeFile {
if {[lindex $argv 0] != "-c"} {
error "sh: unexpected arguments $argv"
}
@@ -89,196 +80,198 @@ puts $f {
lappend newcmd $arg
}
exit
-}
-close $f
+} sh]
-set f [open sleep w]
-puts $f {
+set path(sleep) [makeFile {
after [expr $argv*1000]
exit
-}
-close $f
+} sleep]
-set f [open exit w]
-puts $f {
+set path(exit) [makeFile {
exit $argv
-}
-close $f
+} exit]
# Basic operations.
-test exec-1.1 {basic exec operation} {execCommandExists stdio} {
- exec $::tcltest::tcltest echo a b c
+test exec-1.1 {basic exec operation} {exec} {
+ exec [interpreter] $path(echo) a b c
} "a b c"
-test exec-1.2 {pipelining} {execCommandExists stdio} {
- exec $::tcltest::tcltest echo a b c d | $::tcltest::tcltest cat | $::tcltest::tcltest cat
+test exec-1.2 {pipelining} {exec stdio} {
+ exec [interpreter] $path(echo) a b c d | [interpreter] $path(cat) | [interpreter] $path(cat)
} "a b c d"
-test exec-1.3 {pipelining} {execCommandExists stdio} {
- set a [exec $::tcltest::tcltest echo a b c d | $::tcltest::tcltest cat | $::tcltest::tcltest wc]
+test exec-1.3 {pipelining} {exec stdio} {
+ set a [exec [interpreter] $path(echo) a b c d | [interpreter] $path(cat) | [interpreter] $path(wc)]
list [scan $a "%d %d %d" b c d] $b $c
} {3 1 4}
set arg {12345678901234567890123456789012345678901234567890}
set arg "$arg$arg$arg$arg$arg$arg"
-test exec-1.4 {long command lines} {execCommandExists stdio} {
- exec $::tcltest::tcltest echo $arg
+test exec-1.4 {long command lines} {exec} {
+ exec [interpreter] $path(echo) $arg
} $arg
set arg {}
# I/O redirection: input from Tcl command.
-test exec-2.1 {redirecting input from immediate source} {execCommandExists stdio} {
- exec $::tcltest::tcltest cat << "Sample text"
+test exec-2.1 {redirecting input from immediate source} {exec stdio} {
+ exec [interpreter] $path(cat) << "Sample text"
} {Sample text}
-test exec-2.2 {redirecting input from immediate source} {execCommandExists stdio} {
- exec << "Sample text" $::tcltest::tcltest cat | $::tcltest::tcltest cat
+test exec-2.2 {redirecting input from immediate source} {exec stdio} {
+ exec << "Sample text" [interpreter] $path(cat) | [interpreter] $path(cat)
} {Sample text}
-test exec-2.3 {redirecting input from immediate source} {execCommandExists stdio} {
- exec $::tcltest::tcltest cat << "Sample text" | $::tcltest::tcltest cat
+test exec-2.3 {redirecting input from immediate source} {exec stdio} {
+ exec [interpreter] $path(cat) << "Sample text" | [interpreter] $path(cat)
} {Sample text}
-test exec-2.4 {redirecting input from immediate source} {execCommandExists stdio} {
- exec $::tcltest::tcltest cat | $::tcltest::tcltest cat << "Sample text"
+test exec-2.4 {redirecting input from immediate source} {exec stdio} {
+ exec [interpreter] $path(cat) | [interpreter] $path(cat) << "Sample text"
} {Sample text}
-test exec-2.5 {redirecting input from immediate source} {execCommandExists stdio} {
- exec $::tcltest::tcltest cat "<<Joined to arrows"
+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} {execCommandExists stdio} {
+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 $::tcltest::tcltest cat << "\uE9\uE0\uFC\uF1"
+ exec [interpreter] $path(cat) << "\uE9\uE0\uFC\uF1"
} "\uE9\uE0\uFC\uF1"
# I/O redirection: output to file.
-file delete gorp.file
-test exec-3.1 {redirecting output to file} {execCommandExists stdio} {
- exec $::tcltest::tcltest echo "Some simple words" > gorp.file
- exec $::tcltest::tcltest cat gorp.file
+set path(gorp.file) [makeFile {} gorp.file]
+removeFile gorp.file
+
+test exec-3.1 {redirecting output to file} {exec} {
+ exec [interpreter] $path(echo) "Some simple words" > $path(gorp.file)
+ exec [interpreter] $path(cat) $path(gorp.file)
} "Some simple words"
-test exec-3.2 {redirecting output to file} {execCommandExists stdio} {
- exec $::tcltest::tcltest echo "More simple words" | >gorp.file $::tcltest::tcltest cat | $::tcltest::tcltest cat
- exec $::tcltest::tcltest cat gorp.file
+test exec-3.2 {redirecting output to file} {exec stdio} {
+ exec [interpreter] $path(echo) "More simple words" | >$path(gorp.file) [interpreter] $path(cat) | [interpreter] $path(cat)
+ exec [interpreter] $path(cat) $path(gorp.file)
} "More simple words"
-test exec-3.3 {redirecting output to file} {execCommandExists stdio} {
- exec > gorp.file $::tcltest::tcltest echo "Different simple words" | $::tcltest::tcltest cat | $::tcltest::tcltest cat
- exec $::tcltest::tcltest cat gorp.file
+test exec-3.3 {redirecting output to file} {exec stdio} {
+ exec > $path(gorp.file) [interpreter] $path(echo) "Different simple words" | [interpreter] $path(cat) | [interpreter] $path(cat)
+ exec [interpreter] $path(cat) $path(gorp.file)
} "Different simple words"
-test exec-3.4 {redirecting output to file} {execCommandExists stdio} {
- exec $::tcltest::tcltest echo "Some simple words" >gorp.file
- exec $::tcltest::tcltest cat gorp.file
+test exec-3.4 {redirecting output to file} {exec} {
+ exec [interpreter] $path(echo) "Some simple words" >$path(gorp.file)
+ exec [interpreter] $path(cat) $path(gorp.file)
} "Some simple words"
-test exec-3.5 {redirecting output to file} {execCommandExists stdio} {
- exec $::tcltest::tcltest echo "First line" >gorp.file
- exec $::tcltest::tcltest echo "Second line" >> gorp.file
- exec $::tcltest::tcltest cat gorp.file
+test exec-3.5 {redirecting output to file} {exec} {
+ exec [interpreter] $path(echo) "First line" >$path(gorp.file)
+ exec [interpreter] $path(echo) "Second line" >> $path(gorp.file)
+ exec [interpreter] $path(cat) $path(gorp.file)
} "First line\nSecond line"
-test exec-3.6 {redirecting output to file} {execCommandExists stdio} {
- exec $::tcltest::tcltest echo "First line" >gorp.file
- exec $::tcltest::tcltest echo "Second line" >>gorp.file
- exec $::tcltest::tcltest cat gorp.file
+test exec-3.6 {redirecting output to file} {exec} {
+ exec [interpreter] $path(echo) "First line" >$path(gorp.file)
+ exec [interpreter] $path(echo) "Second line" >>$path(gorp.file)
+ exec [interpreter] $path(cat) $path(gorp.file)
} "First line\nSecond line"
-test exec-3.7 {redirecting output to file} {execCommandExists stdio} {
- set f [open gorp.file w]
+test exec-3.7 {redirecting output to file} {exec} {
+ set f [open $path(gorp.file) w]
puts $f "Line 1"
flush $f
- exec $::tcltest::tcltest echo "More text" >@ $f
- exec $::tcltest::tcltest 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 $::tcltest::tcltest cat gorp.file
+ exec [interpreter] $path(cat) $path(gorp.file)
} "Line 1\nMore text\nEven more\nLine 3"
# I/O redirection: output and stderr to file.
-file delete gorp.file
-test exec-4.1 {redirecting output and stderr to file} {execCommandExists stdio} {
- exec $::tcltest::tcltest echo "test output" >& gorp.file
- exec $::tcltest::tcltest cat gorp.file
+removeFile 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)
} "test output"
-test exec-4.2 {redirecting output and stderr to file} {execCommandExists stdio} {
- list [exec $::tcltest::tcltest sh -c "echo foo bar 1>&2" >&gorp.file] \
- [exec $::tcltest::tcltest cat gorp.file]
+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)]
} {{} {foo bar}}
-test exec-4.3 {redirecting output and stderr to file} {execCommandExists stdio} {
- exec $::tcltest::tcltest echo "first line" > gorp.file
- list [exec $::tcltest::tcltest sh -c "echo foo bar 1>&2" >>&gorp.file] \
- [exec $::tcltest::tcltest cat gorp.file]
+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)]
} "{} {first line\nfoo bar}"
-test exec-4.4 {redirecting output and stderr to file} {execCommandExists stdio} {
- set f [open gorp.file w]
+test exec-4.4 {redirecting output and stderr to file} {exec} {
+ set f [open $path(gorp.file) w]
puts $f "Line 1"
flush $f
- exec $::tcltest::tcltest echo "More text" >&@ $f
- exec $::tcltest::tcltest 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 $::tcltest::tcltest cat 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} {execCommandExists stdio} {
- set f [open gorp.file w]
+test exec-4.5 {redirecting output and stderr to file} {exec} {
+ set f [open $path(gorp.file) w]
puts $f "Line 1"
flush $f
- exec >&@ $f $::tcltest::tcltest sh -c "echo foo bar 1>&2"
- exec >&@$f $::tcltest::tcltest sh -c "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 $::tcltest::tcltest cat gorp.file
+ exec [interpreter] $path(cat) $path(gorp.file)
} "Line 1\nfoo bar\nxyzzy\nLine 3"
# I/O redirection: input from file.
-exec $::tcltest::tcltest echo "Just a few thoughts" > gorp.file
-test exec-5.1 {redirecting input from file} {execCommandExists stdio} {
- exec $::tcltest::tcltest cat < gorp.file
+if { [set ::tcltest::testConstraints(exec)] } {
+exec [interpreter] $path(echo) "Just a few thoughts" > $path(gorp.file)
+}
+test exec-5.1 {redirecting input from file} {exec} {
+ exec [interpreter] $path(cat) < $path(gorp.file)
} {Just a few thoughts}
-test exec-5.2 {redirecting input from file} {execCommandExists stdio} {
- exec $::tcltest::tcltest cat | $::tcltest::tcltest cat < gorp.file
+test exec-5.2 {redirecting input from file} {exec stdio} {
+ exec [interpreter] $path(cat) | [interpreter] $path(cat) < $path(gorp.file)
} {Just a few thoughts}
-test exec-5.3 {redirecting input from file} {execCommandExists stdio} {
- exec $::tcltest::tcltest cat < gorp.file | $::tcltest::tcltest cat
+test exec-5.3 {redirecting input from file} {exec stdio} {
+ exec [interpreter] $path(cat) < $path(gorp.file) | [interpreter] $path(cat)
} {Just a few thoughts}
-test exec-5.4 {redirecting input from file} {execCommandExists stdio} {
- exec < gorp.file $::tcltest::tcltest cat | $::tcltest::tcltest cat
+test exec-5.4 {redirecting input from file} {exec stdio} {
+ exec < $path(gorp.file) [interpreter] $path(cat) | [interpreter] $path(cat)
} {Just a few thoughts}
-test exec-5.5 {redirecting input from file} {execCommandExists stdio} {
- exec $::tcltest::tcltest cat <gorp.file
+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} {execCommandExists stdio} {
- set f [open gorp.file r]
- set result [exec $::tcltest::tcltest cat <@ $f]
+test exec-5.6 {redirecting input from file} {exec} {
+ set f [open $path(gorp.file) r]
+ set result [exec [interpreter] $path(cat) <@ $f]
close $f
set result
} {Just a few thoughts}
-test exec-5.7 {redirecting input from file} {execCommandExists stdio} {
- set f [open gorp.file r]
- set result [exec <@$f $::tcltest::tcltest cat]
+test exec-5.7 {redirecting input from file} {exec} {
+ set f [open $path(gorp.file) r]
+ set result [exec <@$f [interpreter] $path(cat)]
close $f
set result
} {Just a few thoughts}
# I/O redirection: standard error through a pipeline.
-test exec-6.1 {redirecting stderr through a pipeline} {execCommandExists stdio} {
- exec $::tcltest::tcltest sh -c "echo foo bar" |& $::tcltest::tcltest cat
+test exec-6.1 {redirecting stderr through a pipeline} {exec stdio} {
+ exec [interpreter] $path(sh) -c "$path(echo) foo bar" |& [interpreter] $path(cat)
} "foo bar"
-test exec-6.2 {redirecting stderr through a pipeline} {execCommandExists stdio} {
- exec $::tcltest::tcltest sh -c "echo foo bar 1>&2" |& $::tcltest::tcltest cat
+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)
} "foo bar"
-test exec-6.3 {redirecting stderr through a pipeline} {execCommandExists stdio} {
- exec $::tcltest::tcltest sh -c "echo foo bar 1>&2" \
- |& $::tcltest::tcltest sh -c "echo second msg 1>&2 ; cat" |& $::tcltest::tcltest cat
+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)
} "second msg\nfoo bar"
# I/O redirection: combinations.
-file delete gorp.file2
-test exec-7.1 {multiple I/O redirections} {execCommandExists stdio} {
- exec << "command input" > gorp.file2 $::tcltest::tcltest cat < gorp.file
- exec $::tcltest::tcltest cat gorp.file2
+set path(gorp.file2) [makeFile {} gorp.file2]
+removeFile gorp.file2
+
+test exec-7.1 {multiple I/O redirections} {exec} {
+ exec << "command input" > $path(gorp.file2) [interpreter] $path(cat) < $path(gorp.file)
+ exec [interpreter] $path(cat) $path(gorp.file2)
} {Just a few thoughts}
-test exec-7.2 {multiple I/O redirections} {execCommandExists stdio} {
- exec < gorp.file << "command input" $::tcltest::tcltest cat
+test exec-7.2 {multiple I/O redirections} {exec} {
+ exec < $path(gorp.file) << "command input" [interpreter] $path(cat)
} {command input}
# Long input to command and output from command.
@@ -288,153 +281,158 @@ set a [concat $a $a $a $a]
set a [concat $a $a $a $a]
set a [concat $a $a $a $a]
set a [concat $a $a $a $a]
-test exec-8.1 {long input and output} {execCommandExists stdio} {
- exec $::tcltest::tcltest cat << $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.1 {long input and output} {execCommandExists stdio} {
- exec $::tcltest::tcltest echo 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
+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}
# Commands that return errors.
-test exec-9.1 {commands returning errors} {execCommandExists stdio} {
+test exec-9.1 {commands returning errors} {exec} {
set x [catch {exec gorp456} msg]
list $x [string tolower $msg] [string tolower $errorCode]
} {1 {couldn't execute "gorp456": no such file or directory} {posix enoent {no such file or directory}}}
-test exec-9.2 {commands returning errors} {execCommandExists stdio} {
- string tolower [list [catch {exec $::tcltest::tcltest echo foo | foo123} msg] $msg $errorCode]
+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} {execCommandExists stdio} {
- list [catch {exec $::tcltest::tcltest sleep 1 | $::tcltest::tcltest exit 43 | $::tcltest::tcltest sleep 1} msg] $msg
+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} {execCommandExists stdio} {
- list [catch {exec $::tcltest::tcltest exit 43 | $::tcltest::tcltest echo "foo bar"} msg] $msg
+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} {execCommandExists stdio} {
- list [catch {exec gorp456 | $::tcltest::tcltest echo a b c} msg] [string tolower $msg]
+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} {execCommandExists stdio} {
- list [catch {exec $::tcltest::tcltest sh -c "echo error msg 1>&2"} msg] $msg
+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} {execCommandExists stdio} {
- list [catch {exec $::tcltest::tcltest sh -c "echo error msg 1>&2" \
- | $::tcltest::tcltest sh -c "echo error msg 1>&2"} msg] $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.8 {commands returning errors} {execCommandExists stdio} {
- set f [open err w]
+
+set path(err) [makeFile {} err]
+
+test exec-9.8 {commands returning errors} {exec} {
+ set f [open $path(err) w]
puts $f {
puts stdout out
puts stderr err
}
close $f
- list [catch {exec $::tcltest::tcltest err} msg] $msg
+ 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} {execCommandExists stdio} {
+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} {execCommandExists stdio} {
+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} {execCommandExists stdio} {
+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} {execCommandExists stdio} {
+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} {execCommandExists stdio} {
+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} {execCommandExists stdio} {
+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} {execCommandExists stdio} {
+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} {execCommandExists stdio} {
+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} {execCommandExists stdio} {
+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} {execCommandExists stdio} {
+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} {execCommandExists stdio} {
+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} {execCommandExists stdio} {
+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} {execCommandExists stdio} {
+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} {execCommandExists stdio} {
+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} {execCommandExists stdio} {
+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} {execCommandExists stdio} {
+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} {execCommandExists stdio} {
+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}}
-set f [open gorp.file w]
-test exec-10.18 {errors in exec invocation} {execCommandExists stdio} {
+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}"
close $f
-set f [open gorp.file r]
-test exec-10.19 {errors in exec invocation} {execCommandExists stdio} {
+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}"
close $f
-test exec-10.20 {errors in exec invocation} {execCommandExists stdio} {
+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} {execCommandExists stdio} {
- list [catch {exec $::tcltest::tcltest true | ~xyzzy_bad_user/x | false} msg] $msg
+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}}
# Commands in background.
-test exec-11.1 {commands in background} {execCommandExists stdio} {
- set x [lindex [time {exec $::tcltest::tcltest sleep 2 &}] 0]
+test exec-11.1 {commands in background} {exec} {
+ set x [lindex [time {exec [interpreter] $path(sleep) 2 &}] 0]
expr $x<1000000
} 1
-test exec-11.2 {commands in background} {execCommandExists stdio} {
- list [catch {exec $::tcltest::tcltest echo a &b} msg] $msg
+test exec-11.2 {commands in background} {exec} {
+ list [catch {exec [interpreter] $path(echo) a &b} msg] $msg
} {0 {a &b}}
-test exec-11.3 {commands in background} {execCommandExists stdio} {
- llength [exec $::tcltest::tcltest sleep 1 &]
+test exec-11.3 {commands in background} {exec} {
+ llength [exec [interpreter] $path(sleep) 1 &]
} 1
-test exec-11.4 {commands in background} {execCommandExists stdio} {
- llength [exec $::tcltest::tcltest sleep 1 | $::tcltest::tcltest sleep 1 | $::tcltest::tcltest sleep 1 &]
+test exec-11.4 {commands in background} {exec stdio} {
+ llength [exec [interpreter] $path(sleep) 1 | [interpreter] $path(sleep) 1 | [interpreter] $path(sleep) 1 &]
} 3
-test exec-11.5 {commands in background} {execCommandExists stdio} {
- set f [open gorp.file w]
- puts $f { catch { exec [info nameofexecutable] echo foo & } }
+test exec-11.5 {commands in background} {exec} {
+ set f [open $path(gorp.file) w]
+ puts $f [format { catch { exec [info nameofexecutable] %s foo & } } $path(echo)]
close $f
- string compare "foo" [exec $::tcltest::tcltest gorp.file]
+ string compare "foo" [exec [interpreter] $path(gorp.file)]
} 0
# Make sure that background commands are properly reaped when
# they eventually die.
-exec $::tcltest::tcltest sleep 3
+if { [set ::tcltest::testConstraints(exec)] } {
+exec [interpreter] $path(sleep) 3
+}
test exec-12.1 {reaping background processes} \
- {execCommandExists stdio unixOnly nonPortable} {
+ {exec unixOnly nonPortable} {
for {set i 0} {$i < 20} {incr i} {
exec echo foo > /dev/null &
}
@@ -443,7 +441,7 @@ test exec-12.1 {reaping background processes} \
lindex $msg 0
} 0
test exec-12.2 {reaping background processes} \
- {execCommandExists stdio unixOnly nonPortable} {
+ {exec unixOnly 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]
@@ -452,7 +450,7 @@ test exec-12.2 {reaping background processes} \
list $x [lindex $msg 0]
} {3 0}
test exec-12.3 {reaping background processes} \
- {execCommandExists stdio unixOnly nonPortable} {
+ {exec unixOnly nonPortable} {
exec sleep 1000 &
exec sleep 1000 &
set x [exec ps | fgrep "sleep" | fgrep -v fgrep]
@@ -475,13 +473,13 @@ test exec-12.3 {reaping background processes} \
# Make sure "errorCode" is set correctly.
-test exec-13.1 {setting errorCode variable} {execCommandExists stdio} {
- list [catch {exec $::tcltest::tcltest cat < a/b/c} msg] [string tolower $errorCode]
+test exec-13.1 {setting errorCode variable} {exec} {
+ list [catch {exec [interpreter] $path(cat) < a/b/c} msg] [string tolower $errorCode]
} {1 {posix enoent {no such file or directory}}}
-test exec-13.2 {setting errorCode variable} {execCommandExists stdio} {
- list [catch {exec $::tcltest::tcltest cat > a/b/c} msg] [string tolower $errorCode]
+test exec-13.2 {setting errorCode variable} {exec} {
+ list [catch {exec [interpreter] $path(cat) > a/b/c} msg] [string tolower $errorCode]
} {1 {posix enoent {no such file or directory}}}
-test exec-13.3 {setting errorCode variable} {execCommandExists stdio} {
+test exec-13.3 {setting errorCode variable} {exec} {
set x [catch {exec _weird_cmd_} msg]
list $x [string tolower $msg] [lindex $errorCode 0] \
[string tolower [lrange $errorCode 2 end]]
@@ -489,115 +487,119 @@ test exec-13.3 {setting errorCode variable} {execCommandExists stdio} {
# Switches before the first argument
-test exec-14.1 {-keepnewline switch} {execCommandExists stdio} {
- exec -keepnewline $::tcltest::tcltest echo foo
+test exec-14.1 {-keepnewline switch} {exec} {
+ exec -keepnewline [interpreter] $path(echo) foo
} "foo\n"
-test exec-14.2 {-keepnewline switch} {execCommandExists stdio} {
+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} {execCommandExists stdio} {
+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} {execCommandExists stdio} {
+test exec-14.4 {-- switch} {exec} {
list [catch {exec -- -gorp} msg] [string tolower $msg]
} {1 {couldn't execute "-gorp": no such file or directory}}
# Redirecting standard error separately from standard output
-test exec-15.1 {standard error redirection} {execCommandExists stdio} {
- exec $::tcltest::tcltest echo "First line" > gorp.file
- list [exec $::tcltest::tcltest sh -c "echo foo bar 1>&2" 2> gorp.file] \
- [exec $::tcltest::tcltest cat gorp.file]
+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)]
} {{} {foo bar}}
-test exec-15.2 {standard error redirection} {execCommandExists stdio} {
- list [exec $::tcltest::tcltest sh -c "echo foo bar 1>&2" \
- | $::tcltest::tcltest echo biz baz >gorp.file 2> gorp.file2] \
- [exec $::tcltest::tcltest cat gorp.file] \
- [exec $::tcltest::tcltest cat gorp.file2]
+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)]
} {{} {biz baz} {foo bar}}
-test exec-15.3 {standard error redirection} {execCommandExists stdio} {
- list [exec $::tcltest::tcltest sh -c "echo foo bar 1>&2" \
- | $::tcltest::tcltest echo biz baz 2>gorp.file > gorp.file2] \
- [exec $::tcltest::tcltest cat gorp.file] \
- [exec $::tcltest::tcltest cat gorp.file2]
+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)]
} {{} {foo bar} {biz baz}}
-test exec-15.4 {standard error redirection} {execCommandExists stdio} {
- set f [open gorp.file w]
+test exec-15.4 {standard error redirection} {exec} {
+ set f [open $path(gorp.file) w]
puts $f "Line 1"
flush $f
- exec $::tcltest::tcltest sh -c "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 $::tcltest::tcltest cat gorp.file
+ exec [interpreter] $path(cat) $path(gorp.file)
} {Line 1
foo bar
Line 3}
-test exec-15.5 {standard error redirection} {execCommandExists stdio} {
- exec $::tcltest::tcltest echo "First line" > gorp.file
- exec $::tcltest::tcltest sh -c "echo foo bar 1>&2" 2>> gorp.file
- exec $::tcltest::tcltest cat gorp.file
+test exec-15.5 {standard error redirection} {exec} {
+ 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)
} {First line
foo bar}
-test exec-15.6 {standard error redirection} {execCommandExists stdio} {
- exec $::tcltest::tcltest sh -c "echo foo bar 1>&2" > gorp.file2 2> gorp.file \
- >& gorp.file 2> gorp.file2 | $::tcltest::tcltest echo biz baz
- list [exec $::tcltest::tcltest cat gorp.file] [exec $::tcltest::tcltest cat gorp.file2]
+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)]
} {{biz baz} {foo bar}}
-test exec-16.1 {flush output before exec} {execCommandExists stdio} {
- set f [open gorp.file w]
+test exec-16.1 {flush output before exec} {exec} {
+ set f [open $path(gorp.file) w]
puts $f "First line"
- exec $::tcltest::tcltest echo "Second line" >@ $f
+ exec [interpreter] $path(echo) "Second line" >@ $f
puts $f "Third line"
close $f
- exec $::tcltest::tcltest cat gorp.file
+ exec [interpreter] $path(cat) $path(gorp.file)
} {First line
Second line
Third line}
-test exec-16.2 {flush output before exec} {execCommandExists stdio} {
- set f [open gorp.file w]
+test exec-16.2 {flush output before exec} {exec} {
+ set f [open $path(gorp.file) w]
puts $f "First line"
- exec $::tcltest::tcltest << {puts stderr {Second line}} >&@ $f > gorp.file2
+ exec [interpreter] << {puts stderr {Second line}} >&@ $f > $path(gorp.file2)
puts $f "Third line"
close $f
- exec $::tcltest::tcltest cat gorp.file
+ exec [interpreter] $path(cat) $path(gorp.file)
} {First line
Second line
Third line}
-test exec-17.1 { inheriting standard I/O } {execCommandExists stdio} {
- set f [open script w]
- puts $f {close stdout
- set f [open gorp.file w]
- catch {exec [info nameofexecutable] echo foobar &}
- exec [info nameofexecutable] sleep 2
+set path(script) [makeFile {} script]
+
+test exec-17.1 { inheriting standard I/O } {exec} {
+ set f [open $path(script) w]
+ puts $f [format {close stdout
+ set f [open %s w]
+ catch {exec [info nameofexecutable] %s foobar &}
+ exec [info nameofexecutable] %s 2
close $f
- }
+ } $path(gorp.file) $path(echo) $path(sleep)]
close $f
- catch {exec $::tcltest::tcltest script} result
- set f [open gorp.file r]
+ catch {exec [interpreter] $path(script)} result
+ set f [open $path(gorp.file) r]
lappend result [read $f]
close $f
set result
} {{foobar
}}
-# cleanup
-file delete script gorp.file gorp.file2
-file delete echo cat wc sh sleep exit
-file delete err
-::tcltest::cleanupTests
-return
-
-
-
-
-
-
-
-
-
-
+test exec-18.1 { exec cat deals with weird file names} {exec unixOnly} {
+ # 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}
+# cleanup
+foreach file {script gorp.file gorp.file2 echo cat wc sh sleep exit err} {
+ removeFile $file
+}
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/execute.test b/tcl/tests/execute.test
index 8e9e9495654..6198080cf37 100644
--- a/tcl/tests/execute.test
+++ b/tcl/tests/execute.test
@@ -17,7 +17,7 @@
# RCS: @(#) $Id$
if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+ package require tcltest 2
namespace import -force ::tcltest::*
}
@@ -27,12 +27,15 @@ catch {unset x}
catch {unset y}
catch {unset msg}
-set ::tcltest::testConstraints(testobj) \
+::tcltest::testConstraint testobj \
[expr {[info commands testobj] != {} \
&& [info commands testdoubleobj] != {} \
&& [info commands teststringobj] != {} \
&& [info commands testobj] != {}}]
+::tcltest::testConstraint longIs32bit \
+ [expr {int(0x80000000) < 0}]
+
# Tests for the omnibus TclExecuteByteCode function:
# INST_DONE not tested
@@ -583,6 +586,133 @@ 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-7.0 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} {
+ set x 0x100000000
+ expr {$x && 1}
+} 1
+test execute-7.1 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} {
+ expr {0x100000000 && 1}
+} 1
+test execute-7.2 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} {
+ expr {1 && 0x100000000}
+} 1
+test execute-7.3 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} {
+ expr {wide(0x100000000) && 1}
+} 1
+test execute-7.4 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} {
+ expr {1 && wide(0x100000000)}
+} 1
+test execute-7.5 {Wide int handling in INST_EQ} {longIs32bit} {
+ expr {4 == (wide(1)+wide(3))}
+} 1
+test execute-7.6 {Wide int handling in INST_EQ and [incr]} {longIs32bit} {
+ 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} {
+ 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} {
+ set x 0x80000000
+ expr {int($x) < wide($x)}
+} 1
+test execute-7.9 {Wide int handling in INST_MOD} {longIs32bit} {
+ expr {(wide(1)<<60) % ((wide(47)<<45)-1)}
+} 316659348800185
+test execute-7.10 {Wide int handling in INST_MOD} {longIs32bit} {
+ expr {((wide(1)<<60)-1) % 0x400000000}
+} 17179869183
+test execute-7.11 {Wide int handling in INST_LSHIFT} {longIs32bit} {
+ expr wide(42)<<30
+} 45097156608
+test execute-7.12 {Wide int handling in INST_LSHIFT} {longIs32bit} {
+ expr 12345678901<<3
+} 98765431208
+test execute-7.13 {Wide int handling in INST_RSHIFT} {longIs32bit} {
+ expr 0x543210febcda9876>>7
+} 47397893236700464
+test execute-7.14 {Wide int handling in INST_RSHIFT} {longIs32bit} {
+ expr 0x9876543210febcda>>7
+} -58286587177206407
+test execute-7.15 {Wide int handling in INST_BITOR} {longIs32bit} {
+ expr 0x9876543210febcda | 0x543210febcda9876
+} -2560765885044310786
+test execute-7.16 {Wide int handling in INST_BITXOR} {longIs32bit} {
+ expr 0x9876543210febcda ^ 0x543210febcda9876
+} -3727778945703861076
+test execute-7.17 {Wide int handling in INST_BITAND} {longIs32bit} {
+ expr 0x9876543210febcda & 0x543210febcda9876
+} 1167013060659550290
+test execute-7.18 {Wide int handling in INST_ADD} {longIs32bit} {
+ expr wide(0x7fffffff)+wide(0x7fffffff)
+} 4294967294
+test execute-7.19 {Wide int handling in INST_ADD} {longIs32bit} {
+ expr 0x7fffffff+wide(0x7fffffff)
+} 4294967294
+test execute-7.20 {Wide int handling in INST_ADD} {longIs32bit} {
+ expr wide(0x7fffffff)+0x7fffffff
+} 4294967294
+test execute-7.21 {Wide int handling in INST_ADD} {longIs32bit} {
+ expr double(0x7fffffff)+wide(0x7fffffff)
+} 4294967294.0
+test execute-7.22 {Wide int handling in INST_ADD} {longIs32bit} {
+ expr wide(0x7fffffff)+double(0x7fffffff)
+} 4294967294.0
+test execute-7.23 {Wide int handling in INST_SUB} {longIs32bit} {
+ expr 0x123456789a-0x20406080a
+} 69530054800
+test execute-7.24 {Wide int handling in INST_MULT} {longIs32bit} {
+ expr 0x123456789a*193
+} 15090186251290
+test execute-7.25 {Wide int handling in INST_DIV} {longIs32bit} {
+ expr 0x123456789a/193
+} 405116546
+test execute-7.26 {Wide int handling in INST_UPLUS} {longIs32bit} {
+ set x 0x123456871234568
+ expr {+ $x}
+} 81985533099853160
+test execute-7.27 {Wide int handling in INST_UMINUS} {longIs32bit} {
+ set x 0x123456871234568
+ expr {- $x}
+} -81985533099853160
+test execute-7.28 {Wide int handling in INST_LNOT} {longIs32bit} {
+ set x 0x123456871234568
+ expr {! $x}
+} 0
+test execute-7.29 {Wide int handling in INST_BITNOT} {longIs32bit} {
+ set x 0x123456871234568
+ expr {~ $x}
+} -81985533099853161
+test execute-7.30 {Wide int handling in function call} {longIs32bit} {
+ set x 0x12345687123456
+ incr x
+ expr {sin($x) == sin(double($x))}
+} 1
+test execute-7.31 {Wide int handling in abs()} {longIs32bit} {
+ 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}
+} 0
+test execute-7.33 {Wide int handling} {longIs32bit} {
+ expr {0x1 * 1024 * 1024 * 1024 * 1024}
+} 0
+test execute-7.34 {Wide int handling} {longIs32bit} {
+ expr {wide(0x1) * 1024 * 1024 * 1024 * 1024}
+} 1099511627776
+
# cleanup
catch {eval namespace delete [namespace children :: test_ns_*]}
catch {rename foo ""}
@@ -594,23 +724,3 @@ catch {unset y}
catch {unset msg}
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tcl/tests/expr-old.test b/tcl/tests/expr-old.test
index bbdd2b2a392..f6fb61a0fe8 100644
--- a/tcl/tests/expr-old.test
+++ b/tcl/tests/expr-old.test
@@ -2,13 +2,13 @@
#
# This file contains the original set of tests for Tcl's expr command.
# Since the expr command is now compiled, a new set of tests covering
-# the new implementation are in the files "parseExpr.test and
+# the new implementation are in the files "parseExpr.test" and
# "compExpr.test". 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.
+# 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.
@@ -16,7 +16,7 @@
# RCS: @(#) $Id$
if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+ package require tcltest 2.1
namespace import -force ::tcltest::*
}
@@ -186,6 +186,16 @@ test expr-old-4.15 {string operators} {expr {"abc" != "abd"}} 1
test expr-old-4.16 {string operators} {expr {"abd" != "abd"}} 0
test expr-old-4.17 {string operators} {expr {"0y" < "0x12"}} 0
test expr-old-4.18 {string operators} {expr {"." < " "}} 0
+test expr-old-4.19 {string operators} {expr {"abc" eq "abd"}} 0
+test expr-old-4.20 {string operators} {expr {"abd" eq "abd"}} 1
+test expr-old-4.21 {string operators} {expr {"abc" ne "abd"}} 1
+test expr-old-4.22 {string operators} {expr {"abd" ne "abd"}} 0
+test expr-old-4.23 {string operators} {expr {"" eq "abd"}} 0
+test expr-old-4.24 {string operators} {expr {"" eq ""}} 1
+test expr-old-4.25 {string operators} {expr {"abd" ne ""}} 1
+test expr-old-4.26 {string operators} {expr {"" ne ""}} 0
+test expr-old-4.26 {string operators} {expr {"longerstring" eq "shorter"}} 0
+test expr-old-4.26 {string operators} {expr {"longerstring" ne "shorter"}} 1
# The following tests are non-portable because on some systems "+"
# and "-" can be parsed as numbers.
@@ -305,14 +315,28 @@ test expr-old-14.5 {precedence checks} {expr 1==4>=3} 1
test expr-old-14.6 {precedence checks} {expr 0!=4>=3} 1
test expr-old-14.7 {precedence checks} {expr 1==3<=4} 1
test expr-old-14.8 {precedence checks} {expr 0!=3<=4} 1
+test expr-old-14.9 {precedence checks} {expr 1eq4>3} 1
+test expr-old-14.10 {precedence checks} {expr 0ne4>3} 1
+test expr-old-14.11 {precedence checks} {expr 1eq3<4} 1
+test expr-old-14.12 {precedence checks} {expr 0ne3<4} 1
+test expr-old-14.13 {precedence checks} {expr 1eq4>=3} 1
+test expr-old-14.14 {precedence checks} {expr 0ne4>=3} 1
+test expr-old-14.15 {precedence checks} {expr 1eq3<=4} 1
+test expr-old-14.16 {precedence checks} {expr 0ne3<=4} 1
test expr-old-15.1 {precedence checks} {expr 1==3==3} 0
test expr-old-15.2 {precedence checks} {expr 3==3!=2} 1
test expr-old-15.3 {precedence checks} {expr 2!=3==3} 0
test expr-old-15.4 {precedence checks} {expr 2!=1!=1} 0
+test expr-old-15.5 {precedence checks} {expr 1eq3eq3} 0
+test expr-old-15.6 {precedence checks} {expr 3eq3ne2} 1
+test expr-old-15.7 {precedence checks} {expr 2ne3eq3} 0
+test expr-old-15.8 {precedence checks} {expr 2ne1ne1} 0
-test expr-old-16.1 {precedence checks} {expr 2&3==2} 0
-test expr-old-16.2 {precedence checks} {expr 1&3!=3} 0
+test expr-old-16.1 {precedence checks} {expr 2&3eq2} 0
+test expr-old-16.2 {precedence checks} {expr 1&3ne3} 0
+test expr-old-16.3 {precedence checks} {expr 2&3eq2} 0
+test expr-old-16.4 {precedence checks} {expr 1&3ne3} 0
test expr-old-17.1 {precedence checks} {expr 7&3^0x10} 19
test expr-old-17.2 {precedence checks} {expr 7^0x10&3} 7
@@ -416,10 +440,10 @@ test expr-old-26.1 {error conditions} {
} {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*"}}
+} {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*("}}
+} {1 {syntax error in expression "2+4*(": premature end of expression}}
catch {unset _non_existent_}
test expr-old-26.4 {error conditions} {
list [catch {expr 2+$_non_existent_} msg] $msg
@@ -433,7 +457,7 @@ test expr-old-26.6 {error conditions} {
} {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"}}
+} {1 {syntax error in expression "2+(4": looking for close parenthesis}}
test expr-old-26.8 {error conditions} {
list [catch {expr 2/0} msg] $msg $errorCode
} {1 {divide by zero} {ARITH DIVZERO {divide by zero}}}
@@ -445,31 +469,31 @@ test expr-old-26.10 {error conditions} {
} {1 {divide by zero} {ARITH DIVZERO {divide by zero}}}
test expr-old-26.11 {error conditions} {
list [catch {expr 2#} msg] $msg
-} {1 {syntax error in expression "2#"}}
+} {1 {syntax error in expression "2#": extra tokens at end of expression}}
test expr-old-26.12 {error conditions} {
list [catch {expr a.b} msg] $msg
-} {1 {syntax error in expression "a.b"}}
+} {1 {syntax error in expression "a.b": variable references require preceding $}}
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"}}
+} {1 {syntax error in expression "2:3": extra tokens at end of expression}}
test expr-old-26.15 {error conditions} {
list [catch {expr a@b} msg] $msg
-} {1 {syntax error in expression "a@b"}}
+} {1 {syntax error in expression "a@b": variable references require preceding $}}
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} {
list [catch {expr a`b} msg] $msg
-} {1 {syntax error in expression "a`b"}}
+} {1 {syntax error in expression "a`b": variable references require preceding $}}
test expr-old-26.18 {error conditions} {
list [catch {expr \"a\"\{b} msg] $msg
-} {1 syntax\ error\ in\ expression\ \"\"a\"\{b\"}
+} {1 syntax\ error\ in\ expression\ \"\"a\"\{b\":\ extra\ tokens\ at\ end\ of\ expression}
test expr-old-26.19 {error conditions} {
list [catch {expr a} msg] $msg
-} {1 {syntax error in expression "a"}}
+} {1 {syntax error in expression "a": variable references require preceding $}}
test expr-old-26.20 {error conditions} {
list [catch expr msg] $msg
} {1 {wrong # args: should be "expr arg ?arg ...?"}}
@@ -519,10 +543,10 @@ test expr-old-27.10 {cancelled evaluation} {
} {0 0}
test expr-old-27.11 {cancelled evaluation} {
list [catch {expr {0 && foo}} msg] $msg
-} {1 {syntax error in expression "0 && foo"}}
+} {1 {syntax error in expression "0 && foo": variable references require preceding $}}
test expr-old-27.12 {cancelled evaluation} {
list [catch {expr {0 ? 1 : foo}} msg] $msg
-} {1 {syntax error in expression "0 ? 1 : foo"}}
+} {1 {syntax error in expression "0 ? 1 : foo": variable references require preceding $}}
# Tcl_ExprBool as used in "if" statements
@@ -622,13 +646,13 @@ test expr-old-31.1 {multiple arguments to expr command} {
} 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"}}
+} {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 +"}}
+} {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 )"}}
+} {1 {syntax error in expression "2 + 3 )": extra tokens at end of expression}}
# Math functions
@@ -801,6 +825,12 @@ test expr-old-32.50 {math functions in expressions} {
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.52 {math functions in expressions} {
+ expr {srand(1<<37) < 1}
+} {1}
+test expr-old-32.53 {math functions in expressions} {
+ expr {srand((1<<31) - 1) > 0}
+} {1}
test expr-old-33.1 {conversions and fancy args to math functions} {
expr hypot ( 3 , 4 )
@@ -820,19 +850,19 @@ test expr-old-34.1 {errors in math functions} {
} {1 {unknown math function "func_2"}}
test expr-old-34.2 {errors in math functions} {
list [catch {expr func|(1.0)} msg] $msg
-} {1 {syntax error in expression "func|(1.0)"}}
+} {1 {syntax error in expression "func|(1.0)": variable references require preceding $}}
test expr-old-34.3 {errors in math functions} {
list [catch {expr {hypot("a b", 2.0)}} msg] $msg
} {1 {argument to math function didn't have numeric value}}
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)"}}
+} {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"}}
+} {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 ,"}}
+} {1 {syntax error in expression "hypot(1.0 ,": premature end of expression}}
test expr-old-34.7 {errors in math functions} {
list [catch {expr hypot(1.0)} msg] $msg
} {1 {too few arguments for math function}}
@@ -869,9 +899,9 @@ if $gotT1 {
} {1 {too many arguments for math function}}
}
-test expr-old-36.1 {ExprLooksLikeInt procedure} {
- list [catch {expr 0289} msg] $msg
-} {1 {"0289" is an invalid octal number}}
+test expr-old-36.1 {ExprLooksLikeInt procedure} -body {
+ expr 0289
+} -returnCodes error -match glob -result {*invalid octal number*}
test expr-old-36.2 {ExprLooksLikeInt procedure} {
set x 0289
list [catch {expr {$x+1}} msg] $msg
@@ -904,6 +934,35 @@ test expr-old-36.10 {ExprLooksLikeInt procedure} {nonPortable unixOnly} {
list [catch {expr 78e} msg] $msg
} {1 {syntax error in expression "78e"}}
+# 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 "+"}}
+
+# tests for [Bug #587140]
+test expr-old-36.12 {ExprLooksLikeInt procedure} {
+ set x "10;"
+ list [catch {expr {$x+1}} msg] $msg
+} {1 {can't use non-numeric string as operand of "+"}}
+test expr-old-36.13 {ExprLooksLikeInt procedure} {
+ set x " +"
+ list [catch {expr {$x+1}} msg] $msg
+} {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 "+"}}
+test expr-old-36.15 {ExprLooksLikeInt procedure} {
+ set x "099 "
+ 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 "+"}}
+
if {[info commands testexprlong] == {}} {
puts "This application hasn't been compiled with the \"testexprlong\""
puts "command, so I can't test Tcl_ExprLong etc."
@@ -920,7 +979,7 @@ if {[info commands testexprstring] == {}} {
test expr-old-38.1 {Verify Tcl_ExprString's basic operation} {
list [testexprstring "1+4"] [testexprstring "2*3+4.2"] \
[catch {testexprstring "1+"} msg] $msg
-} {5 10.2 1 {syntax error in expression "1+"}}
+} {5 10.2 1 {syntax error in expression "1+": premature end of expression}}
}
# Special test for Pentium arithmetic bug of 1994:
@@ -935,16 +994,3 @@ if {(4195835.0 - (4195835.0/3145727.0)*3145727.0) == 256.0} {
# cleanup
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tcl/tests/expr.test b/tcl/tests/expr.test
index 56cef1971e3..f66bd83733e 100644
--- a/tcl/tests/expr.test
+++ b/tcl/tests/expr.test
@@ -5,7 +5,7 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# 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.
@@ -17,13 +17,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
namespace import -force ::tcltest::*
}
-if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} {
- set gotT1 0
- puts "This application hasn't been compiled with the \"T1\" and"
- puts "\"T2\" math functions, so I'll skip some of the expr tests."
-} else {
- set gotT1 1
-}
+testConstraint registeredMathFuncs [expr {
+ ([catch {expr T1()} msg] != 1) || ($msg ne {unknown math function "T1"})
+}]
# procedures used below
@@ -126,6 +122,11 @@ test expr-1.14 {TclCompileExprCmd: second level of substitutions in expr with co
set x 2; set b {$x}; set a [expr $b == 2]
set a
} 1
+test expr-1.15 {TclCompileExprCmd: second level of substitutions in expr with comparison as top-level operator} {
+ set a xxx
+ set x 2; set b {$x}; set a [expr $b eq 2]
+ set a
+} 1
test expr-2.1 {TclCompileExpr: are builtin functions registered?} {
expr double(5*[llength "6 2"])
@@ -133,11 +134,11 @@ test expr-2.1 {TclCompileExpr: are builtin functions registered?} {
test expr-2.2 {TclCompileExpr: error in expr} {
catch {expr 2**3} msg
set msg
-} {syntax error in expression "2**3"}
+} {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"}
+} {syntax error in expression "7*2foo": extra tokens at end of expression}
test expr-2.4 {TclCompileExpr: numeric expr string rep == formatted int rep} {
expr {0001}
} 1
@@ -146,17 +147,17 @@ test expr-3.1 {CompileCondExpr: just lor expr} {expr 3||0} 1
test expr-3.2 {CompileCondExpr: error in lor expr} {
catch {expr x||3} msg
set msg
-} {syntax error in expression "x||3"}
+} {syntax error in expression "x||3": variable references require preceding $}
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"}
+} {syntax error in expression "3>2?2**3:66": unexpected operator *}
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"}
+} {syntax error in expression "2>3?44:2**3": unexpected operator *}
test expr-3.7 {CompileCondExpr: long arms & nested cond exprs} {unixOnly nonPortable} {
puts "Note: doing test expr-3.7 which can take several minutes to run"
hello_world
@@ -172,18 +173,18 @@ test expr-4.1 {CompileLorExpr: just land expr} {expr 1.3&&3.3} 1
test expr-4.2 {CompileLorExpr: error in land expr} {
catch {expr x&&3} msg
set msg
-} {syntax error in expression "x&&3"}
+} {syntax error in expression "x&&3": variable references require preceding $}
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"}
+} {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"}
+} {syntax error in expression "1.3||2**3": unexpected operator *}
test expr-4.8 {CompileLorExpr: error compiling lor arms} {
list [catch {expr {"a"||"b"}} msg] $msg
} {1 {expected boolean value but got "a"}}
@@ -197,7 +198,7 @@ test expr-5.1 {CompileLandExpr: just bitor expr} {expr 7|0x13} 23
test expr-5.2 {CompileLandExpr: error in bitor expr} {
catch {expr x|3} msg
set msg
-} {syntax error in expression "x|3"}
+} {syntax error in expression "x|3": variable references require preceding $}
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
@@ -205,11 +206,11 @@ 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"}
+} {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"}
+} {syntax error in expression "1.3&&2**3": unexpected operator *}
test expr-5.9 {CompileLandExpr: error compiling land arm} {
list [catch {expr {"a"&&"b"}} msg] $msg
} {1 {expected boolean value but got "a"}}
@@ -223,7 +224,7 @@ test expr-6.1 {CompileBitXorExpr: just bitand expr} {expr 7&0x13} 3
test expr-6.2 {CompileBitXorExpr: error in bitand expr} {
catch {expr x|3} msg
set msg
-} {syntax error in expression "x|3"}
+} {syntax error in expression "x|3": variable references require preceding $}
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
@@ -231,11 +232,11 @@ 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"}
+} {syntax error in expression "2**3|6": unexpected operator *}
test expr-6.8 {CompileBitXorExpr: error compiling bitxor arm} {
catch {expr 2^x} msg
set msg
-} {syntax error in expression "2^x"}
+} {syntax error in expression "2^x": variable references require preceding $}
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 "^"}}
@@ -250,7 +251,7 @@ test expr-7.4 {CompileBitAndExpr: just equality expr} {expr {"abc" == "abd"}} 0
test expr-7.5 {CompileBitAndExpr: error in equality expr} {
catch {expr x==3} msg
set msg
-} {syntax error in expression "x==3"}
+} {syntax error in expression "x==3": variable references require preceding $}
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
@@ -258,17 +259,23 @@ 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"}
+} {syntax error in expression "2**3&6": unexpected operator *}
test expr-7.11 {CompileBitAndExpr: error compiling bitand arm} {
catch {expr 2&x} msg
set msg
-} {syntax error in expression "2&x"}
+} {syntax error in expression "2&x": variable references require preceding $}
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 "&"}}
test expr-7.13 {CompileBitAndExpr: runtime error in bitand arm} {
list [catch {expr {"a"&"b"}} msg] $msg
} {1 {can't use non-numeric string as operand of "&"}}
+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} {
+ catch {expr xne3} msg
+ set msg
+} {syntax error in expression "xne3": variable references require preceding $}
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
@@ -277,7 +284,7 @@ test expr-8.4 {CompileEqualityExpr: just relational expr} {expr {"0y"<"0x12"}} 0
test expr-8.5 {CompileEqualityExpr: error in relational expr} {
catch {expr x>3} msg
set msg
-} {syntax error in expression "x>3"}
+} {syntax error in expression "x>3": variable references require preceding $}
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
@@ -285,12 +292,28 @@ 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"}
+} {syntax error in expression "2**3==6": unexpected operator *}
test expr-8.11 {CompileEqualityExpr: error compiling equality arm} {
catch {expr 2!=x} msg
set msg
-} {syntax error in expression "2!=x"}
-
+} {syntax error in expression "2!=x": variable references require preceding $}
+test expr-8.14 {CompileBitAndExpr: equality expr} {expr {"a"eq"a"}} 1
+test expr-8.14 {CompileBitAndExpr: equality expr} {expr {"\374" eq "ü"}} 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
+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} {
+ catch {expr x ne3} msg
+ set msg
+} {syntax error in expression "x ne3": variable references require preceding $}
+test expr-8.21 {CompileBitAndExpr: error in equality expr} {
+ # These should be ""ed to avoid the error
+ catch {expr a eq b} msg
+ set msg
+} {syntax error in expression "a eq b": variable references require preceding $}
test expr-9.1 {CompileRelationalExpr: just shift expr} {expr 3<<2} 12
test expr-9.2 {CompileRelationalExpr: just shift expr} {expr 0xff>>2} 63
@@ -312,17 +335,17 @@ if {0x80000000 > 0} {
test expr-9.6 {CompileRelationalExpr: error in shift expr} {
catch {expr x>>3} msg
set msg
-} {syntax error in expression "x>>3"}
+} {syntax error in expression "x>>3": variable references require preceding $}
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"}
+} {syntax error in expression "2**3>6": unexpected operator *}
test expr-9.10 {CompileRelationalExpr: error compiling relational arm} {
catch {expr 2<x} msg
set msg
-} {syntax error in expression "2<x"}
+} {syntax error in expression "2<x": variable references require preceding $}
test expr-10.1 {CompileShiftExpr: just add expr} {expr 4+-2} 2
test expr-10.2 {CompileShiftExpr: just add expr} {expr 0xff-2} 253
@@ -331,17 +354,17 @@ test expr-10.4 {CompileShiftExpr: just add expr} {expr 1-0123} -82
test expr-10.5 {CompileShiftExpr: error in add expr} {
catch {expr x+3} msg
set msg
-} {syntax error in expression "x+3"}
+} {syntax error in expression "x+3": variable references require preceding $}
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"}
+} {syntax error in expression "2**3>>6": unexpected operator *}
test expr-10.9 {CompileShiftExpr: error compiling shift arm} {
catch {expr 2<<x} msg
set msg
-} {syntax error in expression "2<<x"}
+} {syntax error in expression "2<<x": variable references require preceding $}
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 ">>"}}
@@ -356,17 +379,17 @@ test expr-11.4 {CompileAddExpr: just multiply expr} {expr 7891%0123} 6
test expr-11.5 {CompileAddExpr: error in multiply expr} {
catch {expr x*3} msg
set msg
-} {syntax error in expression "x*3"}
+} {syntax error in expression "x*3": variable references require preceding $}
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"}
+} {syntax error in expression "2**3+6": unexpected operator *}
test expr-11.9 {CompileAddExpr: error compiling add arm} {
catch {expr 2-x} msg
set msg
-} {syntax error in expression "2-x"}
+} {syntax error in expression "2-x": variable references require preceding $}
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 "+"}}
@@ -387,17 +410,17 @@ test expr-12.4 {CompileMultiplyExpr: just unary expr} {expr ~0xff00ff} -16711936
test expr-12.5 {CompileMultiplyExpr: error in unary expr} {
catch {expr ~x} msg
set msg
-} {syntax error in expression "~x"}
+} {syntax error in expression "~x": variable references require preceding $}
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"}
+} {syntax error in expression "2*3%%6": unexpected operator %}
test expr-12.9 {CompileMultiplyExpr: error compiling multiply arm} {
catch {expr 2*x} msg
set msg
-} {syntax error in expression "2*x"}
+} {syntax error in expression "2*x": variable references require preceding $}
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 "*"}}
@@ -415,11 +438,11 @@ test expr-13.7 {CompileUnaryExpr: unary exprs} {expr !0xef} 0
test expr-13.8 {CompileUnaryExpr: error compiling unary expr} {
catch {expr ~x} msg
set msg
-} {syntax error in expression "~x"}
+} {syntax error in expression "~x": variable references require preceding $}
test expr-13.9 {CompileUnaryExpr: error compiling unary expr} {
catch {expr !1.x} msg
set msg
-} {syntax error in expression "!1.x"}
+} {syntax error in expression "!1.x": extra tokens at end of expression}
test expr-13.10 {CompileUnaryExpr: runtime error} {
list [catch {expr {~"xx"}} msg] $msg
} {1 {can't use non-numeric string as operand of "~"}}
@@ -439,6 +462,11 @@ test expr-13.16 {CompileUnaryExpr: error in primary expr} {
catch {expr [set]} msg
set msg
} {wrong # args: should be "set varName ?newValue?"}
+test expr-13.17 {CompileUnaryExpr: negating non-numeric boolean literals} {
+ set a1 yes; set a0 no; set b1 true; set b0 false
+ list [expr {!$a1}] [expr {!$a0}] [expr {!$b1}] [expr {!$b0}]
+} {0 1 0 1}
+
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
@@ -531,7 +559,7 @@ test expr-14.26 {CompilePrimaryExpr: math function primary} {
test expr-14.27 {CompilePrimaryExpr: error in math function primary} {
catch {expr sinh::(2.0)} msg
set errorInfo
-} {syntax error in expression "sinh::(2.0)"
+} {syntax error in expression "sinh::(2.0)": expected parenthesis enclosing function arguments
while compiling
"expr sinh::(2.0)"}
test expr-14.28 {CompilePrimaryExpr: subexpression primary} {
@@ -548,7 +576,7 @@ test expr-14.29 {CompilePrimaryExpr: error in subexpression primary} {
test expr-14.30 {CompilePrimaryExpr: missing paren in subexpression primary} {
catch {expr 2+(3*(4+5)} msg
set errorInfo
-} {syntax error in expression "2+(3*(4+5)"
+} {syntax error in expression "2+(3*(4+5)": looking for close parenthesis
while compiling
"expr 2+(3*(4+5)"}
test expr-14.31 {CompilePrimaryExpr: just var ref in subexpression primary} {
@@ -558,14 +586,14 @@ test expr-14.31 {CompilePrimaryExpr: just var ref in subexpression primary} {
test expr-14.32 {CompilePrimaryExpr: unexpected token} {
catch {expr @} msg
set errorInfo
-} {syntax error in expression "@"
+} {syntax error in expression "@": character not legal in expressions
while compiling
"expr @"}
test expr-15.1 {CompileMathFuncCall: missing parenthesis} {
catch {expr sinh2.0)} msg
set errorInfo
-} {syntax error in expression "sinh2.0)"
+} {syntax error in expression "sinh2.0)": variable references require preceding $
while compiling
"expr sinh2.0)"}
test expr-15.2 {CompileMathFuncCall: unknown math function} {
@@ -595,27 +623,39 @@ test expr-15.5 {CompileMathFuncCall: too few arguments} {
test expr-15.6 {CompileMathFuncCall: missing ')'} {
catch {expr sin(1} msg
set errorInfo
-} {syntax error in expression "sin(1"
+} {syntax error in expression "sin(1": missing close parenthesis at end of function call
while compiling
"expr sin(1"}
-if $gotT1 {
- test expr-15.7 {CompileMathFuncCall: call registered math function} {
- expr 2*T1()
- } 246
- test expr-15.8 {CompileMathFuncCall: call registered math function} {
- expr T2()*3
- } 1035
-
- test expr-15.9 {CompileMathFuncCall: call registered math function} {
- expr T3(21, 37)
- } 37
- test expr-15.10 {CompileMathFuncCall: call registered math function} {
- expr T3(21.2, 37)
- } 37.0
- test expr-15.11 {CompileMathFuncCall: call registered math function} {
- expr T3(-21.2, -17.5)
- } -17.5
-}
+test expr-15.7 {CompileMathFuncCall: call registered math function} {registeredMathFuncs} {
+ expr 2*T1()
+} 246
+test expr-15.8 {CompileMathFuncCall: call registered math function} {registeredMathFuncs} {
+ expr T2()*3
+} 1035
+test expr-15.9 {CompileMathFuncCall: call registered math function} {registeredMathFuncs} {
+ expr T3(21, 37)
+} 37
+test expr-15.10 {CompileMathFuncCall: call registered math function} {registeredMathFuncs} {
+ expr T3(21.2, 37)
+} 37.0
+test expr-15.11 {CompileMathFuncCall: call registered math function} {registeredMathFuncs} {
+ expr T3(-21.2, -17.5)
+} -17.5
+test expr-15.12 {ExprCallMathFunc: call registered math function} {registeredMathFuncs} {
+ expr T3(21, wide(37))
+} 37
+test expr=15.13 {ExprCallMathFunc: call registered math function} {registeredMathFuncs} {
+ expr T3(wide(21), 37)
+} 37
+test expr=15.14 {ExprCallMathFunc: call registered math function} {registeredMathFuncs} {
+ expr T3(wide(21), wide(37))
+} 37
+test expr-15.15 {ExprCallMathFunc: call registered math function} {registeredMathFuncs} {
+ expr T3(21.0, wide(37))
+} 37.0
+test expr=15.16 {ExprCallMathFunc: call registered math function} {registeredMathFuncs} {
+ expr T3(wide(21), 37.0)
+} 37.0
test expr-16.1 {GetToken: checks whether integer token starting with "0x" (e.g., "0x$") is invalid} {
catch {unset a}
@@ -701,7 +741,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"} 0 32 {}}
+} {1 {syntax error in expression "1 oops 10 + 20": extra tokens at end of expression} 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]
@@ -721,10 +761,54 @@ test expr-20.7 {handling of compile error in runtime case} {
list [catch {expr + {[error foo]}} msg] $msg
} {1 foo}
+# Test for non-numeric boolean literal handling
+test expr-21.1 {non-numeric boolean literals} {expr false } false
+test expr-21.2 {non-numeric boolean literals} {expr true } true
+test expr-21.3 {non-numeric boolean literals} {expr off } off
+test expr-21.4 {non-numeric boolean literals} {expr on } on
+test expr-21.5 {non-numeric boolean literals} {expr no } no
+test expr-21.6 {non-numeric boolean literals} {expr yes } yes
+test expr-21.7 {non-numeric boolean literals} {expr !false} 1
+test expr-21.8 {non-numeric boolean literals} {expr !true } 0
+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 for non-numeric float handling.
+#
+# These are non-portable because strtod()-support for "Inf" and "NaN"
+# is so wildly variable. This sucks...
+test expr-22.1 {non-numeric floats} nonPortable {
+ list [catch {expr {NaN + 1}} msg] $msg
+} {1 {can't use non-numeric floating-point value as operand of "+"}}
+test expr-22.2 {non-numeric floats} nonPortable {
+ list [catch {expr {Inf + 1}} msg] $msg
+} {1 {can't use infinite floating-point value as operand of "+"}}
+test expr-22.3 {non-numeric floats} nonPortable {
+ set nan NaN
+ list [catch {expr {$nan + 1}} msg] $msg
+} {1 {can't use non-numeric floating-point value as operand of "+"}}
+test expr-22.4 {non-numeric floats} nonPortable {
+ set inf Inf
+ list [catch {expr {$inf + 1}} msg] $msg
+} {1 {can't use infinite floating-point value as operand of "+"}}
+test expr-22.5 {non-numeric floats} nonPortable {
+ list [catch {expr NaN} msg] $msg
+} {1 {domain error: argument not in valid range}}
+test expr-22.6 {non-numeric floats} nonPortable {
+ list [catch {expr Inf} msg] $msg
+} {1 {floating-point value too large to represent}}
+test expr-22.7 {non-numeric floats} nonPortable {
+ list [catch {expr {1 / NaN}} msg] $msg
+} {1 {can't use non-numeric floating-point value as operand of "/"}}
+test expr-22.8 {non-numeric floats} nonPortable {
+ list [catch {expr {1 / Inf}} msg] $msg
+} {1 {can't use infinite floating-point value as operand of "/"}}
+
# cleanup
if {[info exists a]} {
unset a
}
::tcltest::cleanupTests
return
-
diff --git a/tcl/tests/fCmd.test b/tcl/tests/fCmd.test
index c2a98304070..3f3af3e62e3 100644
--- a/tcl/tests/fCmd.test
+++ b/tcl/tests/fCmd.test
@@ -14,25 +14,12 @@
#
if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+ package require tcltest 2
namespace import -force ::tcltest::*
}
-if {[string compare testgetplatform [info commands testgetplatform]] != 0} {
- puts "This application hasn't been compiled with the \"testgetplatform\""
- puts "command, therefore I am skipping all of these tests."
- ::tcltest::cleanupTests
- return
-}
-
-set platform [testgetplatform]
-
-if {"[info commands testchmod]" != "testchmod"} {
- puts "Skipping fCmd tests. This application does not seem to have the"
- puts "testchmod command that is needed to run these tests."
- ::tcltest::cleanupTests
- return
-}
+tcltest::testConstraint testsetplatform [string equal testsetplatform [info commands testsetplatform]]
+tcltest::testConstraint testchmod [string equal testchmod [info commands testchmod]]
# Several tests require need to match results against the unix username
set user {}
@@ -74,7 +61,7 @@ proc openup {path} {
testchmod 777 $path
if {[file isdirectory $path]} {
catch {
- foreach p [glob [file join $path *]] {
+ foreach p [glob -directory $path *] {
openup $p
}
}
@@ -82,10 +69,15 @@ proc openup {path} {
}
proc cleanup {args} {
- foreach p ". $args" {
+ if {$::tcl_platform(platform) == "macintosh"} {
+ set wd [list :]
+ } else {
+ set wd [list .]
+ }
+ foreach p [concat $wd $args] {
set x ""
catch {
- set x [glob [file join $p tf*] [file join $p td*]]
+ set x [glob -directory $p tf* td*]
}
foreach file $x {
if {[catch {file delete -force -- $file}]} {
@@ -299,7 +291,7 @@ test fCmd-4.10 {TclFileMakeDirsCmd: exists, is dir} {notRoot} {
list $x [file exist td1]
} {1 1}
test fCmd-4.11 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} \
- {unixOnly notRoot} {
+ {unixOnly notRoot testchmod} {
cleanup
file mkdir td1/td2/td3
testchmod 000 td1/td2
@@ -309,8 +301,8 @@ test fCmd-4.11 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} \
} {1 {can't create directory "td1/td2/td3": permission denied}}
test fCmd-4.12 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} {macOnly} {
cleanup
- list [catch {file mkdir nonexistantvolume:} msg] $msg
-} {1 {can't create directory "nonexistantvolume:": invalid argument}}
+ list [catch {file mkdir nonexistentvolume:} msg] $msg
+} {1 {can't create directory "nonexistentvolume:": invalid argument}}
test fCmd-4.13 {TclFileMakeDirsCmd: doesn't exist: errno == ENOENT} {notRoot} {
cleanup
set x [file exist td1]
@@ -389,9 +381,26 @@ test fCmd-5.9 {TclFileDeleteCmd: is directory} {notRoot} {
} {0}
test fCmd-5.10 {TclFileDeleteCmd: TclpRemoveDirectory fails} {notRoot} {
cleanup
- file mkdir td1/td2
+ 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} {
+ cleanup
+ set dir [pwd]
+ 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} {unixOnly} {
+ cleanup
+ 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 {}}
test fCmd-6.1 {CopyRenameOneFile: bad source} {notRoot} {
# can't test this, because it's caught by FileCopyRename
@@ -415,7 +424,7 @@ test fCmd-6.5 {CopyRenameOneFile: lstat(target) != 0} {notRoot} {
file rename tf1 tf2
glob tf*
} {tf2}
-test fCmd-6.6 {CopyRenameOneFile: errno != ENOENT} {unixOnly notRoot} {
+test fCmd-6.6 {CopyRenameOneFile: errno != ENOENT} {unixOnly notRoot testchmod} {
cleanup
file mkdir td1
testchmod 000 td1
@@ -424,7 +433,7 @@ test fCmd-6.6 {CopyRenameOneFile: errno != ENOENT} {unixOnly notRoot} {
testchmod 755 td1
set msg
} {1 {error renaming "tf1" to "td1/tf1": permission denied}}
-test fCmd-6.7 {CopyRenameOneFile: errno != ENOENT} {95} {
+test fCmd-6.7 {CopyRenameOneFile: errno != ENOENT} {pcOnly 95} {
cleanup
createfile tf1
list [catch {file rename tf1 $long} msg] $msg
@@ -509,12 +518,13 @@ test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} {pcOnly} {
catch {file delete -force c:/tcl8975@ d:/tcl8975@}
file mkdir c:/tcl8975@
if [catch {file rename c:/tcl8975@ d:/}] {
- list d:/tcl8975@
+ set msg d:/tcl8975@
} else {
set msg [glob c:/tcl8975@ d:/tcl8975@]
file delete -force d:/tcl8975@
- set msg
}
+ file delete -force c:/tcl8975@
+ set msg
} {d:/tcl8975@}
test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} \
{unixOnly notRoot} {
@@ -534,18 +544,19 @@ test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} \
{unixOnly notRoot xdev} {
cleanup /tmp
file mkdir td1/td2/td3
- exec chmod 000 td1
+ file attributes td1 -permissions 0000
set msg [list [catch {file rename td1 /tmp} msg] $msg]
- exec chmod 755 td1
+ file attributes td1 -permissions 0755
set msg
} {1 {error renaming "td1": permission denied}}
test fCmd-6.24 {CopyRenameOneFile: error uses original name} \
{unixOnly notRoot} {
cleanup
file mkdir ~/td1/td2
- exec chmod 000 [file join [file dirname ~] [file tail ~] td1]
+ set td1name [file join [file dirname ~] [file tail ~] td1]
+ file attributes $td1name -permissions 0000
set msg [list [catch {file copy ~/td1 td1} msg] $msg]
- exec chmod 755 [file join [file dirname ~] [file tail ~] td1]
+ file attributes $td1name -permissions 0755
file delete -force ~/td1
set msg
} {1 {error copying "~/td1": permission denied}}
@@ -554,9 +565,10 @@ test fCmd-6.25 {CopyRenameOneFile: error uses original name} \
cleanup
file mkdir td2
file mkdir ~/td1
- exec chmod 000 [file join [file dirname ~] [file tail ~] 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]
- exec chmod 755 [file join [file dirname ~] [file tail ~] td1]
+ file attributes $td1name -permissions 0755
file delete -force ~/td1
set msg
} {1 {error copying "td2" to "~/td1/td2": permission denied}}
@@ -564,9 +576,10 @@ test fCmd-6.26 {CopyRenameOneFile: doesn't use original name} \
{unixOnly notRoot} {
cleanup
file mkdir ~/td1/td2
- exec chmod 000 [file join [file dirname ~] [file tail ~] 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]
- exec chmod 755 [file join [file dirname ~] [file tail ~] td1 td2]
+ 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}"
@@ -582,9 +595,9 @@ test fCmd-6.28 {CopyRenameOneFile: TclpCopyDirectory failed} \
{unixOnly notRoot xdev} {
cleanup /tmp
file mkdir td1/td2/td3
- exec chmod 000 td1/td2/td3
+ file attributes td1/td2/td3 -permissions 0000
set msg [list [catch {file rename td1 /tmp} msg] $msg]
- exec chmod 755 td1/td2/td3
+ 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} \
@@ -675,7 +688,7 @@ test fCmd-9.2 {file rename: comprehensive: source doesn't exist} {notRoot} {
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} {
+test fCmd-9.3 {file rename: comprehensive: file to new name} {notRoot testchmod} {
cleanup
createfile tf1
createfile tf2
@@ -684,7 +697,7 @@ test fCmd-9.3 {file rename: comprehensive: file to new name} {notRoot} {
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} {
+test fCmd-9.4 {file rename: comprehensive: dir to new name} {unixOrPc notRoot testchmod} {
cleanup
file mkdir td1 td2
testchmod 555 td2
@@ -692,7 +705,7 @@ test fCmd-9.4 {file rename: comprehensive: dir to new name} {unixOrPc notRoot} {
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} {
+test fCmd-9.5 {file rename: comprehensive: file to self} {notRoot testchmod} {
cleanup
createfile tf1 tf1
createfile tf2 tf2
@@ -701,7 +714,7 @@ test fCmd-9.5 {file rename: comprehensive: file to self} {notRoot} {
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} {
+test fCmd-9.6 {file rename: comprehensive: dir to self} {notRoot unixOrPc testchmod} {
cleanup
file mkdir td1
file mkdir td2
@@ -710,7 +723,7 @@ test fCmd-9.6 {file rename: comprehensive: dir to self} {notRoot unixOrPc} {
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} {
+test fCmd-9.7 {file rename: comprehensive: file to existing file} {notRoot testchmod} {
cleanup
createfile tf1
createfile tf2
@@ -733,7 +746,7 @@ test fCmd-9.7 {file rename: comprehensive: file to existing file} {notRoot} {
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}
-test fCmd-9.8 {file rename: comprehensive: dir to empty dir} {notRoot} {
+test fCmd-9.8 {file rename: comprehensive: dir to empty dir} {notRoot testchmod} {
# Under unix, you can rename a read-only directory, but you can't
# move it into another directory.
@@ -771,7 +784,7 @@ test fCmd-9.8 {file rename: comprehensive: dir to empty dir} {notRoot} {
list [lsort [glob td*]] $msg [file writable [file join tdd1 tds1]] \
[file writable [file join tdd2 tds2]] $w3 $w4
} [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4} {1 {error renaming "td1" to "[file join td2 td1]": file already exists}} 1 1 0 0}]
-test fCmd-9.9 {file rename: comprehensive: dir to non-empty dir} {notRoot} {
+test fCmd-9.9 {file rename: comprehensive: dir to non-empty dir} {notRoot testchmod} {
cleanup
file mkdir tds1
file mkdir tds2
@@ -789,7 +802,7 @@ test fCmd-9.9 {file rename: comprehensive: dir to non-empty dir} {notRoot} {
}
list [lsort [glob td*]] $a1 $a2 [file writable tds1] $w2
} [subst {{tdd1 tdd2 tds1 tds2} {1 {error renaming "tds1" to "[file join tdd1 tds1]": file already exists}} {1 {error renaming "tds2" to "[file join tdd2 tds2]": file already exists}} 1 0}]
-test fCmd-9.10 {file rename: comprehensive: file to new name and dir} {notRoot} {
+test fCmd-9.10 {file rename: comprehensive: file to new name and dir} {notRoot testchmod} {
cleanup
createfile tf1
createfile tf2
@@ -797,10 +810,10 @@ test fCmd-9.10 {file rename: comprehensive: file to new name and dir} {notRoot}
testchmod 444 tf2
file rename tf1 [file join td1 tf3]
file rename tf2 [file join td1 tf4]
- list [catch {glob tf*}] [lsort [glob [file join td1 t*]]] \
+ 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} {
+test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} {notRoot testchmod} {
cleanup
file mkdir td1
file mkdir td2
@@ -815,10 +828,10 @@ test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} {notRoot} {
} else {
set w4 0
}
- list [lsort [glob td*]] [lsort [glob [file join td3 t*]]] \
+ 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}]
-test fCmd-9.12 {file rename: comprehensive: target exists} {notRoot} {
+test fCmd-9.12 {file rename: comprehensive: target exists} {notRoot testchmod} {
cleanup
file mkdir [file join td1 td2] [file join td2 td1]
if {$tcl_platform(platform) != "macintosh"} {
@@ -862,7 +875,7 @@ test fCmd-10.1 {file copy: comprehensive: source doesn't exist} {notRoot} {
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} {
+test fCmd-10.2 {file copy: comprehensive: file to new name} {notRoot testchmod} {
cleanup
createfile tf1 tf1
createfile tf2 tf2
@@ -871,22 +884,22 @@ test fCmd-10.2 {file copy: comprehensive: file to new name} {notRoot} {
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} {
+test fCmd-10.3 {file copy: comprehensive: dir to new name} {notRoot unixOrPc testchmod} {
cleanup
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 [file join td3 t*]] \
- [glob [file join td4 t*]] [file writable td3] [file writable td4]]
+ set msg [list [lsort [glob td*]] [glob -directory td3 t*] \
+ [glob -directory td4 t*] [file writable td3] [file writable td4]]
if {$tcl_platform(platform) != "macintosh"} {
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} {
+test fCmd-10.4 {file copy: comprehensive: file to existing file} {notRoot testchmod} {
cleanup
createfile tf1
createfile tf2
@@ -909,7 +922,7 @@ test fCmd-10.4 {file copy: comprehensive: file to existing file} {notRoot} {
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} {
+test fCmd-10.5 {file copy: comprehensive: dir to empty dir} {notRoot testchmod} {
cleanup
file mkdir td1
file mkdir [file join td2 td1]
@@ -935,7 +948,7 @@ test fCmd-10.5 {file copy: comprehensive: dir to empty dir} {notRoot} {
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} {
+ {notRoot unixOrPc testchmod} {
cleanup
file mkdir tds1
file mkdir tds2
@@ -946,7 +959,7 @@ test fCmd-10.6 {file copy: comprehensive: dir to non-empty dir} \
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} {
+test fCmd-10.7 {file rename: comprehensive: file to new name and dir} {notRoot testchmod} {
cleanup
createfile tf1
createfile tf2
@@ -954,11 +967,11 @@ test fCmd-10.7 {file rename: comprehensive: file to new name and dir} {notRoot}
testchmod 444 tf2
file copy tf1 [file join td1 tf3]
file copy tf2 [file join td1 tf4]
- list [lsort [glob tf*]] [lsort [glob [file join td1 t*]]] \
+ 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} {
+ {notRoot unixOrPc testchmod} {
cleanup
file mkdir td1
file mkdir td2
@@ -966,7 +979,7 @@ test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} \
testchmod 555 td2
file copy td1 [file join td3 td3]
file copy td2 [file join td3 td4]
- list [lsort [glob td*]] [lsort [glob [file join td3 t*]]] \
+ 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} \
@@ -1145,9 +1158,9 @@ test fCmd-12.8 {renamefile: generic error} {unixOnly notRoot} {
catch {file delete -force -- tfa}
file mkdir tfa
file mkdir tfa/dir
- exec chmod 555 tfa
+ file attributes tfa -permissions 0555
set result [catch {file rename tfa/dir tfa2}]
- exec chmod 777 tfa
+ file attributes tfa -permissions 0777
file delete -force tfa
set result
} {1}
@@ -1346,9 +1359,9 @@ test fCmd-14.7 {copyfile: copy directory succeeding} {notRoot} {
test fCmd-14.8 {copyfile: copy directory failing} {unixOnly notRoot} {
catch {file delete -force -- tfa}
file mkdir tfa/dir/a/b/c
- exec chmod 000 tfa/dir
+ file attributes tfa/dir -permissions 0000
set r1 [catch {file copy tfa tfa2}]
- exec chmod 777 tfa/dir
+ file attributes tfa/dir -permissions 0777
set result $r1
file delete -force tfa tfa2
set result
@@ -1389,9 +1402,9 @@ test fCmd-15.4 {TclMakeDirsCmd - stat failing} {unixOnly notRoot} {
catch {file delete -force -- tfa}
file mkdir tfa
createfile tfa/file
- exec chmod 000 tfa
+ file attributes tfa -permissions 0000
set result [catch {file mkdir tfa/file}]
- exec chmod 777 tfa
+ file attributes tfa -permissions 0777
file delete -force tfa
set result
} {1}
@@ -1435,21 +1448,21 @@ test fCmd-15.8 {TclFileMakeDirsCmd: trying to create an existing dir} {notRoot}
# Coverage tests for TclDeleteFilesCommand()
-test fCmd-16.1 { test the -- argument } {notRoot} {
+test fCmd-16.1 {test the -- argument} {notRoot} {
catch {file delete -force -- tfa}
createfile tfa
file delete -- tfa
file exists tfa
} {0}
-test fCmd-16.2 { test the -force and -- arguments } {notRoot} {
+test fCmd-16.2 {test the -force and -- arguments} {notRoot} {
catch {file delete -force -- tfa}
createfile tfa
file delete -force -- tfa
file exists tfa
} {0}
-test fCmd-16.3 { test bad option } {notRoot} {
+test fCmd-16.3 {test bad option} {notRoot} {
catch {file delete -force -- tfa}
createfile tfa
set result [catch {file delete -dog tfa}]
@@ -1457,11 +1470,11 @@ test fCmd-16.3 { test bad option } {notRoot} {
set result
} {1}
-test fCmd-16.4 { test not enough args } {notRoot} {
+test fCmd-16.4 {test not enough args} {notRoot} {
catch {file delete}
} {1}
-test fCmd-16.5 { test not enough args with options } {notRoot} {
+test fCmd-16.5 {test not enough args with options} {notRoot} {
catch {file delete --}
} {1}
@@ -1496,14 +1509,14 @@ test fCmd-16.9 {error while deleting file } {unixOnly notRoot} {
catch {file delete -force -- tfa}
file mkdir tfa
createfile tfa/a
- exec chmod 555 tfa
+ file attributes tfa -permissions 0555
set result [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"
#######
- exec chmod 777 tfa
+ file attributes tfa -permissions 0777
file delete -force tfa
set result
} {1}
@@ -1516,7 +1529,7 @@ test fCmd-16.10 {deleting multiple files} {notRoot} {
expr ![file exists tfa1] && ![file exists tfa2]
} {1}
-test fCmd-16.11 { TclFileDeleteCmd: removing a nonexistant file} {notRoot} {
+test fCmd-16.11 {TclFileDeleteCmd: removing a nonexistant file} {notRoot} {
catch {file delete -force -- tfa}
file delete tfa
set result 1
@@ -1526,9 +1539,9 @@ test fCmd-16.11 { TclFileDeleteCmd: removing a nonexistant file} {notRoot} {
test fCmd-17.1 {mkdir stat failing on target but not ENOENT} {unixOnly notRoot} {
catch {file delete -force -- tfa1}
file mkdir tfa1
- exec chmod 555 tfa1
+ file attributes tfa1 -permissions 0555
set result [catch {file mkdir tfa1/tfa2}]
- exec chmod 777 tfa1
+ file attributes tfa1 -permissions 0777
file delete -force tfa1
set result
} {1}
@@ -1684,10 +1697,10 @@ test fCmd-18.12 {TclFileRenameCmd : rename a symbolic link to file} \
catch {file delete -force -- tfa1 tfa2 tfa3}
set s [createfile tfa1]
- exec ln -s tfa1 tfa2
+ file link -symbolic tfa2 tfa1
file rename tfa2 tfa3
set t [file type tfa3]
- set result [expr { $t == "link" }]
+ set result [expr {$t eq "link"}]
file delete tfa1 tfa3
set result
} {1}
@@ -1697,10 +1710,10 @@ test fCmd-18.13 {TclFileRenameCmd : rename a symbolic link to dir} \
catch {file delete -force -- tfa1 tfa2 tfa3}
file mkdir tfa1
- exec ln -s tfa1 tfa2
+ file link -symbolic tfa2 tfa1
file rename tfa2 tfa3
set t [file type tfa3]
- set result [expr { $t == "link" }]
+ set result [expr {$t eq "link"}]
file delete tfa1 tfa3
set result
} {1}
@@ -1713,7 +1726,7 @@ test fCmd-18.14 {TclFileRenameCmd : rename a path with sym link} \
file mkdir tfa2
set f [file join [pwd] tfa1/a/b]
set f2 [file join [pwd] {tfa2/b alias}]
- exec ln -s $f $f2
+ 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]
@@ -1728,7 +1741,7 @@ test fCmd-18.15 {TclFileRenameCmd : rename a file to a symlink dir} \
file mkdir tfa1
set s [createfile tfa2]
- exec ln -s tfa1 tfalink
+ file link -symbolic tfalink tfa1
file rename tfa2 tfalink
set result [checkcontent tfa1/tfa2 $s ]
@@ -1740,7 +1753,7 @@ test fCmd-18.16 {TclFileRenameCmd: rename a dangling symlink} {unixOnly notRoot}
catch {file delete -force -- tfa1 tfalink}
file mkdir tfa1
- exec ln -s tfa1 tfalink
+ file link -symbolic tfalink tfa1
file delete tfa1
file rename tfalink tfa2
set result [expr [string compare [file type tfa2] "link"] == 0]
@@ -1752,25 +1765,25 @@ test fCmd-18.16 {TclFileRenameCmd: rename a dangling symlink} {unixOnly notRoot}
#
# Coverage tests for TclUnixRmdir
#
-test fCmd-19.1 { remove empty directory } {notRoot} {
+test fCmd-19.1 {remove empty directory} {notRoot} {
catch {file delete -force -- tfa}
file mkdir tfa
file delete tfa
file exists tfa
} {0}
-test fCmd-19.2 { rmdir error besides EEXIST} {unixOnly notRoot} {
+test fCmd-19.2 {rmdir error besides EEXIST} {unixOnly notRoot} {
catch {file delete -force -- tfa}
file mkdir tfa
file mkdir tfa/a
- exec chmod 555 tfa
+ file attributes tfa -permissions 0555
set result [catch {file delete tfa/a}]
- exec chmod 777 tfa
+ file attributes tfa -permissions 0777
file delete -force tfa
set result
} {1}
-test fCmd-19.3 { recursive remove } {notRoot} {
+test fCmd-19.3 {recursive remove} {notRoot} {
catch {file delete -force -- tfa}
file mkdir tfa
file mkdir tfa/a
@@ -1793,9 +1806,9 @@ test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory } \
catch {file delete -force -- tfa}
file mkdir tfa
file mkdir tfa/a
- exec chmod 000 tfa/a
+ file attributes tfa/a -permissions 0000
set result [catch {file delete -force tfa}]
- exec chmod 777 tfa/a
+ file attributes tfa/a -permissions 0777
file delete -force tfa
set result
} {1}
@@ -1872,9 +1885,17 @@ test fCmd-21.6 {copy: mixed dirs and files into directory} \
set result
} {1}
-test fCmd-21.7 {TclCopyFilesCmd: copy a dangling link} {unixOnly notRoot} {
+test fCmd-21.7.1 {TclCopyFilesCmd: copy a dangling link} {unixOnly notRoot dontCopyLinks} {
file mkdir tfad1
- exec ln -s tfad1 tfalink
+ 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} {unixOnly notRoot} {
+ file mkdir tfad1
+ file link -symbolic tfalink tfad1
file delete tfad1
file copy tfalink tfalink2
set result [string match [file type tfalink2] link]
@@ -1882,21 +1903,32 @@ test fCmd-21.7 {TclCopyFilesCmd: copy a dangling link} {unixOnly notRoot} {
set result
} {1}
-test fCmd-21.8 {TclCopyFilesCmd : copy a link } {unixOnly notRoot} {
+test fCmd-21.8.1 {TclCopyFilesCmd: copy a link } {unixOnly notRoot dontCopyLinks} {
file mkdir tfad1
- exec ln -s tfad1 tfalink
+ file link -symbolic tfalink tfad1
file copy tfalink tfalink2
- set r1 [file type tfalink]
- set r2 [file type tfalink2]
- set r3 [file isdir tfad1]
- set result [expr {("$r1" == "link" ) && ("$r2" == "link" ) && $r3}]
- file delete tfad1 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}]
+ file delete -force tfad1 tfalink tfalink2
+ set result
+} {1}
+test fCmd-21.8.2 {TclCopyFilesCmd: copy a link } {unixOnly notRoot} {
+ 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}]
+ file delete -force tfad1 tfalink tfalink2
set result
} {1}
test fCmd-21.9 {TclCopyFilesCmd: copy dir with a link in it} {unixOnly notRoot} {
file mkdir tfad1
- exec ln -s "[pwd]/tfad1" tfad1/tfalink
+ file link -symbolic tfad1/tfalink "[pwd]/tfad1"
file copy tfad1 tfad2
set result [string match [file type tfad2/tfalink] link]
file delete -force tfad1 tfad2
@@ -1931,7 +1963,7 @@ test fCmd-21.12 {TclFileCopyCmd: copy dir on top of a non-empty dir w/ -force} \
file delete -force tfa tfad
set result
} {1}
-
+
#
# Coverage testing for TclpRenameFile
#
@@ -1956,7 +1988,7 @@ test fCmd-22.2 {TclpRenameFile: attempt to overwrite itself} {macOrUnix notRoot}
set result
} {1}
-test fCmd-22.3 { TclpRenameFile : rename dir to existing dir } {notRoot} {
+test fCmd-22.3 {TclpRenameFile: rename dir to existing dir} {notRoot} {
catch {file delete -force -- d1 tfad}
file mkdir d1 [file join tfad d1]
set r1 [catch {file rename d1 tfad}]
@@ -2026,8 +2058,7 @@ test fCmd-24.1 {TclMacDeleteFile: deleting a normal file} {notRoot} {
# 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} {notRoot notFileSharing} {
catch {file delete -force -- tfad1 tfad2}
file mkdir [file join tfad1 a b c]
@@ -2037,8 +2068,7 @@ test fCmd-25.1 { TclMacCopyDirectory : copying a normal directory} \
set result
} {1}
-test fCmd-25.2 { TclMacCopyDirectory : copying a short path normal directory} \
- {notRoot notFileSharing} {
+test fCmd-25.2 {TclMacCopyDirectory: copying a short path normal directory} {notRoot notFileSharing} {
catch {file delete -force -- tfad1 tfad2}
file mkdir tfad1
@@ -2048,8 +2078,7 @@ test fCmd-25.2 { TclMacCopyDirectory : copying a short path normal directory} \
set result
} {1}
-test fCmd-25.3 { TclMacCopyDirectory : copying dirs between different dirs} \
- {notRoot notFileSharing} {
+test fCmd-25.3 {TclMacCopyDirectory: copying dirs between different dirs} {notRoot notFileSharing} {
catch {file delete -force -- tfad1 tfad2}
file mkdir [file join tfad1 x y z]
@@ -2064,11 +2093,11 @@ test fCmd-25.3 { TclMacCopyDirectory : copying dirs between different dirs} \
# Functionality tests for TclDeleteFilesCmd
#
-test fCmd-26.1 { TclDeleteFilesCmd : delete symlink} {unixOnly notRoot} {
+test fCmd-26.1 {TclDeleteFilesCmd: delete symlink} {unixOnly notRoot} {
catch {file delete -force -- tfad1 tfad2}
file mkdir tfad1
- exec ln -s tfad1 tfalink
+ file link -symbolic tfalink tfad1
file delete tfalink
set r1 [file isdir tfad1]
@@ -2079,12 +2108,12 @@ test fCmd-26.1 { TclDeleteFilesCmd : delete symlink} {unixOnly notRoot} {
set result
} {1}
-test fCmd-26.2 { TclDeleteFilesCmd : delete dir with symlink} {unixOnly notRoot} {
+test fCmd-26.2 {TclDeleteFilesCmd: delete dir with symlink} {unixOnly notRoot} {
catch {file delete -force -- tfad1 tfad2}
file mkdir tfad1
file mkdir tfad2
- exec ln -s tfad1 [file join tfad2 link]
+ file link -symbolic [file join tfad2 link] tfad1
file delete -force tfad2
set r1 [file isdir tfad1]
@@ -2095,11 +2124,11 @@ test fCmd-26.2 { TclDeleteFilesCmd : delete dir with symlink} {unixOnly notRoot}
set result
} {1}
-test fCmd-26.3 { TclDeleteFilesCmd : delete dangling symlink} {unixOnly notRoot} {
+test fCmd-26.3 {TclDeleteFilesCmd: delete dangling symlink} {unixOnly notRoot} {
catch {file delete -force -- tfad1 tfad2}
file mkdir tfad1
- exec ln -s tfad1 tfad2
+ file link -symbolic tfad2 tfad1
file delete tfad1
file delete tfad2
@@ -2110,7 +2139,8 @@ test fCmd-26.3 { TclDeleteFilesCmd : delete dangling symlink} {unixOnly notRoot}
set result
} {1}
-test fCmd-27.2 {TclFileAttrsCmd - Tcl_TranslateFileName fails} {
+test fCmd-27.2 {TclFileAttrsCmd - Tcl_TranslateFileName fails} {testsetplatform} {
+ set platform [testgetplatform]
testsetplatform unix
list [catch {file attributes ~_totally_bogus_user} msg] $msg [testsetplatform $platform]
} {1 {user "_totally_bogus_user" doesn't exist} {}}
@@ -2129,14 +2159,14 @@ test fCmd-27.4 {TclFileAttrsCmd - getting one option} {
# Find a group that exists on this Unix system, or else skip tests that
# require Unix groups.
if {$tcl_platform(platform) == "unix"} {
- set ::tcltest::testConstraints(foundGroup) 0
+ ::tcltest::testConstraint foundGroup 0
catch {
set groupList [exec groups]
set group [lindex $groupList 0]
- set ::tcltest::testConstraints(foundGroup) 1
+ ::tcltest::testConstraint foundGroup 1
}
} else {
- set ::tcltest::testConstraints(foundGroup) 1
+ ::tcltest::testConstraint foundGroup 1
}
test fCmd-27.5 {TclFileAttrsCmd - setting one option} {foundGroup} {
@@ -2152,20 +2182,204 @@ test fCmd-27.6 {TclFileAttrsCmd - setting more than one option} {foundGroup} {
list [catch {eval file attributes foo.tmp [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
+}
+
+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}}
+
+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} {
+ cd [temporaryDirectory]
+ set res [list [catch {file link abc.dir abc2.dir} msg] $msg]
+ 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 macOrWin} {
+ cd [temporaryDirectory]
+ set res [list [catch {file link -hard abc.link abc.dir} msg] $msg]
+ 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} {
+ cd [temporaryDirectory]
+ set res [list [catch {file link abc.file abc2.file} msg] $msg]
+ cd [workingDirectory]
+ set res
+} {1 {could not create new link "abc.file": that path already exists}}
+
+test fCmd-28.8 {file link} {linkFile winOnly} {
+ cd [temporaryDirectory]
+ set res [list [catch {file link -symbolic abc.link abc.file} msg] $msg]
+ 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} {
+ cd [temporaryDirectory]
+ file delete -force abc.link
+ set res [list [catch {file link abc.link abc.file} msg] $msg]
+ cd [workingDirectory]
+ set res
+} {0 abc.file}
+
+cd [temporaryDirectory]
+catch {file delete -force abc.link}
+cd [workingDirectory]
+
+test fCmd-28.10 {file link: linking to nonexistent path} {linkDirectory} {
+ cd [temporaryDirectory]
+ file delete -force abc.link
+ set res [list [catch {file link abc.link abc2.doesnt} msg] $msg]
+ cd [workingDirectory]
+ set res
+} {1 {could not create new link "abc.link" since target "abc2.doesnt" doesn't exist}}
+
+test fCmd-28.11 {file link: success with directory} {linkDirectory} {
+ cd [temporaryDirectory]
+ file delete -force abc.link
+ set res [list [catch {file link abc.link abc.dir} msg] $msg]
+ cd [workingDirectory]
+ set res
+} {0 abc.dir}
+
+test fCmd-28.12 {file link: cd into a link} {linkDirectory} {
+ cd [temporaryDirectory]
+ file delete -force abc.link
+ file link abc.link abc.dir
+ set orig [pwd]
+ cd abc.link
+ set dir [pwd]
+ 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 $link ; cd ..'"
+ } else {
+ set res "ok"
+ }
+ cd [workingDirectory]
+ set res
+} {ok}
+
+test fCmd-28.13 {file link} {linkDirectory} {
+ # duplicate link throws error
+ cd [temporaryDirectory]
+ set res [list [catch {file link abc.link abc.dir} msg] $msg]
+ 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} {
+ cd [temporaryDirectory]
+ file delete -force abc.link
+ set res [list [file exists abc.link] [file exists abc.dir]]
+ cd [workingDirectory]
+ set res
+} {0 1}
+
+test fCmd-28.15.1 {file link: copies link not dir} {linkDirectory dontCopyLinks} {
+ cd [temporaryDirectory]
+ file delete -force abc.link
+ 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]]]
+ cd [workingDirectory]
+ set res
+} {directory abc.dir}
+test fCmd-28.15.2 {file link: copies link not dir} {linkDirectory} {
+ cd [temporaryDirectory]
+ file delete -force abc.link
+ 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]]]
+ cd [workingDirectory]
+ set res
+} {link abc.dir}
+
+cd [temporaryDirectory]
+file delete -force abc.link
+file delete -force abc2.link
+
+file copy abc.file abc.dir
+file copy abc2.file abc.dir
+cd [workingDirectory]
+
+test fCmd-28.16 {file link: glob inside link} {linkDirectory} {
+ cd [temporaryDirectory]
+ file delete -force abc.link
+ file link abc.link abc.dir
+ set res [glob -dir abc.link -tails *]
+ cd [workingDirectory]
+ set res
+} {abc.file abc2.file}
+
+test fCmd-28.17 {file link: glob -type l} {linkDirectory} {
+ cd [temporaryDirectory]
+ set res [glob -dir [pwd] -type l -tails abc*]
+ cd [workingDirectory]
+ set res
+} {abc.link}
+
+test fCmd-28.18 {file link: glob -type d} {linkDirectory} {
+ cd [temporaryDirectory]
+ set res [lsort [glob -dir [pwd] -type d -tails abc*]]
+ cd [workingDirectory]
+ set res
+} [lsort [list abc.link abc.dir abc2.dir]]
+
+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
+cd [workingDirectory]
+
+removeFile abc2.file
+removeFile abc.file
+removeDirectory abc2.dir
+removeDirectory abc.dir
+
# cleanup
cleanup
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tcl/tests/fileName.test b/tcl/tests/fileName.test
index 89175d4fb68..a5d54da1d67 100644
--- a/tcl/tests/fileName.test
+++ b/tcl/tests/fileName.test
@@ -17,878 +17,906 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
namespace import -force ::tcltest::*
}
-if {[info commands testsetplatform] == {}} {
- puts "This application hasn't been compiled with the \"testsetplatform\""
- puts "command, so I can't test the filename conversion procedures."
- ::tcltest::cleanupTests
- return
-}
+tcltest::testConstraint testsetplatform [string equal testsetplatform [info commands testsetplatform]]
+tcltest::testConstraint testtranslatefilename [string equal testtranslatefilename [info commands testtranslatefilename]]
global env
-set platform [testgetplatform]
+if {[tcltest::testConstraint testsetplatform]} {
+ set platform [testgetplatform]
+}
-test filename-1.1 {Tcl_GetPathType: unix} {
+test filename-1.1 {Tcl_GetPathType: unix} {testsetplatform} {
testsetplatform unix
file pathtype /
} absolute
-test filename-1.2 {Tcl_GetPathType: unix} {
+test filename-1.2 {Tcl_GetPathType: unix} {testsetplatform} {
testsetplatform unix
file pathtype /foo
} absolute
-test filename-1.3 {Tcl_GetPathType: unix} {
+test filename-1.3 {Tcl_GetPathType: unix} {testsetplatform} {
testsetplatform unix
file pathtype foo
} relative
-test filename-1.4 {Tcl_GetPathType: unix} {
+test filename-1.4 {Tcl_GetPathType: unix} {testsetplatform} {
testsetplatform unix
file pathtype c:/foo
} relative
-test filename-1.5 {Tcl_GetPathType: unix} {
+test filename-1.5 {Tcl_GetPathType: unix} {testsetplatform} {
testsetplatform unix
file pathtype ~
} absolute
-test filename-1.6 {Tcl_GetPathType: unix} {
+test filename-1.6 {Tcl_GetPathType: unix} {testsetplatform} {
testsetplatform unix
file pathtype ~/foo
} absolute
-test filename-1.7 {Tcl_GetPathType: unix} {
+test filename-1.7 {Tcl_GetPathType: unix} {testsetplatform} {
testsetplatform unix
file pathtype ~foo
} absolute
-test filename-1.8 {Tcl_GetPathType: unix} {
+test filename-1.8 {Tcl_GetPathType: unix} {testsetplatform} {
testsetplatform unix
file pathtype ./~foo
} relative
-test filename-2.1 {Tcl_GetPathType: mac, denerate names} {
+test filename-2.1 {Tcl_GetPathType: mac, denerate names} {testsetplatform} {
testsetplatform mac
file pathtype /
} relative
-test filename-2.2 {Tcl_GetPathType: mac, denerate names} {
+test filename-2.2 {Tcl_GetPathType: mac, denerate names} {testsetplatform} {
testsetplatform mac
file pathtype /.
} relative
-test filename-2.3 {Tcl_GetPathType: mac, denerate names} {
+test filename-2.3 {Tcl_GetPathType: mac, denerate names} {testsetplatform} {
testsetplatform mac
file pathtype /..
} relative
-test filename-2.4 {Tcl_GetPathType: mac, denerate names} {
+test filename-2.4 {Tcl_GetPathType: mac, denerate names} {testsetplatform} {
testsetplatform mac
file pathtype //.//
} relative
-test filename-2.5 {Tcl_GetPathType: mac, denerate names} {
+test filename-2.5 {Tcl_GetPathType: mac, denerate names} {testsetplatform} {
testsetplatform mac
file pathtype //.//../.
} relative
-test filename-2.6 {Tcl_GetPathType: mac, tilde names} {
+test filename-2.6 {Tcl_GetPathType: mac, tilde names} {testsetplatform} {
testsetplatform mac
file pathtype ~
} absolute
-test filename-2.7 {Tcl_GetPathType: mac, tilde names} {
+test filename-2.7 {Tcl_GetPathType: mac, tilde names} {testsetplatform} {
testsetplatform mac
file pathtype ~:
} absolute
-test filename-2.8 {Tcl_GetPathType: mac, tilde names} {
+test filename-2.8 {Tcl_GetPathType: mac, tilde names} {testsetplatform} {
testsetplatform mac
file pathtype ~:foo
} absolute
-test filename-2.9 {Tcl_GetPathType: mac, tilde names} {
+test filename-2.9 {Tcl_GetPathType: mac, tilde names} {testsetplatform} {
testsetplatform mac
file pathtype ~/
} absolute
-test filename-2.10 {Tcl_GetPathType: mac, tilde names} {
+test filename-2.10 {Tcl_GetPathType: mac, tilde names} {testsetplatform} {
testsetplatform mac
file pathtype ~/foo
} absolute
-test filename-2.11 {Tcl_GetPathType: mac, unix-style names} {
+test filename-2.11 {Tcl_GetPathType: mac, unix-style names} {testsetplatform} {
testsetplatform mac
file pathtype /foo
} absolute
-test filename-2.12 {Tcl_GetPathType: mac, unix-style names} {
+test filename-2.12 {Tcl_GetPathType: mac, unix-style names} {testsetplatform} {
testsetplatform mac
file pathtype /./foo
} absolute
-test filename-2.13 {Tcl_GetPathType: mac, unix-style names} {
+test filename-2.13 {Tcl_GetPathType: mac, unix-style names} {testsetplatform} {
testsetplatform mac
file pathtype /..//./foo
} absolute
-test filename-2.14 {Tcl_GetPathType: mac, unix-style names} {
+test filename-2.14 {Tcl_GetPathType: mac, unix-style names} {testsetplatform} {
testsetplatform mac
file pathtype /foo/bar
} absolute
-test filename-2.15 {Tcl_GetPathType: mac, unix-style names} {
+test filename-2.15 {Tcl_GetPathType: mac, unix-style names} {testsetplatform} {
testsetplatform mac
file pathtype foo/bar
} relative
-test filename-2.16 {Tcl_GetPathType: mac, mac-style names} {
+test filename-2.16 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} {
testsetplatform mac
file pathtype :
} relative
-test filename-2.17 {Tcl_GetPathType: mac, mac-style names} {
+test filename-2.17 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} {
testsetplatform mac
file pathtype :foo
} relative
-test filename-2.18 {Tcl_GetPathType: mac, mac-style names} {
+test filename-2.18 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} {
testsetplatform mac
file pathtype foo:
} absolute
-test filename-2.19 {Tcl_GetPathType: mac, mac-style names} {
+test filename-2.19 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} {
testsetplatform mac
file pathtype foo:bar
} absolute
-test filename-2.20 {Tcl_GetPathType: mac, mac-style names} {
+test filename-2.20 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} {
testsetplatform mac
file pathtype :foo:bar
} relative
-test filename-2.21 {Tcl_GetPathType: mac, mac-style names} {
+test filename-2.21 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} {
testsetplatform mac
file pathtype ::foo:bar
} relative
-test filename-2.22 {Tcl_GetPathType: mac, mac-style names} {
+test filename-2.22 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} {
testsetplatform mac
file pathtype ~foo
} absolute
-test filename-2.23 {Tcl_GetPathType: mac, mac-style names} {
+test filename-2.23 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} {
testsetplatform mac
file pathtype :~foo
} relative
-test filename-2.24 {Tcl_GetPathType: mac, mac-style names} {
+test filename-2.24 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} {
testsetplatform mac
file pathtype ~foo:
} absolute
-test filename-2.25 {Tcl_GetPathType: mac, mac-style names} {
+test filename-2.25 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} {
testsetplatform mac
file pathtype foo/bar:
} absolute
-test filename-2.26 {Tcl_GetPathType: mac, mac-style names} {
+test filename-2.26 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} {
testsetplatform mac
file pathtype /foo:
} absolute
-test filename-2.27 {Tcl_GetPathType: mac, mac-style names} {
+test filename-2.27 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} {
testsetplatform mac
file pathtype foo
} relative
-test filename-3.1 {Tcl_GetPathType: windows} {
+test filename-3.1 {Tcl_GetPathType: windows} {testsetplatform} {
testsetplatform windows
file pathtype /
} volumerelative
-test filename-3.2 {Tcl_GetPathType: windows} {
+test filename-3.2 {Tcl_GetPathType: windows} {testsetplatform} {
testsetplatform windows
file pathtype \\
} volumerelative
-test filename-3.3 {Tcl_GetPathType: windows} {
+test filename-3.3 {Tcl_GetPathType: windows} {testsetplatform} {
testsetplatform windows
file pathtype /foo
} volumerelative
-test filename-3.4 {Tcl_GetPathType: windows} {
+test filename-3.4 {Tcl_GetPathType: windows} {testsetplatform} {
testsetplatform windows
file pathtype \\foo
} volumerelative
-test filename-3.5 {Tcl_GetPathType: windows} {
+test filename-3.5 {Tcl_GetPathType: windows} {testsetplatform} {
testsetplatform windows
file pathtype c:/
} absolute
-test filename-3.6 {Tcl_GetPathType: windows} {
+test filename-3.6 {Tcl_GetPathType: windows} {testsetplatform} {
testsetplatform windows
file pathtype c:\\
} absolute
-test filename-3.7 {Tcl_GetPathType: windows} {
+test filename-3.7 {Tcl_GetPathType: windows} {testsetplatform} {
testsetplatform windows
file pathtype c:/foo
} absolute
-test filename-3.8 {Tcl_GetPathType: windows} {
+test filename-3.8 {Tcl_GetPathType: windows} {testsetplatform} {
testsetplatform windows
file pathtype c:\\foo
} absolute
-test filename-3.9 {Tcl_GetPathType: windows} {
+test filename-3.9 {Tcl_GetPathType: windows} {testsetplatform} {
testsetplatform windows
file pathtype c:
} volumerelative
-test filename-3.10 {Tcl_GetPathType: windows} {
+test filename-3.10 {Tcl_GetPathType: windows} {testsetplatform} {
testsetplatform windows
file pathtype c:foo
} volumerelative
-test filename-3.11 {Tcl_GetPathType: windows} {
+test filename-3.11 {Tcl_GetPathType: windows} {testsetplatform} {
testsetplatform windows
file pathtype foo
} relative
-test filename-3.12 {Tcl_GetPathType: windows} {
+test filename-3.12 {Tcl_GetPathType: windows} {testsetplatform} {
testsetplatform windows
file pathtype //foo/bar
} absolute
-test filename-3.13 {Tcl_GetPathType: windows} {
+test filename-3.13 {Tcl_GetPathType: windows} {testsetplatform} {
testsetplatform windows
file pathtype ~foo
} absolute
-test filename-3.14 {Tcl_GetPathType: windows} {
+test filename-3.14 {Tcl_GetPathType: windows} {testsetplatform} {
testsetplatform windows
file pathtype ~
} absolute
-test filename-3.15 {Tcl_GetPathType: windows} {
+test filename-3.15 {Tcl_GetPathType: windows} {testsetplatform} {
testsetplatform windows
file pathtype ~/foo
} absolute
-test filename-3.16 {Tcl_GetPathType: windows} {
+test filename-3.16 {Tcl_GetPathType: windows} {testsetplatform} {
testsetplatform windows
file pathtype ./~foo
} relative
-test filename-4.1 {Tcl_SplitPath: unix} {
+test filename-4.1 {Tcl_SplitPath: unix} {testsetplatform} {
testsetplatform unix
file split /
} {/}
-test filename-4.2 {Tcl_SplitPath: unix} {
+test filename-4.2 {Tcl_SplitPath: unix} {testsetplatform} {
testsetplatform unix
file split /foo
} {/ foo}
-test filename-4.3 {Tcl_SplitPath: unix} {
+test filename-4.3 {Tcl_SplitPath: unix} {testsetplatform} {
testsetplatform unix
file split /foo/bar
} {/ foo bar}
-test filename-4.4 {Tcl_SplitPath: unix} {
+test filename-4.4 {Tcl_SplitPath: unix} {testsetplatform} {
testsetplatform unix
file split /foo/bar/baz
} {/ foo bar baz}
-test filename-4.5 {Tcl_SplitPath: unix} {
+test filename-4.5 {Tcl_SplitPath: unix} {testsetplatform} {
testsetplatform unix
file split foo/bar
} {foo bar}
-test filename-4.6 {Tcl_SplitPath: unix} {
+test filename-4.6 {Tcl_SplitPath: unix} {testsetplatform} {
testsetplatform unix
file split ./foo/bar
} {. foo bar}
-test filename-4.7 {Tcl_SplitPath: unix} {
+test filename-4.7 {Tcl_SplitPath: unix} {testsetplatform} {
testsetplatform unix
file split /foo/../././foo/bar
} {/ foo .. . . foo bar}
-test filename-4.8 {Tcl_SplitPath: unix} {
+test filename-4.8 {Tcl_SplitPath: unix} {testsetplatform} {
testsetplatform unix
file split ../foo/bar
} {.. foo bar}
-test filename-4.9 {Tcl_SplitPath: unix} {
+test filename-4.9 {Tcl_SplitPath: unix} {testsetplatform} {
testsetplatform unix
file split {}
} {}
-test filename-4.10 {Tcl_SplitPath: unix} {
+test filename-4.10 {Tcl_SplitPath: unix} {testsetplatform} {
testsetplatform unix
file split .
} {.}
-test filename-4.11 {Tcl_SplitPath: unix} {
+test filename-4.11 {Tcl_SplitPath: unix} {testsetplatform} {
testsetplatform unix
file split ../
} {..}
-test filename-4.12 {Tcl_SplitPath: unix} {
+test filename-4.12 {Tcl_SplitPath: unix} {testsetplatform} {
testsetplatform unix
file split ../..
} {.. ..}
-test filename-4.13 {Tcl_SplitPath: unix} {
+test filename-4.13 {Tcl_SplitPath: unix} {testsetplatform} {
testsetplatform unix
file split //foo
} {/ foo}
-test filename-4.14 {Tcl_SplitPath: unix} {
+test filename-4.14 {Tcl_SplitPath: unix} {testsetplatform} {
testsetplatform unix
file split foo//bar
} {foo bar}
-test filename-4.15 {Tcl_SplitPath: unix} {
+test filename-4.15 {Tcl_SplitPath: unix} {testsetplatform} {
testsetplatform unix
file split ~foo
} {~foo}
-test filename-4.16 {Tcl_SplitPath: unix} {
+test filename-4.16 {Tcl_SplitPath: unix} {testsetplatform} {
testsetplatform unix
file split ~foo/~bar
} {~foo ./~bar}
-test filename-4.17 {Tcl_SplitPath: unix} {
+test filename-4.17 {Tcl_SplitPath: unix} {testsetplatform} {
testsetplatform unix
file split ~foo/~bar/~baz
} {~foo ./~bar ./~baz}
-test filename-4.18 {Tcl_SplitPath: unix} {
+test filename-4.18 {Tcl_SplitPath: unix} {testsetplatform} {
testsetplatform unix
file split foo/bar~/baz
} {foo bar~ baz}
-test filename-5.1 {Tcl_SplitPath: mac} {
+if {[tcltest::testConstraint testsetplatform]} {
+ testsetplatform $platform
+}
+
+test filename-4.19 {Tcl_SplitPath} {
+ 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 $oldDir
+ catch {file delete -force tildetmp}
+ list $res $err
+} {0 tildetmp/~tilde}
+
+test filename-5.1 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split a:b
} {a: b}
-test filename-5.2 {Tcl_SplitPath: mac} {
+test filename-5.2 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split a:b:c
} {a: b c}
-test filename-5.3 {Tcl_SplitPath: mac} {
+test filename-5.3 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split a:b:c:
} {a: b c}
-test filename-5.4 {Tcl_SplitPath: mac} {
+test filename-5.4 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split a:
} {a:}
-test filename-5.5 {Tcl_SplitPath: mac} {
+test filename-5.5 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split a::
} {a: ::}
-test filename-5.6 {Tcl_SplitPath: mac} {
+test filename-5.6 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split a:::
} {a: :: ::}
-test filename-5.7 {Tcl_SplitPath: mac} {
+test filename-5.7 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split :a
} {a}
-test filename-5.8 {Tcl_SplitPath: mac} {
+test filename-5.8 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split :a::
} {a ::}
-test filename-5.9 {Tcl_SplitPath: mac} {
+test filename-5.9 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split :
} {:}
-test filename-5.10 {Tcl_SplitPath: mac} {
+test filename-5.10 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split ::
} {::}
-test filename-5.11 {Tcl_SplitPath: mac} {
+test filename-5.11 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split :::
} {:: ::}
-test filename-5.12 {Tcl_SplitPath: mac} {
+test filename-5.12 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split a:::b
} {a: :: :: b}
-test filename-5.13 {Tcl_SplitPath: mac} {
+test filename-5.13 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split /a:b
} {/a: b}
-test filename-5.14 {Tcl_SplitPath: mac} {
+test filename-5.14 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split ~:
} {~:}
-test filename-5.15 {Tcl_SplitPath: mac} {
+test filename-5.15 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split ~/:
} {~/:}
-test filename-5.16 {Tcl_SplitPath: mac} {
+test filename-5.16 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split ~:foo
} {~: foo}
-test filename-5.17 {Tcl_SplitPath: mac} {
+test filename-5.17 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split ~/foo
} {~: foo}
-test filename-5.18 {Tcl_SplitPath: mac} {
+test filename-5.18 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split ~foo:
} {~foo:}
-test filename-5.19 {Tcl_SplitPath: mac} {
+test filename-5.19 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split a:~foo
} {a: :~foo}
-test filename-5.20 {Tcl_SplitPath: mac} {
+test filename-5.20 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split /
} {:/}
-test filename-5.21 {Tcl_SplitPath: mac} {
+test filename-5.21 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split a:b/c
} {a: :b/c}
-test filename-5.22 {Tcl_SplitPath: mac} {
+test filename-5.22 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split /foo
} {foo:}
-test filename-5.23 {Tcl_SplitPath: mac} {
+test filename-5.23 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split /a/b
} {a: b}
-test filename-5.24 {Tcl_SplitPath: mac} {
+test filename-5.24 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split /a/b/foo
} {a: b foo}
-test filename-5.25 {Tcl_SplitPath: mac} {
+test filename-5.25 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split a/b
} {a b}
-test filename-5.26 {Tcl_SplitPath: mac} {
+test filename-5.26 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split ./foo/bar
} {: foo bar}
-test filename-5.27 {Tcl_SplitPath: mac} {
+test filename-5.27 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split ../foo/bar
} {:: foo bar}
-test filename-5.28 {Tcl_SplitPath: mac} {
+test filename-5.28 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split {}
} {}
-test filename-5.29 {Tcl_SplitPath: mac} {
+test filename-5.29 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split .
} {:}
-test filename-5.30 {Tcl_SplitPath: mac} {
+test filename-5.30 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split ././
} {: :}
-test filename-5.31 {Tcl_SplitPath: mac} {
+test filename-5.31 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split ././.
} {: : :}
-test filename-5.32 {Tcl_SplitPath: mac} {
+test filename-5.32 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split ../
} {::}
-test filename-5.33 {Tcl_SplitPath: mac} {
+test filename-5.33 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split ..
} {::}
-test filename-5.34 {Tcl_SplitPath: mac} {
+test filename-5.34 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split ../..
} {:: ::}
-test filename-5.35 {Tcl_SplitPath: mac} {
+test filename-5.35 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split //foo
} {foo:}
-test filename-5.36 {Tcl_SplitPath: mac} {
+test filename-5.36 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split foo//bar
} {foo bar}
-test filename-5.37 {Tcl_SplitPath: mac} {
+test filename-5.37 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split ~foo
} {~foo:}
-test filename-5.38 {Tcl_SplitPath: mac} {
+test filename-5.38 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split ~
} {~:}
-test filename-5.39 {Tcl_SplitPath: mac} {
+test filename-5.39 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split foo
} {foo}
-test filename-5.40 {Tcl_SplitPath: mac} {
+test filename-5.40 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split ~/
} {~:}
-test filename-5.41 {Tcl_SplitPath: mac} {
+test filename-5.41 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split ~foo/~bar
} {~foo: :~bar}
-test filename-5.42 {Tcl_SplitPath: mac} {
+test filename-5.42 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split ~foo/~bar/~baz
} {~foo: :~bar :~baz}
-test filename-5.43 {Tcl_SplitPath: mac} {
+test filename-5.43 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split foo/bar~/baz
} {foo bar~ baz}
-test filename-5.44 {Tcl_SplitPath: mac} {
+test filename-5.44 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split a/../b
} {a :: b}
-test filename-5.45 {Tcl_SplitPath: mac} {
+test filename-5.45 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split a/../../b
} {a :: :: b}
-test filename-5.46 {Tcl_SplitPath: mac} {
+test filename-5.46 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split a/.././../b
} {a :: : :: b}
-test filename-5.47 {Tcl_SplitPath: mac} {
+test filename-5.47 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split /../bar
} {bar:}
-test filename-5.48 {Tcl_SplitPath: mac} {
+test filename-5.48 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split /./bar
} {bar:}
-test filename-5.49 {Tcl_SplitPath: mac} {
+test filename-5.49 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split //.//.././bar
} {bar:}
-test filename-5.50 {Tcl_SplitPath: mac} {
+test filename-5.50 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split /..
} {:/..}
-test filename-5.51 {Tcl_SplitPath: mac} {
+test filename-5.51 {Tcl_SplitPath: mac} {testsetplatform} {
testsetplatform mac
file split //.//.././
} {://.//.././}
-test filename-6.1 {Tcl_SplitPath: win} {
+test filename-6.1 {Tcl_SplitPath: win} {testsetplatform} {
testsetplatform win
file split /
} {/}
-test filename-6.2 {Tcl_SplitPath: win} {
+test filename-6.2 {Tcl_SplitPath: win} {testsetplatform} {
testsetplatform win
file split /foo
} {/ foo}
-test filename-6.3 {Tcl_SplitPath: win} {
+test filename-6.3 {Tcl_SplitPath: win} {testsetplatform} {
testsetplatform win
file split /foo/bar
} {/ foo bar}
-test filename-6.4 {Tcl_SplitPath: win} {
+test filename-6.4 {Tcl_SplitPath: win} {testsetplatform} {
testsetplatform win
file split /foo/bar/baz
} {/ foo bar baz}
-test filename-6.5 {Tcl_SplitPath: win} {
+test filename-6.5 {Tcl_SplitPath: win} {testsetplatform} {
testsetplatform win
file split foo/bar
} {foo bar}
-test filename-6.6 {Tcl_SplitPath: win} {
+test filename-6.6 {Tcl_SplitPath: win} {testsetplatform} {
testsetplatform win
file split ./foo/bar
} {. foo bar}
-test filename-6.7 {Tcl_SplitPath: win} {
+test filename-6.7 {Tcl_SplitPath: win} {testsetplatform} {
testsetplatform win
file split /foo/../././foo/bar
} {/ foo .. . . foo bar}
-test filename-6.8 {Tcl_SplitPath: win} {
+test filename-6.8 {Tcl_SplitPath: win} {testsetplatform} {
testsetplatform win
file split ../foo/bar
} {.. foo bar}
-test filename-6.9 {Tcl_SplitPath: win} {
+test filename-6.9 {Tcl_SplitPath: win} {testsetplatform} {
testsetplatform win
file split {}
} {}
-test filename-6.10 {Tcl_SplitPath: win} {
+test filename-6.10 {Tcl_SplitPath: win} {testsetplatform} {
testsetplatform win
file split .
} {.}
-test filename-6.11 {Tcl_SplitPath: win} {
+test filename-6.11 {Tcl_SplitPath: win} {testsetplatform} {
testsetplatform win
file split ../
} {..}
-test filename-6.12 {Tcl_SplitPath: win} {
+test filename-6.12 {Tcl_SplitPath: win} {testsetplatform} {
testsetplatform win
file split ../..
} {.. ..}
-test filename-6.13 {Tcl_SplitPath: win} {
+test filename-6.13 {Tcl_SplitPath: win} {testsetplatform} {
testsetplatform win
file split //foo
} {/ foo}
-test filename-6.14 {Tcl_SplitPath: win} {
+test filename-6.14 {Tcl_SplitPath: win} {testsetplatform} {
testsetplatform win
file split foo//bar
} {foo bar}
-test filename-6.15 {Tcl_SplitPath: win} {
+test filename-6.15 {Tcl_SplitPath: win} {testsetplatform} {
testsetplatform win
file split /\\/foo//bar
} {//foo/bar}
-test filename-6.16 {Tcl_SplitPath: win} {
+test filename-6.16 {Tcl_SplitPath: win} {testsetplatform} {
testsetplatform win
file split /\\/foo//bar
} {//foo/bar}
-test filename-6.17 {Tcl_SplitPath: win} {
+test filename-6.17 {Tcl_SplitPath: win} {testsetplatform} {
testsetplatform win
file split /\\/foo//bar
} {//foo/bar}
-test filename-6.18 {Tcl_SplitPath: win} {
+test filename-6.18 {Tcl_SplitPath: win} {testsetplatform} {
testsetplatform win
file split \\\\foo\\bar
} {//foo/bar}
-test filename-6.19 {Tcl_SplitPath: win} {
+test filename-6.19 {Tcl_SplitPath: win} {testsetplatform} {
testsetplatform win
file split \\\\foo\\bar/baz
} {//foo/bar baz}
-test filename-6.20 {Tcl_SplitPath: win} {
+test filename-6.20 {Tcl_SplitPath: win} {testsetplatform} {
testsetplatform win
file split c:/foo
} {c:/ foo}
-test filename-6.21 {Tcl_SplitPath: win} {
+test filename-6.21 {Tcl_SplitPath: win} {testsetplatform} {
testsetplatform win
file split c:foo
} {c: foo}
-test filename-6.22 {Tcl_SplitPath: win} {
+test filename-6.22 {Tcl_SplitPath: win} {testsetplatform} {
testsetplatform win
file split c:
} {c:}
-test filename-6.23 {Tcl_SplitPath: win} {
+test filename-6.23 {Tcl_SplitPath: win} {testsetplatform} {
testsetplatform win
file split c:\\
} {c:/}
-test filename-6.24 {Tcl_SplitPath: win} {
+test filename-6.24 {Tcl_SplitPath: win} {testsetplatform} {
testsetplatform win
file split c:/
} {c:/}
-test filename-6.25 {Tcl_SplitPath: win} {
+test filename-6.25 {Tcl_SplitPath: win} {testsetplatform} {
testsetplatform win
file split c:/./..
} {c:/ . ..}
-test filename-6.26 {Tcl_SplitPath: win} {
+test filename-6.26 {Tcl_SplitPath: win} {testsetplatform} {
testsetplatform win
file split ~foo
} {~foo}
-test filename-6.27 {Tcl_SplitPath: win} {
+test filename-6.27 {Tcl_SplitPath: win} {testsetplatform} {
testsetplatform win
file split ~foo/~bar
} {~foo ./~bar}
-test filename-6.28 {Tcl_SplitPath: win} {
+test filename-6.28 {Tcl_SplitPath: win} {testsetplatform} {
testsetplatform win
file split ~foo/~bar/~baz
} {~foo ./~bar ./~baz}
-test filename-6.29 {Tcl_SplitPath: win} {
+test filename-6.29 {Tcl_SplitPath: win} {testsetplatform} {
testsetplatform win
file split foo/bar~/baz
} {foo bar~ baz}
-test filename-6.30 {Tcl_SplitPath: win} {
+test filename-6.30 {Tcl_SplitPath: win} {testsetplatform} {
testsetplatform win
file split c:~foo
} {c: ./~foo}
-test filename-7.1 {Tcl_JoinPath: unix} {
+test filename-7.1 {Tcl_JoinPath: unix} {testsetplatform} {
testsetplatform unix
file join / a
} {/a}
-test filename-7.2 {Tcl_JoinPath: unix} {
+test filename-7.2 {Tcl_JoinPath: unix} {testsetplatform} {
testsetplatform unix
file join a b
} {a/b}
-test filename-7.3 {Tcl_JoinPath: unix} {
+test filename-7.3 {Tcl_JoinPath: unix} {testsetplatform} {
testsetplatform unix
file join /a c /b d
} {/b/d}
-test filename-7.4 {Tcl_JoinPath: unix} {
+test filename-7.4 {Tcl_JoinPath: unix} {testsetplatform} {
testsetplatform unix
file join /
} {/}
-test filename-7.5 {Tcl_JoinPath: unix} {
+test filename-7.5 {Tcl_JoinPath: unix} {testsetplatform} {
testsetplatform unix
file join a
} {a}
-test filename-7.6 {Tcl_JoinPath: unix} {
+test filename-7.6 {Tcl_JoinPath: unix} {testsetplatform} {
testsetplatform unix
file join {}
} {}
-test filename-7.7 {Tcl_JoinPath: unix} {
+test filename-7.7 {Tcl_JoinPath: unix} {testsetplatform} {
testsetplatform unix
file join /a/ b
} {/a/b}
-test filename-7.8 {Tcl_JoinPath: unix} {
+test filename-7.8 {Tcl_JoinPath: unix} {testsetplatform} {
testsetplatform unix
file join /a// b
} {/a/b}
-test filename-7.9 {Tcl_JoinPath: unix} {
+test filename-7.9 {Tcl_JoinPath: unix} {testsetplatform} {
testsetplatform unix
file join /a/./../. b
} {/a/./.././b}
-test filename-7.10 {Tcl_JoinPath: unix} {
+test filename-7.10 {Tcl_JoinPath: unix} {testsetplatform} {
testsetplatform unix
file join ~ a
} {~/a}
-test filename-7.11 {Tcl_JoinPath: unix} {
+test filename-7.11 {Tcl_JoinPath: unix} {testsetplatform} {
testsetplatform unix
file join ~a ~b
} {~b}
-test filename-7.12 {Tcl_JoinPath: unix} {
+test filename-7.12 {Tcl_JoinPath: unix} {testsetplatform} {
testsetplatform unix
file join ./~a b
} {./~a/b}
-test filename-7.13 {Tcl_JoinPath: unix} {
+test filename-7.13 {Tcl_JoinPath: unix} {testsetplatform} {
testsetplatform unix
file join ./~a ~b
} {~b}
-test filename-7.14 {Tcl_JoinPath: unix} {
+test filename-7.14 {Tcl_JoinPath: unix} {testsetplatform} {
testsetplatform unix
file join ./~a ./~b
} {./~a/~b}
-test filename-7.15 {Tcl_JoinPath: unix} {
+test filename-7.15 {Tcl_JoinPath: unix} {testsetplatform} {
testsetplatform unix
file join a . b
} {a/./b}
-test filename-7.16 {Tcl_JoinPath: unix} {
+test filename-7.16 {Tcl_JoinPath: unix} {testsetplatform} {
testsetplatform unix
file join a . ./~b
} {a/./~b}
-test filename-7.17 {Tcl_JoinPath: unix} {
+test filename-7.17 {Tcl_JoinPath: unix} {testsetplatform} {
testsetplatform unix
file join //a b
} {/a/b}
-test filename-7.18 {Tcl_JoinPath: unix} {
+test filename-7.18 {Tcl_JoinPath: unix} {testsetplatform} {
testsetplatform unix
file join /// a b
} {/a/b}
-test filename-8.1 {Tcl_JoinPath: mac} {
+test filename-8.1 {Tcl_JoinPath: mac} {testsetplatform} {
testsetplatform mac
file join a b
} {:a:b}
-test filename-8.2 {Tcl_JoinPath: mac} {
+test filename-8.2 {Tcl_JoinPath: mac} {testsetplatform} {
testsetplatform mac
file join :a b
} {:a:b}
-test filename-8.3 {Tcl_JoinPath: mac} {
+test filename-8.3 {Tcl_JoinPath: mac} {testsetplatform} {
testsetplatform mac
file join a b:
} {b:}
-test filename-8.4 {Tcl_JoinPath: mac} {
+test filename-8.4 {Tcl_JoinPath: mac} {testsetplatform} {
testsetplatform mac
file join a: :b
} {a:b}
-test filename-8.5 {Tcl_JoinPath: mac} {
+test filename-8.5 {Tcl_JoinPath: mac} {testsetplatform} {
testsetplatform mac
file join a: :b:
} {a:b}
-test filename-8.6 {Tcl_JoinPath: mac} {
+test filename-8.6 {Tcl_JoinPath: mac} {testsetplatform} {
testsetplatform mac
file join a :: b
} {:a::b}
-test filename-8.7 {Tcl_JoinPath: mac} {
+test filename-8.7 {Tcl_JoinPath: mac} {testsetplatform} {
testsetplatform mac
file join a :: :: b
} {:a:::b}
-test filename-8.8 {Tcl_JoinPath: mac} {
+test filename-8.8 {Tcl_JoinPath: mac} {testsetplatform} {
testsetplatform mac
file join a ::: b
} {:a:::b}
-test filename-8.9 {Tcl_JoinPath: mac} {
+test filename-8.9 {Tcl_JoinPath: mac} {testsetplatform} {
testsetplatform mac
file join a: b:
} {b:}
-test filename-8.10 {Tcl_JoinPath: mac} {
+test filename-8.10 {Tcl_JoinPath: mac} {testsetplatform} {
testsetplatform mac
file join /a/b
} {a:b}
-test filename-8.11 {Tcl_JoinPath: mac} {
+test filename-8.11 {Tcl_JoinPath: mac} {testsetplatform} {
testsetplatform mac
file join /a/b c/d
} {a:b:c:d}
-test filename-8.12 {Tcl_JoinPath: mac} {
+test filename-8.12 {Tcl_JoinPath: mac} {testsetplatform} {
testsetplatform mac
file join /a/b :c:d
} {a:b:c:d}
-test filename-8.13 {Tcl_JoinPath: mac} {
+test filename-8.13 {Tcl_JoinPath: mac} {testsetplatform} {
testsetplatform mac
file join ~ foo
} {~:foo}
-test filename-8.14 {Tcl_JoinPath: mac} {
+test filename-8.14 {Tcl_JoinPath: mac} {testsetplatform} {
testsetplatform mac
file join :: ::
} {:::}
-test filename-8.15 {Tcl_JoinPath: mac} {
+test filename-8.15 {Tcl_JoinPath: mac} {testsetplatform} {
testsetplatform mac
file join a: ::
} {a::}
-test filename-8.16 {Tcl_JoinPath: mac} {
+test filename-8.16 {Tcl_JoinPath: mac} {testsetplatform} {
testsetplatform mac
file join a {} b
} {:a:b}
-test filename-8.17 {Tcl_JoinPath: mac} {
+test filename-8.17 {Tcl_JoinPath: mac} {testsetplatform} {
testsetplatform mac
file join a::: b
} {a:::b}
-test filename-8.18 {Tcl_JoinPath: mac} {
+test filename-8.18 {Tcl_JoinPath: mac} {testsetplatform} {
testsetplatform mac
file join a : : :
} {:a}
-test filename-8.19 {Tcl_JoinPath: mac} {
+test filename-8.19 {Tcl_JoinPath: mac} {testsetplatform} {
testsetplatform mac
file join :
} {:}
-test filename-8.20 {Tcl_JoinPath: mac} {
+test filename-8.20 {Tcl_JoinPath: mac} {testsetplatform} {
testsetplatform mac
file join : a
} {:a}
-test filename-8.21 {Tcl_JoinPath: mac} {
+test filename-8.21 {Tcl_JoinPath: mac} {testsetplatform} {
testsetplatform mac
file join a: :b/c
} {a:b/c}
-test filename-8.22 {Tcl_JoinPath: mac} {
+test filename-8.22 {Tcl_JoinPath: mac} {testsetplatform} {
testsetplatform mac
file join :a :b/c
} {:a:b/c}
-test filename-9.1 {Tcl_JoinPath: win} {
+test filename-9.1 {Tcl_JoinPath: win} {testsetplatform} {
testsetplatform win
file join a b
} {a/b}
-test filename-9.2 {Tcl_JoinPath: win} {
+test filename-9.2 {Tcl_JoinPath: win} {testsetplatform} {
testsetplatform win
file join /a b
} {/a/b}
-test filename-9.3 {Tcl_JoinPath: win} {
+test filename-9.3 {Tcl_JoinPath: win} {testsetplatform} {
testsetplatform win
file join /a /b
} {/b}
-test filename-9.4 {Tcl_JoinPath: win} {
+test filename-9.4 {Tcl_JoinPath: win} {testsetplatform} {
testsetplatform win
file join c: foo
} {c:foo}
-test filename-9.5 {Tcl_JoinPath: win} {
+test filename-9.5 {Tcl_JoinPath: win} {testsetplatform} {
testsetplatform win
file join c:/ foo
} {c:/foo}
-test filename-9.6 {Tcl_JoinPath: win} {
+test filename-9.6 {Tcl_JoinPath: win} {testsetplatform} {
testsetplatform win
file join c:\\bar foo
} {c:/bar/foo}
-test filename-9.7 {Tcl_JoinPath: win} {
+test filename-9.7 {Tcl_JoinPath: win} {testsetplatform} {
testsetplatform win
file join /foo c:bar
} {c:bar}
-test filename-9.8 {Tcl_JoinPath: win} {
+test filename-9.8 {Tcl_JoinPath: win} {testsetplatform} {
testsetplatform win
file join ///host//share dir
} {//host/share/dir}
-test filename-9.9 {Tcl_JoinPath: win} {
+test filename-9.9 {Tcl_JoinPath: win} {testsetplatform} {
testsetplatform win
file join ~ foo
} {~/foo}
-test filename-9.10 {Tcl_JoinPath: win} {
+test filename-9.10 {Tcl_JoinPath: win} {testsetplatform} {
testsetplatform win
file join ~/~foo
} {~/~foo}
-test filename-9.11 {Tcl_JoinPath: win} {
+test filename-9.11 {Tcl_JoinPath: win} {testsetplatform} {
testsetplatform win
file join ~ ./~foo
} {~/~foo}
-test filename-9.12 {Tcl_JoinPath: win} {
+test filename-9.12 {Tcl_JoinPath: win} {testsetplatform} {
testsetplatform win
file join / ~foo
} {~foo}
-test filename-9.13 {Tcl_JoinPath: win} {
+test filename-9.13 {Tcl_JoinPath: win} {testsetplatform} {
testsetplatform win
file join ./a/ b c
} {./a/b/c}
-test filename-9.14 {Tcl_JoinPath: win} {
+test filename-9.14 {Tcl_JoinPath: win} {testsetplatform} {
testsetplatform win
file join ./~a/ b c
} {./~a/b/c}
-test filename-9.15 {Tcl_JoinPath: win} {
+test filename-9.15 {Tcl_JoinPath: win} {testsetplatform} {
testsetplatform win
file join // host share path
} {/host/share/path}
-test filename-9.16 {Tcl_JoinPath: win} {
+test filename-9.16 {Tcl_JoinPath: win} {testsetplatform} {
testsetplatform win
file join foo . bar
} {foo/./bar}
-test filename-9.17 {Tcl_JoinPath: win} {
+test filename-9.17 {Tcl_JoinPath: win} {testsetplatform} {
testsetplatform win
file join foo .. bar
} {foo/../bar}
-test filename-9.18 {Tcl_JoinPath: win} {
+test filename-9.18 {Tcl_JoinPath: win} {testsetplatform} {
testsetplatform win
file join foo/./bar
} {foo/./bar}
-test filename-10.1 {Tcl_TranslateFileName} {
+test filename-10.1 {Tcl_TranslateFileName} {testsetplatform} {
testsetplatform unix
list [catch {testtranslatefilename foo} msg] $msg
} {0 foo}
-test filename-10.2 {Tcl_TranslateFileName} {
+test filename-10.2 {Tcl_TranslateFileName} {testsetplatform} {
testsetplatform windows
list [catch {testtranslatefilename {c:/foo}} msg] $msg
} {0 {c:\foo}}
-test filename-10.3 {Tcl_TranslateFileName} {
+test filename-10.3 {Tcl_TranslateFileName} {testsetplatform} {
testsetplatform windows
list [catch {testtranslatefilename {c:/\\foo/}} msg] $msg
} {0 {c:\foo}}
-test filename-10.4 {Tcl_TranslateFileName} {
+test filename-10.4 {Tcl_TranslateFileName} {testsetplatform} {
testsetplatform mac
list [catch {testtranslatefilename foo} msg] $msg
} {0 :foo}
-test filename-10.5 {Tcl_TranslateFileName} {
+test filename-10.5 {Tcl_TranslateFileName} {testsetplatform} {
testsetplatform mac
list [catch {testtranslatefilename :~foo} msg] $msg
} {0 :~foo}
-test filename-10.6 {Tcl_TranslateFileName} {
+test filename-10.6 {Tcl_TranslateFileName} {testsetplatform} {
global env
set temp $env(HOME)
set env(HOME) "/home/test"
@@ -897,7 +925,7 @@ test filename-10.6 {Tcl_TranslateFileName} {
set env(HOME) $temp
set result
} {0 /home/test/foo}
-test filename-10.7 {Tcl_TranslateFileName} {
+test filename-10.7 {Tcl_TranslateFileName} {testsetplatform} {
global env
set temp $env(HOME)
unset env(HOME)
@@ -906,7 +934,7 @@ test filename-10.7 {Tcl_TranslateFileName} {
set env(HOME) $temp
set result
} {1 {couldn't find HOME environment variable to expand path}}
-test filename-10.8 {Tcl_TranslateFileName} {
+test filename-10.8 {Tcl_TranslateFileName} {testsetplatform} {
global env
set temp $env(HOME)
set env(HOME) "/home/test"
@@ -915,7 +943,7 @@ test filename-10.8 {Tcl_TranslateFileName} {
set env(HOME) $temp
set result
} {0 /home/test}
-test filename-10.9 {Tcl_TranslateFileName} {
+test filename-10.9 {Tcl_TranslateFileName} {testsetplatform} {
global env
set temp $env(HOME)
set env(HOME) "/home/test/"
@@ -924,7 +952,7 @@ test filename-10.9 {Tcl_TranslateFileName} {
set env(HOME) $temp
set result
} {0 /home/test}
-test filename-10.10 {Tcl_TranslateFileName} {
+test filename-10.10 {Tcl_TranslateFileName} {testsetplatform} {
global env
set temp $env(HOME)
set env(HOME) "/home/test/"
@@ -933,7 +961,7 @@ test filename-10.10 {Tcl_TranslateFileName} {
set env(HOME) $temp
set result
} {0 /home/test/foo}
-test filename-10.11 {Tcl_TranslateFileName} {
+test filename-10.11 {Tcl_TranslateFileName} {testsetplatform} {
global env
set temp $env(HOME)
set env(HOME) "Root:"
@@ -942,7 +970,7 @@ test filename-10.11 {Tcl_TranslateFileName} {
set env(HOME) $temp
set result
} {0 Root:foo}
-test filename-10.12 {Tcl_TranslateFileName} {
+test filename-10.12 {Tcl_TranslateFileName} {testsetplatform} {
global env
set temp $env(HOME)
set env(HOME) "Root:home"
@@ -951,7 +979,7 @@ test filename-10.12 {Tcl_TranslateFileName} {
set env(HOME) $temp
set result
} {0 Root:home:foo}
-test filename-10.13 {Tcl_TranslateFileName} {
+test filename-10.13 {Tcl_TranslateFileName} {testsetplatform} {
global env
set temp $env(HOME)
set env(HOME) "Root:home"
@@ -960,7 +988,7 @@ test filename-10.13 {Tcl_TranslateFileName} {
set env(HOME) $temp
set result
} {0 Root:home::foo}
-test filename-10.14 {Tcl_TranslateFileName} {
+test filename-10.14 {Tcl_TranslateFileName} {testsetplatform} {
global env
set temp $env(HOME)
set env(HOME) "Root:home"
@@ -969,7 +997,7 @@ test filename-10.14 {Tcl_TranslateFileName} {
set env(HOME) $temp
set result
} {0 Root:home}
-test filename-10.15 {Tcl_TranslateFileName} {
+test filename-10.15 {Tcl_TranslateFileName} {testsetplatform} {
global env
set temp $env(HOME)
set env(HOME) "Root:home:"
@@ -978,7 +1006,7 @@ test filename-10.15 {Tcl_TranslateFileName} {
set env(HOME) $temp
set result
} {0 Root:home::foo}
-test filename-10.16 {Tcl_TranslateFileName} {
+test filename-10.16 {Tcl_TranslateFileName} {testsetplatform} {
global env
set temp $env(HOME)
set env(HOME) "Root:home::"
@@ -987,7 +1015,7 @@ test filename-10.16 {Tcl_TranslateFileName} {
set env(HOME) $temp
set result
} {0 Root:home:::foo}
-test filename-10.17 {Tcl_TranslateFileName} {
+test filename-10.17 {Tcl_TranslateFileName} {testsetplatform} {
global env
set temp $env(HOME)
set env(HOME) "\\home\\"
@@ -996,7 +1024,7 @@ test filename-10.17 {Tcl_TranslateFileName} {
set env(HOME) $temp
set result
} {0 {\home\foo}}
-test filename-10.18 {Tcl_TranslateFileName} {
+test filename-10.18 {Tcl_TranslateFileName} {testsetplatform} {
global env
set temp $env(HOME)
set env(HOME) "\\home\\"
@@ -1005,7 +1033,7 @@ test filename-10.18 {Tcl_TranslateFileName} {
set env(HOME) $temp
set result
} {0 {\home\foo\bar}}
-test filename-10.19 {Tcl_TranslateFileName} {
+test filename-10.19 {Tcl_TranslateFileName} {testsetplatform} {
global env
set temp $env(HOME)
set env(HOME) "c:"
@@ -1014,10 +1042,10 @@ test filename-10.19 {Tcl_TranslateFileName} {
set env(HOME) $temp
set result
} {0 c:foo}
-test filename-10.20 {Tcl_TranslateFileName} {
+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} {
+test filename-10.21 {Tcl_TranslateFileName} {testsetplatform} {
global env
set temp $env(HOME)
set env(HOME) "c:\\"
@@ -1026,12 +1054,14 @@ test filename-10.21 {Tcl_TranslateFileName} {
set env(HOME) $temp
set result
} {0 {c:\foo}}
-test filename-10.22 {Tcl_TranslateFileName} {
+test filename-10.22 {Tcl_TranslateFileName} {testsetplatform} {
testsetplatform windows
list [catch {testtranslatefilename foo//bar} msg] $msg
} {0 {foo\bar}}
-testsetplatform $platform
+if {[tcltest::testConstraint testsetplatform]} {
+ testsetplatform $platform
+}
test filename-10.23 {Tcl_TranslateFileName} {unixOnly nonPortable} {
# this test fails if ~ouster is not /home/ouster
@@ -1048,7 +1078,7 @@ test filename-11.1 {Tcl_GlobCmd} {
} {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, -types, or --}}
+} {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 ...?"}}
@@ -1067,19 +1097,19 @@ test filename-11.7 {Tcl_GlobCmd} {
test filename-11.8 {Tcl_GlobCmd} {
list [catch {glob -nocomplain -- -nocomplain} msg] $msg
} {0 {}}
-test filename-11.9 {Tcl_GlobCmd} {
+test filename-11.9 {Tcl_GlobCmd} {testsetplatform} {
testsetplatform unix
list [catch {glob ~\\xyqrszzz/bar} msg] $msg
} {1 {user "\xyqrszzz" doesn't exist}}
-test filename-11.10 {Tcl_GlobCmd} {
+test filename-11.10 {Tcl_GlobCmd} {testsetplatform} {
testsetplatform unix
list [catch {glob -nocomplain ~\\xyqrszzz/bar} msg] $msg
} {0 {}}
-test filename-11.11 {Tcl_GlobCmd} {
+test filename-11.11 {Tcl_GlobCmd} {testsetplatform} {
testsetplatform unix
list [catch {glob ~xyqrszzz\\/\\bar} msg] $msg
} {1 {user "xyqrszzz" doesn't exist}}
-test filename-11.12 {Tcl_GlobCmd} {
+test filename-11.12 {Tcl_GlobCmd} {testsetplatform} {
testsetplatform unix
set home $env(HOME)
unset env(HOME)
@@ -1088,13 +1118,17 @@ test filename-11.12 {Tcl_GlobCmd} {
set x
} {1 {couldn't find HOME environment variable to expand path}}
-testsetplatform $platform
+if {[tcltest::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)]]
+set oldpwd [pwd]
set oldhome $env(HOME)
+cd [temporaryDirectory]
set env(HOME) [pwd]
file delete -force globTest
file mkdir globTest/a1/b1
@@ -1124,26 +1158,126 @@ test filename-11.16 {Tcl_GlobCmd} {
set globname "globTest"
set horribleglobname "glob\[\{Test"
-test filename-11.17 {Tcl_GlobCmd} {
+test filename-11.17 {Tcl_GlobCmd} {unixOnly} {
+ list [catch {lsort [glob -directory $globname *]} msg] $msg
+} [list 0 [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]]]]
+test filename-11.17.1 {Tcl_GlobCmd} {pcOnly macOnly} {
list [catch {lsort [glob -directory $globname *]} msg] $msg
} [list 0 [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]]]]
-test filename-11.18 {Tcl_GlobCmd} {
+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
+ } else {
+ tcltest::testConstraint linkDirectory 0
+ }
+} else {
+ tcltest::testConstraint linkDirectory 1
+}
+test filename-11.17.2 {Tcl_GlobCmd} {notRoot linkDirectory} {
+ 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
+ }
+ file delete [file join $globname link]
+ set ret
+} [list 0 [lsort [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} {
+ 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
+ }
+ 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} {
+ 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
+ }
+ file delete [file join $globname link]
+ set ret
+} [list 0 [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]]]
+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.18 {Tcl_GlobCmd} {unixOnly} {
+ list [catch {lsort [glob -path $globname/ *]} msg] $msg
+} [list 0 [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]]]]
+test filename-11.18.1 {Tcl_GlobCmd} {pcOnly macOnly} {
list [catch {lsort [glob -path $globname/ *]} msg] $msg
} [list 0 [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]]]]
+test filename-11.19 {Tcl_GlobCmd} {unixOnly} {
+ 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 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]]]]
-test filename-11.19 {Tcl_GlobCmd} {
+test filename-11.19.1 {Tcl_GlobCmd} {pcOnly macOnly} {
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]\
[file join $globname a3]\
[file join $globname "weird name.c"]\
[file join $globname x,z1.c]\
@@ -1158,18 +1292,32 @@ test filename-11.21 {Tcl_GlobCmd} {
list [catch {lsort [glob -type d -path $globname *]} msg] $msg
} [list 0 [lsort [list $globname]]]
+# 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} {
+test filename-11.22 {Tcl_GlobCmd} {unixOnly} {
+ list [catch {lsort [glob -dir $globname *]} msg] $msg
+} [list 0 [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]]]]
+test filename-11.22.1 {Tcl_GlobCmd} {pcOnly macOnly} {
list [catch {lsort [glob -dir $globname *]} msg] $msg
} [list 0 [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]]]]
-test filename-11.23 {Tcl_GlobCmd} {
+test filename-11.23 {Tcl_GlobCmd} {unixOnly} {
list [catch {lsort [glob -path $globname/ *]} msg] $msg
} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
[file join $globname a3]\
@@ -1177,10 +1325,29 @@ test filename-11.23 {Tcl_GlobCmd} {
[file join $globname x,z1.c]\
[file join $globname x1.c]\
[file join $globname y1.c] [file join $globname z1.c]]]]
-test filename-11.24 {Tcl_GlobCmd} {
+test filename-11.23.1 {Tcl_GlobCmd} {pcOnly macOnly} {
+ list [catch {lsort [glob -path $globname/ *]} msg] $msg
+} [list 0 [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]]]]
+test filename-11.24 {Tcl_GlobCmd} {unixOnly} {
+ 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 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]]]]
+test filename-11.24.1 {Tcl_GlobCmd} {pcOnly macOnly} {
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]\
[file join $globname a3]\
[file join $globname "weird name.c"]\
[file join $globname x,z1.c]\
@@ -1191,6 +1358,16 @@ test filename-11.25 {Tcl_GlobCmd} {
} [list 0 [lsort [list [file join $globname a1]\
[file join $globname a2]\
[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]]]]
+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]]]]
test filename-11.26 {Tcl_GlobCmd} {
list [catch {glob -type d -path $globname *} msg] $msg
} [list 0 [list $globname]]
@@ -1221,7 +1398,65 @@ test filename-11.34 {Tcl_GlobCmd} {
} {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, -types, or --}}
+} {1 {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.37 {Tcl_GlobCmd} {
+ list [catch {glob -type d -tails -path $globname *} msg] $msg
+} [list 0 [list $globname]]
+test filename-11.38 {Tcl_GlobCmd} {
+ list [catch {glob -tails -path $globname *} msg] $msg
+} [list 0 [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} {
+ 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} {
+ set res1 ""
+ set res2 ""
+ catch {
+ set res1 [glob -dir [lindex [file volumes] 0] -tails *]
+ }
+ catch {
+ set tmpd [pwd]
+ cd [lindex [file volumes] 0]
+ set res2 [glob *]
+ cd $tmpd
+ }
+ expr {$res1 == $res2}
+} {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}}
file rename $horribleglobname globTest
set globname globTest
@@ -1230,17 +1465,44 @@ 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 ""}}
+test filename-12.1.2 {simple globbing} {unixOrPc} {
+ list [catch {glob -types d {}} msg] $msg
+} {0 .}
+test filename-12.1.3 {simple globbing} {unixOnly} {
+ list [catch {glob -types hidden {}} msg] $msg
+} {0 .}
+test filename-12.1.4 {simple globbing} {pcOnly} {
+ list [catch {glob -types hidden {}} msg] $msg
+} {1 {no files matched glob pattern ""}}
+test filename-12.1.5 {simple globbing} {pcOnly} {
+ list [catch {glob -types hidden c:/} msg] $msg
+} {1 {no files matched glob pattern "c:/"}}
+test filename-12.1.6 {simple globbing} {pcOnly} {
+ list [catch {glob c:/} msg] $msg
+} {0 c:/}
test filename-12.2 {simple globbing} {macOnly} {
list [catch {glob {}} msg] $msg
} {0 :}
+test filename-12.2.1 {simple globbing} {macOnly} {
+ list [catch {glob -types f {}} msg] $msg
+} {1 {no files matched glob pattern ""}}
+test filename-12.2.2 {simple globbing} {macOnly} {
+ list [catch {glob -types d {}} msg] $msg
+} {0 :}
+test filename-12.2.3 {simple globbing} {macOnly} {
+ list [catch {glob -types hidden {}} msg] $msg
+} {1 {no files matched glob pattern ""}}
test filename-12.3 {simple globbing} {
list [catch {glob -nocomplain \{a1,a2\}} msg] $msg
} {0 {}}
if {$tcl_platform(platform) == "macintosh"} {
- set globPreResult :globTest:
+ set globPreResult :globTest:
} else {
- set globPreResult globTest/
+ set globPreResult globTest/
}
set x1 x1.c
set y1 y1.c
@@ -1333,15 +1595,31 @@ test filename-14.3 {asterisks, question marks, and brackets} {unixOrPc} {
test filename-14.4 {asterisks, question marks, and brackets} {macOnly} {
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} {
lsort [glob */*/*/*.c]
} {globTest/a1/b1/x2.c globTest/a1/b2/y2.c}
test filename-14.6 {asterisks, question marks, and brackets} {macOnly} {
lsort [glob */*/*/*.c]
} {:globTest:a1:b1:x2.c :globTest:a1:b2:y2.c}
-test filename-14.7 {asterisks, question marks, and brackets} {unixOrPc} {
+
+# Reset to where we were
+cd $savepwd
+file rename [file join globTestContext globTest] globTest
+file delete globTestContext
+
+test filename-14.7 {asterisks, question marks, and brackets} {unixOnly} {
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}
+test filename-14.7.1 {asterisks, question marks, and brackets} {pcOnly} {
+ lsort [glob globTest/*]
+} {globTest/.1 globTest/a1 globTest/a2 globTest/a3 {globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}
test filename-14.8 {asterisks, question marks, and brackets} {macOnly} {
lsort [glob globTest/*]
} {:globTest:.1 :globTest:a1 :globTest:a2 :globTest:a3 {:globTest:weird name.c} :globTest:x,z1.c :globTest:x1.c :globTest:y1.c :globTest:z1.c}
@@ -1398,9 +1676,17 @@ test filename-14.23 {slash globbing} {unixOrPc} {
test filename-14.24 {slash globbing} {pcOnly} {
glob {\\}
} /
-test filename-14.25 {type specific globbing} {
+test filename-14.25 {type specific globbing} {unixOnly} {
+ list [catch {lsort [glob -dir globTest -types f *]} msg] $msg
+} [list 0 [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]]]]
+test filename-14.25.1 {type specific globbing} {pcOnly macOnly} {
list [catch {lsort [glob -dir globTest -types f *]} msg] $msg
} [list 0 [lsort [list \
+ [file join $globname .1]\
[file join $globname "weird name.c"]\
[file join $globname x,z1.c]\
[file join $globname x1.c]\
@@ -1415,7 +1701,7 @@ unset globname
# On some systems, like AFS, "000" protection doesn't prevent
# access by owner, so the following test is not portable.
-catch {exec chmod 000 globTest/a1}
+catch {file attributes globTest/a1 -permissions 0000}
test filename-15.1 {unix specific globbing} {unixOnly nonPortable} {
string tolower [list [catch {glob globTest/a1/*} msg] $msg $errorCode]
} {1 {couldn't read directory "globtest/a1": permission denied} {posix eacces {permission denied}}}
@@ -1423,20 +1709,26 @@ test filename-15.2 {unix specific no complain: no errors} {unixOnly nonPortable}
glob -nocomplain globTest/a1/*
} {}
test filename-15.3 {unix specific no complain: no errors, good result} \
- {unixOnly nonPortable knownBug} {
+ {unixOnly nonPortable} {
# test fails because if an error occur , the interp's result
# is reset...
glob -nocomplain globTest/a2 globTest/a1/* globTest/a3
} {globTest/a2 globTest/a3}
-catch {exec chmod 755 globTest/a1}
+catch {file attributes globTest/a1 -permissions 0755}
test filename-15.4 {unix specific no complain: no errors, good result} \
- {unixOnly nonPortable knownBug} {
+ {unixOnly 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
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.5 {unix specific globbing} {unixOnly nonPortable} {
glob ~ouster/.csh*
} "/home/ouster/.cshrc"
@@ -1448,17 +1740,15 @@ test filename-15.6 {unix specific globbing} {unixOnly} {
set result [list [catch {glob ~} msg] $msg]
set env(HOME) $temp
set result
-} [list 0 [list [glob ~]/globTest/odd\\\[\]*?\{\}name]]
-catch {exec rm -f globTest/odd\\\[\]*?\{\}name}
-
+} [list 0 [list [lindex [glob ~] 0]/globTest/odd\\\[\]*?\{\}name]]
+catch {file delete -force globTest/odd\\\[\]*?\{\}name}
# The following tests are only valid for Windows systems.
-set temp [pwd]
-catch {cd c:/}
-catch {
+set oldDir [pwd]
+if {$::tcltest::testConstraints(pcOnly)} {
cd c:/
- removeDirectory globTest
- makeDirectory globTest
+ 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]
@@ -1477,13 +1767,13 @@ test filename-16.4 {windows specific globbing} {pcOnly} {
glob c:/
} c:/
test filename-16.5 {windows specific globbing} {pcOnly} {
- glob c:*Test
+ glob c:*bTest
} c:globTest
test filename-16.6 {windows specific globbing} {pcOnly} {
- glob c:\\\\*Test
+ glob c:\\\\*bTest
} c:/globTest
test filename-16.7 {windows specific globbing} {pcOnly} {
- glob c:/*Test
+ glob c:/*bTest
} c:/globTest
test filename-16.8 {windows specific globbing} {pcOnly} {
lsort [glob c:globTest/*.bat]
@@ -1508,42 +1798,33 @@ if {[catch {cd //[info hostname]/c}]} {
test filename-16.12 {windows specific globbing} {pcOnly sharedCdrive} {
cd //[info hostname]/c
- removeDirectory globTest
- makeDirectory globTest
- close [open globTest/x1.BAT w]
- close [open globTest/y1.Bat w]
- close [open globTest/z1.bat w]
glob //[info hostname]/c/*Test
} //[info hostname]/c/globTest
test filename-16.13 {windows specific globbing} {pcOnly sharedCdrive} {
cd //[info hostname]/c
- removeDirectory globTest
- makeDirectory globTest
- close [open globTest/x1.BAT w]
- close [open globTest/y1.Bat w]
- close [open globTest/z1.bat w]
glob "\\\\\\\\[info hostname]\\\\c\\\\*Test"
} //[info hostname]/c/globTest
+test filename-16.14 {windows specific globbing} {pcOnly} {
+ cd [lindex [glob -types d -dir C:/ *] 0]
+ expr {[lsearch -exact [glob {{.,*}*}] ".."] != -1}
+} {1}
+test filename-16.15 {windows specific globbing} {pcOnly} {
+ cd [lindex [glob -types d -dir C:/ *] 0]
+ glob ..
+} {..}
+test filename-16.16 {windows specific globbing} {pcOnly} {
+ file tail [lindex [glob "[lindex [glob -types d -dir C:/ *] 0]/.."] 0]
+} {..}
# cleanup
-file delete -force //[info hostname]/c/globTest
-cd $temp
+catch {file delete -force C:/globTest}
file delete -force globTest
+cd $oldpwd
set env(HOME) $oldhome
-testsetplatform $platform
-catch {unset oldhome platform temp result}
+if {[tcltest::testConstraint testsetplatform]} {
+ testsetplatform $platform
+ catch {unset platform}
+}
+catch {unset oldhome temp result}
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tcl/tests/fileSystem.test b/tcl/tests/fileSystem.test
new file mode 100644
index 00000000000..2185dbf0876
--- /dev/null
+++ b/tcl/tests/fileSystem.test
@@ -0,0 +1,396 @@
+# 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.
+#
+# 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.
+
+package require tcltest
+namespace eval ::tcl::test::fileSystem {
+
+ catch {
+ namespace import ::tcltest::cleanupTests
+ namespace import ::tcltest::makeDirectory
+ namespace import ::tcltest::makeFile
+ namespace import ::tcltest::removeDirectory
+ namespace import ::tcltest::removeFile
+ namespace import ::tcltest::test
+ }
+
+ catch {
+ file delete -force link.file
+ file delete -force dir.link
+ file delete -force [file join dir.file linkinside.file]
+ }
+
+makeFile "test file" gorp.file
+makeDirectory dir.file
+makeFile "test file in directory" [file join dir.file inside.file]
+
+if {[catch {
+ file link link.file gorp.file
+ file link \
+ [file join dir.file linkinside.file] \
+ [file join dir.file inside.file]
+ file link dir.link dir.file
+}]} {
+ tcltest::testConstraint hasLinks 0
+} else {
+ tcltest::testConstraint hasLinks 1
+}
+
+test filesystem-1.0 {link normalisation} {hasLinks} {
+ string equal [file normalize gorp.file] [file normalize link.file]
+} {0}
+
+test filesystem-1.1 {link normalisation} {hasLinks} {
+ string equal [file normalize dir.file] [file normalize dir.link]
+} {0}
+
+test filesystem-1.2 {link normalisation} {hasLinks macOrUnix} {
+ string equal [file normalize [file join gorp.file foo]] \
+ [file normalize [file join link.file foo]]
+} {1}
+
+test filesystem-1.3 {link normalisation} {hasLinks} {
+ string equal [file normalize [file join dir.file foo]] \
+ [file normalize [file join dir.link foo]]
+} {1}
+
+test filesystem-1.4 {link normalisation} {hasLinks} {
+ string equal [file normalize [file join dir.file inside.file]] \
+ [file normalize [file join dir.link inside.file]]
+} {1}
+
+test filesystem-1.5 {link normalisation} {hasLinks} {
+ string equal [file normalize [file join dir.file linkinside.file]] \
+ [file normalize [file join dir.file linkinside.file]]
+} {1}
+
+test filesystem-1.6 {link normalisation} {hasLinks} {
+ string equal [file normalize [file join dir.file linkinside.file]] \
+ [file normalize [file join dir.link inside.file]]
+} {0}
+
+test filesystem-1.7 {link normalisation} {hasLinks macOrUnix} {
+ string equal [file normalize [file join dir.link linkinside.file foo]] \
+ [file normalize [file join dir.file inside.file foo]]
+} {1}
+
+test filesystem-1.8 {link normalisation} {hasLinks} {
+ string equal [file normalize [file join dir.file linkinside.filefoo]] \
+ [file normalize [file join dir.link inside.filefoo]]
+} {0}
+
+test filesystem-1.9 {link normalisation} {macOrUnix hasLinks} {
+ file delete -force dir.link
+ file link dir.link [file nativename dir.file]
+ string equal [file normalize [file join dir.file linkinside.file foo]] \
+ [file normalize [file join dir.link inside.file foo]]
+} {1}
+
+test filesystem-1.10 {link normalisation: double link} {macOrUnix hasLinks} {
+ file link dir2.link dir.link
+ string equal [file normalize [file join dir.file linkinside.file foo]] \
+ [file normalize [file join dir2.link inside.file foo]]
+} {1}
+
+makeDirectory dir2.file
+
+test filesystem-1.11 {link normalisation: double link, back in tree} {macOrUnix hasLinks} {
+ file link [file join dir2.file dir2.link] dir2.link
+ string equal [file normalize [file join dir.file linkinside.file foo]] \
+ [file normalize [file join dir2.file dir2.link inside.file foo]]
+} {1}
+
+test filesystem-1.12 {file new native path} {} {
+ for {set i 0} {$i < 10} {incr i} {
+ foreach f [lsort [glob -nocomplain -type l *]] {
+ catch {file readlink $f}
+ }
+ }
+ # If we reach here we've succeeded. We used to crash above.
+ expr 1
+} {1}
+
+test filesystem-1.13 {file normalisation} {winOnly} {
+ # This used to be broken
+ file normalize C:/thislongnamedoesntexist
+} {C:/thislongnamedoesntexist}
+
+test filesystem-1.14 {file normalisation} {winOnly} {
+ # This used to be broken
+ file normalize c:/
+} {C:/}
+
+file delete -force dir2.file
+file delete -force dir2.link
+file delete -force link.file dir.link
+removeFile [file join dir.file inside.file]
+removeDirectory dir.file
+removeFile gorp.file
+
+test filesystem-2.0 {new native path} {unixOnly} {
+ 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}
+
+if {[catch {package require tcltest 2}]} {
+ puts stderr "Skipping tests filesystem-{3,4}.*: tcltest 2 required."
+} else {
+ namespace import ::tcltest::testConstraint
+
+ # Is the Tcltest package loaded?
+ # - that is, the special C-coded testing commands in tclTest.c
+ # - tests use testing commands introduced in Tcltest 8.4
+ testConstraint Tcltest [expr {
+ [llength [package provide Tcltest]]
+ && [package vsatisfies [package provide Tcltest] 8.4]}]
+
+# Make sure the testfilesystem hasn't been registered.
+while {![catch {testfilesystem 0}]} {}
+
+test filesystem-3.0 {Tcl_FSRegister} Tcltest {
+ testfilesystem 1
+} {registered}
+
+test filesystem-3.1 {Tcl_FSUnregister} Tcltest {
+ testfilesystem 0
+} {unregistered}
+
+test filesystem-3.2 {Tcl_FSUnregister} Tcltest {
+ list [catch {testfilesystem 0} err] $err
+} {1 failed}
+
+test filesystem-3.3 {Tcl_FSRegister} Tcltest {
+ testfilesystem 1
+ testfilesystem 1
+ testfilesystem 0
+ testfilesystem 0
+} {unregistered}
+
+test filesystem-3.4 {Tcl_FSRegister} Tcltest {
+ testfilesystem 1
+ file system bar
+} {reporting}
+
+test filesystem-3.5 {Tcl_FSUnregister} Tcltest {
+ testfilesystem 0
+ lindex [file system bar] 0
+} {native}
+
+test filesystem-4.0 {testfilesystem} {
+ -constraints Tcltest
+ -match glob
+ -body {
+ testfilesystem 1
+ set filesystemReport {}
+ file exists foo
+ testfilesystem 0
+ set filesystemReport
+ }
+ -result {* {access foo}}
+}
+
+test filesystem-4.1 {testfilesystem} {
+ -constraints Tcltest
+ -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 Tcltest
+ -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 Tcltest
+ -match glob
+ -body {
+ testfilesystem 1
+ set filesystemReport {}
+ catch {glob *}
+ testfilesystem 0
+ set filesystemReport
+ }
+ -result {* {matchindirectory *}*}
+}
+
+test filesystem-5.1 {cache and ~} {
+ -constraints Tcltest
+ -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 (/foo/bar|foo:bar)} {Parent of ~ \(/a/b/c\) is (/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}
+
+# Make sure the testfilesystem hasn't been registered.
+while {![catch {testfilesystem 0}]} {}
+}
+
+cleanupTests
+}
+namespace delete ::tcl::test::fileSystem
+return
diff --git a/tcl/tests/for-old.test b/tcl/tests/for-old.test
index 65a38200ccb..18105b0bf52 100644
--- a/tcl/tests/for-old.test
+++ b/tcl/tests/for-old.test
@@ -83,4 +83,3 @@ return
-
diff --git a/tcl/tests/for.test b/tcl/tests/for.test
index 174475ee4c9..f18a4a9481c 100644
--- a/tcl/tests/for.test
+++ b/tcl/tests/for.test
@@ -587,8 +587,8 @@ test for-4.1 {break must reset the interp result} {
# Test for incorrect "double evaluation" semantics
-test for-5.1 {possible delayed substitution of increment command} {knownBug} {
- # Increment should be 5, and lappend should always append 5
+test for-5.1 {possible delayed substitution of increment command} {
+ # Increment should be 5, and lappend should always append $a
catch {unset a}
catch {unset i}
set a 5
@@ -597,13 +597,35 @@ test for-5.1 {possible delayed substitution of increment command} {knownBug} {
set i
} {1 6 11}
-test for-5.2 {possible delayed substitution of body command} {knownBug} {
- # Increment should be 5, and lappend should always append 5
+test for-5.2 {possible delayed substitution of increment command} {
+ # Increment should be 5, and lappend should always append $a
+ catch {rename p ""}
+ proc p {} {
+ set a 5
+ set i {}
+ for {set a 1} {$a < 12} "incr a $a" {lappend i $a}
+ set i
+ }
+ p
+} {1 6 11}
+test for-5.3 {possible delayed substitution of body command} {
+ # Increment should be $a, and lappend should always append 5
set a 5
set i {}
for {set a 1} {$a < 12} {incr a $a} "lappend i $a"
set i
} {5 5 5 5}
+test for-5.4 {possible delayed substitution of body command} {
+ # Increment should be $a, and lappend should always append 5
+ catch {rename p ""}
+ proc p {} {
+ set a 5
+ set i {}
+ for {set a 1} {$a < 12} {incr a $a} "lappend i $a"
+ set i
+ }
+ p
+} {5 5 5 5}
# In the following tests we need to bypass the bytecode compiler by
# substituting the command from a variable. This ensures that command
@@ -646,7 +668,7 @@ test for-6.6 {Tcl_ForObjCmd: error in initial command} {
test for-6.7 {Tcl_ForObjCmd: error in test expression} {
set z for
list [catch {$z {set i 0} {i < 5} {incr i} {body}} msg] $msg $errorInfo
-} {1 {syntax error in expression "i < 5"} {syntax error in expression "i < 5"
+} {1 {syntax error in expression "i < 5": variable references require preceding $} {syntax error in expression "i < 5": variable references require preceding $
while executing
"$z {set i 0} {i < 5} {incr i} {body}"}}
test for-6.8 {Tcl_ForObjCmd: test expression is enclosed in quotes} {
@@ -753,5 +775,3 @@ test for-6.16 {Tcl_ForObjCmd: for command result} {
# cleanup
::tcltest::cleanupTests
return
-
-
diff --git a/tcl/tests/foreach.test b/tcl/tests/foreach.test
index 83ce27b0566..2aaf4c43c3d 100644
--- a/tcl/tests/foreach.test
+++ b/tcl/tests/foreach.test
@@ -210,10 +210,19 @@ test foreach-5.4 {break tests} {
catch {break foo} msg
set msg
} {wrong # args: should be "break"}
+# Check for bug #406709
+test foreach-5.5 {break tests} {
+ proc a {} {
+ set a 1
+ foreach b b {list [concat a; break]; incr a}
+ incr a
+ }
+ a
+} {2}
# Test for incorrect "double evaluation" semantics
-test foreach-6.1 {delayed substitution of body} {knownBug} {
+test foreach-6.1 {delayed substitution of body} {
proc foo {} {
set a 0
foreach a [list 1 2 3] "
@@ -241,4 +250,3 @@ return
-
diff --git a/tcl/tests/format.test b/tcl/tests/format.test
index 416d47e9c0d..968d46c0c6c 100644
--- a/tcl/tests/format.test
+++ b/tcl/tests/format.test
@@ -13,7 +13,7 @@
# RCS: @(#) $Id$
if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+ package require tcltest 2
namespace import -force ::tcltest::*
}
@@ -22,11 +22,8 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
# fail. Someday I hope this code shouldn't be necessary (code added
# 9/9/91).
-set roundOffBug 0
-if {"[format %7.1e 68.514]" == "6.8e+01"} {
- puts stdout "Note: this system has a sprintf round-off bug, some tests skipped\n"
- set roundOffBug 1
-}
+set ::tcltest::testConstraints(roundOffBug) \
+ [expr {"[format %7.1e 68.514]" != "6.8e+01"}]
test format-1.1 {integer formatting} {
format "%*d %d %d %d" 6 34 16923 -12 -1
@@ -134,20 +131,18 @@ test format-4.1 {e and f formats} {eformat} {
test format-4.2 {e and f formats} {eformat} {
format "%20e %20e %20e %20e" 34.2e12 68.514 -.125 -16000. .000053
} { 3.420000e+13 6.851400e+01 -1.250000e-01 -1.600000e+04}
-if {!$roundOffBug} {
- test format-4.3 {e and f formats} {eformat} {
- format "%.1e %.1e %.1e %.1e" 34.2e12 68.514 -.126 -16000. .000053
- } {3.4e+13 6.9e+01 -1.3e-01 -1.6e+04}
- test format-4.4 {e and f formats} {eformat} {
- format "%020e %020e %020e %020e" 34.2e12 68.514 -.126 -16000. .000053
- } {000000003.420000e+13 000000006.851400e+01 -00000001.260000e-01 -00000001.600000e+04}
- test format-4.5 {e and f formats} {eformat} {
- format "%7.1e %7.1e %7.1e %7.1e" 34.2e12 68.514 -.126 -16000. .000053
- } {3.4e+13 6.9e+01 -1.3e-01 -1.6e+04}
- test format-4.6 {e and f formats} {
- format "%f %f %f %f" 34.2e12 68.514 -.125 -16000. .000053
- } {34200000000000.000000 68.514000 -0.125000 -16000.000000}
-}
+test format-4.3 {e and f formats} {eformat roundOffBug} {
+ format "%.1e %.1e %.1e %.1e" 34.2e12 68.514 -.126 -16000. .000053
+} {3.4e+13 6.9e+01 -1.3e-01 -1.6e+04}
+test format-4.4 {e and f formats} {eformat roundOffBug} {
+ format "%020e %020e %020e %020e" 34.2e12 68.514 -.126 -16000. .000053
+} {000000003.420000e+13 000000006.851400e+01 -00000001.260000e-01 -00000001.600000e+04}
+test format-4.5 {e and f formats} {eformat roundOffBug} {
+ format "%7.1e %7.1e %7.1e %7.1e" 34.2e12 68.514 -.126 -16000. .000053
+} {3.4e+13 6.9e+01 -1.3e-01 -1.6e+04}
+test format-4.6 {e and f formats roundOffBug} {
+ format "%f %f %f %f" 34.2e12 68.514 -.125 -16000. .000053
+} {34200000000000.000000 68.514000 -0.125000 -16000.000000}
test format-4.7 {e and f formats} {nonPortable} {
format "%.4f %.4f %.4f %.4f %.4f" 34.2e12 68.514 -.125 -16000. .000053
} {34200000000000.0000 68.5140 -0.1250 -16000.0000 0.0001}
@@ -486,12 +481,27 @@ for {set i 0} {$i < 290} {incr i} {
append b $a
}
for {set i 290} {$i < 400} {incr i} {
- test format-15.[expr $i -290] {testing MAX_FLOAT_SIZE} {
+ test format-16.[expr $i -289] {testing MAX_FLOAT_SIZE} {
format {%s} $b
} $b
append b "x"
}
+::tcltest::testConstraint 64bitInts \
+ [expr {0x80000000 > 0}]
+::tcltest::testConstraint wideIntExpressions \
+ [expr {wide(0x80000000) != int(0x80000000)}]
+
+test format-17.1 {testing %d with wide} {64bitInts wideIntExpressions} {
+ list [catch {format %d 7810179016327718216} msg] $msg
+} {1 {integer value too large to represent}}
+test format-17.2 {testing %ld with wide} {64bitInts} {
+ format %ld 7810179016327718216
+} 7810179016327718216
+test format-17.3 {testing %ld with non-wide} {64bitInts} {
+ format %ld 42
+} 42
+
# cleanup
catch {unset a}
catch {unset b}
@@ -499,16 +509,3 @@ catch {unset c}
catch {unset d}
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tcl/tests/get.test b/tcl/tests/get.test
index 585422d6972..8a87201e60e 100644
--- a/tcl/tests/get.test
+++ b/tcl/tests/get.test
@@ -45,10 +45,10 @@ test get-1.6 {Tcl_GetInt procedure} {
# The following tests are non-portable because they depend on
# word size.
-if {0x80000000 > 0} {
+if {wide(0x80000000) > wide(0)} {
test get-1.7 {Tcl_GetInt procedure} {
set x 44
- list [catch {incr x 18446744073709551616} msg] $msg $errorCode
+ list [catch {eval incr x 18446744073709551616} msg] $msg $errorCode
} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
test get-1.8 {Tcl_GetInt procedure} {
set x 0
@@ -63,19 +63,19 @@ if {0x80000000 > 0} {
list [catch {incr x -18446744073709551614} msg] $msg
} {0 2}
} else {
- test get-1.7 {Tcl_GetInt procedure} {
+ test get-1.11 {Tcl_GetInt procedure} {
set x 44
list [catch {incr x 4294967296} msg] $msg $errorCode
} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
- test get-1.8 {Tcl_GetInt procedure} {
+ test get-1.12 {Tcl_GetInt procedure} {
set x 0
list [catch {incr x 4294967294} msg] $msg
} {0 -2}
- test get-1.9 {Tcl_GetInt procedure} {
+ test get-1.13 {Tcl_GetInt procedure} {
set x 0
list [catch {incr x +4294967294} msg] $msg
} {0 -2}
- test get-1.10 {Tcl_GetInt procedure} {
+ test get-1.14 {Tcl_GetInt procedure} {
set x 0
list [catch {incr x -4294967294} msg] $msg
} {0 2}
@@ -109,4 +109,3 @@ return
-
diff --git a/tcl/tests/history.test b/tcl/tests/history.test
index 04512210a0a..be6d40882a2 100644
--- a/tcl/tests/history.test
+++ b/tcl/tests/history.test
@@ -229,4 +229,3 @@ return
-
diff --git a/tcl/tests/http.test b/tcl/tests/http.test
index 126cca12f87..2d346289cb4 100644
--- a/tcl/tests/http.test
+++ b/tcl/tests/http.test
@@ -15,11 +15,9 @@
# RCS: @(#) $Id$
if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+ package require tcltest 2
namespace import -force ::tcltest::*
}
-set tcltest::testConstraints(notLinux) \
- [expr ![string equal Linux $tcl_platform(os)]]
if {[catch {package require http 2} version]} {
if {[info exist http2]} {
@@ -29,6 +27,7 @@ if {[catch {package require http 2} version]} {
catch {puts "Running http 2.* tests in slave interp"}
set interp [interp create http2]
$interp eval [list set http2 "running"]
+ $interp eval [list set argv $argv]
$interp eval [list source [info script]]
interp delete $interp
return
@@ -49,16 +48,17 @@ catch {unset data}
# Ensure httpd file exists
set origFile [file join $::tcltest::testsDirectory httpd]
-set newFile [file join $::tcltest::workingDirectory httpd]
-if {![file exists $newFile]} {
- file copy $origFile $newFile
+set httpdFile [file join [temporaryDirectory] httpd_[pid]]
+if {![file exists $httpdFile]} {
+ makeFile "" $httpdFile
+ file delete $httpdFile
+ file copy $origFile $httpdFile
set removeHttpd 1
}
-set httpdFile [file join $::tcltest::workingDirectory httpd]
if {[info commands testthread] == "testthread" && [file exists $httpdFile]} {
set httpthread [testthread create "
- source $httpdFile
+ source [list $httpdFile]
testthread wait
"]
testthread send $httpthread [list set port $port]
@@ -66,16 +66,19 @@ if {[info commands testthread] == "testthread" && [file exists $httpdFile]} {
testthread send $httpthread {httpd_init $port}
puts "Running httpd in thread $httpthread"
} else {
- if ![file exists $httpdFile] {
+ if {![file exists $httpdFile]} {
puts "Cannot read $httpdFile script, http test skipped"
unset port
return
}
source $httpdFile
- if [catch {httpd_init $port} listen] {
+ # Let the OS pick the port; that's much more flexible
+ if {[catch {httpd_init 0} listen]} {
puts "Cannot start http server, http test skipped"
unset port
return
+ } else {
+ set port [lindex [fconfigure $listen -sockname] 2]
}
}
@@ -101,16 +104,18 @@ test http-1.4 {http::config} {
} {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -useragent {Tcl Test Suite}}
test http-1.5 {http::config} {
- catch {http::config -proxyhost {} -junk 8080}
-} 1
+ list [catch {http::config -proxyhost {} -junk 8080} msg] $msg
+} {1 {Unknown option -junk, must be: -accept, -proxyfilter, -proxyhost, -proxyport, -useragent}}
+
test http-2.1 {http::reset} {
catch {http::reset http#1}
} 0
test http-3.1 {http::geturl} {
- catch {http::geturl -bogus flag}
-} 1
+ 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
@@ -222,8 +227,8 @@ test http-3.11 {http::geturl querychannel with -command} {
append query $sep$query
set sep &
}
- ::tcltest::makeFile $query outdata
- set fp [open outdata]
+ set file [makeFile $query outdata]
+ set fp [open $file]
proc asyncCB {token} {
global postResult
@@ -237,12 +242,14 @@ test http-3.11 {http::geturl querychannel with -command} {
# Now do async
http::cleanup $t
close $fp
- set fp [open outdata]
+ set fp [open $file]
set t [http::geturl $posturl -querychannel $fp -command asyncCB]
set postResult [list PostStart]
http::wait $t
+ close $fp
lappend testRes [http::status $t] $postResult
+ removeFile outdata
set testRes
} {ok 122879 {Got 122880 bytes} ok {PostStart {Got 122880 bytes}}}
@@ -263,8 +270,8 @@ test http-3.12 {http::geturl querychannel with aborted request} {nonPortable} {
append query $sep$query
set sep &
}
- ::tcltest::makeFile $query outdata
- set fp [open outdata]
+ set file [makeFile $query outdata]
+ set fp [open $file]
proc asyncCB {token} {
global postResult
@@ -287,13 +294,14 @@ test http-3.12 {http::geturl querychannel with aborted request} {nonPortable} {
error $err
}
+ removeFile outdata
list [http::status $t] [http::code $t]
} {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
@@ -320,13 +328,14 @@ test http-4.3 {http::Event} {
} {HTTP/1.0 200 Data follows}
test http-4.4 {http::Event} {
- set out [open testfile w]
+ set testfile [makeFile "" testfile]
+ set out [open $testfile w]
set token [http::geturl $url -channel $out]
close $out
- set in [open testfile]
+ set in [open $testfile]
set x [read $in]
close $in
- file delete testfile
+ removeFile $testfile
set x
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
@@ -334,23 +343,25 @@ test http-4.4 {http::Event} {
</body></html>"
test http-4.5 {http::Event} {
- set out [open testfile w]
+ set testfile [makeFile "" testfile]
+ set out [open $testfile w]
set token [http::geturl $url -channel $out]
close $out
upvar #0 $token data
- file delete testfile
+ removeFile $testfile
expr $data(currentsize) == $data(totalsize)
} 1
test http-4.6 {http::Event} {
- set out [open testfile w]
+ set testfile [makeFile "" testfile]
+ set out [open $testfile w]
set token [http::geturl $binurl -channel $out]
close $out
- set in [open testfile]
+ set in [open $testfile]
fconfigure $in -translation binary
set x [read $in]
close $in
- file delete testfile
+ removeFile $testfile
set x
} "$bindata$binurl"
@@ -427,7 +438,7 @@ test http-4.14 {http::Event} {
http::status $token
} err]
# error code varies among platforms.
- list $code [string match "connect failed*" $err]
+ list $code [regexp {(connect failed|couldn't open socket)} $err]
} {1 1}
# Bogus host
@@ -466,6 +477,10 @@ test http-6.1 {http::ProxyRequired} {
<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}
+
# cleanup
catch {unset url}
catch {unset badurl}
@@ -484,4 +499,3 @@ if {[info exist removeHttpd]} {
}
::tcltest::cleanupTests
-
diff --git a/tcl/tests/httpd b/tcl/tests/httpd
index e5fa282ec12..fa553d6347a 100644
--- a/tcl/tests/httpd
+++ b/tcl/tests/httpd
@@ -183,6 +183,9 @@ proc httpdRespond { sock } {
append html "<h2>Query</h2>\n<dl>\n"
foreach {key value} [split $data(query) &=] {
append html "<dt>$key<dd>$value\n"
+ if {$key == "timeout"} {
+ after $value ;# pause
+ }
}
append html </dl>\n
}
diff --git a/tcl/tests/httpold.test b/tcl/tests/httpold.test
index bb4b133d0a9..cce61a62541 100644
--- a/tcl/tests/httpold.test
+++ b/tcl/tests/httpold.test
@@ -27,6 +27,7 @@ if {[catch {package require http 1.0}]} {
catch {puts "Running http 1.0 tests in slave interp"}
set interp [interp create httpold]
$interp eval [list set httpold "running"]
+ $interp eval [list set argv $argv]
$interp eval [list source [info script]]
interp delete $interp
::tcltest::cleanupTests
@@ -50,19 +51,19 @@ if [catch {httpd_init $port} listen] {
return
}
-test http-1.1 {http_config} {
+test httpold-1.1 {http_config} {
http_config
} {-accept */* -proxyfilter httpProxyRequired -proxyhost {} -proxyport {} -useragent {Tcl http client package 1.0}}
-test http-1.2 {http_config} {
+test httpold-1.2 {http_config} {
http_config -proxyfilter
} httpProxyRequired
-test http-1.3 {http_config} {
+test httpold-1.3 {http_config} {
catch {http_config -junk}
} 1
-test http-1.4 {http_config} {
+test httpold-1.4 {http_config} {
http_config -proxyhost nowhere.come -proxyport 8080 -proxyfilter myFilter -useragent "Tcl Test Suite"
set x [http_config]
http_config -proxyhost {} -proxyport {} -proxyfilter httpProxyRequired \
@@ -70,24 +71,24 @@ test http-1.4 {http_config} {
set x
} {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -useragent {Tcl Test Suite}}
-test http-1.5 {http_config} {
+test httpold-1.5 {http_config} {
catch {http_config -proxyhost {} -junk 8080}
} 1
-test http-2.1 {http_reset} {
+test httpold-2.1 {http_reset} {
catch {http_reset http#1}
} 0
-test http-3.1 {http_get} {
+test httpold-3.1 {http_get} {
catch {http_get -bogus flag}
} 1
-test http-3.2 {http_get} {
+test httpold-3.2 {http_get} {
catch {http_get http:junk} err
set err
} {Unsupported URL: http:junk}
set url [info hostname]:$port
-test http-3.3 {http_get} {
+test httpold-3.3 {http_get} {
set token [http_get $url]
http_data $token
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
@@ -99,7 +100,7 @@ set tail /a/b/c
set url [info hostname]:$port/a/b/c
set binurl [info hostname]:$port/binary
-test http-3.4 {http_get} {
+test httpold-3.4 {http_get} {
set token [http_get $url]
http_data $token
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
@@ -111,7 +112,7 @@ proc selfproxy {host} {
global port
return [list [info hostname] $port]
}
-test http-3.5 {http_get} {
+test httpold-3.5 {http_get} {
http_config -proxyfilter selfproxy
set token [http_get $url]
http_config -proxyfilter httpProxyRequired
@@ -121,7 +122,7 @@ test http-3.5 {http_get} {
<h2>GET http://$url</h2>
</body></html>"
-test http-3.6 {http_get} {
+test httpold-3.6 {http_get} {
http_config -proxyfilter bogus
set token [http_get $url]
http_config -proxyfilter httpProxyRequired
@@ -131,7 +132,7 @@ test http-3.6 {http_get} {
<h2>GET $tail</h2>
</body></html>"
-test http-3.7 {http_get} {
+test httpold-3.7 {http_get} {
set token [http_get $url -headers {Pragma no-cache}]
http_data $token
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
@@ -139,7 +140,7 @@ test http-3.7 {http_get} {
<h2>GET $tail</h2>
</body></html>"
-test http-3.8 {http_get} {
+test httpold-3.8 {http_get} {
set token [http_get $url -query Name=Value&Foo=Bar]
http_data $token
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
@@ -152,63 +153,66 @@ test http-3.8 {http_get} {
</dl>
</body></html>"
-test http-3.9 {http_get} {
+test httpold-3.9 {http_get} {
set token [http_get $url -validate 1]
http_code $token
} "HTTP/1.0 200 OK"
-test http-4.1 {httpEvent} {
+test httpold-4.1 {httpEvent} {
set token [http_get $url]
upvar #0 $token data
array set meta $data(meta)
expr ($data(totalsize) == $meta(Content-Length))
} 1
-test http-4.2 {httpEvent} {
+test httpold-4.2 {httpEvent} {
set token [http_get $url]
upvar #0 $token data
array set meta $data(meta)
string compare $data(type) [string trim $meta(Content-Type)]
} 0
-test http-4.3 {httpEvent} {
+test httpold-4.3 {httpEvent} {
set token [http_get $url]
http_code $token
} {HTTP/1.0 200 Data follows}
-test http-4.4 {httpEvent} {
- set out [open testfile w]
+test httpold-4.4 {httpEvent} {
+ set testfile [makeFile "" testfile]
+ set out [open $testfile w]
set token [http_get $url -channel $out]
close $out
- set in [open testfile]
+ set in [open $testfile]
set x [read $in]
close $in
- file delete testfile
+ removeFile $testfile
set x
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>GET $tail</h2>
</body></html>"
-test http-4.5 {httpEvent} {
- set out [open testfile w]
+test httpold-4.5 {httpEvent} {
+ set testfile [makeFile "" testfile]
+ set out [open $testfile w]
set token [http_get $url -channel $out]
close $out
upvar #0 $token data
- file delete testfile
+ removeFile $testfile
expr $data(currentsize) == $data(totalsize)
} 1
-test http-4.6 {httpEvent} {
- set out [open testfile w]
+test httpold-4.6 {httpEvent} {
+ set testfile [makeFile "" testfile]
+ set out [open $testfile w]
set token [http_get $binurl -channel $out]
close $out
- set in [open testfile]
+ set in [open $testfile]
fconfigure $in -translation binary
set x [read $in]
close $in
- file delete testfile
+ removeFile $testfile
set x
} "$bindata$binurl"
@@ -222,33 +226,33 @@ proc myProgress {token total current} {
if 0 {
# This test hangs on Windows95 because the client never gets EOF
set httpLog 1
- test http-4.6 {httpEvent} {
+ test httpold-4.6 {httpEvent} {
set token [http_get $url -blocksize 50 -progress myProgress]
set progress
} {111 111}
}
-test http-4.7 {httpEvent} {
+test httpold-4.7 {httpEvent} {
set token [http_get $url -progress myProgress]
set progress
} {111 111}
-test http-4.8 {httpEvent} {
+test httpold-4.8 {httpEvent} {
set token [http_get $url]
http_status $token
} {ok}
-test http-4.9 {httpEvent} {
+test httpold-4.9 {httpEvent} {
set token [http_get $url -progress myProgress]
http_code $token
} {HTTP/1.0 200 Data follows}
-test http-4.10 {httpEvent} {
+test httpold-4.10 {httpEvent} {
set token [http_get $url -progress myProgress]
http_size $token
} {111}
-test http-4.11 {httpEvent} {
+test httpold-4.11 {httpEvent} {
set token [http_get $url -timeout 1 -command {#}]
http_reset $token
http_status $token
} {reset}
-test http-4.12 {httpEvent} {
+test httpold-4.12 {httpEvent} {
update
set x {}
after 500 {lappend x ok}
@@ -257,19 +261,19 @@ test http-4.12 {httpEvent} {
list [http_status $token] $x
} {timeout ok}
-test http-5.1 {http_formatQuery} {
+test httpold-5.1 {http_formatQuery} {
http_formatQuery name1 value1 name2 "value two"
} {name1=value1&name2=value+two}
-test http-5.2 {http_formatQuery} {
+test httpold-5.2 {http_formatQuery} {
http_formatQuery name1 ~bwelch name2 \xa1\xa2\xa2
} {name1=%7ebwelch&name2=%a1%a2%a2}
-test http-5.3 {http_formatQuery} {
+test httpold-5.3 {http_formatQuery} {
http_formatQuery lines "line1\nline2\nline3"
} {lines=line1%0d%0aline2%0d%0aline3}
-test http-6.1 {httpProxyRequired} {
+test httpold-6.1 {httpProxyRequired} {
update
http_config -proxyhost [info hostname] -proxyport $port
set token [http_get $url]
@@ -301,4 +305,3 @@ return
-
diff --git a/tcl/tests/if-old.test b/tcl/tests/if-old.test
index e03e42b0da1..6d51509579c 100644
--- a/tcl/tests/if-old.test
+++ b/tcl/tests/if-old.test
@@ -174,4 +174,3 @@ return
-
diff --git a/tcl/tests/if.test b/tcl/tests/if.test
index eef417b3df2..2b8375e6078 100644
--- a/tcl/tests/if.test
+++ b/tcl/tests/if.test
@@ -28,7 +28,7 @@ test if-1.2 {TclCompileIfCmd: error in if/elseif test} {
} {1 {error in condition}}
test if-1.3 {TclCompileIfCmd: error in if/elseif test} {
list [catch {if {1+}} msg] $msg $errorInfo
-} {1 {syntax error in expression "1+"} {syntax error in expression "1+"
+} {1 {syntax error in expression "1+": premature end of expression} {syntax error in expression "1+": premature end of expression
("if" test expression)
while compiling
"if {1+}"}}
@@ -180,7 +180,7 @@ test if-2.3 {TclCompileIfCmd: missing expression after "elseif"} {
test if-2.4 {TclCompileIfCmd: error in expression after "elseif"} {
set a {}
list [catch {if 3>4 {set a 1} elseif {1>}} msg] $msg $errorInfo
-} {1 {syntax error in expression "1>"} {syntax error in expression "1>"
+} {1 {syntax error in expression "1>": premature end of expression} {syntax error in expression "1>": premature end of expression
("if" test expression)
while compiling
"if 3>4 {set a 1} elseif {1>}"}}
@@ -512,7 +512,7 @@ test if-5.2 {if cmd with computed command names: error in if/elseif test} {
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+"} {syntax error in expression "1+"
+} {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} {
@@ -680,7 +680,7 @@ test if-6.4 {if cmd with computed command names: error in expression after "else
set z if
set a {}
list [catch {$z 3>4 {set a 1} elseif {1>}} msg] $msg $errorInfo
-} {1 {syntax error in expression "1>"} {syntax error in expression "1>"
+} {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} {
@@ -1013,34 +1013,69 @@ test if-9.1 {if cmd with namespace qualifiers} {
# Test for incorrect "double evaluation semantics"
-test if-10.1 {delayed substitution of then body} {knownBug} {
+test if-10.1 {delayed substitution of then body} {
set j 0
- if {[incr j] == 1} "
+ set if if
+ # this is not compiled
+ $if {[incr j] == 1} "
set result $j
"
- set result
-} {0}
-test if-10.2 {delayed substitution of elseif expression} {knownBug} {
+ # this will be compiled
+ proc p {} {
+ set j 0
+ if {[incr j]} "
+ set result $j
+ "
+ set result
+ }
+ append result [p]
+} {00}
+test if-10.2 {delayed substitution of elseif expression} {
set j 0
- if {[incr j] == 0} {
+ set if if
+ # this is not compiled
+ $if {[incr j] == 0} {
set result badthen
} elseif "$j == 1" {
set result badelseif
} else {
- set result ok
+ set result 0
}
- set result
-} {ok}
-test if-10.3 {delayed substitution of elseif body} {knownBug} {
+ # this will be compiled
+ proc p {} {
+ set j 0
+ if {[incr j] == 0} {
+ set result badthen
+ } elseif "$j == 1" {
+ set result badelseif
+ } else {
+ set result 0
+ }
+ set result
+ }
+ append result [p]
+} {00}
+test if-10.3 {delayed substitution of elseif body} {
set j 0
- if {[incr j] == 0} {
+ set if if
+ # this is not compiled
+ $if {[incr j] == 0} {
set result badthen
} elseif {1} "
set result $j
"
- set result
-} {0}
-test if-10.4 {delayed substitution of else body} {knownBug} {
+ # this will be compiled
+ proc p {} {
+ set j 0
+ if {[incr j] == 0} {
+ set result badthen
+ } elseif {1} "
+ set result $j
+ "
+ }
+ append result [p]
+} {00}
+test if-10.4 {delayed substitution of else body} {
set j 0
if {[incr j] == 0} {
set result badthen
@@ -1049,13 +1084,13 @@ test if-10.4 {delayed substitution of else body} {knownBug} {
"
set result
} {0}
-test if-10.5 {substituted control words} {knownBug} {
+test if-10.5 {substituted control words} {
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} {knownBug} {
+test if-10.6 {double invocation of variable traces} {
set iftracecounter 0
proc iftraceproc {args} {
upvar #0 iftracecounter counter
@@ -1073,21 +1108,8 @@ test if-10.6 {double invocation of variable traces} {knownBug} {
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"} 0 {} {}}
+} {1 {syntax error in expression "1 oops 10 + 20": extra tokens at end of expression} 0 {} {}}
# cleanup
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tcl/tests/incr-old.test b/tcl/tests/incr-old.test
index dc2f3f41bbf..740933898d0 100644
--- a/tcl/tests/incr-old.test
+++ b/tcl/tests/incr-old.test
@@ -105,4 +105,3 @@ return
-
diff --git a/tcl/tests/incr.test b/tcl/tests/incr.test
index 64d5197ed6e..bcb3f714c44 100644
--- a/tcl/tests/incr.test
+++ b/tcl/tests/incr.test
@@ -518,4 +518,3 @@ return
-
diff --git a/tcl/tests/indexObj.test b/tcl/tests/indexObj.test
index c372ec7a385..4ece4155ff8 100644
--- a/tcl/tests/indexObj.test
+++ b/tcl/tests/indexObj.test
@@ -70,6 +70,44 @@ test indexObj-4.1 {free old internal representation} {
testindexobj 1 1 $x abc def {a b} zzz
} {2}
+test indexObj-5.1 {Tcl_WrongNumArgs} {
+ testwrongnumargs 1 "?option?" mycmd
+} "wrong # args: should be \"mycmd ?option?\""
+test indexObj-5.2 {Tcl_WrongNumArgs} {
+ testwrongnumargs 2 "bar" mycmd foo
+} "wrong # args: should be \"mycmd foo bar\""
+test indexObj-5.3 {Tcl_WrongNumArgs} {
+ testwrongnumargs 0 "bar" mycmd foo
+} "wrong # args: should be \"bar\""
+test indexObj-5.4 {Tcl_WrongNumArgs} {
+ testwrongnumargs 0 "" mycmd foo
+} "wrong # args: should be \"\""
+test indexObj-5.5 {Tcl_WrongNumArgs} {
+ testwrongnumargs 1 "" mycmd foo
+} "wrong # args: should be \"mycmd\""
+test indexObj-5.6 {Tcl_WrongNumArgs} {
+ testwrongnumargs 2 "" mycmd foo
+} "wrong # args: should be \"mycmd foo\""
+
+test indexObj-6.1 {Tcl_GetIndexFromObjStruct} {
+ set x a
+ testgetindexfromobjstruct $x 0
+} "wrong # args: should be \"testgetindexfromobjstruct a 0\""
+test indexObj-6.2 {Tcl_GetIndexFromObjStruct} {
+ set x a
+ testgetindexfromobjstruct $x 0
+ testgetindexfromobjstruct $x 0
+} "wrong # args: should be \"testgetindexfromobjstruct a 0\""
+test indexObj-6.3 {Tcl_GetIndexFromObjStruct} {
+ set x c
+ testgetindexfromobjstruct $x 1
+} "wrong # args: should be \"testgetindexfromobjstruct c 1\""
+test indexObj-6.4 {Tcl_GetIndexFromObjStruct} {
+ set x c
+ testgetindexfromobjstruct $x 1
+ testgetindexfromobjstruct $x 1
+} "wrong # args: should be \"testgetindexfromobjstruct c 1\""
+
# cleanup
::tcltest::cleanupTests
return
@@ -85,4 +123,3 @@ return
-
diff --git a/tcl/tests/info.test b/tcl/tests/info.test
index c2c2e62d7c3..2e50f740549 100644
--- a/tcl/tests/info.test
+++ b/tcl/tests/info.test
@@ -79,11 +79,11 @@ test info-2.4 {info body option} {
list [info body p] [info body q]
}
} {{return "x=$x"} {return "y=$y"}}
+# Prior to 8.3.0 this would cause a crash because [info body]
+# 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} {
- # Prior to 8.3.0 this would cause a crash because [info body]
- # would return the bytecompiled version of foo, which the catch
- # would then try and eval out of the foo context, accessing
- # compiled local indices
catch {unset args}
proc foo {args} {
foreach v $args {
@@ -94,6 +94,14 @@ 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}}
+# 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]
+test info-2.6 {info body option, returning list bodies} {
+ proc foo args [list subst bar]
+ list [string bytelength [info body foo]] \
+ [foo; string bytelength [info body foo]]
+} {9 9}
# "info cmdcount" is no longer accurate for compiled commands!
# The expected result for info-3.1 used to be "3" and is now "1"
@@ -330,6 +338,11 @@ test info-9.9 {info level option} {
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}]
+ namespace delete t
+ set msg
+} {namespace eval t {info level 0}}
set savedLibrary $tcl_library
test info-10.1 {info library option} {
@@ -358,6 +371,8 @@ test info-12.1 {info locals option} {
set b 13
set c testing
global a
+ global aa
+ set aa 23
return [info locals]
}
lsort [t1 23 24]
@@ -501,16 +516,15 @@ test info-15.8 {info procs option with a global shadowing proc} {
}
test info-16.1 {info script option} {
- list [catch {info script x} msg] $msg
-} {1 {wrong # args: should be "info script"}}
+ list [catch {info script x x} msg] $msg
+} {1 {wrong # args: should be "info script ?filename?"}}
test info-16.2 {info script option} {
file tail [info sc]
} "info.test"
-removeFile gorp.info
-makeFile "info script\n" gorp.info
+set gorpfile [makeFile "info script\n" gorp.info]
test info-16.3 {info script option} {
- list [source gorp.info] [file tail [info script]]
-} [list gorp.info info.test]
+ list [source $gorpfile] [file tail [info script]]
+} [list $gorpfile info.test]
test info-16.4 {resetting "info script" after errors} {
catch {source ~_nobody_/foo}
file tail [info script]
@@ -519,6 +533,23 @@ 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} {
+ 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} {
+ 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]
+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
test info-17.1 {info sharedlibextension option} {
@@ -574,24 +605,41 @@ test info-19.5 {info vars with temporary variables} {
t1
} {a}
-test info-20.1 {miscellaneous error conditions} {
+# 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 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 ceil cos cosh double exp floor fmod hypot int log log10 pow rand round sin sinh sqrt srand tan tanh wide}
+}
+test info-20.1 {info functions option} {info functions sin} sin
+test info-20.2 {info functions option} {lsort [info functions]} $functions
+test info-20.3 {info functions option} {
+ lsort [info functions a*]
+} {abs acos asin atan atan2}
+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-20.2 {miscellaneous error conditions} {
+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, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
-test info-20.3 {miscellaneous error conditions} {
+} {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, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
-test info-20.4 {miscellaneous error conditions} {
+} {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, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
-test info-20.5 {miscellaneous error conditions} {
+} {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, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
+} {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}}
# cleanup
catch {namespace delete test_ns_info1 test_ns_info2}
::tcltest::cleanupTests
return
-
diff --git a/tcl/tests/init.test b/tcl/tests/init.test
index c74a43fe04d..a6c0329fac9 100644
--- a/tcl/tests/init.test
+++ b/tcl/tests/init.test
@@ -75,16 +75,16 @@ auto_reset
catch {rename parray {}}
test init-2.0 {load parray - stage 1} {
- set ret [catch {namespace eval ::tcltest {parray}} error]
+ set ret [catch {parray} error]
rename parray {} ; # remove it, for the next test - that should not fail.
list $ret $error
-} {1 {no value given for parameter "a" to "parray"}}
+} {1 {wrong # args: should be "parray a ?pattern?"}}
test init-2.1 {load parray - stage 2} {
- set ret [catch {namespace eval ::tcltest {parray}} error]
+ set ret [catch {parray} error]
list $ret $error
-} {1 {no value given for parameter "a" to "parray"}}
+} {1 {wrong # args: should be "parray a ?pattern?"}}
auto_reset
@@ -135,11 +135,11 @@ catch {rename ::http::geturl {}}
test init-2.8 {load http::geturl (package)} {
# 3 ':' on purpose
- set ret [catch {namespace eval ::tcltest {http:::geturl}} error]
+ set ret [catch {http:::geturl} error]
# removing it, for the next test. should not fail.
rename ::http::geturl {} ;
list $ret $error
-} {1 {no value given for parameter "url" to "http:::geturl"}}
+} {1 {wrong # args: should be "http:::geturl url args"}}
test init-3.0 {random stuff in the auto_index, should still work} {
@@ -149,22 +149,61 @@ 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.
+
+set count 0
+foreach arg {
+ 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
+ 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}
+ {contrived example: rare circumstance
+ where the point at which to prune the
+ error stack cannot be uniquely determined.
+ foo bar foo
+"}
+ {contrived example: rare circumstance
+ where the point at which to prune the
+ error stack cannot be uniquely determined.
+ foo bar
+"}
+ } {
+
+ test init-4.$count.0 {::errorInfo produced by [unknown]} {
+ auto_reset
+ 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]} {
+ auto_reset
+ 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
+
+ incr count
}
+} ;# End of [interp eval $testInterp]
+
# cleanup
interp delete $testInterp
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tcl/tests/interp.test b/tcl/tests/interp.test
index 86cf49dafa8..39620d4bd4e 100644
--- a/tcl/tests/interp.test
+++ b/tcl/tests/interp.test
@@ -37,7 +37,7 @@ test interp-1.1 {options for interp command} {
} {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, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, marktrusted, slaves, share, target, or transfer}}
+} {1 {bad option "frobox": must be alias, aliases, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, marktrusted, recursionlimit, slaves, share, target, or transfer}}
test interp-1.3 {options for interp command} {
interp delete
} ""
@@ -55,17 +55,18 @@ test interp-1.6 {options for interp command} {
} {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, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, marktrusted, slaves, share, target, or transfer}}
+} {1 {bad option "hello": must be alias, aliases, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, 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, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, marktrusted, slaves, share, target, or transfer}}
+} {1 {bad option "-froboz": must be alias, aliases, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, 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, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, marktrusted, slaves, share, target, or transfer}}
+} {1 {bad option "-froboz": must be alias, aliases, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, 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"}}
+
# Part 1: Basic interpreter creation tests:
test interp-2.1 {basic interpreter creation} {
interp create a
@@ -259,6 +260,9 @@ test interp-7.4 {testing basic alias creation} {
test interp-7.5 {testing basic alias creation} {
a aliases
} {foo bar}
+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"}}
# Part 7: testing basic alias invocation
test interp-8.1 {testing basic alias invocation} {
@@ -271,8 +275,12 @@ 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} {
+ catch {interp create a}
+ list [catch {a alias} msg] $msg
+} {1 {wrong # args: should be "a alias aliasName ?targetName? ?args..?"}}
-# Part 8: Testing aliases for non-existent targets
+# Part 8: Testing aliases for non-existent or hidden targets
test interp-9.1 {testing aliases for non-existent targets} {
catch {interp create a}
a alias zop nonexistent-command-in-master
@@ -284,6 +292,30 @@ test interp-9.2 {testing aliases for non-existent targets} {
proc nonexistent-command-in-master {} {return i_exist!}
a eval zop
} i_exist!
+test interp-9.3 {testing aliases for hidden commands} {
+ catch {interp create a}
+ a eval {proc p {} {return ENTER_A}}
+ interp alias {} p a p
+ lappend res [list [catch p msg] $msg]
+ interp hide a p
+ lappend res [list [catch p msg] $msg]
+ rename p {}
+ interp delete a
+ set res
+ } {{0 ENTER_A} {1 {invalid command name "p"}}}
+test interp-9.4 {testing aliases and namespace commands} {
+ proc p {} {return GLOBAL}
+ namespace eval tst {
+ proc p {} {return NAMESPACE}
+ }
+ interp alias {} a {} p
+ set res [a]
+ lappend res [namespace eval tst a]
+ rename p {}
+ rename a {}
+ namespace delete tst
+ set res
+ } {GLOBAL GLOBAL}
if {[info command nonexistent-command-in-master] != ""} {
rename nonexistent-command-in-master {}
@@ -441,6 +473,10 @@ test interp-13.3 {testing foo issafe} {
interp create {a x3 foo}
a eval x3 eval foo issafe
} 1
+test interp-13.4 {testing issafe arg checking} {
+ catch {interp create a}
+ list [catch {a issafe too many args} msg] $msg
+} {1 {wrong # args: should be "a issafe"}}
# part 14: testing interp aliases
test interp-14.1 {testing interp aliases} {
@@ -469,74 +505,74 @@ test interp-15.1 {testing file sharing} {
z eval close stdout
list [catch {z eval puts hello} msg] $msg
} {1 {can not find channel named "stdout"}}
-catch {removeFile file-15.2}
-test interp-15.2 {testing file sharing} {
+test interp-15.2 {testing file sharing} -body {
catch {interp delete z}
interp create z
- set f [open file-15.2 w]
+ set f [open [makeFile {} file-15.2] w]
interp share "" $f z
z eval puts $f hello
z eval close $f
close $f
-} ""
-catch {removeFile file-15.2}
+} -cleanup {
+ removeFile file-15.2
+} -result ""
test interp-15.3 {testing file sharing} {
catch {interp delete xsafe}
interp create xsafe -safe
list [catch {xsafe eval puts hello} msg] $msg
} {1 {can not find channel named "stdout"}}
-catch {removeFile file-15.4}
-test interp-15.4 {testing file sharing} {
+test interp-15.4 {testing file sharing} -body {
catch {interp delete xsafe}
interp create xsafe -safe
- set f [open file-15.4 w]
+ set f [open [makeFile {} file-15.4] w]
interp share "" $f xsafe
xsafe eval puts $f hello
xsafe eval close $f
close $f
-} ""
-catch {removeFile file-15.4}
+} -cleanup {
+ removeFile file-15.4
+} -result ""
test interp-15.5 {testing file sharing} {
catch {interp delete xsafe}
interp create xsafe -safe
interp share "" stdout xsafe
list [catch {xsafe eval gets stdout} msg] $msg
} {1 {channel "stdout" wasn't opened for reading}}
-catch {removeFile file-15.6}
-test interp-15.6 {testing file sharing} {
+test interp-15.6 {testing file sharing} -body {
catch {interp delete xsafe}
interp create xsafe -safe
- set f [open file-15.6 w]
+ set f [open [makeFile {} file-15.6] w]
interp share "" $f xsafe
set x [list [catch [list xsafe eval gets $f] msg] $msg]
xsafe eval close $f
close $f
string compare [string tolower $x] \
[list 1 [format "channel \"%s\" wasn't opened for reading" $f]]
-} 0
-catch {removeFile file-15.6}
-catch {removeFile file-15.7}
-test interp-15.7 {testing file transferring} {
+} -cleanup {
+ removeFile file-15.6
+} -result 0
+test interp-15.7 {testing file transferring} -body {
catch {interp delete xsafe}
interp create xsafe -safe
- set f [open file-15.7 w]
+ set f [open [makeFile {} file-15.7] w]
interp transfer "" $f xsafe
xsafe eval puts $f hello
xsafe eval close $f
-} ""
-catch {removeFile file-15.7}
-catch {removeFile file-15.8}
-test interp-15.8 {testing file transferring} {
+} -cleanup {
+ removeFile file-15.7
+} -result ""
+test interp-15.8 {testing file transferring} -body {
catch {interp delete xsafe}
interp create xsafe -safe
- set f [open file-15.8 w]
+ set f [open [makeFile {} file-15.8] w]
interp transfer "" $f xsafe
xsafe eval close $f
set x [list [catch {close $f} msg] $msg]
string compare [string tolower $x] \
[list 1 [format "can not find channel named \"%s\"" $f]]
-} 0
-catch {removeFile file-15.8}
+} -cleanup {
+ removeFile file-15.8
+} -result 0
#
# Torture tests for interpreter deletion order
@@ -635,7 +671,10 @@ test interp-17.5 {alias loop prevention} {
# the bugs as a core dump.
#
-if {[info commands testinterpdelete] != ""} {
+if {[info commands testinterpdelete] == ""} {
+ puts "This application hasn't been compiled with the \"testinterpdelete\""
+ puts "command, so I can't test slave delete calls"
+} else {
test interp-18.1 {testing Tcl_DeleteInterp vs slaves} {
list [catch {testinterpdelete} msg] $msg
} {1 {wrong # args: should be "testinterpdelete path"}}
@@ -2264,32 +2303,385 @@ test interp-28.1 {getting fooled by slave's namespace ?} {
set r
} {}
-# Tests of recursionlimit
-# We need testsetrecursionlimit so we need Tcltest package
-if {[catch {package require Tcltest} msg]} {
- puts "This application hasn't been compiled with Tcltest"
- puts "skipping remining interp tests that relies on it."
-} else {
- #
-test interp-29.1 {recursion limit} {
+# Part 29: recursion limit
+# 29.1.* Argument checking
+# 29.2.* Reading and setting the recursion limit
+# 29.3.* Does the recursion limit work?
+# 29.4.* Recursion limit inheritance by sub-interpreters
+# 29.5.* Confirming the recursionlimit command does not affect the parent
+# 29.6.* Safe interpreter restriction
+
+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 {
+ set n1 [interp recursionlimit {} 42]
+ set n2 [interp recursionlimit {}]
+ list $n1 $n2
+ }]
+ 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]
+ set n2 [interp recursionlimit $i]
+ 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]
+ set n2 [$i recursionlimit]
+ 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]
+ set n2 [interp recursionlimit $i]
+ 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]
+ set n2 [$i recursionlimit]
+ interp delete $i
+ list $n1 $n2
+} {42 42}
+
+test interp-29.3.1 {recursion limit} {
set i [interp create]
- load {} Tcltest $i
set r [interp eval $i {
- testsetrecursionlimit 50
+ interp recursionlimit {} 50
proc p {} {incr ::i; p}
set i 0
- catch p
- set i
+ list [catch p msg] $msg $i
+ }]
+ interp delete $i
+ set r
+} {1 {too many nested evaluations (infinite loop?)} 48}
+
+test interp-29.3.2 {recursion limit} {
+ set i [interp create]
+ interp recursionlimit $i 50
+ set r [interp eval $i {
+ proc p {} {incr ::i; p}
+ set i 0
+ list [catch p msg] $msg $i
}]
interp delete $i
set r
-} 49
+} {1 {too many nested evaluations (infinite loop?)} 48}
-test interp-29.2 {recursion limit inheritance} {
+test interp-29.3.3 {recursion limit} {
+ set i [interp create]
+ $i recursionlimit 50
+ set r [interp eval $i {
+ proc p {} {incr ::i; p}
+ set i 0
+ list [catch p msg] $msg $i
+ }]
+ interp delete $i
+ set r
+} {1 {too many nested evaluations (infinite loop?)} 48}
+
+test interp-29.3.4 {recursion limit error reporting} {
+ interp create slave
+ set r1 [slave eval {
+ catch { # nesting level 1
+ eval { # 2
+ eval { # 3
+ eval { # 4
+ eval { # 5
+ interp recursionlimit {} 5
+ set x ok
+ }
+ }
+ }
+ }
+ } msg
+ }]
+ set r2 [slave eval { set msg }]
+ 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 {
+ catch { # nesting level 1
+ eval { # 2
+ eval { # 3
+ eval { # 4
+ eval { # 5
+ interp recursionlimit {} 4
+ set x ok
+ }
+ }
+ }
+ }
+ } msg
+ }]
+ set r2 [slave eval { set msg }]
+ 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 {
+ catch { # nesting level 1
+ eval { # 2
+ eval { # 3
+ eval { # 4
+ eval { # 5
+ interp recursionlimit {} 6
+ set x ok
+ }
+ }
+ }
+ }
+ } msg
+ }]
+ set r2 [slave eval { set msg }]
+ interp delete slave
+ list $r1 $r2
+} {0 ok}
+
+test interp-29.3.7 {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 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.8 {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
+ eval { # 5
+ update
+ 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.9 {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
+ update
+ set x ok
+ }
+ }
+ }
+ }
+ } msg
+ }]
+ set r2 [slave eval { set msg }]
+ interp delete slave
+ list $r1 $r2
+} {0 ok}
+
+test interp-29.3.10 {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
+ eval { # 5
+ update
+ 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} {
+ 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 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.12 {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 x ok
+ }
+ }
+ }
+ }
+ } msg
+ }]
+ set r2 [slave eval { set msg }]
+ interp delete slave
+ list $r1 $r2
+} {0 ok}
+
+test interp-29.4.1 {recursion limit inheritance} {
set i [interp create]
- load {} Tcltest $i
set ii [interp eval $i {
- testsetrecursionlimit 50
+ interp recursionlimit {} 50
interp create
}]
set r [interp eval [list $i $ii] {
@@ -2302,6 +2694,152 @@ test interp-29.2 {recursion limit inheritance} {
set r
} 49
+test interp-29.4.2 {recursion limit inheritance} {
+ set i [interp create]
+ $i recursionlimit 50
+ set ii [interp eval $i {interp create}]
+ set r [interp eval [list $i $ii] {
+ proc p {} {incr ::i; p}
+ set i 0
+ catch p
+ set i
+ }]
+ interp delete $i
+ set r
+} 49
+
+test interp-29.5.1 {does slave recursion limit affect master?} {
+ set before [interp recursionlimit {}]
+ set i [interp create]
+ interp recursionlimit $i 20000
+ set after [interp recursionlimit {}]
+ set slavelimit [interp recursionlimit $i]
+ 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]
+ interp recursionlimit $i 20000
+ set after [interp recursionlimit {}]
+ set slavelimit [$i recursionlimit]
+ 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]
+ $i recursionlimit 20000
+ set after [interp recursionlimit {}]
+ set slavelimit [interp recursionlimit $i]
+ 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]
+ $i recursionlimit 20000
+ set after [interp recursionlimit {}]
+ set slavelimit [$i recursionlimit]
+ 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]
+ set n2 [interp recursionlimit slave]
+ 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]
+ set n2 [interp recursionlimit slave]
+ 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]
+ set n2 [slave recursionlimit]
+ 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]
+ set n2 [slave recursionlimit]
+ 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]
+ set n2 [slave recursionlimit]
+ 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 [
+ slave eval {
+ interp create slave2 -safe
+ set n [catch {
+ interp recursionlimit slave2 42
+ } msg]
+ list $n $msg
+ }
+ ]
+ 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 [
+ slave eval {
+ interp create slave2 -safe
+ set n [catch {
+ slave2 recursionlimit 42
+ } msg]
+ list $n $msg
+ }
+ ]
+ interp delete slave
+ set result
+} {1 {permission denied: safe interpreters cannot change recursion limit}}
+
+
# # Deep recursion (into interps when the regular one fails):
# # still crashes...
# proc p {} {
@@ -2325,7 +2863,6 @@ test interp-29.2 {recursion limit inheritance} {
#} {}
# End of stack-recursion tests
-}
# This test dumps core in Tcl 8.0.3!
test interp-30.1 {deletion of aliases inside namespaces} {
@@ -2353,10 +2890,29 @@ 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 } {
+ cd [temporaryDirectory]
+ set parent [pwd]
+ set i [interp create]
+ set child [$i eval pwd]
+ interp delete $i
+ file mkdir cwd_test
+ cd cwd_test
+ lappend parent [pwd]
+ set i [interp create]
+ lappend child [$i eval pwd]
+ cd ..
+ file delete cwd_test
+ interp delete $i
+ cd [workingDirectory]
+ expr {[string equal $parent $child] ? 1 :
+ "\{$parent\} != \{$child\}"}
+} 1
+
# cleanup
foreach i [interp slaves] {
interp delete $i
}
::tcltest::cleanupTests
return
-
diff --git a/tcl/tests/io.test b/tcl/tests/io.test
index 772f67dbd55..3b6a43cf7cd 100644
--- a/tcl/tests/io.test
+++ b/tcl/tests/io.test
@@ -14,27 +14,34 @@
#
# RCS: @(#) $Id$
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
- namespace import -force ::tcltest::*
-}
-
-if {"[info commands testchannel]" != "testchannel"} {
- puts "Skipping io tests. This application does not seem to have the"
- puts "testchannel command that is needed to run these tests."
+if {[catch {package require tcltest 2}]} {
+ puts stderr "Skipping tests in [info script]. tcltest 2 required."
return
}
+namespace eval ::tcl::test::io {
+
+ 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
-::tcltest::saveState
+testConstraint testchannel [llength [info commands testchannel]]
+testConstraint exec [llength [info commands exec]]
+
+# You need a *very* special environment to do some tests. In
+# particular, many file systems do not support large-files...
+testConstraint largefileSupport 0
removeFile test1
removeFile pipe
-catch {unset u}
-
# set up a long data file for some of the following tests
-set f [open longfile w]
+set path(longfile) [makeFile {} longfile]
+set f [open $path(longfile) w]
fconfigure $f -eofchar {} -translation lf
for { set i 0 } { $i < 100 } { incr i} {
puts $f "#123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef
@@ -43,7 +50,7 @@ for { set i 0 } { $i < 100 } { incr i} {
}
close $f
-makeFile {
+set path(cat) [makeFile {
set f stdin
if {$argv != ""} {
set f [open $argv]
@@ -60,7 +67,7 @@ makeFile {
}
}
vwait forever
-} cat
+} cat]
set thisScript [file join [pwd] [info script]]
@@ -75,116 +82,135 @@ proc contents {file} {
test io-1.5 {Tcl_WriteChars: CheckChannelErrors} {emptyTest} {
# no test, need to cause an async error.
} {}
+
+set path(test1) [makeFile {} test1]
+
test io-1.6 {Tcl_WriteChars: WriteBytes} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -encoding binary
puts -nonewline $f "a\u4e4d\0"
close $f
- contents test1
+ contents $path(test1)
} "a\x4d\x00"
test io-1.7 {Tcl_WriteChars: WriteChars} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -encoding shiftjis
puts -nonewline $f "a\u4e4d\0"
close $f
- contents test1
+ contents $path(test1)
} "a\x93\xe1\x00"
+set path(test2) [makeFile {} test2]
+
+test 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]
+ fconfigure $f -encoding iso2022-jp
+ puts -nonewline $f [format %s%c [string repeat " " 4] 12399]
+ close $f
+ contents $path(test2)
+} " \x1b\$B\$O\x1b(B"
+
test io-2.1 {WriteBytes} {
# loop until all bytes are written
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -encoding binary -buffersize 16 -translation crlf
puts $f "abcdefghijklmnopqrstuvwxyz"
close $f
- contents test1
+ contents $path(test1)
} "abcdefghijklmnopqrstuvwxyz\r\n"
test 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 test1 w]
+ set f [open $path(test1) w]
fconfigure $f -encoding binary -buffersize 16 -translation crlf
puts -nonewline $f "123456789012345\n12"
- set x [list [contents test1]]
+ set x [list [contents $path(test1)]]
close $f
- lappend x [contents test1]
+ lappend x [contents $path(test1)]
} [list "123456789012345\r" "123456789012345\r\n12"]
test io-2.3 {WriteBytes: flush on line} {
# Tcl "line" buffering has weird behavior: if current buffer contains
# a \n, entire buffer gets flushed. Logical behavior would be to flush
# only up to the \n.
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -encoding binary -buffering line -translation crlf
puts -nonewline $f "\n12"
- set x [contents test1]
+ set x [contents $path(test1)]
close $f
set x
} "\r\n12"
test io-2.4 {WriteBytes: reset sawLF after each buffer} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -encoding binary -buffering line -translation lf \
-buffersize 16
puts -nonewline $f "abcdefg\nhijklmnopqrstuvwxyz"
- set x [list [contents test1]]
+ set x [list [contents $path(test1)]]
close $f
- lappend x [contents test1]
+ lappend x [contents $path(test1)]
} [list "abcdefg\nhijklmno" "abcdefg\nhijklmnopqrstuvwxyz"]
test io-3.1 {WriteChars: compatibility with WriteBytes} {
# loop until all bytes are written
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -encoding ascii -buffersize 16 -translation crlf
puts $f "abcdefghijklmnopqrstuvwxyz"
close $f
- contents test1
+ contents $path(test1)
} "abcdefghijklmnopqrstuvwxyz\r\n"
test 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 test1 w]
+ set f [open $path(test1) w]
fconfigure $f -encoding ascii -buffersize 16 -translation crlf
puts -nonewline $f "123456789012345\n12"
- set x [list [contents test1]]
+ set x [list [contents $path(test1)]]
close $f
- lappend x [contents test1]
+ lappend x [contents $path(test1)]
} [list "123456789012345\r" "123456789012345\r\n12"]
test io-3.3 {WriteChars: compatibility with WriteBytes: flush on line} {
# Tcl "line" buffering has weird behavior: if current buffer contains
# a \n, entire buffer gets flushed. Logical behavior would be to flush
# only up to the \n.
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -encoding ascii -buffering line -translation crlf
puts -nonewline $f "\n12"
- set x [contents test1]
+ set x [contents $path(test1)]
close $f
set x
} "\r\n12"
test io-3.4 {WriteChars: loop over stage buffer} {
# stage buffer maps to more than can be queued at once.
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -encoding jis0208 -buffersize 16
puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
- set x [list [contents test1]]
+ set x [list [contents $path(test1)]]
close $f
- lappend x [contents test1]
+ lappend x [contents $path(test1)]
} [list "!)!)!)!)!)!)!)!)" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
test 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 test1 w]
+ set f [open $path(test1) w]
fconfigure $f -encoding jis0208 -buffersize 17
puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
- set x [list [contents test1]]
+ set x [list [contents $path(test1)]]
close $f
- lappend x [contents test1]
+ lappend x [contents $path(test1)]
} [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
test io-3.6 {WriteChars: (stageRead + dstWrote == 0)} {
# One incomplete UTF-8 character at end of staging buffer. Backup
@@ -196,12 +222,12 @@ test io-3.6 {WriteChars: (stageRead + dstWrote == 0)} {
# 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 test1 w]
+ set f [open $path(test1) w]
fconfigure $f -encoding shiftjis -buffersize 16
puts -nonewline $f "12345678901234\uff21\uff22"
- set x [list [contents test1]]
+ set x [list [contents $path(test1)]]
close $f
- lappend x [contents test1]
+ lappend x [contents $path(test1)]
} [list "12345678901234\x82\x60" "12345678901234\x82\x60\x82\x61"]
test io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} {
# When translating UTF-8 to external, the produced bytes went past end
@@ -210,121 +236,121 @@ test io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} {
# blocksize on flush. The truncated bytes are moved to the beginning
# of the next channel buffer.
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -encoding jis0208 -buffersize 17
puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
- set x [list [contents test1]]
+ set x [list [contents $path(test1)]]
close $f
- lappend x [contents test1]
+ lappend x [contents $path(test1)]
} [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
test io-3.8 {WriteChars: reset sawLF after each buffer} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -encoding ascii -buffering line -translation lf \
-buffersize 16
puts -nonewline $f "abcdefg\nhijklmnopqrstuvwxyz"
- set x [list [contents test1]]
+ set x [list [contents $path(test1)]]
close $f
- lappend x [contents test1]
+ lappend x [contents $path(test1)]
} [list "abcdefg\nhijklmno" "abcdefg\nhijklmnopqrstuvwxyz"]
test io-4.1 {TranslateOutputEOL: lf} {
# search for \n
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -buffering line -translation lf
puts $f "abcde"
- set x [list [contents test1]]
+ set x [list [contents $path(test1)]]
close $f
- lappend x [contents test1]
+ lappend x [contents $path(test1)]
} [list "abcde\n" "abcde\n"]
test io-4.2 {TranslateOutputEOL: cr} {
# search for \n, replace with \r
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -buffering line -translation cr
puts $f "abcde"
- set x [list [contents test1]]
+ set x [list [contents $path(test1)]]
close $f
- lappend x [contents test1]
+ lappend x [contents $path(test1)]
} [list "abcde\r" "abcde\r"]
test io-4.3 {TranslateOutputEOL: crlf} {
# simple case: search for \n, replace with \r
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -buffering line -translation crlf
puts $f "abcde"
- set x [list [contents test1]]
+ set x [list [contents $path(test1)]]
close $f
- lappend x [contents test1]
+ lappend x [contents $path(test1)]
} [list "abcde\r\n" "abcde\r\n"]
test 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 test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation crlf -buffersize 16
puts -nonewline $f "1234567\n\n\n\n\nA"
- set x [list [contents test1]]
+ set x [list [contents $path(test1)]]
close $f
- lappend x [contents test1]
+ 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 io-4.5 {TranslateOutputEOL: crlf} {
# Check for overflow of the destination buffer
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation crlf -buffersize 12
puts -nonewline $f "12345678901\n456789012345678901234"
close $f
- set x [contents test1]
+ set x [contents $path(test1)]
} "12345678901\r\n456789012345678901234"
test io-5.1 {CheckFlush: not full} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f
puts -nonewline $f "12345678901234567890"
- set x [list [contents test1]]
+ set x [list [contents $path(test1)]]
close $f
- lappend x [contents test1]
+ lappend x [contents $path(test1)]
} [list "" "12345678901234567890"]
test io-5.2 {CheckFlush: full} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -buffersize 16
puts -nonewline $f "12345678901234567890"
- set x [list [contents test1]]
+ set x [list [contents $path(test1)]]
close $f
- lappend x [contents test1]
+ lappend x [contents $path(test1)]
} [list "1234567890123456" "12345678901234567890"]
test io-5.3 {CheckFlush: not line} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -buffering line
puts -nonewline $f "12345678901234567890"
- set x [list [contents test1]]
+ set x [list [contents $path(test1)]]
close $f
- lappend x [contents test1]
+ lappend x [contents $path(test1)]
} [list "" "12345678901234567890"]
test io-5.4 {CheckFlush: line} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -buffering line -translation lf -encoding ascii
puts -nonewline $f "1234567890\n1234567890"
- set x [list [contents test1]]
+ set x [list [contents $path(test1)]]
close $f
- lappend x [contents test1]
+ lappend x [contents $path(test1)]
} [list "1234567890\n1234567890" "1234567890\n1234567890"]
test io-5.5 {CheckFlush: none} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -buffering none
puts -nonewline $f "1234567890"
- set x [list [contents test1]]
+ set x [list [contents $path(test1)]]
close $f
- lappend x [contents test1]
+ lappend x [contents $path(test1)]
} [list "1234567890" "1234567890"]
test io-6.1 {Tcl_GetsObj: working} {
- set f [open test1 w]
+ set f [open $path(test1) w]
puts $f "foo\nboo"
close $f
- set f [open test1]
+ set f [open $path(test1)]
set x [gets $f]
close $f
set x
@@ -335,32 +361,32 @@ test io-6.2 {Tcl_GetsObj: CheckChannelErrors() != 0} {
test io-6.3 {Tcl_GetsObj: how many have we used?} {
# if (bufPtr != NULL) {oldRemoved = bufPtr->nextRemoved}
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation crlf
puts $f "abc\ndefg"
close $f
- set f [open test1]
+ set f [open $path(test1)]
set x [list [tell $f] [gets $f line] [tell $f] [gets $f line] $line]
close $f
set x
} {0 3 5 4 defg}
test io-6.4 {Tcl_GetsObj: encoding == NULL} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation binary
puts $f "\x81\u1234\0"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation binary
set x [list [gets $f line] $line]
close $f
set x
} [list 3 "\x81\x34\x00"]
test io-6.5 {Tcl_GetsObj: encoding != NULL} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation binary
puts $f "\x88\xea\x92\x9a"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -encoding shiftjis
set x [list [gets $f line] $line]
close $f
@@ -372,11 +398,11 @@ append a $a
test io-6.6 {Tcl_GetsObj: loop test} {
# if (dst >= dstEnd)
- set f [open test1 w]
+ set f [open $path(test1) w]
puts $f $a
puts $f hi
close $f
- set f [open test1]
+ set f [open $path(test1)]
set x [list [gets $f line] $line]
close $f
set x
@@ -384,7 +410,7 @@ test io-6.6 {Tcl_GetsObj: loop test} {
test io-6.7 {Tcl_GetsObj: error in input} {stdio} {
# if (FilterInputBytes(chanPtr, &gs) != 0)
- set f [open "|[list $::tcltest::tcltest cat]" w+]
+ set f [open "|[list [interpreter] cat]" w+]
puts -nonewline $f "hi\nwould"
flush $f
gets $f
@@ -394,20 +420,20 @@ test io-6.7 {Tcl_GetsObj: error in input} {stdio} {
set x
} {-1}
test io-6.8 {Tcl_GetsObj: remember if EOF is seen} {
- set f [open test1 w]
+ set f [open $path(test1) w]
puts $f "abcdef\x1aghijk\nwombat"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -eofchar \x1a
set x [list [gets $f line] $line [gets $f line] $line]
close $f
set x
} {6 abcdef -1 {}}
test io-6.9 {Tcl_GetsObj: remember if EOF is seen} {
- set f [open test1 w]
+ set f [open $path(test1) w]
puts $f "abcdefghijk\nwom\u001abat"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -eofchar \x1a
set x [list [gets $f line] $line [gets $f line] $line]
close $f
@@ -417,236 +443,236 @@ test io-6.9 {Tcl_GetsObj: remember if EOF is seen} {
# Comprehensive tests
test io-6.10 {Tcl_GetsObj: lf mode: no chars} {
- set f [open test1 w]
+ set f [open $path(test1) w]
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation lf
set x [list [gets $f line] $line]
close $f
set x
} {-1 {}}
test io-6.11 {Tcl_GetsObj: lf mode: lone \n} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "\n"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation lf
set x [list [gets $f line] $line [gets $f line] $line]
close $f
set x
} {0 {} -1 {}}
test io-6.12 {Tcl_GetsObj: lf mode: lone \r} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "\r"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation lf
set x [list [gets $f line] $line [gets $f line] $line]
close $f
set x
} [list 1 "\r" -1 ""]
test io-6.13 {Tcl_GetsObj: lf mode: 1 char} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f a
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation lf
set x [list [gets $f line] $line [gets $f line] $line]
close $f
set x
} {1 a -1 {}}
test io-6.14 {Tcl_GetsObj: lf mode: 1 char followed by EOL} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "a\n"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation lf
set x [list [gets $f line] $line [gets $f line] $line]
close $f
set x
} {1 a -1 {}}
test io-6.15 {Tcl_GetsObj: lf mode: several chars} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation lf
set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line [gets $f line] $line]
close $f
set x
} [list 4 "abcd" 10 "efgh\rijkl\r" 4 "mnop" -1 ""]
test io-6.16 {Tcl_GetsObj: cr mode: no chars} {
- set f [open test1 w]
+ set f [open $path(test1) w]
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation cr
set x [list [gets $f line] $line]
close $f
set x
} {-1 {}}
test io-6.17 {Tcl_GetsObj: cr mode: lone \n} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "\n"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation cr
set x [list [gets $f line] $line [gets $f line] $line]
close $f
set x
} [list 1 "\n" -1 ""]
test io-6.18 {Tcl_GetsObj: cr mode: lone \r} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "\r"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation cr
set x [list [gets $f line] $line [gets $f line] $line]
close $f
set x
} {0 {} -1 {}}
test io-6.19 {Tcl_GetsObj: cr mode: 1 char} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f a
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation cr
set x [list [gets $f line] $line [gets $f line] $line]
close $f
set x
} {1 a -1 {}}
test io-6.20 {Tcl_GetsObj: cr mode: 1 char followed by EOL} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "a\r"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation cr
set x [list [gets $f line] $line [gets $f line] $line]
close $f
set x
} {1 a -1 {}}
test io-6.21 {Tcl_GetsObj: cr mode: several chars} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation cr
set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line [gets $f line] $line]
close $f
set x
} [list 9 "abcd\nefgh" 4 "ijkl" 5 "\nmnop" -1 ""]
test io-6.22 {Tcl_GetsObj: crlf mode: no chars} {
- set f [open test1 w]
+ set f [open $path(test1) w]
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation crlf
set x [list [gets $f line] $line]
close $f
set x
} {-1 {}}
test io-6.23 {Tcl_GetsObj: crlf mode: lone \n} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "\n"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation crlf
set x [list [gets $f line] $line [gets $f line] $line]
close $f
set x
} [list 1 "\n" -1 ""]
test io-6.24 {Tcl_GetsObj: crlf mode: lone \r} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "\r"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation crlf
set x [list [gets $f line] $line [gets $f line] $line]
close $f
set x
} [list 1 "\r" -1 ""]
test io-6.25 {Tcl_GetsObj: crlf mode: \r\r} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "\r\r"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation crlf
set x [list [gets $f line] $line [gets $f line] $line]
close $f
set x
} [list 2 "\r\r" -1 ""]
test io-6.26 {Tcl_GetsObj: crlf mode: \r\n} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "\r\n"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation crlf
set x [list [gets $f line] $line [gets $f line] $line]
close $f
set x
} [list 0 "" -1 ""]
test io-6.27 {Tcl_GetsObj: crlf mode: 1 char} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f a
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation crlf
set x [list [gets $f line] $line [gets $f line] $line]
close $f
set x
} {1 a -1 {}}
test io-6.28 {Tcl_GetsObj: crlf mode: 1 char followed by EOL} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "a\r\n"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation crlf
set x [list [gets $f line] $line [gets $f line] $line]
close $f
set x
} {1 a -1 {}}
test io-6.29 {Tcl_GetsObj: crlf mode: several chars} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation crlf
set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line]
close $f
set x
} [list 14 "abcd\nefgh\rijkl" 4 "mnop" -1 ""]
-test io-6.30 {Tcl_GetsObj: crlf mode: buffer exhausted} {
+test io-6.30 {Tcl_GetsObj: crlf mode: buffer exhausted} {testchannel} {
# if (eol >= dstEnd)
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "123456789012345\r\nabcdefghijklmnoprstuvwxyz"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation crlf -buffersize 16
set x [list [gets $f line] $line [testchannel inputbuffered $f]]
close $f
set x
} [list 15 "123456789012345" 15]
-test io-6.31 {Tcl_GetsObj: crlf mode: buffer exhausted, blocked} {stdio} {
+test io-6.31 {Tcl_GetsObj: crlf mode: buffer exhausted, blocked} {stdio testchannel} {
# (FilterInputBytes() != 0)
- set f [open "|[list $::tcltest::tcltest cat]" w+]
+ set f [open "|[list [interpreter] $path(cat)]" w+]
fconfigure $f -translation {crlf lf} -buffering none
puts -nonewline $f "bbbbbbbbbbbbbb\r\n123456789012345\r"
fconfigure $f -buffersize 16
@@ -656,14 +682,14 @@ test io-6.31 {Tcl_GetsObj: crlf mode: buffer exhausted, blocked} {stdio} {
close $f
set x
} [list "bbbbbbbbbbbbbb" -1 "" 1 16]
-test io-6.32 {Tcl_GetsObj: crlf mode: buffer exhausted, more data} {
+test io-6.32 {Tcl_GetsObj: crlf mode: buffer exhausted, more data} {testchannel} {
# not (FilterInputBytes() != 0)
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "123456789012345\r\n123"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation crlf -buffersize 16
set x [list [gets $f line] $line [tell $f] [testchannel inputbuffered $f]]
close $f
@@ -672,11 +698,11 @@ test io-6.32 {Tcl_GetsObj: crlf mode: buffer exhausted, more data} {
test io-6.33 {Tcl_GetsObj: crlf mode: buffer exhausted, at eof} {
# eol still equals dstEnd
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "123456789012345\r"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation crlf -buffersize 16
set x [list [gets $f line] $line [eof $f]]
close $f
@@ -685,107 +711,107 @@ test io-6.33 {Tcl_GetsObj: crlf mode: buffer exhausted, at eof} {
test io-6.34 {Tcl_GetsObj: crlf mode: buffer exhausted, not followed by \n} {
# not (*eol == '\n')
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "123456789012345\rabcd\r\nefg"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation crlf -buffersize 16
set x [list [gets $f line] $line [tell $f]]
close $f
set x
} [list 20 "123456789012345\rabcd" 22]
test io-6.35 {Tcl_GetsObj: auto mode: no chars} {
- set f [open test1 w]
+ set f [open $path(test1) w]
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation auto
set x [list [gets $f line] $line]
close $f
set x
} {-1 {}}
test io-6.36 {Tcl_GetsObj: auto mode: lone \n} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "\n"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation auto
set x [list [gets $f line] $line [gets $f line] $line]
close $f
set x
} [list 0 "" -1 ""]
test io-6.37 {Tcl_GetsObj: auto mode: lone \r} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "\r"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation auto
set x [list [gets $f line] $line [gets $f line] $line]
close $f
set x
} [list 0 "" -1 ""]
test io-6.38 {Tcl_GetsObj: auto mode: \r\r} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "\r\r"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation auto
set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line]
close $f
set x
} [list 0 "" 0 "" -1 ""]
test io-6.39 {Tcl_GetsObj: auto mode: \r\n} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "\r\n"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation auto
set x [list [gets $f line] $line [gets $f line] $line]
close $f
set x
} [list 0 "" -1 ""]
test io-6.40 {Tcl_GetsObj: auto mode: 1 char} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f a
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation auto
set x [list [gets $f line] $line [gets $f line] $line]
close $f
set x
} {1 a -1 {}}
test io-6.41 {Tcl_GetsObj: auto mode: 1 char followed by EOL} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "a\r\n"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation auto
set x [list [gets $f line] $line [gets $f line] $line]
close $f
set x
} {1 a -1 {}}
test io-6.42 {Tcl_GetsObj: auto mode: several chars} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation auto
set x [list [gets $f line] $line [gets $f line] $line]
lappend x [gets $f line] $line [gets $f line] $line [gets $f line] $line
close $f
set x
} [list 4 "abcd" 4 "efgh" 4 "ijkl" 4 "mnop" -1 ""]
-test io-6.43 {Tcl_GetsObj: input saw cr} {stdio} {
+test io-6.43 {Tcl_GetsObj: input saw cr} {stdio testchannel} {
# if (chanPtr->flags & INPUT_SAW_CR)
- set f [open "|[list $::tcltest::tcltest cat]" w+]
+ set f [open "|[list [interpreter] $path(cat)]" w+]
fconfigure $f -translation {auto lf} -buffering none
puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
fconfigure $f -buffersize 16
@@ -799,10 +825,10 @@ test io-6.43 {Tcl_GetsObj: input saw cr} {stdio} {
close $f
set x
} [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"]
-test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio} {
+test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testchannel} {
# not (*eol == '\n')
- set f [open "|[list $::tcltest::tcltest cat]" w+]
+ set f [open "|[list [interpreter] $path(cat)]" w+]
fconfigure $f -translation {auto lf} -buffering none
puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
fconfigure $f -buffersize 16
@@ -816,10 +842,10 @@ test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio} {
close $f
set x
} [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"]
-test io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} {stdio} {
+test io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} {stdio testchannel} {
# Tcl_ExternalToUtf()
- set f [open "|[list $::tcltest::tcltest cat]" w+]
+ set f [open "|[list [interpreter] $path(cat)]" w+]
fconfigure $f -translation {auto lf} -buffering none
fconfigure $f -encoding unicode
puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
@@ -833,10 +859,10 @@ test io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} {stdio} {
close $f
set x
} [list 15 "123456789abcdef" 1 4 "abcd" 0]
-test io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eof} {stdio} {
+test io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eof} {stdio testchannel} {
# memmove()
- set f [open "|[list $::tcltest::tcltest cat]" w+]
+ set f [open "|[list [interpreter] $path(cat)]" w+]
fconfigure $f -translation {auto lf} -buffering none
puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
fconfigure $f -buffersize 16
@@ -849,52 +875,52 @@ test io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eof} {s
close $f
set x
} [list 15 "123456789abcdef" 1 -1 "" 0]
-test io-6.47 {Tcl_GetsObj: auto mode: \r at end of buffer, peek for \n} {
+test io-6.47 {Tcl_GetsObj: auto mode: \r at end of buffer, peek for \n} {testchannel} {
# (eol == dstEnd)
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "123456789012345\r\nabcdefghijklmnopq"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation auto -buffersize 16
set x [list [gets $f] [testchannel inputbuffered $f]]
close $f
set x
} [list "123456789012345" 15]
-test io-6.48 {Tcl_GetsObj: auto mode: \r at end of buffer, no more avail} {
+test io-6.48 {Tcl_GetsObj: auto mode: \r at end of buffer, no more avail} {testchannel} {
# PeekAhead() did not get any, so (eol >= dstEnd)
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "123456789012345\r"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation auto -buffersize 16
set x [list [gets $f] [testchannel queuedcr $f]]
close $f
set x
} [list "123456789012345" 1]
-test io-6.49 {Tcl_GetsObj: auto mode: \r followed by \n} {
+test io-6.49 {Tcl_GetsObj: auto mode: \r followed by \n} {testchannel} {
# if (*eol == '\n') {skip++}
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "123456\r\n78901"
close $f
- set f [open test1]
+ set f [open $path(test1)]
set x [list [gets $f] [testchannel queuedcr $f] [tell $f] [gets $f]]
close $f
set x
} [list "123456" 0 8 "78901"]
-test io-6.50 {Tcl_GetsObj: auto mode: \r not followed by \n} {
+test io-6.50 {Tcl_GetsObj: auto mode: \r not followed by \n} {testchannel} {
# not (*eol == '\n')
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "123456\r78901"
close $f
- set f [open test1]
+ set f [open $path(test1)]
set x [list [gets $f] [testchannel queuedcr $f] [tell $f] [gets $f]]
close $f
set x
@@ -902,23 +928,23 @@ test io-6.50 {Tcl_GetsObj: auto mode: \r not followed by \n} {
test io-6.51 {Tcl_GetsObj: auto mode: \n} {
# else if (*eol == '\n') {goto gotoeol;}
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "123456\n78901"
close $f
- set f [open test1]
+ set f [open $path(test1)]
set x [list [gets $f] [tell $f] [gets $f]]
close $f
set x
} [list "123456" 7 "78901"]
-test io-6.52 {Tcl_GetsObj: saw EOF character} {
+test io-6.52 {Tcl_GetsObj: saw EOF character} {testchannel} {
# if (eof != NULL)
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "123456\x1ak9012345\r"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -eofchar \x1a
set x [list [gets $f] [testchannel queuedcr $f] [tell $f] [gets $f]]
close $f
@@ -927,9 +953,9 @@ test io-6.52 {Tcl_GetsObj: saw EOF character} {
test io-6.53 {Tcl_GetsObj: device EOF} {
# didn't produce any bytes
- set f [open test1 w]
+ set f [open $path(test1) w]
close $f
- set f [open test1]
+ set f [open $path(test1)]
set x [list [gets $f line] $line [eof $f]]
close $f
set x
@@ -937,10 +963,10 @@ test io-6.53 {Tcl_GetsObj: device EOF} {
test io-6.54 {Tcl_GetsObj: device EOF} {
# got some bytes before EOF.
- set f [open test1 w]
+ set f [open $path(test1) w]
puts -nonewline $f abc
close $f
- set f [open test1]
+ set f [open $path(test1)]
set x [list [gets $f line] $line [eof $f]]
close $f
set x
@@ -948,11 +974,11 @@ test io-6.54 {Tcl_GetsObj: device EOF} {
test io-6.55 {Tcl_GetsObj: overconverted} {
# Tcl_ExternalToUtf(), make sure state updated
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -encoding iso2022-jp
puts $f "there\u4e00ok\n\u4e01more bytes\nhere"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -encoding iso2022-jp
set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line]
close $f
@@ -960,21 +986,21 @@ test io-6.55 {Tcl_GetsObj: overconverted} {
} [list 8 "there\u4e00ok" 11 "\u4e01more bytes" 4 "here"]
test io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} {stdio} {
update
- set f [open "|[list $::tcltest::tcltest cat]" w+]
+ set f [open "|[list [interpreter] $path(cat)]" w+]
fconfigure $f -buffering none
puts -nonewline $f "foobar"
fconfigure $f -blocking 0
- set x {}
- after 500 { lappend x timeout }
- fileevent $f readable { lappend x [gets $f] }
- vwait x
- vwait x
+ variable x {}
+ after 500 [namespace code { lappend x timeout }]
+ fileevent $f readable [namespace code { lappend x [gets $f] }]
+ vwait [namespace which -variable x]
+ vwait [namespace which -variable x]
fconfigure $f -blocking 1
puts -nonewline $f "baz\n"
- after 500 { lappend x timeout }
+ after 500 [namespace code { lappend x timeout }]
fconfigure $f -blocking 0
- vwait x
- vwait x
+ vwait [namespace which -variable x]
+ vwait [namespace which -variable x]
close $f
set x
} {{} timeout foobarbaz timeout}
@@ -982,11 +1008,11 @@ test io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} {stdio}
test io-7.1 {FilterInputBytes: split up character at end of buffer} {
# (result == TCL_CONVERT_MULTIBYTE)
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -encoding shiftjis
puts $f "1234567890123\uff10\uff11\uff12\uff13\uff14\nend"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -encoding shiftjis -buffersize 16
set x [gets $f]
close $f
@@ -995,22 +1021,22 @@ test io-7.1 {FilterInputBytes: split up character at end of buffer} {
test io-7.2 {FilterInputBytes: split up character in middle of buffer} {
# (bufPtr->nextAdded < bufPtr->bufLength)
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -encoding binary
puts -nonewline $f "1234567890\n123\x82\x4f\x82\x50\x82"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -encoding shiftjis
set x [list [gets $f line] $line [eof $f]]
close $f
set x
} [list 10 "1234567890" 0]
-test io-7.3 {FilterInputBytes: split up character at EOF} {
- set f [open test1 w]
+test io-7.3 {FilterInputBytes: split up character at EOF} {testchannel} {
+ set f [open $path(test1) w]
fconfigure $f -encoding binary
puts -nonewline $f "1234567890123\x82\x4f\x82\x50\x82"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -encoding shiftjis
set x [list [gets $f line] $line]
lappend x [tell $f] [testchannel inputbuffered $f] [eof $f]
@@ -1019,32 +1045,33 @@ test io-7.3 {FilterInputBytes: split up character at EOF} {
set x
} [list 15 "1234567890123\uff10\uff11" 18 0 1 -1 ""]
test io-7.4 {FilterInputBytes: recover from split up character} {stdio} {
- set f [open "|[list $::tcltest::tcltest cat]" w+]
+ set f [open "|[list [interpreter] $path(cat)]" w+]
fconfigure $f -encoding binary -buffering none
puts -nonewline $f "1234567890123\x82\x4f\x82\x50\x82"
fconfigure $f -encoding shiftjis -blocking 0
- fileevent $f read "ready $f"
- set x {}
+ fileevent $f read [namespace code "ready $f"]
+ variable x {}
proc ready {f} {
- lappend ::x [gets $f line] $line [fblocked $f]
+ variable x
+ lappend x [gets $f line] $line [fblocked $f]
}
- vwait x
+ vwait [namespace which -variable x]
fconfigure $f -encoding binary -blocking 1
puts $f "\x51\x82\x52"
fconfigure $f -encoding shiftjis
- vwait x
+ vwait [namespace which -variable x]
close $f
set x
} [list -1 "" 1 17 "1234567890123\uff10\uff11\uff12\uff13" 0]
-test io-8.1 {PeekAhead: only go to device if no more cached data} {
+test io-8.1 {PeekAhead: only go to device if no more cached data} {testchannel} {
# (bufPtr->nextPtr == NULL)
- set f [open "test1" w]
+ set f [open $path(test1) w]
fconfigure $f -encoding ascii -translation lf
puts -nonewline $f "123456789012345\r\n2345678"
close $f
- set f [open "test1"]
+ set f [open $path(test1)]
fconfigure $f -encoding ascii -translation auto -buffersize 16
# here
gets $f
@@ -1052,29 +1079,30 @@ test io-8.1 {PeekAhead: only go to device if no more cached data} {
close $f
set x
} "7"
-test io-8.2 {PeekAhead: only go to device if no more cached data} {stdio} {
+test io-8.2 {PeekAhead: only go to device if no more cached data} {stdio testchannel} {
# not (bufPtr->nextPtr == NULL)
- set f [open "|[list $::tcltest::tcltest cat]" w+]
+ set f [open "|[list [interpreter] $path(cat)]" w+]
fconfigure $f -translation lf -encoding ascii -buffering none
puts -nonewline $f "123456789012345\r\nbcdefghijklmnopqrstuvwxyz"
- set x {}
- fileevent $f read "ready $f"
+ variable x {}
+ fileevent $f read [namespace code "ready $f"]
proc ready {f} {
- lappend ::x [gets $f line] $line [testchannel inputbuffered $f]
+ variable x
+ lappend x [gets $f line] $line [testchannel inputbuffered $f]
}
fconfigure $f -encoding unicode -buffersize 16 -blocking 0
- vwait x
+ vwait [namespace which -variable x]
fconfigure $f -translation auto -encoding ascii -blocking 1
# here
- vwait x
+ vwait [namespace which -variable x]
close $f
set x
} [list -1 "" 42 15 "123456789012345" 25]
-test io-8.3 {PeekAhead: no cached data available} {stdio} {
+test io-8.3 {PeekAhead: no cached data available} {stdio testchannel} {
# (bytesLeft == 0)
- set f [open "|[list $::tcltest::tcltest cat]" w+]
+ set f [open "|[list [interpreter] $path(cat)]" w+]
fconfigure $f -translation {auto binary}
puts -nonewline $f "abcdefghijklmno\r"
flush $f
@@ -1088,11 +1116,11 @@ append a "1234567890123456789012345678901"
test io-8.4 {PeekAhead: cached data available in this buffer} {
# not (bytesLeft == 0)
- set f [open test1 w+]
+ set f [open $path(test1) w+]
fconfigure $f -translation binary
puts $f "${a}\r\nabcdef"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -encoding binary -translation auto
# "${a}\r" was converted in one operation (because ENCODING_LINESIZE
@@ -1104,10 +1132,10 @@ test io-8.4 {PeekAhead: cached data available in this buffer} {
set x
} $a
unset a
-test io-8.5 {PeekAhead: don't peek if last read was short} {stdio} {
+test io-8.5 {PeekAhead: don't peek if last read was short} {stdio testchannel} {
# (bufPtr->nextAdded < bufPtr->length)
- set f [open "|[list $::tcltest::tcltest cat]" w+]
+ set f [open "|[list [interpreter] $path(cat)]" w+]
fconfigure $f -translation {auto binary}
puts -nonewline $f "abcdefghijklmno\r"
flush $f
@@ -1116,10 +1144,10 @@ test io-8.5 {PeekAhead: don't peek if last read was short} {stdio} {
close $f
set x
} {15 abcdefghijklmno 1}
-test io-8.6 {PeekAhead: change to non-blocking mode} {stdio} {
+test io-8.6 {PeekAhead: change to non-blocking mode} {stdio testchannel} {
# ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0)
- set f [open "|[list $::tcltest::tcltest cat]" w+]
+ set f [open "|[list [interpreter] $path(cat)]" w+]
fconfigure $f -translation {auto binary} -buffersize 16
puts -nonewline $f "abcdefghijklmno\r"
flush $f
@@ -1128,10 +1156,10 @@ test io-8.6 {PeekAhead: change to non-blocking mode} {stdio} {
close $f
set x
} {15 abcdefghijklmno 1}
-test io-8.7 {PeekAhead: cleanup} {stdio} {
+test io-8.7 {PeekAhead: cleanup} {stdio testchannel} {
# Make sure bytes are removed from buffer.
- set f [open "|[list $::tcltest::tcltest cat]" w+]
+ set f [open "|[list [interpreter] $path(cat)]" w+]
fconfigure $f -translation {auto binary} -buffering none
puts -nonewline $f "abcdefghijklmno\r"
# here
@@ -1153,11 +1181,11 @@ test io-10.2 {Tcl_ReadChars: loop until enough copied} {
# one time
# for (copied = 0; (unsigned) toRead > 0; )
- set f [open "test1" w]
+ set f [open $path(test1) w]
puts $f abcdefghijklmnop
close $f
- set f [open "test1"]
+ set f [open $path(test1)]
set x [read $f 5]
close $f
set x
@@ -1166,11 +1194,11 @@ test io-10.3 {Tcl_ReadChars: loop until enough copied} {
# multiple times
# for (copied = 0; (unsigned) toRead > 0; )
- set f [open "test1" w]
+ set f [open $path(test1) w]
puts $f abcdefghijklmnopqrstuvwxyz
close $f
- set f [open "test1"]
+ set f [open $path(test1)]
fconfigure $f -buffersize 16
# here
set x [read $f 19]
@@ -1180,11 +1208,11 @@ test io-10.3 {Tcl_ReadChars: loop until enough copied} {
test io-10.4 {Tcl_ReadChars: no more in channel buffer} {
# (copiedNow < 0)
- set f [open "test1" w]
+ set f [open $path(test1) w]
puts -nonewline $f abcdefghijkl
close $f
- set f [open "test1"]
+ set f [open $path(test1)]
# here
set x [read $f 1000]
close $f
@@ -1193,11 +1221,11 @@ test io-10.4 {Tcl_ReadChars: no more in channel buffer} {
test io-10.5 {Tcl_ReadChars: stop on EOF} {
# (chanPtr->flags & CHANNEL_EOF)
- set f [open "test1" w]
+ set f [open $path(test1) w]
puts -nonewline $f abcdefghijkl
close $f
- set f [open "test1"]
+ set f [open $path(test1)]
# here
set x [read $f 1000]
close $f
@@ -1207,10 +1235,10 @@ test io-10.5 {Tcl_ReadChars: stop on EOF} {
test io-11.1 {ReadBytes: want to read a lot} {
# ((unsigned) toRead > (unsigned) srcLen)
- set f [open "test1" w]
+ set f [open $path(test1) w]
puts -nonewline $f abcdefghijkl
close $f
- set f [open "test1"]
+ set f [open $path(test1)]
fconfigure $f -encoding binary
# here
set x [read $f 1000]
@@ -1220,10 +1248,10 @@ test io-11.1 {ReadBytes: want to read a lot} {
test io-11.2 {ReadBytes: want to read all} {
# ((unsigned) toRead > (unsigned) srcLen)
- set f [open "test1" w]
+ set f [open $path(test1) w]
puts -nonewline $f abcdefghijkl
close $f
- set f [open "test1"]
+ set f [open $path(test1)]
fconfigure $f -encoding binary
# here
set x [read $f]
@@ -1233,10 +1261,10 @@ test io-11.2 {ReadBytes: want to read all} {
test io-11.3 {ReadBytes: allocate more space} {
# (toRead > length - offset - 1)
- set f [open "test1" w]
+ set f [open $path(test1) w]
puts -nonewline $f abcdefghijklmnopqrstuvwxyz
close $f
- set f [open "test1"]
+ set f [open $path(test1)]
fconfigure $f -buffersize 16 -encoding binary
# here
set x [read $f]
@@ -1246,10 +1274,10 @@ test io-11.3 {ReadBytes: allocate more space} {
test io-11.4 {ReadBytes: EOF char found} {
# (TranslateInputEOL() != 0)
- set f [open "test1" w]
+ set f [open $path(test1) w]
puts $f abcdefghijklmnopqrstuvwxyz
close $f
- set f [open "test1"]
+ set f [open $path(test1)]
fconfigure $f -eofchar m -encoding binary
# here
set x [list [read $f] [eof $f] [read $f] [eof $f]]
@@ -1260,10 +1288,10 @@ test io-11.4 {ReadBytes: EOF char found} {
test io-12.1 {ReadChars: want to read a lot} {
# ((unsigned) toRead > (unsigned) srcLen)
- set f [open "test1" w]
+ set f [open $path(test1) w]
puts -nonewline $f abcdefghijkl
close $f
- set f [open "test1"]
+ set f [open $path(test1)]
# here
set x [read $f 1000]
close $f
@@ -1272,10 +1300,10 @@ test io-12.1 {ReadChars: want to read a lot} {
test io-12.2 {ReadChars: want to read all} {
# ((unsigned) toRead > (unsigned) srcLen)
- set f [open "test1" w]
+ set f [open $path(test1) w]
puts -nonewline $f abcdefghijkl
close $f
- set f [open "test1"]
+ set f [open $path(test1)]
# here
set x [read $f]
close $f
@@ -1284,91 +1312,92 @@ test io-12.2 {ReadChars: want to read all} {
test io-12.3 {ReadChars: allocate more space} {
# (toRead > length - offset - 1)
- set f [open "test1" w]
+ set f [open $path(test1) w]
puts -nonewline $f abcdefghijklmnopqrstuvwxyz
close $f
- set f [open "test1"]
+ set f [open $path(test1)]
fconfigure $f -buffersize 16
# here
set x [read $f]
close $f
set x
} {abcdefghijklmnopqrstuvwxyz}
-test io-12.4 {ReadChars: split-up char} {stdio} {
+test io-12.4 {ReadChars: split-up char} {stdio testchannel} {
# (srcRead == 0)
- set f [open "|[list $::tcltest::tcltest cat]" w+]
+ set f [open "|[list [interpreter] $path(cat)]" w+]
fconfigure $f -encoding binary -buffering none -buffersize 16
puts -nonewline $f "123456789012345\x96"
fconfigure $f -encoding shiftjis -blocking 0
- fileevent $f read "ready $f"
+ fileevent $f read [namespace code "ready $f"]
proc ready {f} {
- lappend ::x [read $f] [testchannel inputbuffered $f]
+ variable x
+ lappend x [read $f] [testchannel inputbuffered $f]
}
- set x {}
+ variable x {}
fconfigure $f -encoding shiftjis
- vwait x
+ vwait [namespace which -variable x]
fconfigure $f -encoding binary -blocking 1
puts -nonewline $f "\x7b"
after 500 ;# Give the cat process time to catch up
fconfigure $f -encoding shiftjis -blocking 0
- vwait x
+ vwait [namespace which -variable x]
close $f
set x
} [list "123456789012345" 1 "\u672c" 0]
test io-12.5 {ReadChars: fileevents on partial characters} {stdio} {
- makeFile {
+ set path(test1) [makeFile {
fconfigure stdout -encoding binary -buffering none
gets stdin; puts -nonewline "\xe7"
gets stdin; puts -nonewline "\x89"
gets stdin; puts -nonewline "\xa6"
- } test1
- set f [open "|[list $::tcltest::tcltest test1]" r+]
- fileevent $f readable {
+ } test1]
+ set f [open "|[list [interpreter] $path(test1)]" r+]
+ fileevent $f readable [namespace code {
lappend x [read $f]
if {[eof $f]} {
lappend x eof
}
- }
+ }]
puts $f "go1"
flush $f
fconfigure $f -blocking 0 -encoding utf-8
- set x {}
- vwait x
- after 500 { lappend x timeout }
- vwait x
+ variable x {}
+ vwait [namespace which -variable x]
+ after 500 [namespace code { lappend x timeout }]
+ vwait [namespace which -variable x]
puts $f "go2"
flush $f
- vwait x
- after 500 { lappend x timeout }
- vwait x
+ vwait [namespace which -variable x]
+ after 500 [namespace code { lappend x timeout }]
+ vwait [namespace which -variable x]
puts $f "go3"
flush $f
- vwait x
- vwait x
+ vwait [namespace which -variable x]
+ vwait [namespace which -variable x]
lappend x [catch {close $f} msg] $msg
set x
} "{} timeout {} timeout \u7266 {} eof 0 {}"
test io-13.1 {TranslateInputEOL: cr mode} {} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "abcd\rdef\r"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation cr
set x [read $f]
close $f
set x
} "abcd\ndef\n"
test io-13.2 {TranslateInputEOL: crlf mode} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "abcd\r\ndef\r\n"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation crlf
set x [read $f]
close $f
@@ -1377,11 +1406,11 @@ test io-13.2 {TranslateInputEOL: crlf mode} {
test io-13.3 {TranslateInputEOL: crlf mode: naked cr} {
# (src >= srcMax)
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "abcd\r\ndef\r"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation crlf
set x [read $f]
close $f
@@ -1390,11 +1419,11 @@ test io-13.3 {TranslateInputEOL: crlf mode: naked cr} {
test io-13.4 {TranslateInputEOL: crlf mode: cr followed by not \n} {
# (src >= srcMax)
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "abcd\r\ndef\rfgh"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation crlf
set x [read $f]
close $f
@@ -1403,48 +1432,50 @@ test io-13.4 {TranslateInputEOL: crlf mode: cr followed by not \n} {
test io-13.5 {TranslateInputEOL: crlf mode: naked lf} {
# (src >= srcMax)
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "abcd\r\ndef\nfgh"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation crlf
set x [read $f]
close $f
set x
} "abcd\ndef\nfgh"
-test io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} {stdio} {
+test io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} {stdio testchannel} {
# (chanPtr->flags & INPUT_SAW_CR)
# This test may fail on slower machines.
- set f [open "|[list $::tcltest::tcltest cat]" w+]
+ set f [open "|[list [interpreter] $path(cat)]" w+]
fconfigure $f -blocking 0 -buffering none -translation {auto lf}
- fileevent $f read "ready $f"
+ fileevent $f read [namespace code "ready $f"]
proc ready {f} {
- lappend ::x [read $f] [testchannel queuedcr $f]
+ variable x
+ lappend x [read $f] [testchannel queuedcr $f]
}
- set x {}
+ variable x {}
+ variable y {}
puts -nonewline $f "abcdefghj\r"
- after 500 {set y ok}
- vwait y
+ after 500 [namespace code {set y ok}]
+ vwait [namespace which -variable y]
puts -nonewline $f "\n01234"
- after 500 {set y ok}
- vwait y
+ after 500 [namespace code {set y ok}]
+ vwait [namespace which -variable y]
close $f
set x
} [list "abcdefghj\n" 1 "01234" 0]
-test io-13.7 {TranslateInputEOL: auto mode: naked \r} {
+test io-13.7 {TranslateInputEOL: auto mode: naked \r} {testchannel} {
# (src >= srcMax)
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "abcd\r"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation auto
set x [list [read $f] [testchannel queuedcr $f]]
close $f
@@ -1453,22 +1484,22 @@ test io-13.7 {TranslateInputEOL: auto mode: naked \r} {
test io-13.8 {TranslateInputEOL: auto mode: \r\n} {
# (*src == '\n')
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "abcd\r\ndef"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation auto
set x [read $f]
close $f
set x
} "abcd\ndef"
test io-13.9 {TranslateInputEOL: auto mode: \r followed by not \n} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "abcd\rdef"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation auto
set x [read $f]
close $f
@@ -1477,11 +1508,11 @@ test io-13.9 {TranslateInputEOL: auto mode: \r followed by not \n} {
test io-13.10 {TranslateInputEOL: auto mode: \n} {
# not (*src == '\r')
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "abcd\ndef"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation auto
set x [read $f]
close $f
@@ -1490,11 +1521,11 @@ test io-13.10 {TranslateInputEOL: auto mode: \n} {
test io-13.11 {TranslateInputEOL: EOF char} {
# (*chanPtr->inEofChar != '\0')
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "abcd\ndefgh"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation auto -eofchar e
set x [read $f]
close $f
@@ -1503,11 +1534,11 @@ test io-13.11 {TranslateInputEOL: EOF char} {
test io-13.12 {TranslateInputEOL: find EOF char in src} {
# (*chanPtr->inEofChar != '\0')
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "\r\n\r\n\r\nab\r\n\r\ndef\r\n\r\n\r\n"
close $f
- set f [open test1]
+ set f [open $path(test1)]
fconfigure $f -translation auto -eofchar e
set x [read $f]
close $f
@@ -1518,12 +1549,18 @@ test io-13.12 {TranslateInputEOL: find EOF char in src} {
# Tcl_SetStdChannel and Tcl_GetStdChannel. Incidentally we are
# also testing channel table management.
-if {$tcl_platform(platform) == "macintosh"} {
- set consoleFileNames [list console0 console1 console2]
+if {[info commands testchannel] != ""} {
+ if {$tcl_platform(platform) == "macintosh"} {
+ set consoleFileNames [list console0 console1 console2]
+ } else {
+ set consoleFileNames [lsort [testchannel open]]
+ }
} else {
- set consoleFileNames [lsort [testchannel open]]
+ # just to avoid an error
+ set consoleFileNames [list]
}
-test io-14.1 {Tcl_SetStdChannel and Tcl_GetStdChannel} {
+
+test io-14.1 {Tcl_SetStdChannel and Tcl_GetStdChannel} {testchannel} {
set l ""
lappend l [fconfigure stdin -buffering]
lappend l [fconfigure stdout -buffering]
@@ -1540,26 +1577,29 @@ test io-14.2 {Tcl_SetStdChannel and Tcl_GetStdChannel} {
interp delete x
set l
} {line line none}
-test io-14.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} {stdio} {
- set f [open test1 w]
- puts $f {
+
+set path(test3) [makeFile {} test3]
+
+test io-14.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} {exec} {
+ set f [open $path(test1) w]
+ puts $f [format {
close stdin
close stdout
close stderr
- set f [open test1 r]
- set f2 [open test2 w]
- set f3 [open test3 w]
+ set f [open "%s" r]
+ set f2 [open "%s" w]
+ set f3 [open "%s" w]
puts stdout [gets stdin]
puts stdout out
puts stderr err
close $f
close $f2
close $f3
- }
+ } $path(test1) $path(test2) $path(test3)]
close $f
- set result [exec $::tcltest::tcltest test1]
- set f [open test2 r]
- set f2 [open test3 r]
+ set result [exec [interpreter] $path(test1)]
+ set f [open $path(test2) r]
+ set f2 [open $path(test3) r]
lappend result [read $f] [read $f2]
close $f
close $f2
@@ -1569,25 +1609,25 @@ out
} {err
}}
# This test relies on the fact that the smallest available fd is used first.
-test io-14.4 {Tcl_SetStdChannel & Tcl_GetStdChannel} {unixOnly} {
- set f [open test1 w]
- puts $f { close stdin
+test io-14.4 {Tcl_SetStdChannel & Tcl_GetStdChannel} {exec unixOnly} {
+ set f [open $path(test1) w]
+ puts $f [format { close stdin
close stdout
close stderr
- set f [open test1 r]
- set f2 [open test2 w]
- set f3 [open test3 w]
+ set f [open "%s" r]
+ set f2 [open "%s" w]
+ set f3 [open "%s" w]
puts stdout [gets stdin]
puts stdout $f2
puts stderr $f3
close $f
close $f2
close $f3
- }
+ } $path(test1) $path(test2) $path(test3)]
close $f
- set result [exec $::tcltest::tcltest test1]
- set f [open test2 r]
- set f2 [open test3 r]
+ set result [exec [interpreter] $path(test1)]
+ set f [open $path(test2) r]
+ set f2 [open $path(test3) r]
lappend result [read $f] [read $f2]
close $f
close $f2
@@ -1627,38 +1667,43 @@ test io-14.7 {Tcl_GetChannel: stdio name translation} {
interp delete z
set result
} {{} {} {can not find channel named "stderr"}}
+
+set path(script) [makeFile {} script]
+
test io-14.8 {reuse of stdio special channels} {stdio} {
removeFile script
removeFile test1
- set f [open script w]
- puts $f {
+ set f [open $path(script) w]
+ puts $f [format {
close stderr
- set f [open test1 w]
+ set f [open "%s" w]
puts stderr hello
close $f
- set f [open test1 r]
+ set f [open "%s" r]
puts [gets $f]
- }
+ } $path(test1) $path(test1)]
close $f
- set f [open "|[list $::tcltest::tcltest script]" r]
+ set f [open "|[list [interpreter] $path(script)]" r]
set c [gets $f]
close $f
set c
} hello
+
test io-14.9 {reuse of stdio special channels} {stdio} {
removeFile script
removeFile test1
- set f [open script w]
+ set f [open $path(script) w]
puts $f {
- set f [open test1 w]
+ array set path [lindex $argv 0]
+ set f [open $path(test1) w]
puts $f hello
close $f
close stderr
- set f [open "|[list [info nameofexecutable] cat test1]" r]
+ set f [open "|[list [info nameofexecutable] $path(cat) $path(test1)]" r]
puts [gets $f]
}
close $f
- set f [open "|[list $::tcltest::tcltest script]" r]
+ set f [open "|[list [interpreter] $path(script) [array get path]]" r]
set c [gets $f]
close $f
set c
@@ -1677,7 +1722,7 @@ test io-16.1 {Tcl_DeleteCloseHandler} {
# These functions use "eof stdin" to ensure that the standard
# channels are added to the channel table of the interpreter.
-test io-17.1 {GetChannelTable, DeleteChannelTable on std handles} {
+test io-17.1 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} {
set l1 [testchannel refcount stdin]
eof stdin
interp create x
@@ -1689,7 +1734,7 @@ test io-17.1 {GetChannelTable, DeleteChannelTable on std handles} {
lappend l [expr [testchannel refcount stdin] - $l1]
set l
} {0 1 0}
-test io-17.2 {GetChannelTable, DeleteChannelTable on std handles} {
+test io-17.2 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} {
set l1 [testchannel refcount stdout]
eof stdin
interp create x
@@ -1701,7 +1746,7 @@ test io-17.2 {GetChannelTable, DeleteChannelTable on std handles} {
lappend l [expr [testchannel refcount stdout] - $l1]
set l
} {0 1 0}
-test io-17.3 {GetChannelTable, DeleteChannelTable on std handles} {
+test io-17.3 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} {
set l1 [testchannel refcount stderr]
eof stdin
interp create x
@@ -1714,10 +1759,10 @@ test io-17.3 {GetChannelTable, DeleteChannelTable on std handles} {
set l
} {0 1 0}
-test io-18.1 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {
+test io-18.1 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {testchannel} {
removeFile test1
set l ""
- set f [open test1 w]
+ set f [open $path(test1) w]
lappend l [lindex [testchannel info $f] 15]
close $f
if {[catch {lindex [testchannel info $f] 15} msg]} {
@@ -1728,10 +1773,10 @@ test io-18.1 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {
string compare [string tolower $l] \
[list 1 [format "can not find channel named \"%s\"" $f]]
} 0
-test io-18.2 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {
+test io-18.2 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {testchannel} {
removeFile test1
set l ""
- set f [open test1 w]
+ set f [open $path(test1) w]
lappend l [lindex [testchannel info $f] 15]
interp create x
interp share "" $f x
@@ -1749,10 +1794,10 @@ test io-18.2 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {
string compare [string tolower $l] \
[list 1 2 1 1 [format "can not find channel named \"%s\"" $f]]
} 0
-test io-18.3 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {
+test io-18.3 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {testchannel} {
removeFile test1
set l ""
- set f [open test1 w]
+ set f [open $path(test1) w]
lappend l [lindex [testchannel info $f] 15]
interp create x
interp share "" $f x
@@ -1774,7 +1819,7 @@ test io-19.1 {Tcl_GetChannel->Tcl_GetStdChannel, standard handles} {
} 0
test io-19.2 {testing Tcl_GetChannel, user opened handle} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
set x [eof $f]
close $f
set x
@@ -1782,9 +1827,9 @@ test io-19.2 {testing Tcl_GetChannel, user opened handle} {
test io-19.3 {Tcl_GetChannel, channel not found} {
list [catch {eof file34} msg] $msg
} {1 {can not find channel named "file34"}}
-test io-19.4 {Tcl_CreateChannel, insertion into channel table} {
+test io-19.4 {Tcl_CreateChannel, insertion into channel table} {testchannel} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
set l ""
lappend l [eof $f]
close $f
@@ -1798,10 +1843,10 @@ test io-19.4 {Tcl_CreateChannel, insertion into channel table} {
} 0
test io-20.1 {Tcl_CreateChannel: initial settings} {
- set a [open test2 w]
+ set a [open $path(test2) w]
set old [encoding system]
encoding system ascii
- set f [open test1 w]
+ set f [open $path(test1) w]
set x [fconfigure $f -encoding]
close $f
encoding system $old
@@ -1809,33 +1854,36 @@ test io-20.1 {Tcl_CreateChannel: initial settings} {
set x
} {ascii}
test io-20.2 {Tcl_CreateChannel: initial settings} {pcOnly} {
- set f [open test1 w+]
+ set f [open $path(test1) w+]
set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]]
close $f
set x
} [list [list \x1a ""] {auto crlf}]
test io-20.3 {Tcl_CreateChannel: initial settings} {unixOnly} {
- set f [open test1 w+]
+ set f [open $path(test1) w+]
set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]]
close $f
set x
} {{{} {}} {auto lf}}
test io-20.4 {Tcl_CreateChannel: initial settings} {macOnly} {
- set f [open test1 w+]
+ set f [open $path(test1) w+]
set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]]
close $f
set x
} {{{} {}} {auto cr}}
+
+set path(stdout) [makeFile {} stdout]
+
test io-20.5 {Tcl_CreateChannel: install channel in empty slot} {stdio} {
- set f [open script w]
- puts $f {
+ set f [open $path(script) w]
+ puts $f [format {
close stdout
- set f1 [open stdout w]
+ set f1 [open "%s" w]
fconfigure $f1 -buffersize 777
puts stderr [fconfigure stdout -buffersize]
- }
+ } $path(stdout)]
close $f
- set f [open "|[list $::tcltest::tcltest script]"]
+ set f [open "|[list [interpreter] $path(script)]"]
catch {close $f} msg
set msg
} {777}
@@ -1853,28 +1901,28 @@ test io-22.1 {Tcl_GetChannelMode} {
# Not used anywhere in Tcl.
} {}
-test io-23.1 {Tcl_GetChannelName} {
+test io-23.1 {Tcl_GetChannelName} {testchannel} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
set n [testchannel name $f]
close $f
string compare $n $f
} 0
-test io-24.1 {Tcl_GetChannelType} {
+test io-24.1 {Tcl_GetChannelType} {testchannel} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
set t [testchannel type $f]
close $f
string compare $t file
} 0
-test io-25.1 {Tcl_GetChannelHandle, input} {
- set f [open test1 w]
+test io-25.1 {Tcl_GetChannelHandle, input} {testchannel} {
+ set f [open $path(test1) w]
fconfigure $f -translation lf -eofchar {}
puts $f "1234567890\n098765432"
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
gets $f
set l ""
lappend l [testchannel inputbuffered $f]
@@ -1882,9 +1930,9 @@ test io-25.1 {Tcl_GetChannelHandle, input} {
close $f
set l
} {10 11}
-test io-25.2 {Tcl_GetChannelHandle, output} {
+test io-25.2 {Tcl_GetChannelHandle, output} {testchannel} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts $f hello
set l ""
@@ -1902,7 +1950,7 @@ test io-26.1 {Tcl_GetChannelInstanceData} {stdio} {
# "pid" command uses Tcl_GetChannelInstanceData
# Don't care what pid is (but must be a number), just want to exercise it.
- set f [open "|[list $::tcltest::tcltest << exit]"]
+ set f [open "|[list [interpreter] << exit]"]
expr [pid $f]
close $f
} {}
@@ -1911,100 +1959,104 @@ test io-26.1 {Tcl_GetChannelInstanceData} {stdio} {
test io-27.1 {FlushChannel, no output buffered} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
flush $f
- set s [file size test1]
+ set s [file size $path(test1)]
close $f
set s
} 0
test io-27.2 {FlushChannel, some output buffered} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf -eofchar {}
set l ""
puts $f hello
- lappend l [file size test1]
+ lappend l [file size $path(test1)]
flush $f
- lappend l [file size test1]
+ lappend l [file size $path(test1)]
close $f
- lappend l [file size test1]
+ lappend l [file size $path(test1)]
set l
} {0 6 6}
test io-27.3 {FlushChannel, implicit flush on close} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf -eofchar {}
set l ""
puts $f hello
- lappend l [file size test1]
+ lappend l [file size $path(test1)]
close $f
- lappend l [file size test1]
+ lappend l [file size $path(test1)]
set l
} {0 6}
test io-27.4 {FlushChannel, implicit flush when buffer fills} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf -eofchar {}
fconfigure $f -buffersize 60
set l ""
- lappend l [file size test1]
+ lappend l [file size $path(test1)]
for {set i 0} {$i < 12} {incr i} {
puts $f hello
}
- lappend l [file size test1]
+ lappend l [file size $path(test1)]
flush $f
- lappend l [file size test1]
+ lappend l [file size $path(test1)]
close $f
set l
} {0 60 72}
test io-27.5 {FlushChannel, implicit flush when buffer fills and on close} \
{unixOrPc} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf -buffersize 60 -eofchar {}
set l ""
- lappend l [file size test1]
+ lappend l [file size $path(test1)]
for {set i 0} {$i < 12} {incr i} {
puts $f hello
}
- lappend l [file size test1]
+ lappend l [file size $path(test1)]
close $f
- lappend l [file size test1]
+ lappend l [file size $path(test1)]
set l
} {0 60 72}
+
+set path(pipe) [makeFile {} pipe]
+set path(output) [makeFile {} output]
+
test io-27.6 {FlushChannel, async flushing, async close} \
{stdio asyncPipeClose } {
removeFile pipe
removeFile output
- set f [open pipe w]
- puts $f {
- set f [open output w]
+ set f [open $path(pipe) w]
+ puts $f [format {
+ set f [open "%s" w]
fconfigure $f -translation lf -buffering none -eofchar {}
while {![eof stdin]} {
after 20
puts -nonewline $f [read stdin 1024]
}
close $f
- }
+ } $path(output)]
close $f
set x 01234567890123456789012345678901
for {set i 0} {$i < 11} {incr i} {
set x "$x$x"
}
- set f [open output w]
+ set f [open $path(output) w]
close $f
- set f [open "|[list $::tcltest::tcltest pipe]" w]
+ set f [open "|[list [interpreter] $path(pipe)]" w]
fconfigure $f -blocking off
puts -nonewline $f $x
close $f
set counter 0
- while {([file size output] < 65536) && ($counter < 1000)} {
+ while {([file size $path(output)] < 65536) && ($counter < 1000)} {
incr counter
after 20
update
}
if {$counter == 1000} {
- set result "file size only [file size output]"
+ set result "file size only [file size $path(output)]"
} else {
set result ok
}
@@ -2012,9 +2064,9 @@ test io-27.6 {FlushChannel, async flushing, async close} \
# Tests closing a channel. The functions tested are CloseChannel and Tcl_Close.
-test io-28.1 {CloseChannel called when all references are dropped} {
+test io-28.1 {CloseChannel called when all references are dropped} {testchannel} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
interp create x
interp share "" $f x
set l ""
@@ -2027,7 +2079,7 @@ test io-28.1 {CloseChannel called when all references are dropped} {
} {2 1}
test io-28.2 {CloseChannel called when all references are dropped} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
interp create x
interp share "" $f x
puts -nonewline $f abc
@@ -2035,7 +2087,7 @@ test io-28.2 {CloseChannel called when all references are dropped} {
x eval puts $f def
x eval close $f
interp delete x
- set f [open test1 r]
+ set f [open $path(test1) r]
set l [gets $f]
close $f
set l
@@ -2044,7 +2096,7 @@ test io-28.3 {CloseChannel, not called before output queue is empty} \
{stdio asyncPipeClose nonPortable} {
removeFile pipe
removeFile output
- set f [open pipe w]
+ set f [open $path(pipe) w]
puts $f {
# Need to not have eof char appended on close, because the other
@@ -2054,7 +2106,7 @@ test io-28.3 {CloseChannel, not called before output queue is empty} \
fconfigure stdout -eofchar {}
fconfigure stderr -eofchar {}
- set f [open output w]
+ set f [open $path(output) w]
fconfigure $f -translation lf -buffering none
for {set x 0} {$x < 20} {incr x} {
after 20
@@ -2067,15 +2119,15 @@ test io-28.3 {CloseChannel, not called before output queue is empty} \
for {set i 0} {$i < 11} {incr i} {
set x "$x$x"
}
- set f [open output w]
+ set f [open $path(output) w]
close $f
- set f [open "|[list $::tcltest::tcltest pipe]" r+]
+ set f [open "|[list [interpreter] pipe]" r+]
fconfigure $f -blocking off -eofchar {}
puts -nonewline $f $x
close $f
set counter 0
- while {([file size output] < 20480) && ($counter < 1000)} {
+ while {([file size $path(output)] < 20480) && ($counter < 1000)} {
incr counter
after 20
update
@@ -2086,11 +2138,11 @@ test io-28.3 {CloseChannel, not called before output queue is empty} \
set result ok
}
} ok
-test io-28.4 {Tcl_Close} {
+test io-28.4 {Tcl_Close} {testchannel} {
removeFile test1
set l ""
lappend l [lsort [testchannel open]]
- set f [open test1 w]
+ set f [open $path(test1) w]
lappend l [lsort [testchannel open]]
close $f
lappend l [lsort [testchannel open]]
@@ -2099,15 +2151,15 @@ test io-28.4 {Tcl_Close} {
$consoleFileNames]
string compare $l $x
} 0
-test io-28.5 {Tcl_Close vs standard handles} {stdio unixOnly} {
+test io-28.5 {Tcl_Close vs standard handles} {stdio unixOnly testchannel} {
removeFile script
- set f [open script w]
+ set f [open $path(script) w]
puts $f {
close stdin
puts [testchannel open]
}
close $f
- set f [open "|[list $::tcltest::tcltest script]" r]
+ set f [open "|[list [interpreter] $path(script)]" r]
set l [gets $f]
close $f
set l
@@ -2118,97 +2170,97 @@ test io-29.1 {Tcl_WriteChars, channel not writable} {
} {1 {channel "stdin" wasn't opened for writing}}
test io-29.2 {Tcl_WriteChars, empty string} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -eofchar {}
puts -nonewline $f ""
close $f
- file size test1
+ file size $path(test1)
} 0
test io-29.3 {Tcl_WriteChars, nonempty string} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -eofchar {}
puts -nonewline $f hello
close $f
- file size test1
+ file size $path(test1)
} 5
-test io-29.4 {Tcl_WriteChars, buffering in full buffering mode} {
+test io-29.4 {Tcl_WriteChars, buffering in full buffering mode} {testchannel} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf -buffering full -eofchar {}
puts $f hello
set l ""
lappend l [testchannel outputbuffered $f]
- lappend l [file size test1]
+ lappend l [file size $path(test1)]
flush $f
lappend l [testchannel outputbuffered $f]
- lappend l [file size test1]
+ lappend l [file size $path(test1)]
close $f
set l
} {6 0 0 6}
-test io-29.5 {Tcl_WriteChars, buffering in line buffering mode} {
+test io-29.5 {Tcl_WriteChars, buffering in line buffering mode} {testchannel} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf -buffering line -eofchar {}
puts -nonewline $f hello
set l ""
lappend l [testchannel outputbuffered $f]
- lappend l [file size test1]
+ lappend l [file size $path(test1)]
puts $f hello
lappend l [testchannel outputbuffered $f]
- lappend l [file size test1]
+ lappend l [file size $path(test1)]
close $f
set l
} {5 0 0 11}
-test io-29.6 {Tcl_WriteChars, buffering in no buffering mode} {
+test io-29.6 {Tcl_WriteChars, buffering in no buffering mode} {testchannel} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf -buffering none -eofchar {}
puts -nonewline $f hello
set l ""
lappend l [testchannel outputbuffered $f]
- lappend l [file size test1]
+ lappend l [file size $path(test1)]
puts $f hello
lappend l [testchannel outputbuffered $f]
- lappend l [file size test1]
+ lappend l [file size $path(test1)]
close $f
set l
} {0 5 0 11}
-test io-29.7 {Tcl_Flush, full buffering} {
+test io-29.7 {Tcl_Flush, full buffering} {testchannel} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf -buffering full -eofchar {}
puts -nonewline $f hello
set l ""
lappend l [testchannel outputbuffered $f]
- lappend l [file size test1]
+ lappend l [file size $path(test1)]
puts $f hello
lappend l [testchannel outputbuffered $f]
- lappend l [file size test1]
+ lappend l [file size $path(test1)]
flush $f
lappend l [testchannel outputbuffered $f]
- lappend l [file size test1]
+ lappend l [file size $path(test1)]
close $f
set l
} {5 0 11 0 0 11}
-test io-29.8 {Tcl_Flush, full buffering} {
+test io-29.8 {Tcl_Flush, full buffering} {testchannel} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf -buffering line
puts -nonewline $f hello
set l ""
lappend l [testchannel outputbuffered $f]
- lappend l [file size test1]
+ lappend l [file size $path(test1)]
flush $f
lappend l [testchannel outputbuffered $f]
- lappend l [file size test1]
+ lappend l [file size $path(test1)]
puts $f hello
lappend l [testchannel outputbuffered $f]
- lappend l [file size test1]
+ lappend l [file size $path(test1)]
flush $f
lappend l [testchannel outputbuffered $f]
- lappend l [file size test1]
+ lappend l [file size $path(test1)]
close $f
set l
} {5 0 0 5 0 11 0 11}
@@ -2217,41 +2269,41 @@ test io-29.9 {Tcl_Flush, channel not writable} {
} {1 {channel "stdin" wasn't opened for writing}}
test io-29.10 {Tcl_WriteChars, looping and buffering} {
removeFile test1
- set f1 [open test1 w]
+ set f1 [open $path(test1) w]
fconfigure $f1 -translation lf -eofchar {}
- set f2 [open longfile r]
+ set f2 [open $path(longfile) r]
for {set x 0} {$x < 10} {incr x} {
puts $f1 [gets $f2]
}
close $f2
close $f1
- file size test1
+ file size $path(test1)
} 387
test io-29.11 {Tcl_WriteChars, no newline, implicit flush} {
removeFile test1
- set f1 [open test1 w]
+ set f1 [open $path(test1) w]
fconfigure $f1 -eofchar {}
- set f2 [open longfile r]
+ set f2 [open $path(longfile) r]
for {set x 0} {$x < 10} {incr x} {
puts -nonewline $f1 [gets $f2]
}
close $f1
close $f2
- file size test1
+ file size $path(test1)
} 377
test io-29.12 {Tcl_WriteChars on a pipe} {stdio} {
removeFile test1
removeFile pipe
- set f1 [open pipe w]
- puts $f1 {
- set f1 [open longfile r]
+ set f1 [open $path(pipe) w]
+ puts $f1 [format {
+ set f1 [open "%s" r]
for {set x 0} {$x < 10} {incr x} {
puts [gets $f1]
}
- }
+ } $path(longfile)]
close $f1
- set f1 [open "|[list $::tcltest::tcltest pipe]" r]
- set f2 [open longfile r]
+ set f1 [open "|[list [interpreter] $path(pipe)]" r]
+ set f2 [open $path(longfile) r]
set y ok
for {set x 0} {$x < 10} {incr x} {
set l1 [gets $f1]
@@ -2267,16 +2319,16 @@ test io-29.12 {Tcl_WriteChars on a pipe} {stdio} {
test io-29.13 {Tcl_WriteChars to a pipe, line buffered} {stdio} {
removeFile test1
removeFile pipe
- set f1 [open pipe w]
+ set f1 [open $path(pipe) w]
puts $f1 {
puts [gets stdin]
puts [gets stdin]
}
close $f1
set y ok
- set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
+ set f1 [open "|[list [interpreter] $path(pipe)]" r+]
fconfigure $f1 -buffering line
- set f2 [open longfile r]
+ set f2 [open $path(longfile) r]
set line [gets $f2]
puts $f1 $line
set backline [gets $f1]
@@ -2295,28 +2347,28 @@ test io-29.13 {Tcl_WriteChars to a pipe, line buffered} {stdio} {
} ok
test io-29.14 {Tcl_WriteChars, buffering and implicit flush at close} {
removeFile test3
- set f [open test3 w]
+ set f [open $path(test3) w]
puts -nonewline $f "Text1"
puts -nonewline $f " Text 2"
puts $f " Text 3"
close $f
- set f [open test3 r]
+ set f [open $path(test3) r]
set x [gets $f]
close $f
set x
} {Text1 Text 2 Text 3}
test io-29.15 {Tcl_Flush, channel not open for writing} {
removeFile test1
- set fd [open test1 w]
+ set fd [open $path(test1) w]
close $fd
- set fd [open test1 r]
+ set fd [open $path(test1) r]
set x [list [catch {flush $fd} msg] $msg]
close $fd
string compare $x \
[list 1 "channel \"$fd\" wasn't opened for writing"]
} 0
test io-29.16 {Tcl_Flush on pipe opened only for reading} {stdio} {
- set fd [open "|[list $::tcltest::tcltest cat longfile]" r]
+ set fd [open "|[list [interpreter] cat longfile]" r]
set x [list [catch {flush $fd} msg] $msg]
catch {close $fd}
string compare $x \
@@ -2324,79 +2376,79 @@ test io-29.16 {Tcl_Flush on pipe opened only for reading} {stdio} {
} 0
test io-29.17 {Tcl_WriteChars buffers, then Tcl_Flush flushes} {
removeFile test1
- set f1 [open test1 w]
+ set f1 [open $path(test1) w]
fconfigure $f1 -translation lf
puts $f1 hello
puts $f1 hello
puts $f1 hello
flush $f1
- set x [file size test1]
+ set x [file size $path(test1)]
close $f1
set x
} 18
test io-29.18 {Tcl_WriteChars and Tcl_Flush intermixed} {
removeFile test1
set x ""
- set f1 [open test1 w]
+ set f1 [open $path(test1) w]
fconfigure $f1 -translation lf
puts $f1 hello
puts $f1 hello
puts $f1 hello
flush $f1
- lappend x [file size test1]
+ lappend x [file size $path(test1)]
puts $f1 hello
flush $f1
- lappend x [file size test1]
+ lappend x [file size $path(test1)]
puts $f1 hello
flush $f1
- lappend x [file size test1]
+ lappend x [file size $path(test1)]
close $f1
set x
} {18 24 30}
test io-29.19 {Explicit and implicit flushes} {
removeFile test1
- set f1 [open test1 w]
+ set f1 [open $path(test1) w]
fconfigure $f1 -translation lf -eofchar {}
set x ""
puts $f1 hello
puts $f1 hello
puts $f1 hello
flush $f1
- lappend x [file size test1]
+ lappend x [file size $path(test1)]
puts $f1 hello
flush $f1
- lappend x [file size test1]
+ lappend x [file size $path(test1)]
puts $f1 hello
close $f1
- lappend x [file size test1]
+ lappend x [file size $path(test1)]
set x
} {18 24 30}
test io-29.20 {Implicit flush when buffer is full} {
removeFile test1
- set f1 [open test1 w]
+ set f1 [open $path(test1) w]
fconfigure $f1 -translation lf -eofchar {}
set line "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
for {set x 0} {$x < 100} {incr x} {
puts $f1 $line
}
set z ""
- lappend z [file size test1]
+ lappend z [file size $path(test1)]
for {set x 0} {$x < 100} {incr x} {
puts $f1 $line
}
- lappend z [file size test1]
+ lappend z [file size $path(test1)]
close $f1
- lappend z [file size test1]
+ lappend z [file size $path(test1)]
set z
} {4096 12288 12600}
test io-29.21 {Tcl_Flush to pipe} {stdio} {
removeFile pipe
- set f1 [open pipe w]
+ set f1 [open $path(pipe) w]
puts $f1 {set x [read stdin 6]}
puts $f1 {set cnt [string length $x]}
puts $f1 {puts "read $cnt characters"}
close $f1
- set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
+ set f1 [open "|[list [interpreter] $path(pipe)]" r+]
puts $f1 hello
flush $f1
set x [gets $f1]
@@ -2405,7 +2457,7 @@ test io-29.21 {Tcl_Flush to pipe} {stdio} {
} "read 6 characters"
test io-29.22 {Tcl_Flush called at other end of pipe} {stdio} {
removeFile pipe
- set f1 [open pipe w]
+ set f1 [open $path(pipe) w]
puts $f1 {
fconfigure stdout -buffering full
puts hello
@@ -2416,7 +2468,7 @@ test io-29.22 {Tcl_Flush called at other end of pipe} {stdio} {
flush stdout
}
close $f1
- set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
+ set f1 [open "|[list [interpreter] $path(pipe)]" r+]
set x ""
lappend x [gets $f1]
lappend x [gets $f1]
@@ -2428,7 +2480,7 @@ test io-29.22 {Tcl_Flush called at other end of pipe} {stdio} {
} {hello hello bye}
test io-29.23 {Tcl_Flush and line buffering at end of pipe} {stdio} {
removeFile pipe
- set f1 [open pipe w]
+ set f1 [open $path(pipe) w]
puts $f1 {
puts hello
puts hello
@@ -2436,7 +2488,7 @@ test io-29.23 {Tcl_Flush and line buffering at end of pipe} {stdio} {
puts bye
}
close $f1
- set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
+ set f1 [open "|[list [interpreter] $path(pipe)]" r+]
set x ""
lappend x [gets $f1]
lappend x [gets $f1]
@@ -2447,15 +2499,15 @@ test io-29.23 {Tcl_Flush and line buffering at end of pipe} {stdio} {
set x
} {hello hello bye}
test io-29.24 {Tcl_WriteChars and Tcl_Flush move end of file} {
- set f [open test3 w]
+ set f [open $path(test3) w]
puts $f "Line 1"
puts $f "Line 2"
- set f2 [open test3]
+ set f2 [open $path(test3)]
set x {}
lappend x [read -nonewline $f2]
close $f2
flush $f
- set f2 [open test3]
+ set f2 [open $path(test3)]
lappend x [read -nonewline $f2]
close $f2
close $f
@@ -2463,12 +2515,12 @@ test io-29.24 {Tcl_WriteChars and Tcl_Flush move end of file} {
} "{} {Line 1\nLine 2}"
test io-29.25 {Implicit flush with Tcl_Flush to command pipelines} {stdio} {
removeFile test3
- set f [open "|[list $::tcltest::tcltest cat | $::tcltest::tcltest cat > test3]" w]
+ set f [open "|[list [interpreter] $path(cat) | [interpreter] $path(cat) > $path(test3)]" w]
puts $f "Line 1"
puts $f "Line 2"
close $f
after 100
- set f [open test3 r]
+ set f [open $path(test3) r]
set x [read $f]
close $f
set x
@@ -2483,10 +2535,10 @@ test io-29.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} {stdio unixExecs
} {Line1}
test io-29.27 {Tcl_Flush on closed pipeline} {stdio} {
removeFile pipe
- set f [open pipe w]
+ set f [open $path(pipe) w]
puts $f {exit}
close $f
- set f [open "|[list $::tcltest::tcltest pipe]" r+]
+ set f [open "|[list [interpreter] $path(pipe)]" r+]
gets $f
puts $f output
after 50
@@ -2511,35 +2563,35 @@ test io-29.27 {Tcl_Flush on closed pipeline} {stdio} {
} {1 {error flushing "": broken pipe} {posix epipe {broken pipe}}}
test io-29.28 {Tcl_WriteChars, lf mode} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf -eofchar {}
puts $f hello\nthere\nand\nhere
flush $f
- set s [file size test1]
+ set s [file size $path(test1)]
close $f
set s
} 21
test io-29.29 {Tcl_WriteChars, cr mode} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation cr -eofchar {}
puts $f hello\nthere\nand\nhere
close $f
- file size test1
+ file size $path(test1)
} 21
test io-29.30 {Tcl_WriteChars, crlf mode} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation crlf -eofchar {}
puts $f hello\nthere\nand\nhere
close $f
- file size test1
+ file size $path(test1)
} 25
test io-29.31 {Tcl_WriteChars, background flush} {stdio} {
removeFile pipe
removeFile output
- set f [open pipe w]
- puts $f {set f [open output w]}
+ set f [open $path(pipe) w]
+ puts $f [format {set f [open "%s" w]} $path(output)]
puts $f {fconfigure $f -translation lf}
set x [list while {![eof stdin]}]
set x "$x {"
@@ -2553,20 +2605,20 @@ test io-29.31 {Tcl_WriteChars, background flush} {stdio} {
for {set i 0} {$i < 11} {incr i} {
set x "$x$x"
}
- set f [open output w]
+ set f [open $path(output) w]
close $f
- set f [open "|[list $::tcltest::tcltest pipe]" r+]
+ set f [open "|[list [interpreter] $path(pipe)]" r+]
fconfigure $f -blocking off
puts -nonewline $f $x
close $f
set counter 0
- while {([file size output] < 65536) && ($counter < 1000)} {
+ while {([file size $path(output)] < 65536) && ($counter < 1000)} {
incr counter
after 5
update
}
if {$counter == 1000} {
- set result "file size only [file size output]"
+ set result "file size only [file size $path(output)]"
} else {
set result ok
}
@@ -2575,8 +2627,8 @@ test io-29.32 {Tcl_WriteChars, background flush to slow reader} \
{stdio asyncPipeClose} {
removeFile pipe
removeFile output
- set f [open pipe w]
- puts $f {set f [open output w]}
+ set f [open $path(pipe) w]
+ puts $f [format {set f [open "%s" w]} $path(output)]
puts $f {fconfigure $f -translation lf}
set x [list while {![eof stdin]}]
set x "$x {"
@@ -2591,43 +2643,43 @@ test io-29.32 {Tcl_WriteChars, background flush to slow reader} \
for {set i 0} {$i < 11} {incr i} {
set x "$x$x"
}
- set f [open output w]
+ set f [open $path(output) w]
close $f
- set f [open "|[list $::tcltest::tcltest pipe]" r+]
+ set f [open "|[list [interpreter] $path(pipe)]" r+]
fconfigure $f -blocking off
puts -nonewline $f $x
close $f
set counter 0
- while {([file size output] < 65536) && ($counter < 1000)} {
+ while {([file size $path(output)] < 65536) && ($counter < 1000)} {
incr counter
after 20
update
}
if {$counter == 1000} {
- set result "file size only [file size output]"
+ set result "file size only [file size $path(output)]"
} else {
set result ok
}
} ok
-test io-29.33 {Tcl_Flush, implicit flush on exit} {stdio} {
- set f [open script w]
- puts $f {
- set f [open test1 w]
+test io-29.33 {Tcl_Flush, implicit flush on exit} {exec} {
+ set f [open $path(script) w]
+ puts $f [format {
+ set f [open "%s" w]
fconfigure $f -translation lf
puts $f hello
puts $f bye
puts $f strange
- }
+ } $path(test1)]
close $f
- exec $::tcltest::tcltest script
- set f [open test1 r]
+ exec [interpreter] $path(script)
+ set f [open $path(test1) r]
set r [read $f]
close $f
set r
} "hello\nbye\nstrange\n"
test io-29.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMac} {
set c 0
- set x running
+ variable x running
set l abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz
proc writelots {s l} {
for {set i 0} {$i < 2000} {incr i} {
@@ -2635,13 +2687,14 @@ test io-29.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMa
}
}
proc accept {s a p} {
- global x
- fileevent $s readable [list readit $s]
+ variable x
+ fileevent $s readable [namespace code [list readit $s]]
fconfigure $s -blocking off
set x accepted
}
proc readit {s} {
- global c x
+ variable c
+ variable x
set l [gets $s]
if {[eof $s]} {
@@ -2651,14 +2704,14 @@ test io-29.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMa
incr c
}
}
- set ss [socket -server accept 2828]
- set cs [socket [info hostname] 2828]
- vwait x
+ set ss [socket -server [namespace code accept] 0]
+ set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
+ vwait [namespace which -variable x]
fconfigure $cs -blocking off
writelots $cs $l
close $cs
close $ss
- vwait x
+ vwait [namespace which -variable x]
set c
} 2000
test io-29.35 {Tcl_Close vs fileevent vs multiple interpreters} {socket tempNotMac} {
@@ -2669,12 +2722,12 @@ test io-29.35 {Tcl_Close vs fileevent vs multiple interpreters} {socket tempNotM
catch {interp delete y}
interp create x
interp create y
- set s [socket -server accept 2828]
+ set s [socket -server [namespace code accept] 0]
proc accept {s a p} {
puts $s hello
close $s
}
- set c [socket [info hostname] 2828]
+ set c [socket [info hostname] [lindex [fconfigure $s -sockname] 2]]
interp share {} $c x
interp share {} $c y
close $c
@@ -2707,11 +2760,11 @@ test io-29.35 {Tcl_Close vs fileevent vs multiple interpreters} {socket tempNotM
test io-30.1 {Tcl_Write lf, Tcl_Read lf} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts $f hello\nthere\nand\nhere
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation lf
set x [read $f]
close $f
@@ -2719,11 +2772,11 @@ test io-30.1 {Tcl_Write lf, Tcl_Read lf} {
} "hello\nthere\nand\nhere\n"
test io-30.2 {Tcl_Write lf, Tcl_Read cr} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts $f hello\nthere\nand\nhere
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation cr
set x [read $f]
close $f
@@ -2731,11 +2784,11 @@ test io-30.2 {Tcl_Write lf, Tcl_Read cr} {
} "hello\nthere\nand\nhere\n"
test io-30.3 {Tcl_Write lf, Tcl_Read crlf} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts $f hello\nthere\nand\nhere
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation crlf
set x [read $f]
close $f
@@ -2743,11 +2796,11 @@ test io-30.3 {Tcl_Write lf, Tcl_Read crlf} {
} "hello\nthere\nand\nhere\n"
test io-30.4 {Tcl_Write cr, Tcl_Read cr} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation cr
puts $f hello\nthere\nand\nhere
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation cr
set x [read $f]
close $f
@@ -2755,11 +2808,11 @@ test io-30.4 {Tcl_Write cr, Tcl_Read cr} {
} "hello\nthere\nand\nhere\n"
test io-30.5 {Tcl_Write cr, Tcl_Read lf} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation cr
puts $f hello\nthere\nand\nhere
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation lf
set x [read $f]
close $f
@@ -2767,11 +2820,11 @@ test io-30.5 {Tcl_Write cr, Tcl_Read lf} {
} "hello\rthere\rand\rhere\r"
test io-30.6 {Tcl_Write cr, Tcl_Read crlf} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation cr
puts $f hello\nthere\nand\nhere
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation crlf
set x [read $f]
close $f
@@ -2779,11 +2832,11 @@ test io-30.6 {Tcl_Write cr, Tcl_Read crlf} {
} "hello\rthere\rand\rhere\r"
test io-30.7 {Tcl_Write crlf, Tcl_Read crlf} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation crlf
puts $f hello\nthere\nand\nhere
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation crlf
set x [read $f]
close $f
@@ -2791,11 +2844,11 @@ test io-30.7 {Tcl_Write crlf, Tcl_Read crlf} {
} "hello\nthere\nand\nhere\n"
test io-30.8 {Tcl_Write crlf, Tcl_Read lf} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation crlf
puts $f hello\nthere\nand\nhere
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation lf
set x [read $f]
close $f
@@ -2803,11 +2856,11 @@ test io-30.8 {Tcl_Write crlf, Tcl_Read lf} {
} "hello\r\nthere\r\nand\r\nhere\r\n"
test io-30.9 {Tcl_Write crlf, Tcl_Read cr} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation crlf
puts $f hello\nthere\nand\nhere
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation cr
set x [read $f]
close $f
@@ -2815,11 +2868,11 @@ test io-30.9 {Tcl_Write crlf, Tcl_Read cr} {
} "hello\n\nthere\n\nand\n\nhere\n\n"
test io-30.10 {Tcl_Write lf, Tcl_Read auto} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts $f hello\nthere\nand\nhere
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
set c [read $f]
set x [fconfigure $f -translation]
close $f
@@ -2831,11 +2884,11 @@ here
} auto}
test io-30.11 {Tcl_Write cr, Tcl_Read auto} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation cr
puts $f hello\nthere\nand\nhere
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
set c [read $f]
set x [fconfigure $f -translation]
close $f
@@ -2847,11 +2900,11 @@ here
} auto}
test io-30.12 {Tcl_Write crlf, Tcl_Read auto} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation crlf
puts $f hello\nthere\nand\nhere
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
set c [read $f]
set x [fconfigure $f -translation]
close $f
@@ -2864,7 +2917,7 @@ here
test io-30.13 {Tcl_Write crlf on block boundary, Tcl_Read auto} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation crlf
set line "123456789ABCDE" ;# 14 char plus crlf
puts -nonewline $f x ;# shift crlf across block boundary
@@ -2872,7 +2925,7 @@ test io-30.13 {Tcl_Write crlf on block boundary, Tcl_Read auto} {
puts $f $line
}
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation auto
set c [read $f]
close $f
@@ -2881,7 +2934,7 @@ test io-30.13 {Tcl_Write crlf on block boundary, Tcl_Read auto} {
test io-30.14 {Tcl_Write crlf on block boundary, Tcl_Read crlf} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation crlf
set line "123456789ABCDE" ;# 14 char plus crlf
puts -nonewline $f x ;# shift crlf across block boundary
@@ -2889,7 +2942,7 @@ test io-30.14 {Tcl_Write crlf on block boundary, Tcl_Read crlf} {
puts $f $line
}
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation crlf
set c [read $f]
close $f
@@ -2898,11 +2951,11 @@ test io-30.14 {Tcl_Write crlf on block boundary, Tcl_Read crlf} {
test io-30.15 {Tcl_Write mixed, Tcl_Read auto} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts $f hello\nthere\nand\rhere
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation auto
set c [read $f]
close $f
@@ -2914,11 +2967,11 @@ here
}
test io-30.16 {Tcl_Write ^Z at end, Tcl_Read auto} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f hello\nthere\nand\rhere\n\x1a
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -eofchar \x1a -translation auto
set c [read $f]
close $f
@@ -2930,11 +2983,11 @@ here
}
test io-30.17 {Tcl_Write, implicit ^Z at end, Tcl_Read auto} {pcOnly} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -eofchar \x1a -translation lf
puts $f hello\nthere\nand\rhere
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -eofchar \x1a -translation auto
set c [read $f]
close $f
@@ -2946,12 +2999,12 @@ here
}
test io-30.18 {Tcl_Write, ^Z in middle, Tcl_Read auto} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
set s [format "abc\ndef\n%cghi\nqrs" 26]
puts $f $s
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -eofchar \x1a -translation auto
set l ""
lappend l [gets $f]
@@ -2966,12 +3019,12 @@ test io-30.18 {Tcl_Write, ^Z in middle, Tcl_Read auto} {
} {abc def 0 {} 1 {} 1}
test io-30.19 {Tcl_Write, ^Z no newline in middle, Tcl_Read auto} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
set s [format "abc\ndef\n%cghi\nqrs" 26]
puts $f $s
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -eofchar \x1a -translation auto
set l ""
lappend l [gets $f]
@@ -2986,12 +3039,12 @@ test io-30.19 {Tcl_Write, ^Z no newline in middle, Tcl_Read auto} {
} {abc def 0 {} 1 {} 1}
test io-30.20 {Tcl_Write, ^Z in middle ignored, Tcl_Read lf} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf -eofchar {}
set s [format "abc\ndef\n%cghi\nqrs" 26]
puts $f $s
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation lf -eofchar {}
set l ""
lappend l [gets $f]
@@ -3008,12 +3061,12 @@ test io-30.20 {Tcl_Write, ^Z in middle ignored, Tcl_Read lf} {
} "abc def 0 \x1aghi 0 qrs 0 {} 1"
test io-30.21 {Tcl_Write, ^Z in middle ignored, Tcl_Read cr} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf -eofchar {}
set s [format "abc\ndef\n%cghi\nqrs" 26]
puts $f $s
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation cr -eofchar {}
set l ""
set x [gets $f]
@@ -3026,12 +3079,12 @@ test io-30.21 {Tcl_Write, ^Z in middle ignored, Tcl_Read cr} {
} {0 1 {} 1}
test io-30.22 {Tcl_Write, ^Z in middle ignored, Tcl_Read crlf} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf -eofchar {}
set s [format "abc\ndef\n%cghi\nqrs" 26]
puts $f $s
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation crlf -eofchar {}
set l ""
set x [gets $f]
@@ -3044,12 +3097,12 @@ test io-30.22 {Tcl_Write, ^Z in middle ignored, Tcl_Read crlf} {
} {0 1 {} 1}
test io-30.23 {Tcl_Write lf, ^Z in middle, Tcl_Read auto} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
set c [format abc\ndef\n%cqrs\ntuv 26]
puts $f $c
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation auto -eofchar \x1a
set c [string length [read $f]]
set e [eof $f]
@@ -3058,12 +3111,12 @@ test io-30.23 {Tcl_Write lf, ^Z in middle, Tcl_Read auto} {
} {8 1}
test io-30.24 {Tcl_Write lf, ^Z in middle, Tcl_Read lf} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
set c [format abc\ndef\n%cqrs\ntuv 26]
puts $f $c
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation lf -eofchar \x1a
set c [string length [read $f]]
set e [eof $f]
@@ -3072,12 +3125,12 @@ test io-30.24 {Tcl_Write lf, ^Z in middle, Tcl_Read lf} {
} {8 1}
test io-30.25 {Tcl_Write cr, ^Z in middle, Tcl_Read auto} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation cr
set c [format abc\ndef\n%cqrs\ntuv 26]
puts $f $c
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation auto -eofchar \x1a
set c [string length [read $f]]
set e [eof $f]
@@ -3086,12 +3139,12 @@ test io-30.25 {Tcl_Write cr, ^Z in middle, Tcl_Read auto} {
} {8 1}
test io-30.26 {Tcl_Write cr, ^Z in middle, Tcl_Read cr} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation cr
set c [format abc\ndef\n%cqrs\ntuv 26]
puts $f $c
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation cr -eofchar \x1a
set c [string length [read $f]]
set e [eof $f]
@@ -3100,12 +3153,12 @@ test io-30.26 {Tcl_Write cr, ^Z in middle, Tcl_Read cr} {
} {8 1}
test io-30.27 {Tcl_Write crlf, ^Z in middle, Tcl_Read auto} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation crlf
set c [format abc\ndef\n%cqrs\ntuv 26]
puts $f $c
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation auto -eofchar \x1a
set c [string length [read $f]]
set e [eof $f]
@@ -3114,12 +3167,12 @@ test io-30.27 {Tcl_Write crlf, ^Z in middle, Tcl_Read auto} {
} {8 1}
test io-30.28 {Tcl_Write crlf, ^Z in middle, Tcl_Read crlf} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation crlf
set c [format abc\ndef\n%cqrs\ntuv 26]
puts $f $c
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation crlf -eofchar \x1a
set c [string length [read $f]]
set e [eof $f]
@@ -3131,11 +3184,11 @@ test io-30.28 {Tcl_Write crlf, ^Z in middle, Tcl_Read crlf} {
test io-31.1 {Tcl_Write lf, Tcl_Gets auto} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts $f hello\nthere\nand\nhere
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
set l ""
lappend l [gets $f]
lappend l [tell $f]
@@ -3148,11 +3201,11 @@ test io-31.1 {Tcl_Write lf, Tcl_Gets auto} {
} {hello 6 auto there 12 auto}
test io-31.2 {Tcl_Write cr, Tcl_Gets auto} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation cr
puts $f hello\nthere\nand\nhere
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
set l ""
lappend l [gets $f]
lappend l [tell $f]
@@ -3165,11 +3218,11 @@ test io-31.2 {Tcl_Write cr, Tcl_Gets auto} {
} {hello 6 auto there 12 auto}
test io-31.3 {Tcl_Write crlf, Tcl_Gets auto} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation crlf
puts $f hello\nthere\nand\nhere
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
set l ""
lappend l [gets $f]
lappend l [tell $f]
@@ -3182,11 +3235,11 @@ test io-31.3 {Tcl_Write crlf, Tcl_Gets auto} {
} {hello 7 auto there 14 auto}
test io-31.4 {Tcl_Write lf, Tcl_Gets lf} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts $f hello\nthere\nand\nhere
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation lf
set l ""
lappend l [gets $f]
@@ -3200,11 +3253,11 @@ test io-31.4 {Tcl_Write lf, Tcl_Gets lf} {
} {hello 6 lf there 12 lf}
test io-31.5 {Tcl_Write lf, Tcl_Gets cr} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts $f hello\nthere\nand\nhere
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation cr
set l ""
lappend l [string length [gets $f]]
@@ -3220,11 +3273,11 @@ test io-31.5 {Tcl_Write lf, Tcl_Gets cr} {
} {21 21 cr 1 {} 21 cr 1}
test io-31.6 {Tcl_Write lf, Tcl_Gets crlf} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts $f hello\nthere\nand\nhere
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation crlf
set l ""
lappend l [string length [gets $f]]
@@ -3240,11 +3293,11 @@ test io-31.6 {Tcl_Write lf, Tcl_Gets crlf} {
} {21 21 crlf 1 {} 21 crlf 1}
test io-31.7 {Tcl_Write cr, Tcl_Gets cr} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation cr
puts $f hello\nthere\nand\nhere
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation cr
set l ""
lappend l [gets $f]
@@ -3260,11 +3313,11 @@ test io-31.7 {Tcl_Write cr, Tcl_Gets cr} {
} {hello 6 cr 0 there 12 cr 0}
test io-31.8 {Tcl_Write cr, Tcl_Gets lf} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation cr
puts $f hello\nthere\nand\nhere
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation lf
set l ""
lappend l [string length [gets $f]]
@@ -3280,11 +3333,11 @@ test io-31.8 {Tcl_Write cr, Tcl_Gets lf} {
} {21 21 lf 1 {} 21 lf 1}
test io-31.9 {Tcl_Write cr, Tcl_Gets crlf} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation cr
puts $f hello\nthere\nand\nhere
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation crlf
set l ""
lappend l [string length [gets $f]]
@@ -3300,11 +3353,11 @@ test io-31.9 {Tcl_Write cr, Tcl_Gets crlf} {
} {21 21 crlf 1 {} 21 crlf 1}
test io-31.10 {Tcl_Write crlf, Tcl_Gets crlf} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation crlf
puts $f hello\nthere\nand\nhere
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation crlf
set l ""
lappend l [gets $f]
@@ -3320,11 +3373,11 @@ test io-31.10 {Tcl_Write crlf, Tcl_Gets crlf} {
} {hello 7 crlf 0 there 14 crlf 0}
test io-31.11 {Tcl_Write crlf, Tcl_Gets cr} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation crlf
puts $f hello\nthere\nand\nhere
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation cr
set l ""
lappend l [gets $f]
@@ -3340,11 +3393,11 @@ test io-31.11 {Tcl_Write crlf, Tcl_Gets cr} {
} {hello 6 cr 0 6 13 cr 0}
test io-31.12 {Tcl_Write crlf, Tcl_Gets lf} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation crlf
puts $f hello\nthere\nand\nhere
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation lf
set l ""
lappend l [string length [gets $f]]
@@ -3360,7 +3413,7 @@ test io-31.12 {Tcl_Write crlf, Tcl_Gets lf} {
} {6 7 lf 0 6 14 lf 0}
test io-31.13 {binary mode is synonym of lf mode} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation binary
set x [fconfigure $f -translation]
close $f
@@ -3372,11 +3425,11 @@ test io-31.13 {binary mode is synonym of lf mode} {
#
test io-31.14 {Tcl_Write mixed, Tcl_Gets auto} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts $f hello\nthere\rand\r\nhere
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation auto
set l ""
lappend l [gets $f]
@@ -3391,11 +3444,11 @@ test io-31.14 {Tcl_Write mixed, Tcl_Gets auto} {
} {hello there and here 0 {} 1}
test io-31.15 {Tcl_Write mixed, Tcl_Gets auto} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f hello\nthere\rand\r\nhere\r
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation auto
set l ""
lappend l [gets $f]
@@ -3410,11 +3463,11 @@ test io-31.15 {Tcl_Write mixed, Tcl_Gets auto} {
} {hello there and here 0 {} 1}
test io-31.16 {Tcl_Write mixed, Tcl_Gets auto} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f hello\nthere\rand\r\nhere\n
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
set l ""
lappend l [gets $f]
lappend l [gets $f]
@@ -3428,11 +3481,11 @@ test io-31.16 {Tcl_Write mixed, Tcl_Gets auto} {
} {hello there and here 0 {} 1}
test io-31.17 {Tcl_Write mixed, Tcl_Gets auto} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f hello\nthere\rand\r\nhere\r\n
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation auto
set l ""
lappend l [gets $f]
@@ -3447,12 +3500,12 @@ test io-31.17 {Tcl_Write mixed, Tcl_Gets auto} {
} {hello there and here 0 {} 1}
test io-31.18 {Tcl_Write ^Z at end, Tcl_Gets auto} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
set s [format "hello\nthere\nand\rhere\n\%c" 26]
puts $f $s
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -eofchar \x1a -translation auto
set l ""
lappend l [gets $f]
@@ -3467,11 +3520,11 @@ test io-31.18 {Tcl_Write ^Z at end, Tcl_Gets auto} {
} {hello there and here 0 {} 1}
test io-31.19 {Tcl_Write, implicit ^Z at end, Tcl_Gets auto} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -eofchar \x1a -translation lf
puts $f hello\nthere\nand\rhere
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -eofchar \x1a -translation auto
set l ""
lappend l [gets $f]
@@ -3486,12 +3539,12 @@ test io-31.19 {Tcl_Write, implicit ^Z at end, Tcl_Gets auto} {
} {hello there and here 0 {} 1}
test io-31.20 {Tcl_Write, ^Z in middle, Tcl_Gets auto, eofChar} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
set s [format "abc\ndef\n%cqrs\ntuv" 26]
puts $f $s
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -eofchar \x1a
fconfigure $f -translation auto
set l ""
@@ -3505,12 +3558,12 @@ test io-31.20 {Tcl_Write, ^Z in middle, Tcl_Gets auto, eofChar} {
} {abc def 0 {} 1}
test io-31.21 {Tcl_Write, no newline ^Z in middle, Tcl_Gets auto, eofChar} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
set s [format "abc\ndef\n%cqrs\ntuv" 26]
puts $f $s
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -eofchar \x1a -translation auto
set l ""
lappend l [gets $f]
@@ -3523,12 +3576,12 @@ test io-31.21 {Tcl_Write, no newline ^Z in middle, Tcl_Gets auto, eofChar} {
} {abc def 0 {} 1}
test io-31.22 {Tcl_Write, ^Z in middle ignored, Tcl_Gets lf} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf -eofchar {}
set s [format "abc\ndef\n%cqrs\ntuv" 26]
puts $f $s
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation lf -eofchar {}
set l ""
lappend l [gets $f]
@@ -3545,12 +3598,12 @@ test io-31.22 {Tcl_Write, ^Z in middle ignored, Tcl_Gets lf} {
} "abc def 0 \x1aqrs 0 tuv 0 {} 1"
test io-31.23 {Tcl_Write, ^Z in middle ignored, Tcl_Gets cr} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation cr -eofchar {}
set s [format "abc\ndef\n%cqrs\ntuv" 26]
puts $f $s
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation cr -eofchar {}
set l ""
lappend l [gets $f]
@@ -3567,12 +3620,12 @@ test io-31.23 {Tcl_Write, ^Z in middle ignored, Tcl_Gets cr} {
} "abc def 0 \x1aqrs 0 tuv 0 {} 1"
test io-31.24 {Tcl_Write, ^Z in middle ignored, Tcl_Gets crlf} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation crlf -eofchar {}
set s [format "abc\ndef\n%cqrs\ntuv" 26]
puts $f $s
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation crlf -eofchar {}
set l ""
lappend l [gets $f]
@@ -3589,12 +3642,12 @@ test io-31.24 {Tcl_Write, ^Z in middle ignored, Tcl_Gets crlf} {
} "abc def 0 \x1aqrs 0 tuv 0 {} 1"
test io-31.25 {Tcl_Write lf, ^Z in middle, Tcl_Gets auto} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
set s [format "abc\ndef\n%cqrs\ntuv" 26]
puts $f $s
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation auto -eofchar \x1a
set l ""
lappend l [gets $f]
@@ -3607,12 +3660,12 @@ test io-31.25 {Tcl_Write lf, ^Z in middle, Tcl_Gets auto} {
} {abc def 0 {} 1}
test io-31.26 {Tcl_Write lf, ^Z in middle, Tcl_Gets lf} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
set s [format "abc\ndef\n%cqrs\ntuv" 26]
puts $f $s
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation lf -eofchar \x1a
set l ""
lappend l [gets $f]
@@ -3625,12 +3678,12 @@ test io-31.26 {Tcl_Write lf, ^Z in middle, Tcl_Gets lf} {
} {abc def 0 {} 1}
test io-31.27 {Tcl_Write cr, ^Z in middle, Tcl_Gets auto} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation cr -eofchar {}
set s [format "abc\ndef\n%cqrs\ntuv" 26]
puts $f $s
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation auto -eofchar \x1a
set l ""
lappend l [gets $f]
@@ -3643,12 +3696,12 @@ test io-31.27 {Tcl_Write cr, ^Z in middle, Tcl_Gets auto} {
} {abc def 0 {} 1}
test io-31.28 {Tcl_Write cr, ^Z in middle, Tcl_Gets cr} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation cr -eofchar {}
set s [format "abc\ndef\n%cqrs\ntuv" 26]
puts $f $s
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation cr -eofchar \x1a
set l ""
lappend l [gets $f]
@@ -3661,12 +3714,12 @@ test io-31.28 {Tcl_Write cr, ^Z in middle, Tcl_Gets cr} {
} {abc def 0 {} 1}
test io-31.29 {Tcl_Write crlf, ^Z in middle, Tcl_Gets auto} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation crlf -eofchar {}
set s [format "abc\ndef\n%cqrs\ntuv" 26]
puts $f $s
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation auto -eofchar \x1a
set l ""
lappend l [gets $f]
@@ -3679,12 +3732,12 @@ test io-31.29 {Tcl_Write crlf, ^Z in middle, Tcl_Gets auto} {
} {abc def 0 {} 1}
test io-31.30 {Tcl_Write crlf, ^Z in middle, Tcl_Gets crlf} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation crlf -eofchar {}
set s [format "abc\ndef\n%cqrs\ntuv" 26]
puts $f $s
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation crlf -eofchar \x1a
set l ""
lappend l [gets $f]
@@ -3697,7 +3750,7 @@ test io-31.30 {Tcl_Write crlf, ^Z in middle, Tcl_Gets crlf} {
} {abc def 0 {} 1}
test io-31.31 {Tcl_Write crlf on block boundary, Tcl_Gets crlf} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation crlf
set line "123456789ABCDE" ;# 14 char plus crlf
puts -nonewline $f x ;# shift crlf across block boundary
@@ -3705,7 +3758,7 @@ test io-31.31 {Tcl_Write crlf on block boundary, Tcl_Gets crlf} {
puts $f $line
}
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation crlf
set c ""
while {[gets $f line] >= 0} {
@@ -3716,7 +3769,7 @@ test io-31.31 {Tcl_Write crlf on block boundary, Tcl_Gets crlf} {
} [expr 700*15+1]
test io-31.32 {Tcl_Write crlf on block boundary, Tcl_Gets auto} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation crlf
set line "123456789ABCDE" ;# 14 char plus crlf
puts -nonewline $f x ;# shift crlf across block boundary
@@ -3724,7 +3777,7 @@ test io-31.32 {Tcl_Write crlf on block boundary, Tcl_Gets auto} {
puts $f $line
}
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation auto
set c ""
while {[gets $f line] >= 0} {
@@ -3744,13 +3797,13 @@ test io-32.2 {Tcl_Read, zero byte count} {
read stdin 0
} ""
test io-32.3 {Tcl_Read, negative byte count} {
- set f [open longfile r]
+ set f [open $path(longfile) r]
set l [list [catch {read $f -1} msg] $msg]
close $f
set l
} {1 {bad argument "-1": should be "nonewline"}}
test io-32.4 {Tcl_Read, positive byte count} {
- set f [open longfile r]
+ set f [open $path(longfile) r]
set x [read $f 1024]
set s [string length $x]
unset x
@@ -3758,7 +3811,7 @@ test io-32.4 {Tcl_Read, positive byte count} {
set s
} 1024
test io-32.5 {Tcl_Read, multiple buffers} {
- set f [open longfile r]
+ set f [open $path(longfile) r]
fconfigure $f -buffersize 100
set x [read $f 1024]
set s [string length $x]
@@ -3767,19 +3820,19 @@ test io-32.5 {Tcl_Read, multiple buffers} {
set s
} 1024
test io-32.6 {Tcl_Read, very large read} {
- set f1 [open longfile r]
+ set f1 [open $path(longfile) r]
set z [read $f1 1000000]
close $f1
set l [string length $z]
set x ok
- set z [file size longfile]
+ set z [file size $path(longfile)]
if {$z != $l} {
set x broken
}
set x
} ok
test io-32.7 {Tcl_Read, nonblocking, file} {nonBlockFiles} {
- set f1 [open longfile r]
+ set f1 [open $path(longfile) r]
fconfigure $f1 -blocking off
set z [read $f1 20]
close $f1
@@ -3791,25 +3844,25 @@ test io-32.7 {Tcl_Read, nonblocking, file} {nonBlockFiles} {
set x
} ok
test io-32.8 {Tcl_Read, nonblocking, file} {nonBlockFiles} {
- set f1 [open longfile r]
+ set f1 [open $path(longfile) r]
fconfigure $f1 -blocking off
set z [read $f1 1000000]
close $f1
set x ok
- set l [string length $z]]
- set z [file size longfile]]
+ set l [string length $z]
+ set z [file size $path(longfile)]
if {$z != $l} {
set x broken
}
- set x
+ set x
} ok
test io-32.9 {Tcl_Read, read to end of file} {
- set f1 [open longfile r]
+ set f1 [open $path(longfile) r]
set z [read $f1]
close $f1
set l [string length $z]
set x ok
- set z [file size longfile]
+ set z [file size $path(longfile)]
if {$z != $l} {
set x broken
}
@@ -3817,10 +3870,10 @@ test io-32.9 {Tcl_Read, read to end of file} {
} ok
test io-32.10 {Tcl_Read from a pipe} {stdio} {
removeFile pipe
- set f1 [open pipe w]
+ set f1 [open $path(pipe) w]
puts $f1 {puts [gets stdin]}
close $f1
- set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
+ set f1 [open "|[list [interpreter] $path(pipe)]" r+]
puts $f1 hello
flush $f1
set x [read $f1]
@@ -3829,11 +3882,11 @@ test io-32.10 {Tcl_Read from a pipe} {stdio} {
} "hello\n"
test io-32.11 {Tcl_Read from a pipe} {stdio} {
removeFile pipe
- set f1 [open pipe w]
+ set f1 [open $path(pipe) w]
puts $f1 {puts [gets stdin]}
puts $f1 {puts [gets stdin]}
close $f1
- set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
+ set f1 [open "|[list [interpreter] $path(pipe)]" r+]
puts $f1 hello
flush $f1
set x ""
@@ -3848,11 +3901,11 @@ test io-32.11 {Tcl_Read from a pipe} {stdio} {
}}
test io-32.12 {Tcl_Read, -nonewline} {
removeFile test1
- set f1 [open test1 w]
+ set f1 [open $path(test1) w]
puts $f1 hello
puts $f1 bye
close $f1
- set f1 [open test1 r]
+ set f1 [open $path(test1) r]
set c [read -nonewline $f1]
close $f1
set c
@@ -3860,11 +3913,11 @@ test io-32.12 {Tcl_Read, -nonewline} {
bye}
test io-32.13 {Tcl_Read, -nonewline} {
removeFile test1
- set f1 [open test1 w]
+ set f1 [open $path(test1) w]
puts $f1 hello
puts $f1 bye
close $f1
- set f1 [open test1 r]
+ set f1 [open $path(test1) r]
set c [read -nonewline $f1]
close $f1
list [string length $c] $c
@@ -3872,11 +3925,11 @@ test io-32.13 {Tcl_Read, -nonewline} {
bye}}
test io-32.14 {Tcl_Read, reading in small chunks} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
puts $f "Two lines: this one"
puts $f "and this one"
close $f
- set f [open test1]
+ set f [open $path(test1)]
set x [list [read $f 1] [read $f 2] [read $f]]
close $f
set x
@@ -3885,11 +3938,11 @@ and this one
}}
test io-32.15 {Tcl_Read, asking for more input than available} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
puts $f "Two lines: this one"
puts $f "and this one"
close $f
- set f [open test1]
+ set f [open $path(test1)]
set x [read $f 100]
close $f
set x
@@ -3898,11 +3951,11 @@ and this one
}
test io-32.16 {Tcl_Read, read to end of file with -nonewline} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
puts $f "Two lines: this one"
puts $f "and this one"
close $f
- set f [open test1]
+ set f [open $path(test1)]
set x [read -nonewline $f]
close $f
set x
@@ -3913,11 +3966,11 @@ and this one}
test io-33.1 {Tcl_Gets, reading what was written} {
removeFile test1
- set f1 [open test1 w]
+ set f1 [open $path(test1) w]
set y "first line"
puts $f1 $y
close $f1
- set f1 [open test1 r]
+ set f1 [open $path(test1) r]
set x [gets $f1]
set z ok
if {"$x" != "$y"} {
@@ -3927,7 +3980,7 @@ test io-33.1 {Tcl_Gets, reading what was written} {
set z
} ok
test io-33.2 {Tcl_Gets into variable} {
- set f1 [open longfile r]
+ set f1 [open $path(longfile) r]
set c [gets $f1 x]
set l [string length x]
set z ok
@@ -3939,10 +3992,10 @@ test io-33.2 {Tcl_Gets into variable} {
} ok
test io-33.3 {Tcl_Gets from pipe} {stdio} {
removeFile pipe
- set f1 [open pipe w]
+ set f1 [open $path(pipe) w]
puts $f1 {puts [gets stdin]}
close $f1
- set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
+ set f1 [open "|[list [interpreter] $path(pipe)]" r+]
puts $f1 hello
flush $f1
set x [gets $f1]
@@ -3955,30 +4008,30 @@ test io-33.3 {Tcl_Gets from pipe} {stdio} {
} ok
test io-33.4 {Tcl_Gets with long line} {
removeFile test3
- set f [open test3 w]
+ set f [open $path(test3) w]
puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
puts $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
close $f
- set f [open test3]
+ set f [open $path(test3)]
set x [gets $f]
close $f
set x
} {abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
test io-33.5 {Tcl_Gets with long line} {
- set f [open test3]
+ set f [open $path(test3)]
set x [gets $f y]
close $f
list $x $y
} {260 abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
test io-33.6 {Tcl_Gets and end of file} {
removeFile test3
- set f [open test3 w]
+ set f [open $path(test3) w]
puts -nonewline $f "Test1\nTest2"
close $f
- set f [open test3]
+ set f [open $path(test3)]
set x {}
set y {}
lappend x [gets $f y] $y
@@ -3990,51 +4043,51 @@ test io-33.6 {Tcl_Gets and end of file} {
set x
} {5 Test1 5 Test2 -1 {}}
test io-33.7 {Tcl_Gets and bad variable} {
- set f [open test3 w]
+ set f [open $path(test3) w]
puts $f "Line 1"
puts $f "Line 2"
close $f
catch {unset x}
set x 24
- set f [open test3 r]
+ set f [open $path(test3) r]
set result [list [catch {gets $f x(0)} msg] $msg]
close $f
set result
} {1 {can't set "x(0)": variable isn't array}}
test io-33.8 {Tcl_Gets, exercising double buffering} {
- set f [open test3 w]
+ set f [open $path(test3) w]
fconfigure $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} {puts $f $x}
close $f
- set f [open test3 r]
+ set f [open $path(test3) r]
fconfigure $f -translation lf
for {set y 0} {$y < 100} {incr y} {gets $f}
close $f
set y
} 100
test io-33.9 {Tcl_Gets, exercising double buffering} {
- set f [open test3 w]
+ set f [open $path(test3) w]
fconfigure $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} {puts $f $x}
close $f
- set f [open test3 r]
+ set f [open $path(test3) r]
fconfigure $f -translation lf
for {set y 0} {$y < 200} {incr y} {gets $f}
close $f
set y
} 200
test io-33.10 {Tcl_Gets, exercising double buffering} {
- set f [open test3 w]
+ set f [open $path(test3) w]
fconfigure $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} {puts $f $x}
close $f
- set f [open test3 r]
+ set f [open $path(test3) r]
fconfigure $f -translation lf
for {set y 0} {$y < 300} {incr y} {gets $f}
close $f
@@ -4044,7 +4097,7 @@ test io-33.10 {Tcl_Gets, exercising double buffering} {
# Test Tcl_Seek and Tcl_Tell.
test io-34.1 {Tcl_Seek to current position at start of file} {
- set f1 [open longfile r]
+ set f1 [open $path(longfile) r]
seek $f1 0 current
set c [tell $f1]
close $f1
@@ -4052,12 +4105,12 @@ test io-34.1 {Tcl_Seek to current position at start of file} {
} 0
test io-34.2 {Tcl_Seek to offset from start} {
removeFile test1
- set f1 [open test1 w]
+ set f1 [open $path(test1) w]
fconfigure $f1 -translation lf -eofchar {}
puts $f1 "abcdefghijklmnopqrstuvwxyz"
puts $f1 "abcdefghijklmnopqrstuvwxyz"
close $f1
- set f1 [open test1 r]
+ set f1 [open $path(test1) r]
seek $f1 10 start
set c [tell $f1]
close $f1
@@ -4065,12 +4118,12 @@ test io-34.2 {Tcl_Seek to offset from start} {
} 10
test io-34.3 {Tcl_Seek to end of file} {
removeFile test1
- set f1 [open test1 w]
+ set f1 [open $path(test1) w]
fconfigure $f1 -translation lf -eofchar {}
puts $f1 "abcdefghijklmnopqrstuvwxyz"
puts $f1 "abcdefghijklmnopqrstuvwxyz"
close $f1
- set f1 [open test1 r]
+ set f1 [open $path(test1) r]
seek $f1 0 end
set c [tell $f1]
close $f1
@@ -4078,12 +4131,12 @@ test io-34.3 {Tcl_Seek to end of file} {
} 54
test io-34.4 {Tcl_Seek to offset from end of file} {
removeFile test1
- set f1 [open test1 w]
+ set f1 [open $path(test1) w]
fconfigure $f1 -translation lf -eofchar {}
puts $f1 "abcdefghijklmnopqrstuvwxyz"
puts $f1 "abcdefghijklmnopqrstuvwxyz"
close $f1
- set f1 [open test1 r]
+ set f1 [open $path(test1) r]
seek $f1 -10 end
set c [tell $f1]
close $f1
@@ -4091,12 +4144,12 @@ test io-34.4 {Tcl_Seek to offset from end of file} {
} 44
test io-34.5 {Tcl_Seek to offset from current position} {
removeFile test1
- set f1 [open test1 w]
+ set f1 [open $path(test1) w]
fconfigure $f1 -translation lf -eofchar {}
puts $f1 "abcdefghijklmnopqrstuvwxyz"
puts $f1 "abcdefghijklmnopqrstuvwxyz"
close $f1
- set f1 [open test1 r]
+ set f1 [open $path(test1) r]
seek $f1 10 current
seek $f1 10 current
set c [tell $f1]
@@ -4105,12 +4158,12 @@ test io-34.5 {Tcl_Seek to offset from current position} {
} 20
test io-34.6 {Tcl_Seek to offset from end of file} {
removeFile test1
- set f1 [open test1 w]
+ set f1 [open $path(test1) w]
fconfigure $f1 -translation lf -eofchar {}
puts $f1 "abcdefghijklmnopqrstuvwxyz"
puts $f1 "abcdefghijklmnopqrstuvwxyz"
close $f1
- set f1 [open test1 r]
+ set f1 [open $path(test1) r]
seek $f1 -10 end
set c [tell $f1]
set r [read $f1]
@@ -4120,12 +4173,12 @@ test io-34.6 {Tcl_Seek to offset from end of file} {
}}
test io-34.7 {Tcl_Seek to offset from end of file, then to current position} {
removeFile test1
- set f1 [open test1 w]
+ set f1 [open $path(test1) w]
fconfigure $f1 -translation lf -eofchar {}
puts $f1 "abcdefghijklmnopqrstuvwxyz"
puts $f1 "abcdefghijklmnopqrstuvwxyz"
close $f1
- set f1 [open test1 r]
+ set f1 [open $path(test1) r]
seek $f1 -10 end
set c1 [tell $f1]
set r1 [read $f1 5]
@@ -4135,7 +4188,7 @@ test io-34.7 {Tcl_Seek to offset from end of file, then to current position} {
list $c1 $r1 $c2
} {44 rstuv 49}
test io-34.8 {Tcl_Seek on pipes: not supported} {stdio} {
- set f1 [open "|[list $::tcltest::tcltest]" r+]
+ set f1 [open "|[list [interpreter]]" r+]
set x [list [catch {seek $f1 0 current} msg] $msg]
close $f1
regsub {".*":} $x {"":} x
@@ -4143,11 +4196,11 @@ test io-34.8 {Tcl_Seek on pipes: not supported} {stdio} {
} {1 {error during seek on "": invalid argument}}
test io-34.9 {Tcl_Seek, testing buffered input flushing} {
removeFile test3
- set f [open test3 w]
+ set f [open $path(test3) w]
fconfigure $f -eofchar {}
puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
close $f
- set f [open test3 RDWR]
+ set f [open $path(test3) RDWR]
set x [read $f 1]
seek $f 3
lappend x [read $f 1]
@@ -4164,12 +4217,15 @@ test io-34.9 {Tcl_Seek, testing buffered input flushing} {
close $f
set x
} {a d a l Y {} b}
+
+set path(test3) [makeFile {} test3]
+
test io-34.10 {Tcl_Seek testing flushing of buffered input} {
- set f [open test3 w]
+ set f [open $path(test3) w]
fconfigure $f -translation lf
puts $f xyz\n123
close $f
- set f [open test3 r+]
+ set f [open $path(test3) r+]
fconfigure $f -translation lf
set x [gets $f]
seek $f 0 current
@@ -4179,10 +4235,10 @@ test io-34.10 {Tcl_Seek testing flushing of buffered input} {
} "xyz {xyz
456}"
test io-34.11 {Tcl_Seek testing flushing of buffered output} {
- set f [open test3 w]
+ set f [open $path(test3) w]
puts $f xyz\n123
close $f
- set f [open test3 w+]
+ set f [open $path(test3) w+]
puts $f xyzzy
seek $f 2
set x [gets $f]
@@ -4190,11 +4246,11 @@ test io-34.11 {Tcl_Seek testing flushing of buffered output} {
list $x [viewFile test3]
} "zzy xyzzy"
test io-34.12 {Tcl_Seek testing combination of write, seek back and read} {
- set f [open test3 w]
+ set f [open $path(test3) w]
fconfigure $f -translation lf -eofchar {}
puts $f xyz\n123
close $f
- set f [open test3 a+]
+ set f [open $path(test3) a+]
fconfigure $f -translation lf -eofchar {}
puts $f xyzzy
flush $f
@@ -4208,19 +4264,19 @@ test io-34.12 {Tcl_Seek testing combination of write, seek back and read} {
xyzzy} zzy}
test io-34.13 {Tcl_Tell at start of file} {
removeFile test1
- set f1 [open test1 w]
+ set f1 [open $path(test1) w]
set p [tell $f1]
close $f1
set p
} 0
test io-34.14 {Tcl_Tell after seek to end of file} {
removeFile test1
- set f1 [open test1 w]
+ set f1 [open $path(test1) w]
fconfigure $f1 -translation lf -eofchar {}
puts $f1 "abcdefghijklmnopqrstuvwxyz"
puts $f1 "abcdefghijklmnopqrstuvwxyz"
close $f1
- set f1 [open test1 r]
+ set f1 [open $path(test1) r]
seek $f1 0 end
set c1 [tell $f1]
close $f1
@@ -4228,12 +4284,12 @@ test io-34.14 {Tcl_Tell after seek to end of file} {
} 54
test io-34.15 {Tcl_Tell combined with seeking} {
removeFile test1
- set f1 [open test1 w]
+ set f1 [open $path(test1) w]
fconfigure $f1 -translation lf -eofchar {}
puts $f1 "abcdefghijklmnopqrstuvwxyz"
puts $f1 "abcdefghijklmnopqrstuvwxyz"
close $f1
- set f1 [open test1 r]
+ set f1 [open $path(test1) r]
seek $f1 10 start
set c1 [tell $f1]
seek $f1 10 current
@@ -4242,13 +4298,13 @@ test io-34.15 {Tcl_Tell combined with seeking} {
list $c1 $c2
} {10 20}
test io-34.16 {Tcl_tell on pipe: always -1} {stdio} {
- set f1 [open "|[list $::tcltest::tcltest]" r+]
+ set f1 [open "|[list [interpreter]]" r+]
set c [tell $f1]
close $f1
set c
} -1
test io-34.17 {Tcl_Tell on pipe: always -1} {stdio} {
- set f1 [open "|[list $::tcltest::tcltest]" r+]
+ set f1 [open "|[list [interpreter]]" r+]
puts $f1 {puts hello}
flush $f1
set c [tell $f1]
@@ -4258,11 +4314,11 @@ test io-34.17 {Tcl_Tell on pipe: always -1} {stdio} {
} -1
test io-34.18 {Tcl_Tell combined with seeking and reading} {
removeFile test2
- set f [open test2 w]
+ set f [open $path(test2) w]
fconfigure $f -translation lf -eofchar {}
puts -nonewline $f "line1\nline2\nline3\nline4\nline5\n"
close $f
- set f [open test2]
+ set f [open $path(test2)]
fconfigure $f -translation lf
set x [tell $f]
read $f 3
@@ -4277,18 +4333,18 @@ test io-34.18 {Tcl_Tell combined with seeking and reading} {
set x
} {0 3 2 12 30}
test io-34.19 {Tcl_Tell combined with opening in append mode} {
- set f [open test3 w]
+ set f [open $path(test3) w]
fconfigure $f -translation lf -eofchar {}
puts $f "abcdefghijklmnopqrstuvwxyz"
puts $f "abcdefghijklmnopqrstuvwxyz"
close $f
- set f [open test3 a]
+ set f [open $path(test3) a]
set c [tell $f]
close $f
set c
} 54
test io-34.20 {Tcl_Tell combined with writing} {
- set f [open test3 w]
+ set f [open $path(test3) w]
set l ""
seek $f 29 start
lappend l [tell $f]
@@ -4302,16 +4358,38 @@ test io-34.20 {Tcl_Tell combined with writing} {
close $f
set l
} {29 39 40 447}
+test io-34.21 {Tcl_Seek and Tcl_Tell on large files} {largefileSupport} {
+ removeFile test3
+ set f [open $path(test3) w]
+ fconfigure $f -encoding binary
+ set l ""
+ lappend l [tell $f]
+ puts -nonewline $f abcdef
+ lappend l [tell $f]
+ flush $f
+ lappend l [tell $f]
+ # 4GB offset!
+ seek $f 0x100000000
+ lappend l [tell $f]
+ puts -nonewline $f abcdef
+ lappend l [tell $f]
+ close $f
+ lappend l [file size $f]
+ # truncate...
+ close [open $path(test3) w]
+ lappend l [file size $f]
+ set l
+} {0 6 6 4294967296 4294967302 4294967302 0}
# Test Tcl_Eof
test io-35.1 {Tcl_Eof} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
puts $f hello
puts $f hello
close $f
- set f [open test1]
+ set f [open $path(test1)]
set x [eof $f]
lappend x [eof $f]
gets $f
@@ -4326,11 +4404,11 @@ test io-35.1 {Tcl_Eof} {
} {0 0 0 0 1 1}
test io-35.2 {Tcl_Eof with pipe} {stdio} {
removeFile pipe
- set f1 [open pipe w]
+ set f1 [open $path(pipe) w]
puts $f1 {gets stdin}
puts $f1 {puts hello}
close $f1
- set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
+ set f1 [open "|[list [interpreter] $path(pipe)]" r+]
puts $f1 hello
set x [eof $f1]
flush $f1
@@ -4344,11 +4422,11 @@ test io-35.2 {Tcl_Eof with pipe} {stdio} {
} {0 0 0 1}
test io-35.3 {Tcl_Eof with pipe} {stdio} {
removeFile pipe
- set f1 [open pipe w]
+ set f1 [open $path(pipe) w]
puts $f1 {gets stdin}
puts $f1 {puts hello}
close $f1
- set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
+ set f1 [open "|[list [interpreter] $path(pipe)]" r+]
puts $f1 hello
set x [eof $f1]
flush $f1
@@ -4366,9 +4444,9 @@ test io-35.3 {Tcl_Eof with pipe} {stdio} {
} {0 0 0 1 1 1}
test io-35.4 {Tcl_Eof, eof detection on nonblocking file} {nonBlockFiles} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -blocking off
set l ""
lappend l [gets $f]
@@ -4378,12 +4456,12 @@ test io-35.4 {Tcl_Eof, eof detection on nonblocking file} {nonBlockFiles} {
} {{} 1}
test io-35.5 {Tcl_Eof, eof detection on nonblocking pipe} {stdio} {
removeFile pipe
- set f [open pipe w]
+ set f [open $path(pipe) w]
puts $f {
exit
}
close $f
- set f [open "|[list $::tcltest::tcltest pipe]" r]
+ set f [open "|[list [interpreter] $path(pipe)]" r]
set l ""
lappend l [gets $f]
lappend l [eof $f]
@@ -4392,12 +4470,12 @@ test io-35.5 {Tcl_Eof, eof detection on nonblocking pipe} {stdio} {
} {{} 1}
test io-35.6 {Tcl_Eof, eof char, lf write, auto read} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf -eofchar \x1a
puts $f abc\ndef
close $f
- set s [file size test1]
- set f [open test1 r]
+ set s [file size $path(test1)]
+ set f [open $path(test1) r]
fconfigure $f -translation auto -eofchar \x1a
set l [string length [read $f]]
set e [eof $f]
@@ -4406,12 +4484,12 @@ test io-35.6 {Tcl_Eof, eof char, lf write, auto read} {
} {9 8 1}
test io-35.7 {Tcl_Eof, eof char, lf write, lf read} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf -eofchar \x1a
puts $f abc\ndef
close $f
- set s [file size test1]
- set f [open test1 r]
+ set s [file size $path(test1)]
+ set f [open $path(test1) r]
fconfigure $f -translation lf -eofchar \x1a
set l [string length [read $f]]
set e [eof $f]
@@ -4420,12 +4498,12 @@ test io-35.7 {Tcl_Eof, eof char, lf write, lf read} {
} {9 8 1}
test io-35.8 {Tcl_Eof, eof char, cr write, auto read} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation cr -eofchar \x1a
puts $f abc\ndef
close $f
- set s [file size test1]
- set f [open test1 r]
+ set s [file size $path(test1)]
+ set f [open $path(test1) r]
fconfigure $f -translation auto -eofchar \x1a
set l [string length [read $f]]
set e [eof $f]
@@ -4434,12 +4512,12 @@ test io-35.8 {Tcl_Eof, eof char, cr write, auto read} {
} {9 8 1}
test io-35.9 {Tcl_Eof, eof char, cr write, cr read} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation cr -eofchar \x1a
puts $f abc\ndef
close $f
- set s [file size test1]
- set f [open test1 r]
+ set s [file size $path(test1)]
+ set f [open $path(test1) r]
fconfigure $f -translation cr -eofchar \x1a
set l [string length [read $f]]
set e [eof $f]
@@ -4448,12 +4526,12 @@ test io-35.9 {Tcl_Eof, eof char, cr write, cr read} {
} {9 8 1}
test io-35.10 {Tcl_Eof, eof char, crlf write, auto read} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation crlf -eofchar \x1a
puts $f abc\ndef
close $f
- set s [file size test1]
- set f [open test1 r]
+ set s [file size $path(test1)]
+ set f [open $path(test1) r]
fconfigure $f -translation auto -eofchar \x1a
set l [string length [read $f]]
set e [eof $f]
@@ -4462,12 +4540,12 @@ test io-35.10 {Tcl_Eof, eof char, crlf write, auto read} {
} {11 8 1}
test io-35.11 {Tcl_Eof, eof char, crlf write, crlf read} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation crlf -eofchar \x1a
puts $f abc\ndef
close $f
- set s [file size test1]
- set f [open test1 r]
+ set s [file size $path(test1)]
+ set f [open $path(test1) r]
fconfigure $f -translation crlf -eofchar \x1a
set l [string length [read $f]]
set e [eof $f]
@@ -4476,13 +4554,13 @@ test io-35.11 {Tcl_Eof, eof char, crlf write, crlf read} {
} {11 8 1}
test io-35.12 {Tcl_Eof, eof char in middle, lf write, auto read} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf -eofchar {}
set i [format abc\ndef\n%cqrs\nuvw 26]
puts $f $i
close $f
- set c [file size test1]
- set f [open test1 r]
+ set c [file size $path(test1)]
+ set f [open $path(test1) r]
fconfigure $f -translation auto -eofchar \x1a
set l [string length [read $f]]
set e [eof $f]
@@ -4491,13 +4569,13 @@ test io-35.12 {Tcl_Eof, eof char in middle, lf write, auto read} {
} {17 8 1}
test io-35.13 {Tcl_Eof, eof char in middle, lf write, lf read} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf -eofchar {}
set i [format abc\ndef\n%cqrs\nuvw 26]
puts $f $i
close $f
- set c [file size test1]
- set f [open test1 r]
+ set c [file size $path(test1)]
+ set f [open $path(test1) r]
fconfigure $f -translation lf -eofchar \x1a
set l [string length [read $f]]
set e [eof $f]
@@ -4506,13 +4584,13 @@ test io-35.13 {Tcl_Eof, eof char in middle, lf write, lf read} {
} {17 8 1}
test io-35.14 {Tcl_Eof, eof char in middle, cr write, auto read} {
removeFile test1
- set f [open test1 w]
+ 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 test1]
- set f [open test1 r]
+ set c [file size $path(test1)]
+ set f [open $path(test1) r]
fconfigure $f -translation auto -eofchar \x1a
set l [string length [read $f]]
set e [eof $f]
@@ -4521,13 +4599,13 @@ test io-35.14 {Tcl_Eof, eof char in middle, cr write, auto read} {
} {17 8 1}
test io-35.15 {Tcl_Eof, eof char in middle, cr write, cr read} {
removeFile test1
- set f [open test1 w]
+ 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 test1]
- set f [open test1 r]
+ set c [file size $path(test1)]
+ set f [open $path(test1) r]
fconfigure $f -translation cr -eofchar \x1a
set l [string length [read $f]]
set e [eof $f]
@@ -4536,13 +4614,13 @@ test io-35.15 {Tcl_Eof, eof char in middle, cr write, cr read} {
} {17 8 1}
test io-35.16 {Tcl_Eof, eof char in middle, crlf write, auto read} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation crlf -eofchar {}
set i [format abc\ndef\n%cqrs\nuvw 26]
puts $f $i
close $f
- set c [file size test1]
- set f [open test1 r]
+ set c [file size $path(test1)]
+ set f [open $path(test1) r]
fconfigure $f -translation auto -eofchar \x1a
set l [string length [read $f]]
set e [eof $f]
@@ -4551,13 +4629,13 @@ test io-35.16 {Tcl_Eof, eof char in middle, crlf write, auto read} {
} {21 8 1}
test io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation crlf -eofchar {}
set i [format abc\ndef\n%cqrs\nuvw 26]
puts $f $i
close $f
- set c [file size test1]
- set f [open test1 r]
+ set c [file size $path(test1)]
+ set f [open $path(test1) r]
fconfigure $f -translation crlf -eofchar \x1a
set l [string length [read $f]]
set e [eof $f]
@@ -4568,7 +4646,7 @@ test io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} {
# Test Tcl_InputBlocked
test io-36.1 {Tcl_InputBlocked on nonblocking pipe} {stdio} {
- set f1 [open "|[list $::tcltest::tcltest]" r+]
+ set f1 [open "|[list [interpreter]]" r+]
puts $f1 {puts hello_from_pipe}
flush $f1
gets $f1
@@ -4587,7 +4665,7 @@ test io-36.1 {Tcl_InputBlocked on nonblocking pipe} {stdio} {
set x
} {{} 1 hello 0 {} 1}
test io-36.2 {Tcl_InputBlocked on blocking pipe} {stdio} {
- set f1 [open "|[list $::tcltest::tcltest]" r+]
+ set f1 [open "|[list [interpreter]]" r+]
fconfigure $f1 -buffering line
puts $f1 {puts hello_from_pipe}
set x ""
@@ -4602,10 +4680,10 @@ test io-36.2 {Tcl_InputBlocked on blocking pipe} {stdio} {
} {hello_from_pipe 0 {} 0 1}
test io-36.3 {Tcl_InputBlocked vs files, short read} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
puts $f abcdefghijklmnop
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
set l ""
lappend l [fblocked $f]
lappend l [read $f 3]
@@ -4618,27 +4696,29 @@ test io-36.3 {Tcl_InputBlocked vs files, short read} {
} {0 abc 0 defghijklmnop 0 1}
test io-36.4 {Tcl_InputBlocked vs files, event driven read} {
proc in {f} {
- global l x
+ variable l
+ variable x
lappend l [read $f 3]
if {[eof $f]} {lappend l eof; close $f; set x done}
}
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
puts $f abcdefghijklmnop
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
set l ""
- fileevent $f readable [list in $f]
- vwait x
+ fileevent $f readable [namespace code [list in $f]]
+ variable x
+ vwait [namespace which -variable x]
set l
} {abc def ghi jkl mno {p
} eof}
test io-36.5 {Tcl_InputBlocked vs files, short read, nonblocking} {nonBlockFiles} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
puts $f abcdefghijklmnop
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -blocking off
set l ""
lappend l [fblocked $f]
@@ -4652,27 +4732,29 @@ test io-36.5 {Tcl_InputBlocked vs files, short read, nonblocking} {nonBlockFiles
} {0 abc 0 defghijklmnop 0 1}
test io-36.6 {Tcl_InputBlocked vs files, event driven read} {nonBlockFiles} {
proc in {f} {
- global l x
+ variable l
+ variable x
lappend l [read $f 3]
if {[eof $f]} {lappend l eof; close $f; set x done}
}
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
puts $f abcdefghijklmnop
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -blocking off
set l ""
- fileevent $f readable [list in $f]
- vwait x
+ fileevent $f readable [namespace code [list in $f]]
+ variable x
+ vwait [namespace which -variable x]
set l
} {abc def ghi jkl mno {p
} eof}
# Test Tcl_InputBuffered
-test io-37.1 {Tcl_InputBuffered} {
- set f [open longfile r]
+test io-37.1 {Tcl_InputBuffered} {testchannel} {
+ set f [open $path(longfile) r]
fconfigure $f -buffersize 4096
read $f 3
set l ""
@@ -4681,8 +4763,8 @@ test io-37.1 {Tcl_InputBuffered} {
close $f
set l
} {4093 3}
-test io-37.2 {Tcl_InputBuffered, test input flushing on seek} {
- set f [open longfile r]
+test io-37.2 {Tcl_InputBuffered, test input flushing on seek} {testchannel} {
+ set f [open $path(longfile) r]
fconfigure $f -buffersize 4096
read $f 3
set l ""
@@ -4698,13 +4780,13 @@ test io-37.2 {Tcl_InputBuffered, test input flushing on seek} {
# Test Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize
test io-38.1 {Tcl_GetChannelBufferSize, default buffer size} {
- set f [open longfile r]
+ set f [open $path(longfile) r]
set s [fconfigure $f -buffersize]
close $f
set s
} 4096
test io-38.2 {Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize} {
- set f [open longfile r]
+ set f [open $path(longfile) r]
set l ""
lappend l [fconfigure $f -buffersize]
fconfigure $f -buffersize 10000
@@ -4723,11 +4805,22 @@ test io-38.2 {Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize} {
set l
} {4096 10000 4096 4096 4096 100000 4096}
+test 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]
+ fconfigure $chan -buffersize 10
+ set var [read $chan 2]
+ fconfigure $chan -buffersize 32
+ append var [read $chan]
+ close $chan
+} {}
+
# Test Tcl_SetChannelOption, Tcl_GetChannelOption
test io-39.1 {Tcl_GetChannelOption} {
removeFile test1
- set f1 [open test1 w]
+ set f1 [open $path(test1) w]
set x [fconfigure $f1 -blocking]
close $f1
set x
@@ -4737,14 +4830,14 @@ test io-39.1 {Tcl_GetChannelOption} {
#
test io-39.2 {Tcl_GetChannelOption} {
removeFile test1
- set f1 [open test1 w]
+ set f1 [open $path(test1) w]
set x [fconfigure $f1 -buffering]
close $f1
set x
} full
test io-39.3 {Tcl_GetChannelOption} {
removeFile test1
- set f1 [open test1 w]
+ set f1 [open $path(test1) w]
fconfigure $f1 -buffering line
set x [fconfigure $f1 -buffering]
close $f1
@@ -4752,7 +4845,7 @@ test io-39.3 {Tcl_GetChannelOption} {
} line
test io-39.4 {Tcl_GetChannelOption, Tcl_SetChannelOption} {
removeFile test1
- set f1 [open test1 w]
+ set f1 [open $path(test1) w]
set l ""
lappend l [fconfigure $f1 -buffering]
fconfigure $f1 -buffering line
@@ -4768,7 +4861,7 @@ test io-39.4 {Tcl_GetChannelOption, Tcl_SetChannelOption} {
} {full line none line full}
test io-39.5 {Tcl_GetChannelOption, invariance} {
removeFile test1
- set f1 [open test1 w]
+ set f1 [open $path(test1) w]
set l ""
lappend l [fconfigure $f1 -buffering]
lappend l [list [catch {fconfigure $f1 -buffering green} msg] $msg]
@@ -4778,53 +4871,53 @@ test io-39.5 {Tcl_GetChannelOption, invariance} {
} {full {1 {bad value for -buffering: must be one of full, line, or none}} full}
test io-39.6 {Tcl_SetChannelOption, multiple options} {
removeFile test1
- set f1 [open test1 w]
+ set f1 [open $path(test1) w]
fconfigure $f1 -translation lf -buffering line
puts $f1 hello
puts $f1 bye
- set x [file size test1]
+ set x [file size $path(test1)]
close $f1
set x
} 10
test io-39.7 {Tcl_SetChannelOption, buffering, translation} {
removeFile test1
- set f1 [open test1 w]
+ set f1 [open $path(test1) w]
fconfigure $f1 -translation lf
puts $f1 hello
puts $f1 bye
set x ""
fconfigure $f1 -buffering line
- lappend x [file size test1]
+ lappend x [file size $path(test1)]
puts $f1 really_bye
- lappend x [file size test1]
+ lappend x [file size $path(test1)]
close $f1
set x
} {0 21}
test io-39.8 {Tcl_SetChannelOption, different buffering options} {
removeFile test1
- set f1 [open test1 w]
+ set f1 [open $path(test1) w]
set l ""
fconfigure $f1 -translation lf -buffering none -eofchar {}
puts -nonewline $f1 hello
- lappend l [file size test1]
+ lappend l [file size $path(test1)]
puts -nonewline $f1 hello
- lappend l [file size test1]
+ lappend l [file size $path(test1)]
fconfigure $f1 -buffering full
puts -nonewline $f1 hello
- lappend l [file size test1]
+ lappend l [file size $path(test1)]
fconfigure $f1 -buffering none
- lappend l [file size test1]
+ lappend l [file size $path(test1)]
puts -nonewline $f1 hello
- lappend l [file size test1]
+ lappend l [file size $path(test1)]
close $f1
- lappend l [file size test1]
+ lappend l [file size $path(test1)]
set l
} {5 10 10 10 20 20}
test io-39.9 {Tcl_SetChannelOption, blocking mode} {nonBlockFiles} {
removeFile test1
- set f1 [open test1 w]
+ set f1 [open $path(test1) w]
close $f1
- set f1 [open test1 r]
+ set f1 [open $path(test1) r]
set x ""
lappend x [fconfigure $f1 -blocking]
fconfigure $f1 -blocking off
@@ -4838,7 +4931,7 @@ test io-39.9 {Tcl_SetChannelOption, blocking mode} {nonBlockFiles} {
} {1 0 {} {} 0 1}
test io-39.10 {Tcl_SetChannelOption, blocking mode} {stdio} {
removeFile pipe
- set f1 [open pipe w]
+ set f1 [open $path(pipe) w]
puts $f1 {
gets stdin
after 100
@@ -4847,7 +4940,7 @@ test io-39.10 {Tcl_SetChannelOption, blocking mode} {stdio} {
}
close $f1
set x ""
- set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
+ set f1 [open "|[list [interpreter] $path(pipe)]" r+]
fconfigure $f1 -blocking off -buffering line
lappend x [fconfigure $f1 -blocking]
lappend x [gets $f1]
@@ -4874,7 +4967,7 @@ test io-39.10 {Tcl_SetChannelOption, blocking mode} {stdio} {
} {0 {} 1 {} 1 {} 1 1 hi 0 0 {} 1}
test io-39.11 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -buffersize -10
set x [fconfigure $f -buffersize]
close $f
@@ -4882,7 +4975,7 @@ test io-39.11 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} {
} 4096
test io-39.12 {Tcl_SetChannelOption, Tcl_GetChannelOption buffer size} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -buffersize 10000000
set x [fconfigure $f -buffersize]
close $f
@@ -4890,7 +4983,7 @@ test io-39.12 {Tcl_SetChannelOption, Tcl_GetChannelOption buffer size} {
} 4096
test io-39.13 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -buffersize 40000
set x [fconfigure $f -buffersize]
close $f
@@ -4898,11 +4991,11 @@ test io-39.13 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} {
} 40000
test io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -encoding {}
puts -nonewline $f \xe7\x89\xa6
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -encoding utf-8
set x [read $f]
close $f
@@ -4910,11 +5003,11 @@ test io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} {
} \u7266
test io-39.15 {Tcl_SetChannelOption: -encoding, binary & utf-8} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -encoding binary
puts -nonewline $f \xe7\x89\xa6
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -encoding utf-8
set x [read $f]
close $f
@@ -4922,30 +5015,30 @@ test io-39.15 {Tcl_SetChannelOption: -encoding, binary & utf-8} {
} \u7266
test io-39.16 {Tcl_SetChannelOption: -encoding, errors} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
set result [list [catch {fconfigure $f -encoding foobar} msg] $msg]
close $f
set result
} {1 {unknown encoding "foobar"}}
test io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} {stdio} {
- set f [open "|[list $::tcltest::tcltest cat]" r+]
+ set f [open "|[list [interpreter] $path(cat)]" r+]
fconfigure $f -encoding binary
puts -nonewline $f "\xe7"
flush $f
fconfigure $f -encoding utf-8 -blocking 0
- set x {}
- fileevent $f readable { lappend x [read $f] }
- vwait x
- after 300 { lappend x timeout }
- vwait x
+ variable x {}
+ fileevent $f readable [namespace code { lappend x [read $f] }]
+ vwait [namespace which -variable x]
+ after 300 [namespace code { lappend x timeout }]
+ vwait [namespace which -variable x]
fconfigure $f -encoding utf-8
- vwait x
- after 300 { lappend x timeout }
- vwait x
+ vwait [namespace which -variable x]
+ after 300 [namespace code { lappend x timeout }]
+ vwait [namespace which -variable x]
fconfigure $f -encoding binary
- vwait x
- after 300 { lappend x timeout }
- vwait x
+ vwait [namespace which -variable x]
+ after 300 [namespace code { lappend x timeout }]
+ vwait [namespace which -variable x]
close $f
set x
} "{} timeout {} timeout \xe7 timeout"
@@ -4953,7 +5046,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 accept 0]
+ set s1 [socket -server [namespace code accept] 0]
set port [lindex [fconfigure $s1 -sockname] 2]
set s2 [socket 127.0.0.1 $port]
update
@@ -4966,7 +5059,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 accept 0]
+ set s1 [socket -server [namespace code accept] 0]
set port [lindex [fconfigure $s1 -sockname] 2]
set s2 [socket 127.0.0.1 $port]
update
@@ -4979,7 +5072,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 accept 0]
+ set s1 [socket -server [namespace code accept] 0]
set port [lindex [fconfigure $s1 -sockname] 2]
set s2 [socket 127.0.0.1 $port]
update
@@ -4992,7 +5085,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 accept 0]
+ set s1 [socket -server [namespace code accept] 0]
set port [lindex [fconfigure $s1 -sockname] 2]
set s2 [socket 127.0.0.1 $port]
update
@@ -5003,29 +5096,74 @@ test io-39.21 {Tcl_SetChannelOption, setting read mode independently} \
set modes
} {auto crlf}
+test io-39.22 {Tcl_SetChannelOption, invariance} {unixOnly} {
+ removeFile test1
+ set f1 [open $path(test1) w+]
+ set l ""
+ lappend l [fconfigure $f1 -eofchar]
+ fconfigure $f1 -eofchar {ON GO}
+ lappend l [fconfigure $f1 -eofchar]
+ fconfigure $f1 -eofchar D
+ lappend l [fconfigure $f1 -eofchar]
+ close $f1
+ set l
+} {{{} {}} {O G} {D D}}
+
+test io-39.22a {Tcl_SetChannelOption, invariance} {
+ removeFile test1
+ set f1 [open $path(test1) w+]
+ set l [list]
+ fconfigure $f1 -eofchar {ON GO}
+ lappend l [fconfigure $f1 -eofchar]
+ fconfigure $f1 -eofchar D
+ lappend l [fconfigure $f1 -eofchar]
+ lappend l [list [catch {fconfigure $f1 -eofchar {1 2 3}} msg] $msg]
+ close $f1
+ set l
+} {{O G} {D D} {1 {bad value for -eofchar: should be a list of zero, one, or two elements}}}
+
+
+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]
+ lappend l [fconfigure $sock -eofchar] [fconfigure $sock -translation]
+ close $sock
+ set l
+} {{{}} auto}
+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]
+ fconfigure $sock -eofchar D -translation lf
+ lappend l [fconfigure $sock -eofchar] [fconfigure $sock -translation]
+ close $sock
+ set l
+} {{{}} auto}
+
test io-40.1 {POSIX open access modes: RDWR} {
removeFile test3
- set f [open test3 w]
+ set f [open $path(test3) w]
puts $f xyzzy
close $f
- set f [open test3 RDWR]
+ set f [open $path(test3) RDWR]
puts -nonewline $f "ab"
seek $f 0 current
set x [gets $f]
close $f
- set f [open test3 r]
+ set f [open $path(test3) r]
lappend x [gets $f]
close $f
set x
} {zzy abzzy}
test io-40.2 {POSIX open access modes: CREAT} {unixOnly} {
removeFile test3
- set f [open test3 {WRONLY CREAT} 0600]
- file stat test3 stats
+ set f [open $path(test3) {WRONLY CREAT} 0600]
+ file stat $path(test3) stats
set x [format "0%o" [expr $stats(mode)&0777]]
puts $f "line 1"
close $f
- set f [open test3 r]
+ set f [open $path(test3) r]
lappend x [gets $f]
close $f
set x
@@ -5033,44 +5171,44 @@ test io-40.2 {POSIX open access modes: CREAT} {unixOnly} {
# some tests can only be run is umask is 2
# if "umask" cannot be run, the tests will be skipped.
-catch {set ::tcltest::testConstraints(umask2) [expr {[exec umask] == 2}]}
+catch {testConstraint umask2 [expr {[exec umask] == 2}]}
test io-40.3 {POSIX open access modes: CREAT} {unixOnly umask2} {
# This test only works if your umask is 2, like ouster's.
removeFile test3
- set f [open test3 {WRONLY CREAT}]
+ set f [open $path(test3) {WRONLY CREAT}]
close $f
file stat test3 stats
format "0%o" [expr $stats(mode)&0777]
} 0664
test io-40.4 {POSIX open access modes: CREAT} {
removeFile test3
- set f [open test3 w]
+ set f [open $path(test3) w]
fconfigure $f -eofchar {}
puts $f xyzzy
close $f
- set f [open test3 {WRONLY CREAT}]
+ set f [open $path(test3) {WRONLY CREAT}]
fconfigure $f -eofchar {}
puts -nonewline $f "ab"
close $f
- set f [open test3 r]
+ set f [open $path(test3) r]
set x [gets $f]
close $f
set x
} abzzy
test io-40.5 {POSIX open access modes: APPEND} {
removeFile test3
- set f [open test3 w]
+ set f [open $path(test3) w]
fconfigure $f -translation lf -eofchar {}
puts $f xyzzy
close $f
- set f [open test3 {WRONLY APPEND}]
+ set f [open $path(test3) {WRONLY APPEND}]
fconfigure $f -translation lf
puts $f "new line"
seek $f 0
puts $f "abc"
close $f
- set f [open test3 r]
+ set f [open $path(test3) r]
fconfigure $f -translation lf
set x ""
seek $f 6 current
@@ -5081,16 +5219,17 @@ test io-40.5 {POSIX open access modes: APPEND} {
} {{new line} abc}
test io-40.6 {POSIX open access modes: EXCL} {
removeFile test3
- set f [open test3 w]
+ set f [open $path(test3) w]
puts $f xyzzy
close $f
- set msg [list [catch {open test3 {WRONLY CREAT EXCL}} msg] $msg]
+ set msg [list [catch {open $path(test3) {WRONLY CREAT EXCL}} msg] $msg]
regsub " already " $msg " " msg
+ regsub [file join {} $path(test3)] $msg "test3" msg
string tolower $msg
} {1 {couldn't open "test3": file exists}}
test io-40.7 {POSIX open access modes: EXCL} {
removeFile test3
- set f [open test3 {WRONLY CREAT EXCL}]
+ set f [open $path(test3) {WRONLY CREAT EXCL}]
fconfigure $f -eofchar {}
puts $f "A test line"
close $f
@@ -5098,33 +5237,33 @@ test io-40.7 {POSIX open access modes: EXCL} {
} {A test line}
test io-40.8 {POSIX open access modes: TRUNC} {
removeFile test3
- set f [open test3 w]
+ set f [open $path(test3) w]
puts $f xyzzy
close $f
- set f [open test3 {WRONLY TRUNC}]
+ set f [open $path(test3) {WRONLY TRUNC}]
puts $f abc
close $f
- set f [open test3 r]
+ set f [open $path(test3) r]
set x [gets $f]
close $f
set x
} abc
test io-40.9 {POSIX open access modes: NONBLOCK} {nonPortable macOrUnix} {
removeFile test3
- set f [open test3 {WRONLY NONBLOCK CREAT}]
+ set f [open $path(test3) {WRONLY NONBLOCK CREAT}]
puts $f "NONBLOCK test"
close $f
- set f [open test3 r]
+ set f [open $path(test3) r]
set x [gets $f]
close $f
set x
} {NONBLOCK test}
test io-40.10 {POSIX open access modes: RDONLY} {
- set f [open test1 w]
+ set f [open $path(test1) w]
puts $f "two lines: this one"
puts $f "and this"
close $f
- set f [open test1 RDONLY]
+ set f [open $path(test1) RDONLY]
set x [list [gets $f] [catch {puts $f Test} msg] $msg]
close $f
string compare [string tolower $x] \
@@ -5133,15 +5272,19 @@ test io-40.10 {POSIX open access modes: RDONLY} {
} 0
test io-40.11 {POSIX open access modes: RDONLY} {
removeFile test3
- string tolower [list [catch {open test3 RDONLY} msg] $msg]
+ set msg [list [catch {open $path(test3) RDONLY} msg] $msg]
+ regsub [file join {} $path(test3)] $msg "test3" msg
+ string tolower $msg
} {1 {couldn't open "test3": no such file or directory}}
test io-40.12 {POSIX open access modes: WRONLY} {
removeFile test3
- string tolower [list [catch {open test3 WRONLY} msg] $msg]
+ set msg [list [catch {open $path(test3) WRONLY} msg] $msg]
+ regsub [file join {} $path(test3)] $msg "test3" msg
+ string tolower $msg
} {1 {couldn't open "test3": no such file or directory}}
test io-40.13 {POSIX open access modes: WRONLY} {
makeFile xyzzy test3
- set f [open test3 WRONLY]
+ set f [open $path(test3) WRONLY]
fconfigure $f -eofchar {}
puts -nonewline $f "ab"
seek $f 0 current
@@ -5153,11 +5296,13 @@ test io-40.13 {POSIX open access modes: WRONLY} {
} 0
test io-40.14 {POSIX open access modes: RDWR} {
removeFile test3
- string tolower [list [catch {open test3 RDWR} msg] $msg]
+ set msg [list [catch {open $path(test3) RDWR} msg] $msg]
+ regsub [file join {} $path(test3)] $msg "test3" msg
+ string tolower $msg
} {1 {couldn't open "test3": no such file or directory}}
test io-40.15 {POSIX open access modes: RDWR} {
makeFile xyzzy test3
- set f [open test3 RDWR]
+ set f [open $path(test3) RDWR]
puts -nonewline $f "ab"
seek $f 0 current
set x [gets $f]
@@ -5202,7 +5347,8 @@ test io-41.5 {Tcl_FileeventCmd: errors} {
# Test fileevent on a file
#
-set f [open foo w+]
+set path(foo) [makeFile {} foo]
+set f [open $path(foo) w+]
test io-42.1 {Tcl_FileeventCmd: creating, deleting, querying} {
list [fileevent $f readable] [fileevent $f writable]
@@ -5264,65 +5410,59 @@ test io-43.2 {Tcl_FileeventCmd: deleting when many present} {stdio unixExecs} {
} {{} {} {} {read f} {read f2} {read f3} {read f} {} {read f3} {read f} {} {} {} {} {}}
test io-44.1 {FileEventProc procedure: normal read event} {stdio unixExecs} {
- fileevent $f2 readable {
+ fileevent $f2 readable [namespace code {
set x [gets $f2]; fileevent $f2 readable {}
- }
+ }]
puts $f2 text; flush $f2
- set x initial
- vwait x
+ variable x initial
+ vwait [namespace which -variable x]
set x
} {text}
test io-44.2 {FileEventProc procedure: error in read event} {stdio unixExecs} {
- proc bgerror args {
- global x
- set x $args
- }
+ proc ::bgerror args "set [namespace which -variable x] \$args"
fileevent $f2 readable {error bogus}
puts $f2 text; flush $f2
- set x initial
- vwait x
- rename bgerror {}
+ variable x initial
+ vwait [namespace which -variable x]
+ rename ::bgerror {}
list $x [fileevent $f2 readable]
} {bogus {}}
test io-44.3 {FileEventProc procedure: normal write event} {stdio unixExecs} {
- fileevent $f2 writable {
+ fileevent $f2 writable [namespace code {
lappend x "triggered"
incr count -1
if {$count <= 0} {
fileevent $f2 writable {}
}
- }
- set x initial
+ }]
+ variable x initial
set count 3
- vwait x
- vwait x
- vwait x
+ vwait [namespace which -variable x]
+ vwait [namespace which -variable x]
+ vwait [namespace which -variable x]
set x
} {initial triggered triggered triggered}
test io-44.4 {FileEventProc procedure: eror in write event} {stdio unixExecs} {
- proc bgerror args {
- global x
- set x $args
- }
+ proc ::bgerror args "set [namespace which -variable x] \$args"
fileevent $f2 writable {error bad-write}
- set x initial
- vwait x
- rename bgerror {}
+ variable x initial
+ vwait [namespace which -variable x]
+ rename ::bgerror {}
list $x [fileevent $f2 writable]
} {bad-write {}}
test io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs} {
- set f4 [open "|[list $::tcltest::tcltest cat << foo]" r]
- fileevent $f4 readable {
+ set f4 [open "|[list [interpreter] $path(cat) << foo]" r]
+ fileevent $f4 readable [namespace code {
if {[gets $f4 line] < 0} {
lappend x eof
fileevent $f4 readable {}
} else {
lappend x $line
}
- }
- set x initial
- vwait x
- vwait x
+ }]
+ variable x initial
+ vwait [namespace which -variable x]
+ vwait [namespace which -variable x]
close $f4
set x
} {initial foo eof}
@@ -5334,38 +5474,39 @@ catch {close $f3}
close $f
makeFile "foo bar" foo
test io-45.1 {DeleteFileEvent, cleanup on close} {
- set f [open foo r]
- fileevent $f readable {
+ set f [open $path(foo) r]
+ fileevent $f readable [namespace code {
lappend x "binding triggered: \"[gets $f]\""
fileevent $f readable {}
- }
+ }]
close $f
set x initial
- after 100 { set y done }
- vwait y
+ after 100 [namespace code { set y done }]
+ variable y
+ vwait [namespace which -variable y]
set x
} {initial}
test io-45.2 {DeleteFileEvent, cleanup on close} {
- set f [open foo r]
- set f2 [open foo r]
- fileevent $f readable {
+ set f [open $path(foo) r]
+ set f2 [open $path(foo) r]
+ fileevent $f readable [namespace code {
lappend x "f triggered: \"[gets $f]\""
fileevent $f readable {}
- }
- fileevent $f2 readable {
+ }]
+ fileevent $f2 readable [namespace code {
lappend x "f2 triggered: \"[gets $f2]\""
fileevent $f2 readable {}
- }
+ }]
close $f
- set x initial
- vwait x
+ variable x initial
+ vwait [namespace which -variable x]
close $f2
set x
} {initial {f2 triggered: "foo bar"}}
test io-45.3 {DeleteFileEvent, cleanup on close} {
- set f [open foo r]
- set f2 [open foo r]
- set f3 [open foo r]
+ set f [open $path(foo) r]
+ set f2 [open $path(foo) r]
+ set f3 [open $path(foo) r]
fileevent $f readable {f script}
fileevent $f2 readable {f2 script}
fileevent $f3 readable {f3 script}
@@ -5385,34 +5526,33 @@ test io-45.3 {DeleteFileEvent, cleanup on close} {
} {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.
+testConstraint testfevent [llength [info commands testfevent]]
-if {[info commands testfevent] == "testfevent"} {
-
- test io-46.1 {Tcl event loop vs multiple interpreters} {} {
+test io-46.1 {Tcl event loop vs multiple interpreters} {testfevent} {
testfevent create
- testfevent cmd {
- set f [open foo r]
+ testfevent cmd [format {
+ set f [open %s r]
set x "no event"
- fileevent $f readable {
+ fileevent $f readable [namespace code {
set x "f triggered: [gets $f]"
fileevent $f readable {}
- }
- }
+ }]
+ } $path(foo)]
after 1 ;# We must delay because Windows takes a little time to notice
update
testfevent cmd {close $f}
list [testfevent cmd {set x}] [testfevent cmd {info commands after}]
} {{f triggered: foo bar} after}
-test io-46.2 {Tcl event loop vs multiple interpreters} {
+test io-46.2 {Tcl event loop vs multiple interpreters} testfevent {
testfevent create
testfevent cmd {
- set x 0
+ variable x 0
after 100 {set x triggered}
- vwait x
+ vwait [namespace which -variable x]
set x
}
} {triggered}
-test io-46.3 {Tcl event loop vs multiple interpreters} {
+test io-46.3 {Tcl event loop vs multiple interpreters} testfevent {
testfevent create
testfevent cmd {
set x 0
@@ -5426,10 +5566,10 @@ test io-46.3 {Tcl event loop vs multiple interpreters} {
}
} {0 0 {0 timer}}
-test io-47.1 {fileevent vs multiple interpreters} {
- set f [open foo r]
- set f2 [open foo r]
- set f3 [open foo r]
+test io-47.1 {fileevent vs multiple interpreters} testfevent {
+ set f [open $path(foo) r]
+ set f2 [open $path(foo) r]
+ set f3 [open $path(foo) r]
fileevent $f readable {script 1}
testfevent create
testfevent share $f2
@@ -5445,11 +5585,11 @@ test io-47.1 {fileevent vs multiple interpreters} {
close $f3
set x
} {{} {script 1} {} {sript 3}}
-test io-47.2 {deleting fileevent on interpreter delete} {
- set f [open foo r]
- set f2 [open foo r]
- set f3 [open foo r]
- set f4 [open foo r]
+test io-47.2 {deleting fileevent on interpreter delete} testfevent {
+ set f [open $path(foo) r]
+ set f2 [open $path(foo) r]
+ set f3 [open $path(foo) r]
+ set f4 [open $path(foo) r]
fileevent $f readable {script 1}
testfevent create
testfevent share $f2
@@ -5466,11 +5606,11 @@ test io-47.2 {deleting fileevent on interpreter delete} {
close $f4
set x
} {{script 1} {} {} {script 4}}
-test io-47.3 {deleting fileevent on interpreter delete} {
- set f [open foo r]
- set f2 [open foo r]
- set f3 [open foo r]
- set f4 [open foo r]
+test io-47.3 {deleting fileevent on interpreter delete} testfevent {
+ set f [open $path(foo) r]
+ set f2 [open $path(foo) r]
+ set f3 [open $path(foo) r]
+ set f4 [open $path(foo) r]
testfevent create
testfevent share $f3
testfevent share $f4
@@ -5487,9 +5627,9 @@ test io-47.3 {deleting fileevent on interpreter delete} {
close $f4
set x
} {{script 1} {script 2} {} {}}
-test io-47.4 {file events on shared files and multiple interpreters} {
- set f [open foo r]
- set f2 [open foo r]
+test io-47.4 {file events on shared files and multiple interpreters} testfevent {
+ set f [open $path(foo) r]
+ set f2 [open $path(foo) r]
testfevent create
testfevent share $f
testfevent cmd "fileevent $f readable {script 1}"
@@ -5503,8 +5643,8 @@ test io-47.4 {file events on shared files and multiple interpreters} {
close $f2
set x
} {{script 3} {script 1} {script 2}}
-test io-47.5 {file events on shared files, deleting file events} {
- set f [open foo r]
+test io-47.5 {file events on shared files, deleting file events} testfevent {
+ set f [open $path(foo) r]
testfevent create
testfevent share $f
testfevent cmd "fileevent $f readable {script 1}"
@@ -5516,8 +5656,8 @@ test io-47.5 {file events on shared files, deleting file events} {
close $f
set x
} {{} {script 2}}
-test io-47.6 {file events on shared files, deleting file events} {
- set f [open foo r]
+test io-47.6 {file events on shared files, deleting file events} testfevent {
+ set f [open $path(foo) r]
testfevent create
testfevent share $f
testfevent cmd "fileevent $f readable {script 1}"
@@ -5530,22 +5670,21 @@ test io-47.6 {file events on shared files, deleting file events} {
set x
} {{script 1} {}}
-}
-
-# The above curly closes the test for presence of the "testfevent" command.
+set path(bar) [makeFile {} bar]
test io-48.1 {testing readability conditions} {
- set f [open bar w]
+ set f [open $path(bar) w]
puts $f abcdefg
puts $f abcdefg
puts $f abcdefg
puts $f abcdefg
puts $f abcdefg
close $f
- set f [open bar r]
- fileevent $f readable [list consume $f]
+ set f [open $path(bar) r]
+ fileevent $f readable [namespace code [list consume $f]]
proc consume {f} {
- global x l
+ variable l
+ variable x
lappend l called
if {[eof $f]} {
close $f
@@ -5555,23 +5694,24 @@ test io-48.1 {testing readability conditions} {
}
}
set l ""
- set x not_done
- vwait x
+ variable x not_done
+ vwait [namespace which -variable x]
list $x $l
} {done {called called called called called called called}}
test io-48.2 {testing readability conditions} {nonBlockFiles} {
- set f [open bar w]
+ set f [open $path(bar) w]
puts $f abcdefg
puts $f abcdefg
puts $f abcdefg
puts $f abcdefg
puts $f abcdefg
close $f
- set f [open bar r]
- fileevent $f readable [list consume $f]
+ set f [open $path(bar) r]
+ fileevent $f readable [namespace code [list consume $f]]
fconfigure $f -blocking off
proc consume {f} {
- global x l
+ variable x
+ variable l
lappend l called
if {[eof $f]} {
close $f
@@ -5581,19 +5721,22 @@ test io-48.2 {testing readability conditions} {nonBlockFiles} {
}
}
set l ""
- set x not_done
- vwait x
+ variable x not_done
+ vwait [namespace which -variable x]
list $x $l
} {done {called called called called called called called}}
-test io-48.3 {testing readability conditions} {unixOnly nonBlockFiles} {
- set f [open bar w]
+
+set path(my_script) [makeFile {} my_script]
+
+test io-48.3 {testing readability conditions} {stdio unixOnly nonBlockFiles} {
+ set f [open $path(bar) w]
puts $f abcdefg
puts $f abcdefg
puts $f abcdefg
puts $f abcdefg
puts $f abcdefg
close $f
- set f [open my_script w]
+ set f [open $path(my_script) w]
puts $f {
proc copy_slowly {f} {
while {![eof $f]} {
@@ -5604,12 +5747,13 @@ test io-48.3 {testing readability conditions} {unixOnly nonBlockFiles} {
}
}
close $f
- set f [open "|[list $::tcltest::tcltest]" r+]
- fileevent $f readable [list consume $f]
+ set f [open "|[list [interpreter]]" r+]
+ fileevent $f readable [namespace code [list consume $f]]
fconfigure $f -buffering line
fconfigure $f -blocking off
proc consume {f} {
- global x l
+ variable l
+ variable x
if {[eof $f]} {
set x done
} else {
@@ -5620,24 +5764,26 @@ test io-48.3 {testing readability conditions} {unixOnly nonBlockFiles} {
}
}
set l ""
- set x not_done
- puts $f {source my_script}
- puts $f {set f [open bar r]}
+ variable x not_done
+ puts $f [format {source %s} $path(my_script)]
+ puts $f [format {set f [open %s r]} $path(bar)]
puts $f {copy_slowly $f}
puts $f {exit}
- vwait x
+ vwait [namespace which -variable x]
close $f
list $x $l
} {done {0 1 0 1 0 1 0 1 0 1 0 1 0 0}}
test io-48.4 {lf write, testing readability, ^Z termination, auto read mode} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
set c [format "abc\ndef\n%c" 26]
puts -nonewline $f $c
close $f
proc consume {f} {
- global c x l
+ variable l
+ variable c
+ variable x
if {[eof $f]} {
set x done
close $f
@@ -5648,21 +5794,24 @@ test io-48.4 {lf write, testing readability, ^Z termination, auto read mode} {
}
set c 0
set l ""
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation auto -eofchar \x1a
- fileevent $f readable [list consume $f]
- vwait x
+ fileevent $f readable [namespace code [list consume $f]]
+ variable x
+ vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
test io-48.5 {lf write, testing readability, ^Z in middle, auto read mode} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
set c [format "abc\ndef\n%cfoo\nbar\n" 26]
puts -nonewline $f $c
close $f
proc consume {f} {
- global c x l
+ variable l
+ variable x
+ variable c
if {[eof $f]} {
set x done
close $f
@@ -5673,21 +5822,24 @@ test io-48.5 {lf write, testing readability, ^Z in middle, auto read mode} {
}
set c 0
set l ""
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -eofchar \x1a -translation auto
- fileevent $f readable [list consume $f]
- vwait x
+ fileevent $f readable [namespace code [list consume $f]]
+ variable x
+ vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
test io-48.6 {cr write, testing readability, ^Z termination, auto read mode} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation cr
set c [format "abc\ndef\n%c" 26]
puts -nonewline $f $c
close $f
proc consume {f} {
- global c x l
+ variable l
+ variable x
+ variable c
if {[eof $f]} {
set x done
close $f
@@ -5698,21 +5850,24 @@ test io-48.6 {cr write, testing readability, ^Z termination, auto read mode} {
}
set c 0
set l ""
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation auto -eofchar \x1a
- fileevent $f readable [list consume $f]
- vwait x
+ fileevent $f readable [namespace code [list consume $f]]
+ variable x
+ vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
test io-48.7 {cr write, testing readability, ^Z in middle, auto read mode} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation cr
set c [format "abc\ndef\n%cfoo\nbar\n" 26]
puts -nonewline $f $c
close $f
proc consume {f} {
- global c x l
+ variable l
+ variable c
+ variable x
if {[eof $f]} {
set x done
close $f
@@ -5723,21 +5878,24 @@ test io-48.7 {cr write, testing readability, ^Z in middle, auto read mode} {
}
set c 0
set l ""
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -eofchar \x1a -translation auto
- fileevent $f readable [list consume $f]
- vwait x
+ fileevent $f readable [namespace code [list consume $f]]
+ variable x
+ vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
test io-48.8 {crlf write, testing readability, ^Z termination, auto read mode} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation crlf
set c [format "abc\ndef\n%c" 26]
puts -nonewline $f $c
close $f
proc consume {f} {
- global c x l
+ variable l
+ variable x
+ variable c
if {[eof $f]} {
set x done
close $f
@@ -5748,21 +5906,24 @@ test io-48.8 {crlf write, testing readability, ^Z termination, auto read mode} {
}
set c 0
set l ""
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation auto -eofchar \x1a
- fileevent $f readable [list consume $f]
- vwait x
+ fileevent $f readable [namespace code [list consume $f]]
+ variable x
+ vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
test io-48.9 {crlf write, testing readability, ^Z in middle, auto read mode} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation crlf
set c [format "abc\ndef\n%cfoo\nbar\n" 26]
puts -nonewline $f $c
close $f
proc consume {f} {
- global c x l
+ variable l
+ variable c
+ variable x
if {[eof $f]} {
set x done
close $f
@@ -5773,21 +5934,24 @@ test io-48.9 {crlf write, testing readability, ^Z in middle, auto read mode} {
}
set c 0
set l ""
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -eofchar \x1a -translation auto
- fileevent $f readable [list consume $f]
- vwait x
+ fileevent $f readable [namespace code [list consume $f]]
+ variable x
+ vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
test io-48.10 {lf write, testing readability, ^Z in middle, lf read mode} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
set c [format "abc\ndef\n%cfoo\nbar\n" 26]
puts -nonewline $f $c
close $f
proc consume {f} {
- global c x l
+ variable l
+ variable c
+ variable x
if {[eof $f]} {
set x done
close $f
@@ -5798,21 +5962,24 @@ test io-48.10 {lf write, testing readability, ^Z in middle, lf read mode} {
}
set c 0
set l ""
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -eofchar \x1a -translation lf
- fileevent $f readable [list consume $f]
- vwait x
+ fileevent $f readable [namespace code [list consume $f]]
+ variable x
+ vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
test io-48.11 {lf write, testing readability, ^Z termination, lf read mode} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
set c [format "abc\ndef\n%c" 26]
puts -nonewline $f $c
close $f
proc consume {f} {
- global c x l
+ variable l
+ variable x
+ variable c
if {[eof $f]} {
set x done
close $f
@@ -5823,21 +5990,24 @@ test io-48.11 {lf write, testing readability, ^Z termination, lf read mode} {
}
set c 0
set l ""
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation lf -eofchar \x1a
- fileevent $f readable [list consume $f]
- vwait x
+ fileevent $f readable [namespace code [list consume $f]]
+ variable x
+ vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
test io-48.12 {cr write, testing readability, ^Z in middle, cr read mode} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation cr
set c [format "abc\ndef\n%cfoo\nbar\n" 26]
puts -nonewline $f $c
close $f
proc consume {f} {
- global c x l
+ variable l
+ variable x
+ variable c
if {[eof $f]} {
set x done
close $f
@@ -5848,21 +6018,24 @@ test io-48.12 {cr write, testing readability, ^Z in middle, cr read mode} {
}
set c 0
set l ""
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -eofchar \x1a -translation cr
- fileevent $f readable [list consume $f]
- vwait x
+ fileevent $f readable [namespace code [list consume $f]]
+ variable x
+ vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
test io-48.13 {cr write, testing readability, ^Z termination, cr read mode} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation cr
set c [format "abc\ndef\n%c" 26]
puts -nonewline $f $c
close $f
proc consume {f} {
- global c x l
+ variable c
+ variable x
+ variable l
if {[eof $f]} {
set x done
close $f
@@ -5873,21 +6046,24 @@ test io-48.13 {cr write, testing readability, ^Z termination, cr read mode} {
}
set c 0
set l ""
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation cr -eofchar \x1a
- fileevent $f readable [list consume $f]
- vwait x
+ fileevent $f readable [namespace code [list consume $f]]
+ variable x
+ vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
test io-48.14 {crlf write, testing readability, ^Z in middle, crlf read mode} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation crlf
set c [format "abc\ndef\n%cfoo\nbar\n" 26]
puts -nonewline $f $c
close $f
proc consume {f} {
- global c x l
+ variable c
+ variable x
+ variable l
if {[eof $f]} {
set x done
close $f
@@ -5898,21 +6074,24 @@ test io-48.14 {crlf write, testing readability, ^Z in middle, crlf read mode} {
}
set c 0
set l ""
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -eofchar \x1a -translation crlf
- fileevent $f readable [list consume $f]
- vwait x
+ fileevent $f readable [namespace code [list consume $f]]
+ variable x
+ vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
test io-48.15 {crlf write, testing readability, ^Z termi, crlf read mode} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation crlf
set c [format "abc\ndef\n%c" 26]
puts -nonewline $f $c
close $f
proc consume {f} {
- global c x l
+ variable c
+ variable x
+ variable l
if {[eof $f]} {
set x done
close $f
@@ -5923,22 +6102,23 @@ test io-48.15 {crlf write, testing readability, ^Z termi, crlf read mode} {
}
set c 0
set l ""
- set f [open test1 r]
+ set f [open $path(test1) r]
fconfigure $f -translation crlf -eofchar \x1a
- fileevent $f readable [list consume $f]
- vwait x
+ fileevent $f readable [namespace code [list consume $f]]
+ variable x
+ vwait [namespace which -variable x]
list $c $l
} {3 {abc def {}}}
test io-49.1 {testing crlf reading, leftover cr disgorgment} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "a\rb\rc\r\n"
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
set l ""
- lappend l [file size test1]
+ lappend l [file size $path(test1)]
fconfigure $f -translation crlf
lappend l [read $f 1]
lappend l [tell $f]
@@ -5961,13 +6141,13 @@ test io-49.1 {testing crlf reading, leftover cr disgorgment} {
} 7 0 {} 1"
test io-49.2 {testing crlf reading, leftover cr disgorgment} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "a\rb\rc\r\n"
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
set l ""
- lappend l [file size test1]
+ lappend l [file size $path(test1)]
fconfigure $f -translation crlf
lappend l [read $f 2]
lappend l [tell $f]
@@ -5984,13 +6164,13 @@ test io-49.2 {testing crlf reading, leftover cr disgorgment} {
} "7 [list a\r] 2 [list b\r] 4 [list c\n] 7 0 {} 7 1"
test io-49.3 {testing crlf reading, leftover cr disgorgment} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "a\rb\rc\r\n"
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
set l ""
- lappend l [file size test1]
+ lappend l [file size $path(test1)]
fconfigure $f -translation crlf
lappend l [read $f 3]
lappend l [tell $f]
@@ -6005,13 +6185,13 @@ test io-49.3 {testing crlf reading, leftover cr disgorgment} {
} "7 [list a\rb] 3 [list \rc\n] 7 0 {} 7 1"
test io-49.4 {testing crlf reading, leftover cr disgorgment} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "a\rb\rc\r\n"
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
set l ""
- lappend l [file size test1]
+ lappend l [file size $path(test1)]
fconfigure $f -translation crlf
lappend l [read $f 3]
lappend l [tell $f]
@@ -6026,13 +6206,13 @@ test io-49.4 {testing crlf reading, leftover cr disgorgment} {
} "7 [list a\rb] 3 [list \rc] 7 0 {} 7 1"
test io-49.5 {testing crlf reading, leftover cr disgorgment} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "a\rb\rc\r\n"
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
set l ""
- lappend l [file size test1]
+ lappend l [file size $path(test1)]
fconfigure $f -translation crlf
lappend l [set x [gets $f]]
lappend l [tell $f]
@@ -6043,14 +6223,15 @@ test io-49.5 {testing crlf reading, leftover cr disgorgment} {
set l
} [list 7 a\rb\rc 7 {} 7 1]
-test io-50.1 {testing handler deletion} {} {
+testConstraint testchannelevent [llength [info commands testchannelevent]]
+test io-50.1 {testing handler deletion} {testchannelevent} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
close $f
- set f [open test1 r]
- testchannelevent $f add readable [list delhandler $f]
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list delhandler $f]]
proc delhandler {f} {
- global z
+ variable z
set z called
testchannelevent $f delete 0
}
@@ -6059,15 +6240,15 @@ test io-50.1 {testing handler deletion} {} {
close $f
set z
} called
-test io-50.2 {testing handler deletion with multiple handlers} {} {
+test io-50.2 {testing handler deletion with multiple handlers} {testchannelevent} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
close $f
- set f [open test1 r]
- testchannelevent $f add readable [list delhandler $f 1]
- testchannelevent $f add readable [list delhandler $f 0]
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list delhandler $f 1]]
+ testchannelevent $f add readable [namespace code [list delhandler $f 0]]
proc delhandler {f i} {
- global z
+ variable z
lappend z "called delhandler $f $i"
testchannelevent $f delete 0
}
@@ -6077,20 +6258,20 @@ test io-50.2 {testing handler deletion with multiple handlers} {} {
string compare [string tolower $z] \
[list [list called delhandler $f 0] [list called delhandler $f 1]]
} 0
-test io-50.3 {testing handler deletion with multiple handlers} {} {
+test io-50.3 {testing handler deletion with multiple handlers} {testchannelevent} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
close $f
- set f [open test1 r]
- testchannelevent $f add readable [list notcalled $f 1]
- testchannelevent $f add readable [list delhandler $f 0]
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list notcalled $f 1]]
+ testchannelevent $f add readable [namespace code [list delhandler $f 0]]
set z ""
proc notcalled {f i} {
- global z
+ variable z
lappend z "notcalled was called!! $f $i"
}
proc delhandler {f i} {
- global z
+ variable z
testchannelevent $f delete 1
lappend z "delhandler $f $i called"
testchannelevent $f delete 0
@@ -6103,14 +6284,15 @@ test io-50.3 {testing handler deletion with multiple handlers} {} {
[list [list delhandler $f 0 called] \
[list delhandler $f 0 deleted myself]]
} 0
-test io-50.4 {testing handler deletion vs reentrant calls} {} {
+test io-50.4 {testing handler deletion vs reentrant calls} {testchannelevent} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
close $f
- set f [open test1 r]
- testchannelevent $f add readable [list delrecursive $f]
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list delrecursive $f]]
proc delrecursive {f} {
- global z u
+ variable z
+ variable u
if {"$u" == "recursive"} {
testchannelevent $f delete 0
lappend z "delrecursive deleting recursive"
@@ -6127,19 +6309,20 @@ test io-50.4 {testing handler deletion vs reentrant calls} {} {
string compare [string tolower $z] \
{{delrecursive calling recursive} {delrecursive deleting recursive}}
} 0
-test io-50.5 {testing handler deletion vs reentrant calls} {} {
+test io-50.5 {testing handler deletion vs reentrant calls} {testchannelevent} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
close $f
- set f [open test1 r]
- testchannelevent $f add readable [list notcalled $f]
- testchannelevent $f add readable [list del $f]
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list notcalled $f]]
+ testchannelevent $f add readable [namespace code [list del $f]]
proc notcalled {f} {
- global z
+ variable z
lappend z "notcalled was called!! $f"
}
proc del {f} {
- global z u
+ variable u
+ variable z
if {"$u" == "recursive"} {
testchannelevent $f delete 1
testchannelevent $f delete 0
@@ -6160,15 +6343,16 @@ test io-50.5 {testing handler deletion vs reentrant calls} {} {
[list {del calling recursive} {del deleted notcalled} \
{del deleted myself} {del after update}]
} 0
-test io-50.6 {testing handler deletion vs reentrant calls} {} {
+test io-50.6 {testing handler deletion vs reentrant calls} {testchannelevent} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
close $f
- set f [open test1 r]
- testchannelevent $f add readable [list second $f]
- testchannelevent $f add readable [list first $f]
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list second $f]]
+ testchannelevent $f add readable [namespace code [list first $f]]
proc first {f} {
- global u z
+ variable u
+ variable z
if {"$u" == "toplevel"} {
lappend z "first called"
set u first
@@ -6179,7 +6363,8 @@ test io-50.6 {testing handler deletion vs reentrant calls} {} {
}
}
proc second {f} {
- global u z
+ variable u
+ variable z
if {"$u" == "first"} {
lappend z "second called, first time"
set u second
@@ -6206,34 +6391,35 @@ test io-51.1 {Test old socket deletion on Macintosh} {socket} {
set x 0
set result ""
proc accept {s a p} {
- global x wait
+ variable x
+ variable wait
fconfigure $s -blocking off
puts $s "sock[incr x]"
close $s
set wait done
}
- set ss [socket -server accept 2831]
- set wait ""
- set cs [socket [info hostname] 2831]
- vwait wait
+ set ss [socket -server [namespace code accept] 0]
+ variable wait ""
+ set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
+ vwait [namespace which -variable wait]
lappend result [gets $cs]
close $cs
set wait ""
- set cs [socket [info hostname] 2831]
- vwait wait
+ set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
+ vwait [namespace which -variable wait]
lappend result [gets $cs]
close $cs
set wait ""
- set cs [socket [info hostname] 2831]
- vwait wait
+ set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
+ vwait [namespace which -variable wait]
lappend result [gets $cs]
close $cs
set wait ""
- set cs [socket [info hostname] 2831]
- vwait wait
+ set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
+ vwait [namespace which -variable wait]
lappend result [gets $cs]
close $cs
close $ss
@@ -6243,7 +6429,7 @@ test io-51.1 {Test old socket deletion on Macintosh} {socket} {
test io-52.1 {TclCopyChannel} {
removeFile test1
set f1 [open $thisScript]
- set f2 [open test1 w]
+ set f2 [open $path(test1) w]
fcopy $f1 $f2 -command { # }
catch { fcopy $f1 $f2 } msg
close $f1
@@ -6253,7 +6439,7 @@ test io-52.1 {TclCopyChannel} {
test io-52.2 {TclCopyChannel} {
removeFile test1
set f1 [open $thisScript]
- set f2 [open test1 w]
+ set f2 [open $path(test1) w]
set f3 [open $thisScript]
fcopy $f1 $f2 -command { # }
catch { fcopy $f3 $f2 } msg
@@ -6265,7 +6451,7 @@ test io-52.2 {TclCopyChannel} {
test io-52.3 {TclCopyChannel} {
removeFile test1
set f1 [open $thisScript]
- set f2 [open test1 w]
+ set f2 [open $path(test1) w]
fconfigure $f1 -translation lf -blocking 0
fconfigure $f2 -translation cr -blocking 0
set s0 [fcopy $f1 $f2]
@@ -6273,7 +6459,7 @@ test io-52.3 {TclCopyChannel} {
close $f1
close $f2
set s1 [file size $thisScript]
- set s2 [file size test1]
+ set s2 [file size $path(test1)]
if {("$s1" == "$s2") && ($s0 == $s1)} {
lappend result ok
}
@@ -6282,19 +6468,19 @@ test io-52.3 {TclCopyChannel} {
test io-52.4 {TclCopyChannel} {
removeFile test1
set f1 [open $thisScript]
- set f2 [open test1 w]
+ set f2 [open $path(test1) w]
fconfigure $f1 -translation lf -blocking 0
fconfigure $f2 -translation cr -blocking 0
fcopy $f1 $f2 -size 40
set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
close $f1
close $f2
- lappend result [file size test1]
+ lappend result [file size $path(test1)]
} {0 0 40}
test io-52.5 {TclCopyChannel} {
removeFile test1
set f1 [open $thisScript]
- set f2 [open test1 w]
+ set f2 [open $path(test1) w]
fconfigure $f1 -translation lf -blocking 0
fconfigure $f2 -translation lf -blocking 0
fcopy $f1 $f2 -size -1
@@ -6302,7 +6488,7 @@ test io-52.5 {TclCopyChannel} {
close $f1
close $f2
set s1 [file size $thisScript]
- set s2 [file size test1]
+ set s2 [file size $path(test1)]
if {"$s1" == "$s2"} {
lappend result ok
}
@@ -6311,7 +6497,7 @@ test io-52.5 {TclCopyChannel} {
test io-52.6 {TclCopyChannel} {
removeFile test1
set f1 [open $thisScript]
- set f2 [open test1 w]
+ set f2 [open $path(test1) w]
fconfigure $f1 -translation lf -blocking 0
fconfigure $f2 -translation lf -blocking 0
set s0 [fcopy $f1 $f2 -size [expr [file size $thisScript] + 5]]
@@ -6319,7 +6505,7 @@ test io-52.6 {TclCopyChannel} {
close $f1
close $f2
set s1 [file size $thisScript]
- set s2 [file size test1]
+ set s2 [file size $path(test1)]
if {("$s1" == "$s2") && ($s0 == $s1)} {
lappend result ok
}
@@ -6328,13 +6514,13 @@ test io-52.6 {TclCopyChannel} {
test io-52.7 {TclCopyChannel} {
removeFile test1
set f1 [open $thisScript]
- set f2 [open test1 w]
+ set f2 [open $path(test1) w]
fconfigure $f1 -translation lf -blocking 0
fconfigure $f2 -translation lf -blocking 0
fcopy $f1 $f2
set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
set s1 [file size $thisScript]
- set s2 [file size test1]
+ set s2 [file size $path(test1)]
close $f1
close $f2
if {"$s1" == "$s2"} {
@@ -6345,7 +6531,7 @@ test io-52.7 {TclCopyChannel} {
test io-52.8 {TclCopyChannel} {stdio} {
removeFile test1
removeFile pipe
- set f1 [open pipe w]
+ set f1 [open $path(pipe) w]
fconfigure $f1 -translation lf
puts $f1 "
puts ready
@@ -6356,65 +6542,145 @@ test io-52.8 {TclCopyChannel} {stdio} {
close \$f1
"
close $f1
- set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
+ set f1 [open "|[list [interpreter] $path(pipe)]" r+]
fconfigure $f1 -translation lf
gets $f1
puts $f1 ready
flush $f1
- set f2 [open test1 w]
+ set f2 [open $path(test1) w]
fconfigure $f2 -translation lf
set s0 [fcopy $f1 $f2 -size 40]
catch {close $f1}
close $f2
- list $s0 [file size test1]
+ list $s0 [file size $path(test1)]
} {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]
+fconfigure $out -encoding koi8-r -translation lf
+puts $out "\u0410\u0410"
+close $out
+
+test io-52.9 {TclCopyChannel & encodings} {
+ # Copy kyrillic to UTF-8, using fcopy.
+
+ set in [open $path(kyrillic.txt) r]
+ set out [open $path(utf8-fcopy.txt) w]
+
+ fconfigure $in -encoding koi8-r -translation lf
+ fconfigure $out -encoding utf-8 -translation lf
+
+ fcopy $in $out
+ close $in
+ close $out
+
+ # Do the same again, but differently (read/puts).
+
+ set in [open $path(kyrillic.txt) r]
+ set out [open $path(utf8-rp.txt) w]
+
+ fconfigure $in -encoding koi8-r -translation lf
+ fconfigure $out -encoding utf-8 -translation lf
+
+ puts -nonewline $out [read $in]
+
+ close $in
+ close $out
+
+ list [file size $path(kyrillic.txt)] \
+ [file size $path(utf8-fcopy.txt)] \
+ [file size $path(utf8-rp.txt)]
+} {3 5 5}
+
+test io-52.10 {TclCopyChannel & encodings} {
+ # 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]
+
+ fconfigure $in -encoding koi8-r -translation lf
+ # -translation binary is also -encoding binary
+ fconfigure $out -translation binary
+
+ fcopy $in $out
+ close $in
+ close $out
+
+ file size $path(utf8-fcopy.txt)
+} 5
+
+test io-52.11 {TclCopyChannel & encodings} {
+ # 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
+ fconfigure $in -translation binary
+ fconfigure $out -encoding koi8-r -translation lf
+
+ fcopy $in $out
+ close $in
+ close $out
+
+ file size $path(kyrillic.txt)
+} 3
+
+
test io-53.1 {CopyData} {
removeFile test1
set f1 [open $thisScript]
- set f2 [open test1 w]
+ set f2 [open $path(test1) w]
fconfigure $f1 -translation lf -blocking 0
fconfigure $f2 -translation cr -blocking 0
fcopy $f1 $f2 -size 0
set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
close $f1
close $f2
- lappend result [file size test1]
+ lappend result [file size $path(test1)]
} {0 0 0}
test io-53.2 {CopyData} {
removeFile test1
set f1 [open $thisScript]
- set f2 [open test1 w]
+ set f2 [open $path(test1) w]
fconfigure $f1 -translation lf -blocking 0
fconfigure $f2 -translation cr -blocking 0
- fcopy $f1 $f2 -command {set s0}
+ fcopy $f1 $f2 -command [namespace code {set s0}]
set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
- vwait s0
+ variable s0
+ vwait [namespace which -variable s0]
close $f1
close $f2
set s1 [file size $thisScript]
- set s2 [file size test1]
+ set s2 [file size $path(test1)]
if {("$s1" == "$s2") && ($s0 == $s1)} {
lappend result ok
}
set result
} {0 0 ok}
-test io-53.3 {CopyData: background read underflow} {unixOnly} {
+test io-53.3 {CopyData: background read underflow} {stdio unixOnly} {
removeFile test1
removeFile pipe
- set f1 [open pipe w]
- puts $f1 {
+ set f1 [open $path(pipe) w]
+ puts $f1 [format {
puts ready
flush stdout ;# Don't assume line buffered!
fcopy stdin stdout -command { set x }
vwait x
- set f [open test1 w]
+ set f [open "%s" w]
fconfigure $f -translation lf
puts $f "done"
close $f
- }
+ } $path(test1)]
close $f1
- set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
+ set f1 [open "|[list [interpreter] $path(pipe)]" r+]
set result [gets $f1]
puts $f1 line1
flush $f1
@@ -6424,43 +6690,44 @@ test io-53.3 {CopyData: background read underflow} {unixOnly} {
lappend result [gets $f1]
close $f1
after 500
- set f [open test1]
+ set f [open $path(test1)]
lappend result [read $f]
close $f
set result
} "ready line1 line2 {done\n}"
-test io-53.4 {CopyData: background write overflow} {unixOnly} {
+test io-53.4 {CopyData: background write overflow} {stdio unixOnly} {
set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n
+ variable x
for {set x 0} {$x < 12} {incr x} {
append big $big
}
removeFile test1
removeFile pipe
- set f1 [open pipe w]
+ set f1 [open $path(pipe) w]
puts $f1 {
puts ready
fcopy stdin stdout -command { set x }
vwait x
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf
puts $f "done"
close $f
}
close $f1
- set f1 [open "|[list $::tcltest::tcltest pipe]" r+]
+ set f1 [open "|[list [interpreter] $path(pipe)]" r+]
set result [gets $f1]
fconfigure $f1 -blocking 0
puts $f1 $big
flush $f1
after 500
set result ""
- fileevent $f1 read {
+ fileevent $f1 read [namespace code {
append result [read $f1 1024]
if {[string length $result] >= [string length $big]} {
set x done
}
- }
- vwait x
+ }]
+ vwait [namespace which -variable x]
close $f1
set big {}
set x
@@ -6471,7 +6738,7 @@ proc FcopyTestAccept {sock args} {
after 1000 "close $sock"
}
proc FcopyTestDone {bytes {error {}}} {
- global fcopyTestDone
+ variable fcopyTestDone
if {[string length $error]} {
set fcopyTestDone 1
} else {
@@ -6480,65 +6747,123 @@ proc FcopyTestDone {bytes {error {}}} {
}
test io-53.5 {CopyData: error during fcopy} {socket} {
- set listen [socket -server FcopyTestAccept 2828]
+ variable fcopyTestDone
+ set listen [socket -server [namespace code FcopyTestAccept] 0]
set in [open $thisScript] ;# 126 K
- set out [socket 127.0.0.1 2828]
+ set out [socket 127.0.0.1 [lindex [fconfigure $listen -sockname] 2]]
catch {unset fcopyTestDone}
close $listen ;# This means the socket open never really succeeds
- fcopy $in $out -command FcopyTestDone
+ fcopy $in $out -command [namespace code FcopyTestDone]
+ variable fcopyTestDone
if ![info exists fcopyTestDone] {
- vwait fcopyTestDone ;# The error occurs here in the b.g.
+ vwait [namespace which -variable fcopyTestDone] ;# The error occurs here in the b.g.
}
close $in
close $out
set fcopyTestDone ;# 1 for error condition
} 1
test io-53.6 {CopyData: error during fcopy} {stdio} {
+ variable fcopyTestDone
removeFile pipe
removeFile test1
catch {unset fcopyTestDone}
- set f1 [open pipe w]
+ set f1 [open $path(pipe) w]
puts $f1 "exit 1"
close $f1
- set in [open "|[list $::tcltest::tcltest pipe]" r+]
- set out [open test1 w]
- fcopy $in $out -command [list FcopyTestDone]
+ set in [open "|[list [interpreter] $path(pipe)]" r+]
+ set out [open $path(test1) w]
+ fcopy $in $out -command [namespace code FcopyTestDone]
+ variable fcopyTestDone
if ![info exists fcopyTestDone] {
- vwait fcopyTestDone
+ vwait [namespace which -variable fcopyTestDone]
}
catch {close $in}
close $out
set fcopyTestDone ;# 0 for plain end of file
} {0}
+proc doFcopy {in out {bytes 0} {error {}}} {
+ variable fcopyTestDone
+ variable fcopyTestCount
+ incr fcopyTestCount $bytes
+ if {[string length $error]} {
+ set fcopyTestDone 1
+ } elseif {[eof $in]} {
+ set fcopyTestDone 0
+ } else {
+ # Delay next fcopy to wait for size>0 input bytes
+ after 100 [list
+ fcopy $in $out -size 1000 \
+ -command [namespace code [list doFcopy $in $out]]
+ ]
+ }
+}
+
+test io-53.7 {CopyData: Flooding fcopy from pipe} {stdio} {
+ variable fcopyTestDone
+ removeFile pipe
+ removeFile test1
+ catch {unset fcopyTestDone}
+ set fcopyTestCount 0
+ set f1 [open $path(pipe) w]
+ puts $f1 {
+ # Write 10 bytes / 10 msec
+ proc Write {count} {
+ puts -nonewline "1234567890"
+ if {[incr count -1]} {
+ after 10 [list Write $count]
+ } else {
+ set ::ready 1
+ }
+ }
+ fconfigure stdout -buffering none
+ Write 345 ;# 3450 bytes ~3.45 sec
+ vwait ready
+ exit 0
+ }
+ close $f1
+ set in [open "|[list [interpreter] $path(pipe) &]" r+]
+ set out [open $path(test1) w]
+ doFcopy $in $out
+ variable fcopyTestDone
+ if ![info exists fcopyTestDone] {
+ vwait [namespace which -variable fcopyTestDone]
+ }
+ catch {close $in}
+ close $out
+ # -1=error 0=script error N=number of bytes
+ expr ($fcopyTestDone == 0) ? $fcopyTestCount : -1
+} {3450}
+
test io-54.1 {Recursive channel events} {socket} {
# 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} {
- global as
+ variable as
fconfigure $s -translation lf
puts $s "line 1\nline2\nline3"
flush $s
set as $s
}
proc readit {s next} {
- global result x
+ variable x
+ variable result
lappend result $next
if {$next == 1} {
- fileevent $s readable [list readit $s 2]
- vwait x
+ fileevent $s readable [namespace code [list readit $s 2]]
+ vwait [namespace which -variable x]
}
incr x
}
- set ss [socket -server accept 2828]
+ set ss [socket -server [namespace code accept] 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] 2828]}]} {
+ if {![catch {set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]}]} {
set done 1
break
}
@@ -6548,15 +6873,16 @@ test io-54.1 {Recursive channel events} {socket} {
close $ss
error "failed to connect to server"
}
- set result {}
- set x 0
- vwait as
+ variable result {}
+ variable x 0
+ variable as
+ vwait [namespace which -variable as]
fconfigure $cs -translation lf
lappend result [gets $cs]
fconfigure $cs -blocking off
- fileevent $cs readable [list readit $cs 1]
- set a [after 2000 { set x failure }]
- vwait x
+ fileevent $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
close $as
close $ss
@@ -6566,27 +6892,30 @@ test io-54.1 {Recursive channel events} {socket} {
test io-54.2 {Testing for busy-wait in recursive channel events} {socket} {
set accept {}
set after {}
- set s [socket -server accept 3939]
+ variable s [socket -server [namespace code accept] 0]
proc accept {s a p} {
- global counter accept
+ variable counter
+ variable accept
set accept $s
set counter 0
fconfigure $s -blocking off -buffering line -translation lf
- fileevent $s readable "doit $s"
+ fileevent $s readable [namespace code "doit $s"]
}
proc doit {s} {
- global counter after
+ variable counter
+ variable after
incr counter
set l [gets $s]
if {"$l" == ""} {
- fileevent $s readable "doit1 $s"
- set after [after 1000 newline]
+ fileevent $s readable [namespace code "doit1 $s"]
+ set after [after 1000 [namespace code newline]]
}
}
proc doit1 {s} {
- global counter accept
+ variable counter
+ variable accept
incr counter
set l [gets $s]
@@ -6594,22 +6923,25 @@ test io-54.2 {Testing for busy-wait in recursive channel events} {socket} {
set accept {}
}
proc producer {} {
- global writer
+ variable s
+ variable writer
- set writer [socket 127.0.0.1 3939]
+ set writer [socket 127.0.0.1 [lindex [fconfigure $s -sockname] 2]]
fconfigure $writer -buffering line
puts -nonewline $writer hello
flush $writer
}
proc newline {} {
- global writer done
+ variable done
+ variable writer
puts $writer hello
flush $writer
set done 1
}
producer
- vwait done
+ variable done
+ vwait [namespace which -variable done]
close $writer
close $s
after cancel $after
@@ -6617,58 +6949,63 @@ test io-54.2 {Testing for busy-wait in recursive channel events} {socket} {
set counter
} 1
+set path(fooBar) [makeFile {} fooBar]
+
test io-55.1 {ChannelEventScriptInvoker: deletion} {
+ variable x
proc eventScript {fd} {
+ variable x
close $fd
error "planned error"
- set ::x whoops
+ set x whoops
}
- proc bgerror {args} {
- set ::x got_error
- }
- set f [open fooBar w]
- fileevent $f writable [list eventScript $f]
- set x not_done
- vwait x
+ proc ::bgerror {args} "set [namespace which -variable x] got_error"
+ set f [open $path(fooBar) w]
+ fileevent $f writable [namespace code [list eventScript $f]]
+ variable x not_done
+ vwait [namespace which -variable x]
set x
} {got_error}
-test io-56.1 {ChannelTimerProc} {
- set f [open fooBar w]
+test io-56.1 {ChannelTimerProc} {testchannelevent} {
+ set f [open $path(fooBar) w]
puts $f "this is a test"
close $f
- set f [open fooBar r]
- testchannelevent $f add readable {
+ set f [open $path(fooBar) r]
+ testchannelevent $f add readable [namespace code {
read $f 1
incr x
- }
- set x 0
- vwait x
- vwait x
+ }]
+ variable x 0
+ vwait [namespace which -variable x]
+ vwait [namespace which -variable x]
set result $x
testchannelevent $f set 0 none
- after idle {set y done}
- vwait y
+ after idle [namespace code {set y done}]
+ variable y
+ vwait [namespace which -variable y]
close $f
lappend result $y
} {2 done}
test io-57.1 {buffered data and file events, gets} {
proc accept {sock args} {
- set ::s2 $sock
+ variable s2
+ set s2 $sock
}
- set server [socket -server accept 4040]
- set s [socket 127.0.0.1 4040]
- vwait s2
+ set server [socket -server [namespace code accept] 0]
+ set s [socket 127.0.0.1 [lindex [fconfigure $server -sockname] 2]]
+ variable s2
+ vwait [namespace which -variable s2]
update
- fileevent $s2 readable {lappend result readable}
+ fileevent $s2 readable [namespace code {lappend result readable}]
puts $s "12\n34567890"
flush $s
- set result [gets $s2]
- after 1000 {lappend result timer}
- vwait result
+ variable result [gets $s2]
+ after 1000 [namespace code {lappend result timer}]
+ vwait [namespace which -variable result]
lappend result [gets $s2]
- vwait result
+ vwait [namespace which -variable result]
close $s
close $s2
close $server
@@ -6676,35 +7013,38 @@ test io-57.1 {buffered data and file events, gets} {
} {12 readable 34567890 timer}
test io-57.2 {buffered data and file events, read} {
proc accept {sock args} {
- set ::s2 $sock
+ variable s2
+ set s2 $sock
}
- set server [socket -server accept 4041]
- set s [socket 127.0.0.1 4041]
- vwait s2
+ set server [socket -server [namespace code accept] 0]
+ set s [socket 127.0.0.1 [lindex [fconfigure $server -sockname] 2]]
+ variable s2
+ vwait [namespace which -variable s2]
update
- fileevent $s2 readable {lappend result readable}
+ fileevent $s2 readable [namespace code {lappend result readable}]
puts -nonewline $s "1234567890"
flush $s
- set result [read $s2 1]
- after 1000 {lappend result timer}
- vwait result
+ variable result [read $s2 1]
+ after 1000 [namespace code {lappend result timer}]
+ vwait [namespace which -variable result]
lappend result [read $s2 9]
- vwait result
+ vwait [namespace which -variable result]
close $s
close $s2
close $server
set result
} {1 readable 234567890 timer}
-test io-58.1 {Tcl_NotifyChannel and error when closing} {unixOrPc} {
- set out [open script w]
+test io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrPc} {
+ set out [open $path(script) w]
puts $out {
puts "normal message from pipe"
puts stderr "error message from pipe"
exit 1
}
proc readit {pipe} {
- global x result
+ variable x
+ variable result
if {[eof $pipe]} {
set x [catch {close $pipe} line]
lappend result catch $line
@@ -6714,33 +7054,70 @@ test io-58.1 {Tcl_NotifyChannel and error when closing} {unixOrPc} {
}
}
close $out
- set pipe [open "|[list $::tcltest::tcltest] script" r]
- fileevent $pipe readable [list readit $pipe]
- set x ""
+ set pipe [open "|[list [interpreter] $path(script)]" r]
+ fileevent $pipe readable [namespace code [list readit $pipe]]
+ variable x ""
set result ""
- vwait x
+ vwait [namespace which -variable x]
list $x $result
} {1 {gets {normal message from pipe} gets {} catch {error message from pipe}}}
-# cleanup
-foreach file [list fooBar longfile script output test1 pipe my_script foo \
- bar test2 test3 cat stdout] {
- ::tcltest::removeFile $file
-}
-::tcltest::restoreState
-::tcltest::cleanupTests
-return
-
-
-
-
+testConstraint testmainthread [llength [info commands testmainthread]]
+test 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'. Or we have to extend [testthread] as well.
+ set f [open $path(longfile) r]
+ set result [testchannel mthread $f]
+ close $f
+ string equal $result [testmainthread]
+} {1}
+test io-60.1 {writing illegal utf sequences} {
+ # This test will hang in older revisions of the core.
+ set out [open $path(script) w]
+ puts $out {
+ puts [encoding convertfrom identity \xe2]
+ exit 1
+ }
+ proc readit {pipe} {
+ variable x
+ variable result
+ if {[eof $pipe]} {
+ set x [catch {close $pipe} line]
+ lappend result catch $line
+ } else {
+ gets $pipe line
+ lappend result gets $line
+ }
+ }
+ close $out
+ set pipe [open "|[list [interpreter] $path(script)]" r]
+ fileevent $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}}}
+# cleanup
+foreach file [list fooBar longfile script output test1 pipe my_script foo \
+ bar test2 test3 cat stdout] {
+ removeFile $file
+}
+cleanupTests
+}
+namespace delete ::tcl::test::io
+return
diff --git a/tcl/tests/ioCmd.test b/tcl/tests/ioCmd.test
index c668299cfa4..d263b630091 100644
--- a/tcl/tests/ioCmd.test
+++ b/tcl/tests/ioCmd.test
@@ -22,8 +22,6 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
removeFile test1
removeFile pipe
-set executable [list [info nameofexecutable]]
-
test iocmd-1.1 {puts command} {
list [catch {puts} msg] $msg
} {1 {wrong # args: should be "puts ?-nonewline? ?channelId? string"}}
@@ -39,26 +37,29 @@ test iocmd-1.4 {puts command} {
test iocmd-1.5 {puts command} {
list [catch {puts stdin hello} msg] $msg
} {1 {channel "stdin" wasn't opened for writing}}
+
+set path(test1) [makeFile {} test1]
+
test iocmd-1.6 {puts command} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf -eofchar {}
puts -nonewline $f foobar
close $f
- file size test1
+ file size $path(test1)
} 6
test iocmd-1.7 {puts command} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf -eofchar {}
puts $f foobar
close $f
- file size test1
+ file size $path(test1)
} 7
test iocmd-1.8 {puts command} {
- set f [open test1 w]
+ set f [open $path(test1) w]
fconfigure $f -translation lf -eofchar {}
puts -nonewline $f [binary format a4a5 foo bar]
close $f
- file size test1
+ file size $path(test1)
} 9
@@ -88,10 +89,10 @@ test iocmd-3.4 {gets command} {
list [catch {gets stdout} msg] $msg
} {1 {channel "stdout" wasn't opened for reading}}
test iocmd-3.5 {gets command} {
- set f [open test1 w]
+ set f [open $path(test1) w]
puts $f [binary format a4a5 foo bar]
close $f
- set f [open test1 r]
+ set f [open $path(test1) r]
set result [gets $f]
close $f
set x foo\x00
@@ -122,11 +123,11 @@ test iocmd-4.7 {read command} {
} {1 {channel "stdout" wasn't opened for reading}}
test iocmd-4.8 {read command with incorrect combination of arguments} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
puts $f "Two lines: this one"
puts $f "and this one"
close $f
- set f [open test1]
+ set f [open $path(test1)]
set x [list [catch {read -nonewline $f 20 z} msg] $msg $errorCode]
close $f
set x
@@ -137,15 +138,18 @@ test iocmd-4.9 {read command} {
test iocmd-4.10 {read command} {
list [catch {read file107} msg] $msg $errorCode
} {1 {can not find channel named "file107"} NONE}
+
+set path(test3) [makeFile {} test3]
+
test iocmd-4.11 {read command} {
- set f [open test3 w]
+ set f [open $path(test3) w]
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} {
- set f [open test1]
+ set f [open $path(test1)]
set x [list [catch {read $f 12z} msg] $msg $errorCode]
close $f
set x
@@ -195,7 +199,7 @@ test iocmd-8.3 {fconfigure command} {
} {1 {can not find channel named "a"}}
test iocmd-8.4 {fconfigure command} {
removeFile test1
- set f1 [open test1 w]
+ set f1 [open $path(test1) w]
set x [list [catch {fconfigure $f1 froboz} msg] $msg]
close $f1
set x
@@ -208,7 +212,7 @@ test iocmd-8.6 {fconfigure command} {
} {1 {bad value for -translation: must be one of auto, binary, cr, lf, crlf, or platform}}
test iocmd-8.7 {fconfigure command} {
removeFile test1
- set f1 [open test1 w]
+ set f1 [open $path(test1) w]
fconfigure $f1 -translation lf -eofchar {} -encoding unicode
set x [fconfigure $f1]
close $f1
@@ -216,7 +220,7 @@ test iocmd-8.7 {fconfigure command} {
} {-blocking 1 -buffering full -buffersize 4096 -encoding unicode -eofchar {} -translation lf}
test iocmd-8.8 {fconfigure command} {
removeFile test1
- set f1 [open test1 w]
+ set f1 [open $path(test1) w]
fconfigure $f1 -translation lf -buffering line -buffersize 3030 \
-eofchar {} -encoding unicode
set x ""
@@ -227,7 +231,7 @@ test iocmd-8.8 {fconfigure command} {
} {line {-blocking 1 -buffering line -buffersize 3030 -encoding unicode -eofchar {} -translation lf}}
test iocmd-8.9 {fconfigure command} {
removeFile test1
- set f1 [open test1 w]
+ set f1 [open $path(test1) w]
fconfigure $f1 -translation binary -buffering none -buffersize 4040 \
-eofchar {} -encoding binary
set x [fconfigure $f1]
@@ -237,44 +241,68 @@ 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} {
- list [catch {fconfigure stdout -froboz blarfo} msg] $msg
+ 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} {
- list [catch {fconfigure stdout -b blarfo} msg] $msg
+ 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} {
- list [catch {fconfigure stdout -buffer blarfo} msg] $msg
+ 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];
+ 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];
- }
+ set cli [socket 127.0.0.1 $port]
+ }
}
proc iocmdSSHTDWN {} {
- uplevel {
- close $cli;
- close $srv;
+ uplevel {
+ close $cli
+ close $srv
unset cli srv port
rename iocmdSRV {}
- }
+ }
}
-test iocmd-8.15 {fconfigure command / tcp channel} {socket} {
+test iocmd-8.15.0 {fconfigure command / tcp channel} {socket macOnly} {
iocmdSSETUP
- set r [list [catch {fconfigure $cli -blah} msg] $msg];
+ set r [list [catch {fconfigure $cli -blah} msg] $msg]
iocmdSSHTDWN
- set r;
+ set r
+} {1 {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, -error, -peername, or -sockname}}
+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];
+ set r [expr [lindex [fconfigure $cli -peername] 2]==$port]
iocmdSSHTDWN
set r
} 1
@@ -334,26 +362,29 @@ test iocmd-10.5 {fblocked command} {
fblocked stdin
} 0
+set path(test4) [makeFile {} test4]
+set path(test5) [makeFile {} test5]
+
removeFile test5
test iocmd-11.1 {I/O to command pipelines} {unixOrPc unixExecs} {
- set f [open test4 w]
+ set f [open $path(test4) w]
close $f
- list [catch {open "| cat < test4 > test5" w} msg] $msg $errorCode
+ list [catch {open "| cat < $path(test4) > $path(test5)" w} msg] $msg $errorCode
} {1 {can't write input to command: standard input was redirected} NONE}
test iocmd-11.2 {I/O to command pipelines} {unixOrPc unixExecs} {
- list [catch {open "| echo > test5" r} msg] $msg $errorCode
+ list [catch {open "| echo > $path(test5)" r} msg] $msg $errorCode
} {1 {can't read output from command: standard output was redirected} NONE}
test iocmd-11.3 {I/O to command pipelines} {unixOrPc unixExecs} {
- list [catch {open "| echo > test5" r+} msg] $msg $errorCode
+ list [catch {open "| echo > $path(test5)" r+} msg] $msg $errorCode
} {1 {can't read output from command: standard output was redirected} NONE}
test iocmd-12.1 {POSIX open access modes: RDONLY} {
removeFile test1
- set f [open test1 w]
+ set f [open $path(test1) w]
puts $f "Two lines: this one"
puts $f "and this one"
close $f
- set f [open test1 RDONLY]
+ set f [open $path(test1) RDONLY]
set x [list [gets $f] [catch {puts $f Test} msg] $msg]
close $f
string compare $x \
@@ -361,28 +392,32 @@ test iocmd-12.1 {POSIX open access modes: RDONLY} {
} 0
test iocmd-12.2 {POSIX open access modes: RDONLY} {
removeFile test3
- string tolower [list [catch {open test3 RDONLY} msg] $msg]
+ set msg [list [catch {open $path(test3) RDONLY} msg] $msg]
+ regsub [file join {} $path(test3)] $msg "test3" msg
+ string tolower $msg
} {1 {couldn't open "test3": no such file or directory}}
test iocmd-12.3 {POSIX open access modes: WRONLY} {
removeFile test3
- string tolower [list [catch {open test3 WRONLY} msg] $msg]
+ set msg [list [catch {open $path(test3) WRONLY} msg] $msg]
+ regsub [file join {} $path(test3)] $msg "test3" msg
+ string tolower $msg
} {1 {couldn't open "test3": no such file or directory}}
#
# Test 13.4 relies on assigning the same channel name twice.
#
test iocmd-12.4 {POSIX open access modes: WRONLY} {unixOnly} {
removeFile test3
- set f [open test3 w]
+ set f [open $path(test3) w]
fconfigure $f -eofchar {}
puts $f xyzzy
close $f
- set f [open test3 WRONLY]
+ set f [open $path(test3) WRONLY]
fconfigure $f -eofchar {}
puts -nonewline $f "ab"
seek $f 0 current
set x [list [catch {gets $f} msg] $msg]
close $f
- set f [open test3 r]
+ set f [open $path(test3) r]
fconfigure $f -eofchar {}
lappend x [gets $f]
close $f
@@ -391,20 +426,22 @@ test iocmd-12.4 {POSIX open access modes: WRONLY} {unixOnly} {
} 0
test iocmd-12.5 {POSIX open access modes: RDWR} {
removeFile test3
- string tolower [list [catch {open test3 RDWR} msg] $msg]
+ set msg [list [catch {open $path(test3) RDWR} msg] $msg]
+ regsub [file join {} $path(test3)] $msg "test3" msg
+ string tolower $msg
} {1 {couldn't open "test3": no such file or directory}}
test iocmd-12.6 {POSIX open access modes: errors} {
- concat [catch {open 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\"
invoked from within
-\"open test3 \"FOO \\{BAR BAZ\"\""
+\"open \$path(test3) \"FOO \\{BAR BAZ\"\""
test iocmd-12.7 {POSIX open access modes: errors} {
- list [catch {open test3 {FOO BAR BAZ}} msg] $msg
+ list [catch {open $path(test3) {FOO BAR BAZ}} msg] $msg
} {1 {invalid access mode "FOO": must be RDONLY, WRONLY, RDWR, APPEND, CREAT EXCL, NOCTTY, NONBLOCK, or TRUNC}}
test iocmd-12.8 {POSIX open access modes: errors} {
- list [catch {open test3 {TRUNC CREAT}} msg] $msg
+ list [catch {open $path(test3) {TRUNC CREAT}} msg] $msg
} {1 {access mode must include either RDONLY, WRONLY, or RDWR}}
test iocmd-13.1 {errors in open command} {
@@ -414,16 +451,18 @@ test iocmd-13.2 {errors in open command} {
list [catch {open a b c d} msg] $msg
} {1 {wrong # args: should be "open fileName ?access? ?permissions?"}}
test iocmd-13.3 {errors in open command} {
- list [catch {open test1 x} msg] $msg
+ list [catch {open $path(test1) x} msg] $msg
} {1 {illegal access mode "x"}}
test iocmd-13.4 {errors in open command} {
- list [catch {open test1 rw} msg] $msg
+ list [catch {open $path(test1) rw} msg] $msg
} {1 {illegal access mode "rw"}}
test iocmd-13.5 {errors in open command} {
- list [catch {open test1 r+1} msg] $msg
+ list [catch {open $path(test1) r+1} msg] $msg
} {1 {illegal access mode "r+1"}}
test iocmd-13.6 {errors in open command} {
- string tolower [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
} {1 {couldn't open "_non_existent_": no such file or directory} {posix enoent {no such file or directory}}}
test iocmd-14.1 {file id parsing errors} {
@@ -453,8 +492,10 @@ test iocmd-14.8 {file id parsing errors} {
test iocmd-14.9 {file id parsing errors} {
list [catch {eof stderr1} msg] $msg
} {1 {can not find channel named "stderr1"}}
-set f [open test1 w]
+
+set f [open $path(test1) w]
close $f
+
set expect "1 {can not find channel named \"$f\"}"
test iocmd-14.10 {file id parsing errors} {
list [catch {eof $f} msg] $msg
@@ -475,10 +516,15 @@ test iocmd-15.4 {Tcl_FcopyObjCmd} {
test iocmd-15.5 {Tcl_FcopyObjCmd} {
list [catch {fcopy 1 2 3 4 5} msg] $msg
} {1 {wrong # args: should be "fcopy input output ?-size size? ?-command callback?"}}
-set f [open test1 w]
+
+set path(test2) [makeFile {} test2]
+
+set f [open $path(test1) w]
close $f
-set rfile [open test1 r]
-set wfile [open test2 w]
+
+set rfile [open $path(test1) r]
+set wfile [open $path(test2) w]
+
test iocmd-15.6 {Tcl_FcopyObjCmd} {
list [catch {fcopy foo $wfile} msg] $msg
} {1 {can not find channel named "foo"}}
@@ -506,25 +552,12 @@ close $wfile
# cleanup
foreach file [list test1 test2 test3 test4] {
- ::tcltest::removeFile $file
+ catch {::tcltest::removeFile $file}
}
# delay long enough for background processes to finish
after 500
foreach file [list test5 pipe output] {
- ::tcltest::removeFile $file
+ catch {::tcltest::removeFile $file}
}
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tcl/tests/ioUtil.test b/tcl/tests/ioUtil.test
index 95b2df6b530..bd263e97d7b 100644
--- a/tcl/tests/ioUtil.test
+++ b/tcl/tests/ioUtil.test
@@ -11,28 +11,31 @@
# RCS: @(#) $Id$
if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+ 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.} {knownBug} {
+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
-} {{couldn't stat "testStat1%.fil": no such file or directory} {couldn't stat "testStat2%.fil": no such file or directory} {couldn't stat "testStat3%.fil": no such file or directory}}
+} {{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}}
-if {[info commands teststatproc] == {}} {
- puts "This application hasn't been compiled with the \"teststatproc\""
- puts "command, so I can't test Tcl_Stat_* etc."
-} else {
-test ioUtil-1.2 {TclStatInsertProc: Insert the 3 test TclStat_ procedures.} {
+test ioUtil-1.2 {TclStatInsertProc: Insert the 3 test TclStat_ procedures.} {teststatproc} {
catch {teststatproc insert TclpStat} err1
teststatproc insert TestStatProc1
teststatproc insert TestStatProc2
@@ -40,7 +43,7 @@ test ioUtil-1.2 {TclStatInsertProc: Insert the 3 test TclStat_ procedures.} {
set err1
} {bad arg "insert": must be TestStatProc1, TestStatProc2, or TestStatProc3}
-test ioUtil-1.3 {TclStat: Use "file stat ?" to invoke each procedure.} {knownBug} {
+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
@@ -50,12 +53,12 @@ test ioUtil-1.3 {TclStat: Use "file stat ?" to invoke each procedure.} {knownBug
eval $unsetScript
-test ioUtil-1.4 {TclStatDeleteProc: "TclpStat" function should not be deletedable.} {
+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.} {knownBug} {
+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.
@@ -65,11 +68,11 @@ test ioUtil-1.5 {TclStatDeleteProc: Delete the 2nd TclStat procedure.} {knownBug
file stat testStat3%.fil testStat3
list $testStat1(size) $err3 $testStat3(size)
-} {1234 {couldn't stat "testStat2%.fil": no such file or directory} 3456}
+} {1234 {could not read "testStat2%.fil": no such file or directory} 3456}
eval $unsetScript
-test ioUtil-1.6 {TclStatDeleteProc: Delete the 1st TclStat procedure.} {knownBug} {
+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.
@@ -79,11 +82,11 @@ test ioUtil-1.6 {TclStatDeleteProc: Delete the 1st TclStat procedure.} {knownBug
file stat testStat3%.fil testStat3
list $err4 $err5 $testStat3(size)
-} {{couldn't stat "testStat1%.fil": no such file or directory} {couldn't stat "testStat2%.fil": no such file or directory} 3456}
+} {{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.} {knownBug} {
+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.
@@ -93,11 +96,11 @@ test ioUtil-1.7 {TclStatDeleteProc: Delete the 3rd procedure & verify all are go
catch {file stat testStat3%.fil testStat3} err8
list $err6 $err7 $err8
-} {{couldn't stat "testStat1%.fil": no such file or directory} {couldn't stat "testStat2%.fil": no such file or directory} {couldn't stat "testStat3%.fil": no such file or directory}}
+} {{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.} {knownBug} {
+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.
@@ -107,23 +110,17 @@ test ioUtil-1.8 {TclStatDeleteProc: Verify that all procs have been deleted.} {k
list $err9 $err10 $err11
} {{"TestStatProc1": could not be deleteed} {"TestStatProc2": could not be deleteed} {"TestStatProc3": could not be deleteed}}
-}
eval $unsetScript
-
-test access-1.1 {TclAccess: Check that none of the test procs are there.} {
+test ioUtil-1.1 {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}
-if {[info commands testaccessproc] == {}} {
- puts "This application hasn't been compiled with the \"testaccessproc\""
- puts "command, so I can't test Tcl_Access_* etc."
-} else {
-test ioUtil-1.2 {TclAccessInsertProc: Insert the 3 test TclAccess_ procedures.} {
+test ioUtil-1.2 {TclAccessInsertProc: Insert the 3 test TclAccess_ procedures.} {testaccessproc} {
catch {testaccessproc insert TclpAccess} err1
testaccessproc insert TestAccessProc1
testaccessproc insert TestAccessProc2
@@ -131,21 +128,20 @@ test ioUtil-1.2 {TclAccessInsertProc: Insert the 3 test TclAccess_ procedures.}
set err1
} {bad arg "insert": must be TestAccessProc1, TestAccessProc2, or TestAccessProc3}
-test ioUtil-2.3 {TclAccess: Use "file access ?" to invoke each procedure.} {
- list \
- [file exists testAccess2%.fil] \
- [file exists testAccess1%.fil] \
- [file exists testAccess3%.fil]
+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 deletedable.} {
+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 accesst-1.5 {TclAccessDeleteProc: Delete the 2nd TclAccess procedure.} {
+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.
+ # the others do actually return a result.
testaccessproc delete TestAccessProc2
set res1 [file exists testAccess1%.fil]
@@ -155,7 +151,7 @@ test accesst-1.5 {TclAccessDeleteProc: Delete the 2nd TclAccess procedure.} {
list $res1 $err3 $res2
} {1 0 1}
-test ioUtil-2.6 {TclAccessDeleteProc: Delete the 1st TclAccess procedure.} {
+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.
@@ -167,7 +163,7 @@ test ioUtil-2.6 {TclAccessDeleteProc: Delete the 1st TclAccess procedure.} {
list $err4 $err5 $res3
} {0 0 1}
-test ioUtil-2.7 {TclAccessDeleteProc: Delete the 3rd procedure & verify all are gone.} {
+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.
@@ -179,7 +175,7 @@ test ioUtil-2.7 {TclAccessDeleteProc: Delete the 3rd procedure & verify all are
list $err6 $err7 $err8
} {0 0 0}
-test ioUtil-2.8 {TclAccessDeleteProc: Verify that all procs have been deleted.} {
+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.
@@ -189,23 +185,23 @@ test ioUtil-2.8 {TclAccessDeleteProc: Verify that all procs have been deleted.}
list $err9 $err10 $err11
} {{"TestAccessProc1": could not be deleteed} {"TestAccessProc2": could not be deleteed} {"TestAccessProc3": could not be deleteed}}
-}
-test ioUtil-3.1 {TclOpenFileChannel: Check that none of the test procs are there.} {
- catch {file exists __testOpenFileChannel1%__.fil} err1
- catch {file exists __testOpenFileChannel2%__.fil} err2
- catch {file exists __testOpenFileChannel3%__.fil} err3
+# 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 {eval [list file delete -force] [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}
-if {[info commands testopenfilechannelproc] == {}} {
- puts "This application hasn't been compiled with the \"testopenfilechannelproc\""
- puts "command, so I can't test Tcl_OpenFileChannelInsert"
-} else {
-test ioUtil-3.2 {TclOpenFileChannelInsertProc: Insert the 3 test TclOpenFileChannel_ procedures.} {
+test ioUtil-3.2 {TclOpenFileChannelInsertProc: Insert the 3 test TclOpenFileChannel_ procedures.} {testopenfilechannelproc} {
catch {testopenfilechannelproc insert TclpOpenFileChannel} err1
testopenfilechannelproc insert TestOpenFileChannelProc1
testopenfilechannelproc insert TestOpenFileChannelProc2
@@ -213,86 +209,92 @@ test ioUtil-3.2 {TclOpenFileChannelInsertProc: Insert the 3 test TclOpenFileChan
set err1
} {bad arg "insert": must be TestOpenFileChannelProc1, TestOpenFileChannelProc2, or TestOpenFileChannelProc3}
-test ioUtil-3.3 {TclOpenFileChannel: Use "file openfilechannel ?" to invoke each procedure.} {
- close [open __testOpenFileChannel1%__.fil w]
- close [open __testOpenFileChannel2%__.fil w]
- close [open __testOpenFileChannel3%__.fil w]
+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
+ 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
+ file delete __testOpenFileChannel1%__.fil
+ file delete __testOpenFileChannel2%__.fil
+ file delete __testOpenFileChannel3%__.fil
- set err
+ set err
} {}
-test ioUtil-3.4 {TclOpenFileChannelDeleteProc: "TclpOpenFileChannel" function should not be deletedable.} {
+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 openfilechannelt-1.5 {TclOpenFileChannelDeleteProc: Delete the 2nd TclOpenFileChannel procedure.} {
+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]
+ close [open __testOpenFileChannel1%__.fil w]
+ close [open __testOpenFileChannel3%__.fil w]
- catch {
- close [open testOpenFileChannel1%.fil r]
- catch {close [open testOpenFileChannel2%.fil r]}
- close [open testOpenFileChannel3%.fil r]
- } err3
+ 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
+ file delete __testOpenFileChannel1%__.fil
+ file delete __testOpenFileChannel3%__.fil
- set err3
-} {}
+ list $err3 $msg1
+} {{} {couldn't open "testOpenFileChannel2%.fil": no such file or directory}}
-test ioUtil-3.6 {TclOpenFileChannelDeleteProc: Delete the 1st TclOpenFileChannel procedure.} {
+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]
+ close [open __testOpenFileChannel3%__.fil w]
- catch {
- catch {close [open testOpenFileChannel1%.fil r]}
- catch {close [open testOpenFileChannel2%.fil r]}
- close [open testOpenFileChannel3%.fil r]
- } err4
+ 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
+ file delete __testOpenFileChannel3%__.fil
- set err4
-} {}
+ 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.} {
+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 [open testOpenFileChannel1%.fil r]
- catch [open testOpenFileChannel2%.fil r]
- catch [open testOpenFileChannel3%.fil r]
- } err5
+ catch {
+ catch {close [open testOpenFileChannel1%.fil r]} msg4
+ catch {close [open testOpenFileChannel2%.fil r]} msg5
+ catch {close [open testOpenFileChannel3%.fil r]} msg6
+ } err5
- set err5
-} {1}
+ 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.} {
- # Attempt to delete all the OpenFileChannel procs. again to ensure they no longer
- # exist and an error is returned.
+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
@@ -300,21 +302,9 @@ test ioUtil-3.8 {TclOpenFileChannelDeleteProc: Verify that all procs have been d
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/tcl/tests/iogt.test b/tcl/tests/iogt.test
index 0ee5d559c55..1816a619273 100644
--- a/tcl/tests/iogt.test
+++ b/tcl/tests/iogt.test
@@ -12,29 +12,28 @@
#
# RCS: @(#) $Id$
-
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
- namespace import -force ::tcltest::*
-}
-
-if {[info commands testchannel] == ""} {
- puts "Skipping io tests. This application does not seem to have the"
- puts "testchannel command that is needed to run these tests."
+if {[catch {package require tcltest 2.1}]} {
+ puts stderr "Skipping tests in [info script]. tcltest 2.1 required."
return
}
+namespace eval ::tcl::test::iogt {
-::tcltest::saveState
+ namespace import ::tcltest::cleanupTests
+ namespace import ::tcltest::makeFile
+ namespace import ::tcltest::removeFile
+ namespace import ::tcltest::test
+ namespace import ::tcltest::testConstraint
-#::tcltest::makeFile contents name
+ testConstraint testchannel [llength [info commands testchannel]]
-::tcltest::makeFile {abcdefghijklmnopqrstuvwxyz0123456789,./?><;'\|":[]\}\{`~!@#$%^&*()_+-=} dummy
+set path(dummy) [makeFile {abcdefghijklmnopqrstuvwxyz0123456789,./?><;'\|":[]\}\{`~!@#$%^&*()_+-=
+} dummy]
# " capture coloring of quotes
-::tcltest::makeFile {} dummyout
+set path(dummyout) [makeFile {} dummyout]
-::tcltest::makeFile {
+set path(__echo_srv__.tcl) [makeFile {
#!/usr/local/bin/tclsh
# -*- tcl -*-
# echo server
@@ -51,12 +50,14 @@ set bsizes [lrange $argv 3 end]
set c 0
proc newconn {sock rhost rport} {
- global c fdelay
+ variable fdelay
+ variable c
incr c
+ variable c$c
#puts stdout "C $sock $rhost $rport / $fdelay" ; flush stdout
- upvar #0 c$c conn
+ upvar 0 c$c conn
set conn(after) {}
set conn(state) 0
set conn(size) 0
@@ -68,8 +69,9 @@ proc newconn {sock rhost rport} {
}
proc echoGet {c sock} {
- global fdelay
- upvar #0 c$c conn
+ variable fdelay
+ variable c$c
+ upvar 0 c$c conn
if {[eof $sock]} {
# one-shot echo
@@ -86,8 +88,11 @@ proc echoGet {c sock} {
}
proc echoPut {c sock} {
- global idelay fdelay bsizes
- upvar #0 c$c conn
+ variable idelay
+ variable fdelay
+ variable bsizes
+ variable c$c
+ upvar 0 c$c conn
if {[string length $conn(data)] == 0} {
#puts stdout "C $c $sock" ; flush stdout
@@ -128,7 +133,7 @@ proc echoPut {c sock} {
# main
socket -server newconn $port
vwait forever
-} __echo_srv__.tcl
+} __echo_srv__.tcl]
########################################################################
@@ -189,7 +194,8 @@ proc id {op data} {
}
proc id_optrail {var op data} {
- upvar #0 $var trail
+ variable $var
+ upvar 0 $var trail
lappend trail $op
@@ -215,7 +221,8 @@ proc id_optrail {var op data} {
proc id_fulltrail {var op data} {
- upvar #0 $var trail
+ variable $var
+ upvar 0 $var trail
#puts stdout ">> $var $op $data" ; flush stdout
@@ -243,7 +250,8 @@ proc id_fulltrail {var op data} {
}
proc counter {var op data} {
- upvar #0 $var n
+ variable $var
+ upvar 0 $var n
switch -- $op {
create/write - create/read -
@@ -270,7 +278,9 @@ proc counter {var op data} {
proc counter_audit {var vtrail op data} {
- upvar #0 $var n $vtrail trail
+ variable $var
+ variable $vtrail
+ upvar 0 $var n $vtrail trail
switch -- $op {
create/write - create/read -
@@ -304,7 +314,9 @@ proc counter_audit {var vtrail op data} {
proc rblocks {var vtrail n op data} {
- upvar #0 $var buf $vtrail trail
+ variable $var
+ variable $vtrail
+ upvar 0 $var buf $vtrail trail
set res {}
@@ -348,31 +360,33 @@ proc rblocks {var vtrail n op data} {
# ... and convenience procedures to stack them
proc identity {-attach channel} {
- testchannel transform $channel -command id
+ testchannel transform $channel -command [namespace code id]
}
proc audit_ops {var -attach channel} {
- testchannel transform $channel -command [list id_optrail $var]
+ testchannel transform $channel -command [namespace code [list id_optrail $var]]
}
proc audit_flow {var -attach channel} {
- testchannel transform $channel -command [list id_fulltrail $var]
+ testchannel transform $channel -command [namespace code [list id_fulltrail $var]]
}
proc stopafter {var n -attach channel} {
- upvar #0 $var vn
+ variable $var
+ upvar 0 $var vn
set vn $n
- testchannel transform $channel -command [list counter $var]
+ testchannel transform $channel -command [namespace code [list counter $var]]
}
proc stopafter_audit {var trail n -attach channel} {
- upvar #0 $var vn
+ variable $var
+ upvar 0 $var vn
set vn $n
- testchannel transform $channel -command [list counter_audit $var $trail]
+ testchannel transform $channel -command [namespace code [list counter_audit $var $trail]]
}
proc rblocks_t {var trail n -attach channel} {
- testchannel transform $channel -command [list rblocks $var $trail $n]
+ testchannel transform $channel -command [namespace code [list rblocks $var $trail $n]]
}
# --------------------------------------------------------------
@@ -397,22 +411,21 @@ proc asort {alist} {
########################################################################
-
-test iogt-1.1 {stack/unstack} {
- set fh [open dummy r]
+test iogt-1.1 {stack/unstack} testchannel {
+ set fh [open $path(dummy) r]
identity -attach $fh
testchannel unstack $fh
close $fh
} {}
-test iogt-1.2 {stack/close} {
- set fh [open dummy r]
+test iogt-1.2 {stack/close} testchannel {
+ set fh [open $path(dummy) r]
identity -attach $fh
close $fh
} {}
-test iogt-1.3 {stack/unstack, configuration, options} {
- set fh [open dummy r]
+test iogt-1.3 {stack/unstack, configuration, options} testchannel {
+ set fh [open $path(dummy) r]
set ca [asort [fconfigure $fh]]
identity -attach $fh
set cb [asort [fconfigure $fh]]
@@ -429,8 +442,8 @@ test iogt-1.3 {stack/unstack, configuration, options} {
list [string equal $ca $cb] [string equal $cb $cc] [string equal $ca $cc]
} {1 1 1}
-test iogt-1.4 {stack/unstack, configuration} {
- set fh [open dummy r]
+test iogt-1.4 {stack/unstack, configuration} testchannel {
+ set fh [open $path(dummy) r]
set ca [asort [fconfigure $fh]]
identity -attach $fh
fconfigure $fh \
@@ -451,9 +464,9 @@ test iogt-1.4 {stack/unstack, configuration} {
set res
} {0 line cr shiftjis}
-test iogt-2.0 {basic I/O going through transform} {
- set fin [open dummy r]
- set fout [open dummyout w]
+test iogt-2.0 {basic I/O going through transform} testchannel {
+ set fin [open $path(dummy) r]
+ set fout [open $path(dummyout) w]
identity -attach $fin
identity -attach $fout
@@ -463,8 +476,8 @@ test iogt-2.0 {basic I/O going through transform} {
close $fin
close $fout
- set fin [open dummy r]
- set fout [open dummyout 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]
@@ -476,9 +489,9 @@ test iogt-2.0 {basic I/O going through transform} {
} {1 71 71}
-test iogt-2.1 {basic I/O, operation trail} {unixOnly} {
- set fin [open dummy r]
- set fout [open dummyout w]
+test iogt-2.1 {basic I/O, operation trail} {testchannel unixOnly} {
+ set fin [open $path(dummy) r]
+ set fout [open $path(dummyout) w]
set ain [list] ; set aout [list]
audit_ops ain -attach $fin
@@ -512,7 +525,6 @@ query/maxRead
read
query/maxRead
flush/read
-query/maxRead
delete/read
--------
create/write
@@ -527,9 +539,9 @@ write
flush/write
delete/write}
-test iogt-2.2 {basic I/O, data trail} {unixOnly} {
- set fin [open dummy r]
- set fout [open dummyout w]
+test iogt-2.2 {basic I/O, data trail} {testchannel unixOnly} {
+ set fin [open $path(dummy) r]
+ set fout [open $path(dummyout) w]
set ain [list] ; set aout [list]
audit_flow ain -attach $fin
@@ -565,7 +577,6 @@ read {
}
query/maxRead {} -1
flush/read {} {}
-query/maxRead {} -1
delete/read {} *ignored*
--------
create/write {} *ignored*
@@ -583,9 +594,9 @@ flush/write {} {}
delete/write {} *ignored*}
-test iogt-2.3 {basic I/O, mixed trail} {unixOnly} {
- set fin [open dummy r]
- set fout [open dummyout w]
+test iogt-2.3 {basic I/O, mixed trail} {testchannel unixOnly} {
+ set fin [open $path(dummy) r]
+ set fout [open $path(dummyout) w]
set trail [list]
audit_flow trail -attach $fin
@@ -624,14 +635,13 @@ write %^&*()_+-= %^&*()_+-=
write {
} {
}
-query/maxRead {} -1
delete/read {} *ignored*
flush/write {} {}
delete/write {} *ignored*}
test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \
- {unknownFailure} {
+ {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
@@ -642,10 +652,10 @@ test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \
# delay, causing the fcopy to underflow immediately.
proc DoneCopy {n {err {}}} {
- global copy ; set copy 1
+ variable copy ; set copy 1
}
- set fin [open dummy r]
+ set fin [open $path(dummy) r]
fevent 1000 500 {20 20 20 10 1 1} {
close $fin
@@ -656,7 +666,7 @@ test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \
# But the 1 second delay should be enough to
# initialize everything else here.
- fcopy $sock $fout -command DoneCopy
+ fcopy $sock $fout -command [namespace code DoneCopy]
# transform after fcopy got its handles !
# They should be still valid for fcopy.
@@ -664,7 +674,7 @@ test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \
set trail [list]
audit_ops trail -attach $fout
- vwait copy
+ vwait [namespace which -variable copy]
} [read $fin] ; # {}
close $fout
@@ -673,8 +683,8 @@ test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \
# Check result of copy.
- set fin [open dummy r]
- set fout [open dummyout r]
+ set fin [open $path(dummy) r]
+ set fout [open $path(dummyout) r]
set res [string equal [read $fin] [read $fout]]
@@ -685,8 +695,8 @@ test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \
} {1 {create/write create/read write flush/write flush/read delete/write delete/read}}
-test iogt-4.0 {fileevent readable, after transform} {unknownFailure} {
- set fin [open dummy r]
+test iogt-4.0 {fileevent readable, after transform} {testchannel unknownFailure} {
+ set fin [open $path(dummy) r]
set data [read $fin]
close $fin
@@ -694,12 +704,13 @@ test iogt-4.0 {fileevent readable, after transform} {unknownFailure} {
set got [list]
proc Done {args} {
- global stop
+ variable stop
set stop 1
}
proc Get {sock} {
- global trail got
+ variable trail
+ variable got
if {[eof $sock]} {
Done
lappend trail "xxxxxxxxxxxxx"
@@ -723,7 +734,7 @@ test iogt-4.0 {fileevent readable, after transform} {unknownFailure} {
# But the 1 second delay should be enough to
# initialize everything else here.
- vwait stop
+ vwait [namespace which -variable stop]
} $data
@@ -815,9 +826,9 @@ delete/write {} *ignored*
delete/read {} *ignored*} ; # catch unescaped quote "
-test iogt-5.0 {EOF simulation} {unknownFailure} {
- set fin [open dummy r]
- set fout [open dummyout w]
+test iogt-5.0 {EOF simulation} {testchannel unknownFailure} {
+ set fin [open $path(dummy) r]
+ set fout [open $path(dummyout) w]
set trail [list]
@@ -891,11 +902,11 @@ proc constX {op data} {
}
proc constx {-attach channel} {
- testchannel transform $channel -command constX
+ testchannel transform $channel -command [namespace code constX]
}
-test iogt-6.0 {Push back} {
- set f [open dummy r]
+test iogt-6.0 {Push back} testchannel {
+ set f [open $path(dummy) r]
# contents of dummy = "abcdefghi..."
read $f 3 ; # skip behind "abc"
@@ -915,8 +926,8 @@ test iogt-6.0 {Push back} {
set res
} {xxx}
-test iogt-6.1 {Push back and up} {knownBug} {
- set f [open dummy r]
+test iogt-6.1 {Push back and up} {testchannel knownBug} {
+ set f [open $path(dummy) r]
# contents of dummy = "abcdefghi..."
read $f 3 ; # skip behind "abc"
@@ -933,8 +944,9 @@ test iogt-6.1 {Push back and up} {knownBug} {
# cleanup
foreach file [list dummy dummyout __echo_srv__.tcl] {
- ::tcltest::removeFile $file
+ removeFile $file
+}
+cleanupTests
}
-::tcltest::restoreState
-::tcltest::cleanupTests
+namespace delete ::tcl::test::iogt
return
diff --git a/tcl/tests/join.test b/tcl/tests/join.test
index d2721a66192..353a1cc181c 100644
--- a/tcl/tests/join.test
+++ b/tcl/tests/join.test
@@ -64,4 +64,3 @@ return
-
diff --git a/tcl/tests/license.terms b/tcl/tests/license.terms
index 9df3e600352..f1dcaa5245c 100644
--- a/tcl/tests/license.terms
+++ b/tcl/tests/license.terms
@@ -1,7 +1,8 @@
This software is copyrighted by the Regents of the University of
-California, Sun Microsystems, Inc., Scriptics Corporation,
-and other parties. The following terms apply to all files associated
-with the software unless explicitly disclaimed in individual files.
+California, Sun Microsystems, Inc., Scriptics Corporation, ActiveState
+Corporation and other parties. The following terms apply to all files
+associated with the software unless explicitly disclaimed in
+individual files.
The authors hereby grant permission to use, copy, modify, distribute,
and license this software and its documentation for any purpose, provided
diff --git a/tcl/tests/lindex.test b/tcl/tests/lindex.test
index 3060c7c039e..8469d279646 100644
--- a/tcl/tests/lindex.test
+++ b/tcl/tests/lindex.test
@@ -7,6 +7,7 @@
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
+# 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.
@@ -18,66 +19,459 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
namespace import -force ::tcltest::*
}
-test lindex-1.1 {basic tests} {
- lindex {a b c} 0} a
-test lindex-1.2 {basic tests} {
- lindex {a {b c d} x} 1} {b c d}
-test lindex-1.3 {basic tests} {
- lindex {a b\ c\ d x} 1} {b c d}
-test lindex-1.4 {basic tests} {
- lindex {a b c} 3} {}
-test lindex-1.5 {basic tests} {
- list [catch {lindex {a b c} -1} msg] $msg
-} {0 {}}
-test lindex-1.6 {basic tests} {
- lindex {a b c d} end
-} d
-test lindex-1.7 {basic tests} {
- lindex {a b c d} 100
+set lindex lindex
+set minus -
+
+# Tests of Tcl_LindexObjCmd, NOT COMPILED
+
+test lindex-1.1 {wrong # args} {
+ list [catch {eval $lindex} result] $result
+} "1 {wrong # args: should be \"lindex list ?index...?\"}"
+
+# Indices that are lists or convertible to lists
+
+test lindex-2.1 {empty index list} {
+ set x {}
+ list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
+} {{a b c} {a b c}}
+
+test lindex-2.2 {singleton index list} {
+ set x { 1 }
+ list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
+} {b b}
+
+test lindex-2.3 {multiple indices in list} {
+ set x {1 2}
+ list [eval [list $lindex {{a b c} {d e f}} $x]] \
+ [eval [list $lindex {{a b c} {d e f}} $x]]
+} {f f}
+
+test lindex-2.4 {malformed index list} {
+ set x \{
+ list [catch { eval [list $lindex {a b c} $x] } result] $result
+} {1 bad\ index\ \"\{\":\ must\ be\ integer\ or\ end?-integer?}
+
+# Indices that are integers or convertible to integers
+
+test lindex-3.1 {integer -1} {
+ set x ${minus}1
+ list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
+} {{} {}}
+
+test lindex-3.2 {integer 0} {
+ set x [string range 00 0 0]
+ list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
+} {a a}
+
+test lindex-3.3 {integer 2} {
+ set x [string range 22 0 0]
+ list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
+} {c c}
+
+test lindex-3.4 {integer 3} {
+ set x [string range 33 0 0]
+ list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
+} {{} {}}
+
+test lindex-3.5 {bad octal} {
+ set x 08
+ list [catch { eval [list $lindex {a b c} $x] } result] $result
+} "1 {bad index \"08\": must be integer or end?-integer? (looks like invalid octal number)}"
+
+test lindex-3.6 {bad octal} {
+ set x -09
+ list [catch { eval [list $lindex {a b c} $x] } result] $result
+} "1 {bad index \"-09\": must be integer or end?-integer? (looks like 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]
+} {2147483646 {} 2147483647 2147483648}
+
+# Indices relative to end
+
+test lindex-4.1 {index = end} {
+ set x end
+ list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
+} {c c}
+
+test lindex-4.2 {index = end--1} {
+ set x end--1
+ list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
+} {{} {}}
+
+test lindex-4.3 {index = end-0} {
+ set x end-0
+ list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
+} {c c}
+
+test lindex-4.4 {index = end-2} {
+ set x end-2
+ list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
+} {a a}
+
+test lindex-4.5 {index = end-3} {
+ set x end-3
+ list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
+} {{} {}}
+
+test lindex-4.6 {bad octal} {
+ set x end-08
+ list [catch { eval [list $lindex {a b c} $x] } result] $result
+} "1 {bad index \"end-08\": must be integer or end?-integer? (looks like invalid octal number)}"
+
+test lindex-4.7 {bad octal} {
+ set x end--09
+ list [catch { eval [list $lindex {a b c} $x] } result] $result
+} "1 {bad index \"end--09\": must be integer or end?-integer?}"
+
+test lindex-4.8 {bad integer, not octal} {
+ set x end-0a2
+ list [catch { eval [list $lindex {a b c} $x] } result] $result
+} "1 {bad index \"end-0a2\": must be integer or end?-integer?}"
+
+test lindex-4.9 {incomplete end} {
+ set x en
+ list [eval [list $lindex {a b c} $x]] [eval [list $lindex {a b c} $x]]
+} {c c}
+
+test lindex-4.10 {incomplete end-} {
+ set x end-
+ list [catch { eval [list $lindex {a b c} $x] } result] $result
+} "1 {bad index \"end-\": must be integer or end?-integer?}"
+
+test lindex-5.1 {bad second index} {
+ list [catch { eval [list $lindex {a b c} 0 0a2] } result] $result
+} "1 {bad index \"0a2\": must be integer or end?-integer?}"
+
+test lindex-5.2 {good second index} {
+ eval [list $lindex {{a b c} {d e f} {g h i}} 1 2]
+} f
+
+test lindex-5.3 {three indices} {
+ eval [list $lindex {{{a b} {c d}} {{e f} {g h}}} 1 0 1]
+} f
+test lindex-6.1 {error conditions in parsing list} {
+ list [catch {eval [list $lindex "a \{" 2]} msg] $msg
+} {1 {unmatched open brace in list}}
+test lindex-6.2 {error conditions in parsing list} {
+ list [catch {eval [list $lindex {a {b c}d e} 2]} msg] $msg
+} {1 {list element in braces followed by "d" instead of space}}
+test lindex-6.3 {error conditions in parsing list} {
+ list [catch {eval [list $lindex {a "b c"def ghi} 2]} msg] $msg
+} {1 {list element in quotes followed by "def" instead of space}}
+
+test lindex-7.1 {quoted elements} {
+ eval [list $lindex {a "b c" d} 1]
+} {b c}
+test lindex-7.2 {quoted elements} {
+ eval [list $lindex {"{}" b c} 0]
+} {{}}
+test lindex-7.3 {quoted elements} {
+ eval [list $lindex {ab "c d \" x" y} 1]
+} {c d " x}
+test lindex-7.4 {quoted elements} {
+ lindex {a b {c d "e} {f g"}} 2
+} {c d "e}
+
+test lindex-8.1 {data reuse} {
+ set x 0
+ eval [list $lindex $x $x]
+} {0}
+
+test lindex-8.2 {data reuse} {
+ set a 0
+ eval [list $lindex $a $a $a]
+} 0
+test lindex-8.3 {data reuse} {
+ set a 1
+ eval [list $lindex $a $a $a]
} {}
-test lindex-1.8 {basic tests} {
- lindex {a} e
-} a
-test lindex-1.9 {basic tests} {
- lindex {} end
+
+test lindex-8.4 {data reuse} {
+ set x [list 0 0]
+ eval [list $lindex $x $x]
+} {0}
+
+test lindex-8.5 {data reuse} {
+ set x 0
+ eval [list $lindex $x [list $x $x]]
+} {0}
+
+test lindex-8.6 {data reuse} {
+ set x [list 1 1]
+ eval [list $lindex $x $x]
} {}
-test lindex-1.10 {basic tests} {
- lindex {a b c d} 3
-} d
-
-test lindex-2.1 {error conditions} {
- list [catch {lindex msg} msg] $msg
-} {1 {wrong # args: should be "lindex list index"}}
-test lindex-2.2 {error conditions} {
- list [catch {lindex 1 2 3 4} msg] $msg
-} {1 {wrong # args: should be "lindex list index"}}
-test lindex-2.3 {error conditions} {
- list [catch {lindex 1 2a2} msg] $msg
-} {1 {bad index "2a2": must be integer or end?-integer?}}
-test lindex-2.4 {error conditions} {
- list [catch {lindex "a \{" 2} msg] $msg
+
+test lindex-8.7 {data reuse} {
+ set x 1
+ eval [list lindex $x [list $x $x]]
+} {}
+
+#----------------------------------------------------------------------
+
+# Compilation tests for lindex
+
+test lindex-9.1 {wrong # args} {
+ list [catch {lindex} result] $result
+} "1 {wrong # args: should be \"lindex list ?index...?\"}"
+
+# Indices that are lists or convertible to lists
+
+test lindex-10.1 {empty index list} {
+ set x {}
+ catch {
+ list [lindex {a b c} $x] [lindex {a b c} $x]
+ } result
+ set result
+} {{a b c} {a b c}}
+
+test lindex-10.2 {singleton index list} {
+ set x { 1 }
+ catch {
+ list [lindex {a b c} $x] [lindex {a b c} $x]
+ } result
+ set result
+} {b b}
+
+test lindex-10.3 {multiple indices in list} {
+ set x {1 2}
+ catch {
+ list [lindex {{a b c} {d e f}} $x] [lindex {{a b c} {d e f}} $x]
+ } result
+ set result
+} {f f}
+
+test lindex-10.4 {malformed index list} {
+ set x \{
+ list [catch { lindex {a b c} $x } result] $result
+} {1 bad\ index\ \"\{\":\ must\ be\ integer\ or\ end?-integer?}
+
+# Indices that are integers or convertible to integers
+
+test lindex-11.1 {integer -1} {
+ set x ${minus}1
+ catch {
+ list [lindex {a b c} $x] [lindex {a b c} $x]
+ } result
+ set result
+} {{} {}}
+
+test lindex-11.2 {integer 0} {
+ set x [string range 00 0 0]
+ catch {
+ list [lindex {a b c} $x] [lindex {a b c} $x]
+ } result
+ set result
+} {a a}
+
+test lindex-11.3 {integer 2} {
+ set x [string range 22 0 0]
+ catch {
+ list [lindex {a b c} $x] [lindex {a b c} $x]
+ } result
+ set result
+} {c c}
+
+test lindex-11.4 {integer 3} {
+ set x [string range 33 0 0]
+ catch {
+ list [lindex {a b c} $x] [lindex {a b c} $x]
+ } result
+ set result
+} {{} {}}
+
+test lindex-11.5 {bad octal} {
+ set x 08
+ list [catch { lindex {a b c} $x } result] $result
+} "1 {bad index \"08\": must be integer or end?-integer? (looks like invalid octal number)}"
+
+test lindex-11.6 {bad octal} {
+ set x -09
+ list [catch { lindex {a b c} $x } result] $result
+} "1 {bad index \"-09\": must be integer or end?-integer? (looks like invalid octal number)}"
+
+# Indices relative to end
+
+test lindex-12.1 {index = end} {
+ set x end
+ catch {
+ list [lindex {a b c} $x] [lindex {a b c} $x]
+ } result
+ set result
+} {c c}
+
+test lindex-12.2 {index = end--1} {
+ set x end--1
+ catch {
+ list [lindex {a b c} $x] [lindex {a b c} $x]
+ } result
+ set result
+} {{} {}}
+
+test lindex-12.3 {index = end-0} {
+ set x end-0
+ catch {
+ list [lindex {a b c} $x] [lindex {a b c} $x]
+ } result
+ set result
+} {c c}
+
+test lindex-12.4 {index = end-2} {
+ set x end-2
+ catch {
+ list [lindex {a b c} $x] [lindex {a b c} $x]
+ } result
+ set result
+} {a a}
+
+test lindex-12.5 {index = end-3} {
+ set x end-3
+ catch {
+ list [lindex {a b c} $x] [lindex {a b c} $x]
+ } result
+ set result
+} {{} {}}
+
+test lindex-12.6 {bad octal} {
+ set x end-08
+ list [catch { lindex {a b c} $x } result] $result
+} "1 {bad index \"end-08\": must be integer or end?-integer? (looks like invalid octal number)}"
+
+test lindex-12.7 {bad octal} {
+ set x end--09
+ list [catch { lindex {a b c} $x } result] $result
+} "1 {bad index \"end--09\": must be integer or end?-integer?}"
+
+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 or end?-integer?}"
+
+test lindex-12.9 {incomplete end} {
+ set x en
+ catch {
+ list [lindex {a b c} $x] [lindex {a b c} $x]
+ } result
+ set result
+} {c c}
+
+test lindex-12.10 {incomplete end-} {
+ set x end-
+ list [catch { lindex {a b c} $x } result] $result
+} "1 {bad index \"end-\": must be integer or end?-integer?}"
+
+test lindex-13.1 {bad second index} {
+ list [catch { lindex {a b c} 0 0a2 } result] $result
+} "1 {bad index \"0a2\": must be 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
+ } result
+ set result
+} f
+
+test lindex-14.1 {error conditions in parsing list} {
+ list [catch { lindex "a \{" 2 } msg] $msg
} {1 {unmatched open brace in list}}
-test lindex-2.5 {error conditions} {
- list [catch {lindex {a {b c}d e} 2} msg] $msg
+test lindex-14.2 {error conditions in parsing list} {
+ list [catch { lindex {a {b c}d e} 2 } msg] $msg
} {1 {list element in braces followed by "d" instead of space}}
-test lindex-2.6 {error conditions} {
- list [catch {lindex {a "b c"def ghi} 2} msg] $msg
+test lindex-14.3 {error conditions in parsing list} {
+ list [catch { lindex {a "b c"def ghi} 2 } msg] $msg
} {1 {list element in quotes followed by "def" instead of space}}
-test lindex-3.1 {quoted elements} {
- lindex {a "b c" d} 1
+test lindex-15.1 {quoted elements} {
+ catch {
+ lindex {a "b c" d} 1
+ } result
+ set result
} {b c}
-test lindex-3.2 {quoted elements} {
- lindex {"{}" b c} 0
+test lindex-15.2 {quoted elements} {
+ catch {
+ lindex {"{}" b c} 0
+ } result
+ set result
} {{}}
-test lindex-3.3 {quoted elements} {
- lindex {ab "c d \" x" y} 1
+test lindex-15.3 {quoted elements} {
+ catch {
+ lindex {ab "c d \" x" y} 1
+ } result
+ set result
} {c d " x}
-test lindex-3.4 {quoted elements} {
- lindex {a b {c d "e} {f g"}} 2
+test lindex-15.4 {quoted elements} {
+ catch {
+ lindex {a b {c d "e} {f g"}} 2
+ } result
+ set result
} {c d "e}
+test lindex-16.1 {data reuse} {
+ set x 0
+ catch {
+ lindex $x $x
+ } result
+ set result
+} {0}
+
+test lindex-16.2 {data reuse} {
+ set a 0
+ catch {
+ lindex $a $a $a
+ } result
+ set result
+} 0
+test lindex-16.3 {data reuse} {
+ set a 1
+ catch {
+ lindex $a $a $a
+ } result
+ set result
+} {}
+
+test lindex-16.4 {data reuse} {
+ set x [list 0 0]
+ catch {
+ lindex $x $x
+ } result
+ set result
+} {0}
+
+test lindex-16.5 {data reuse} {
+ set x 0
+ catch {
+ lindex $x [list $x $x]
+ } result
+ set result
+} {0}
+
+test lindex-16.6 {data reuse} {
+ set x [list 1 1]
+ catch {
+ lindex $x $x
+ } result
+ set result
+} {}
+
+test lindex-16.7 {data reuse} {
+ set x 1
+ catch {
+ lindex $x [list $x $x]
+ } result
+ set result
+} {}
+
+catch { unset lindex}
+catch { unset minus }
+
# cleanup
::tcltest::cleanupTests
return
-
diff --git a/tcl/tests/link.test b/tcl/tests/link.test
index 1aaf1133058..48acf5e00bb 100644
--- a/tcl/tests/link.test
+++ b/tcl/tests/link.test
@@ -14,244 +14,249 @@
# RCS: @(#) $Id$
if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+ package require tcltest 2
namespace import -force ::tcltest::*
}
-if {[info commands testlink] == {}} {
- puts "This application hasn't been compiled with the \"testlink\""
- puts "command, so I can't test Tcl_LinkVar et al."
- ::tcltest::cleanupTests
- return
-}
+::tcltest::testConstraint testlink \
+ [expr {[info commands testlink] != {}}]
foreach i {int real bool string} {
catch {unset $i}
}
-test link-1.1 {reading C variables from Tcl} {
+test link-1.1 {reading C variables from Tcl} {testlink} {
testlink delete
- testlink set 43 1.23 4 -
- testlink create 1 1 1 1
- list $int $real $bool $string
-} {43 1.23 1 NULL}
-test link-1.2 {reading C variables from Tcl} {
+ testlink set 43 1.23 4 - 12341234
+ testlink create 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} {
testlink delete
- testlink create 1 1 1 1
- testlink set -3 2 0 "A long string with spaces"
- list $int $real $bool $string $int $real $bool $string
-} {-3 2.0 0 {A long string with spaces} -3 2.0 0 {A long string with spaces}}
+ testlink create 1 1 1 1 1
+ testlink set -3 2 0 "A long string with spaces" 43214321
+ 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}
-test link-2.1 {writing C variables from Tcl} {
+test link-2.1 {writing C variables from Tcl} {testlink} {
testlink delete
- testlink set 43 1.21 4 -
- testlink create 1 1 1 1
+ testlink set 43 1.21 4 - 56785678
+ testlink create 1 1 1 1 1
set int "00721"
set real -10.5
set bool true
set string abcdef
- concat [testlink get] $int $real $bool $string
-} {465 -10.5 1 abcdef 00721 -10.5 true abcdef}
-test link-2.2 {writing bad values into variables} {
+ set wide 135135
+ concat [testlink get] $int $real $bool $string $wide
+} {465 -10.5 1 abcdef 135135 00721 -10.5 true abcdef 135135}
+test link-2.2 {writing bad values into variables} {testlink} {
testlink delete
- testlink set 43 1.23 4 -
- testlink create 1 1 1 1
+ testlink set 43 1.23 4 - 56785678
+ testlink create 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} {
+test link-2.3 {writing bad values into variables} {testlink} {
testlink delete
- testlink set 43 1.23 4 -
- testlink create 1 1 1 1
+ testlink set 43 1.23 4 - 56785678
+ testlink create 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} {
+test link-2.4 {writing bad values into variables} {testlink} {
testlink delete
- testlink set 43 1.23 4 -
- testlink create 1 1 1 1
+ testlink set 43 1.23 4 - 56785678
+ testlink create 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} {
+ testlink delete
+ testlink set 43 1.23 4 - 56785678
+ testlink create 1 1 1 1 1
+ list [catch {set wide gorp} msg] $msg $bool
+} {1 {can't set "wide": variable must have integer value} 1}
-test link-3.1 {read-only variables} {
+test link-3.1 {read-only variables} {testlink} {
testlink delete
- testlink set 43 1.23 4 -
- testlink create 0 1 1 0
+ testlink set 43 1.23 4 - 56785678
+ testlink create 0 1 1 0 0
list [catch {set int 4} msg] $msg $int \
[catch {set real 10.6} msg] $msg $real \
[catch {set bool no} msg] $msg $bool \
- [catch {set string "new value"} msg] $msg $string
-} {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}
-test link-3.2 {read-only variables} {
+ [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} {
testlink delete
- testlink set 43 1.23 4 -
- testlink create 1 0 0 1
+ testlink set 43 1.23 4 - 56785678
+ testlink create 1 0 0 1 1
list [catch {set int 4} msg] $msg $int \
[catch {set real 10.6} msg] $msg $real \
[catch {set bool no} msg] $msg $bool \
- [catch {set string "new value"} msg] $msg $string
-} {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}}
+ [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}
-test link-4.1 {unsetting linked variables} {
+test link-4.1 {unsetting linked variables} {testlink} {
testlink delete
- testlink set -6 -2.5 0 stringValue
- testlink create 1 1 1 1
- unset int real bool string
+ testlink set -6 -2.5 0 stringValue 13579
+ testlink create 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
-} {0 -6 0 -2.5 0 0 0 stringValue}
-test link-4.2 {unsetting linked variables} {
+ [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} {
testlink delete
- testlink set -6 -2.1 0 stringValue
- testlink create 1 1 1 1
- unset int real bool string
+ testlink set -6 -2.1 0 stringValue 97531
+ testlink create 1 1 1 1 1
+ unset int real bool string wide
set int 102
set real 16
set bool true
set string newValue
+ set wide 333555
testlink get
-} {102 16.0 1 newValue}
+} {102 16.0 1 newValue 333555}
-test link-5.1 {unlinking variables} {
+test link-5.1 {unlinking variables} {testlink} {
testlink delete
- testlink set -6 -2.25 0 stringValue
+ testlink set -6 -2.25 0 stringValue 13579
testlink delete
set int xx1
set real qrst
set bool bogus
set string 12345
+ set wide 875421
testlink get
-} {-6 -2.25 0 stringValue}
-test link-5.2 {unlinking variables} {
+} {-6 -2.25 0 stringValue 13579}
+test link-5.2 {unlinking variables} {testlink} {
testlink delete
- testlink set -6 -2.25 0 stringValue
- testlink create 1 1 1 1
+ testlink set -6 -2.25 0 stringValue 97531
+ testlink create 1 1 1 1 1
testlink delete
- testlink set 25 14.7 7 -
- list $int $real $bool $string
-} {-6 -2.25 0 stringValue}
+ testlink set 25 14.7 7 - 999999
+ list $int $real $bool $string $wide
+} {-6 -2.25 0 stringValue 97531}
-test link-6.1 {errors in setting up link} {
+test link-6.1 {errors in setting up link} {testlink} {
testlink delete
catch {unset int}
set int(44) 1
- list [catch {testlink create 1 1 1 1} msg] $msg
+ list [catch {testlink create 1 1 1 1 1} msg] $msg
} {1 {can't set "int": variable is array}}
catch {unset int}
-test link-7.1 {access to linked variables via upvar} {
+test link-7.1 {access to linked variables via upvar} {testlink} {
proc x {} {
upvar int y
unset y
}
testlink delete
- testlink create 1 0 0 0
- testlink set 14 {} {} {}
+ testlink create 1 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} {
+test link-7.2 {access to linked variables via upvar} {testlink} {
proc x {} {
upvar int y
return [set y]
}
testlink delete
- testlink create 1 0 0 0
- testlink set 0 {} {} {}
+ testlink create 1 0 0 0 0
+ testlink set 0 {} {} {} {}
set int
- testlink set 23 {} {} {}
+ testlink set 23 {} {} {} {}
x
list [x] $int
} {23 23}
-test link-7.3 {access to linked variables via upvar} {
+test link-7.3 {access to linked variables via upvar} {testlink} {
proc x {} {
upvar int y
set y 44
}
testlink delete
- testlink create 0 0 0 0
- testlink set 11 {} {} {}
+ testlink create 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} {
+test link-7.4 {access to linked variables via upvar} {testlink} {
proc x {} {
upvar int y
set y abc
}
testlink delete
- testlink create 1 1 1 1
- testlink set -4 {} {} {}
+ testlink create 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} {
+test link-7.5 {access to linked variables via upvar} {testlink} {
proc x {} {
upvar real y
set y abc
}
testlink delete
- testlink create 1 1 1 1
- testlink set -4 16.75 {} {}
+ testlink create 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} {
+test link-7.6 {access to linked variables via upvar} {testlink} {
proc x {} {
upvar bool y
set y abc
}
testlink delete
- testlink create 1 1 1 1
- testlink set -4 16.3 1 {}
+ testlink create 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} {
+ proc x {} {
+ upvar wide y
+ set y abc
+ }
+ testlink delete
+ testlink create 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}
-test link-8.1 {Tcl_UpdateLinkedVar procedure} {
+test link-8.1 {Tcl_UpdateLinkedVar procedure} {testlink} {
proc x args {
- global x int real bool string
- lappend x $args $int $real $bool $string
+ global x int real bool string wide
+ lappend x $args $int $real $bool $string $wide
}
set x {}
- testlink create 1 1 1 1
- testlink set 14 -2.0 0 xyzzy
+ testlink create 1 1 1 1 1
+ testlink set 14 -2.0 0 xyzzy 995511
trace var int w x
- testlink update 32 4.0 3 abcd
+ testlink update 32 4.0 3 abcd 113355
trace vdelete int w x
set x
-} {{int {} w} 32 -2.0 0 xyzzy}
-test link-8.2 {Tcl_UpdateLinkedVar procedure} {
+} {{int {} w} 32 -2.0 0 xyzzy 995511}
+test link-8.2 {Tcl_UpdateLinkedVar procedure} {testlink} {
proc x args {
- global x int real bool string
- lappend x $args $int $real $bool $string
+ global x int real bool string wide
+ lappend x $args $int $real $bool $string $wide
}
set x {}
- testlink create 1 1 1 1
- testlink set 14 -2.0 0 xyzzy
+ testlink create 1 1 1 1 1
+ testlink set 14 -2.0 0 xyzzy 995511
testlink delete
trace var int w x
- testlink update 32 4.0 6 abcd
+ testlink update 32 4.0 6 abcd 113355
trace vdelete int w x
set x
} {}
-test link-8.3 {Tcl_UpdateLinkedVar procedure, read-only variable} {
- testlink create 0 0 0 0
- list [catch {testlink update 47 {} {} {}} msg] $msg $int
+test link-8.3 {Tcl_UpdateLinkedVar procedure, read-only variable} {testlink} {
+ testlink create 0 0 0 0 0
+ list [catch {testlink update 47 {} {} {} {}} msg] $msg $int
} {0 {} 47}
-testlink set 0 0 0 -
-testlink delete
-foreach i {int real bool string} {
+catch {testlink set 0 0 0 - 0}
+catch {testlink delete}
+foreach i {int real bool string wide} {
catch {unset $i}
}
# cleanup
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tcl/tests/linsert.test b/tcl/tests/linsert.test
index b110c700b96..f3dc1188784 100644
--- a/tcl/tests/linsert.test
+++ b/tcl/tests/linsert.test
@@ -113,4 +113,3 @@ catch {unset lis}
catch {rename p ""}
::tcltest::cleanupTests
return
-
diff --git a/tcl/tests/list.test b/tcl/tests/list.test
index 88763272d19..45161ca9c7b 100644
--- a/tcl/tests/list.test
+++ b/tcl/tests/list.test
@@ -125,4 +125,3 @@ return
-
diff --git a/tcl/tests/listObj.test b/tcl/tests/listObj.test
index f4bc31ba2ca..03eea1f4d93 100644
--- a/tcl/tests/listObj.test
+++ b/tcl/tests/listObj.test
@@ -198,4 +198,3 @@ return
-
diff --git a/tcl/tests/llength.test b/tcl/tests/llength.test
index 72a422f7b49..2b571430c05 100644
--- a/tcl/tests/llength.test
+++ b/tcl/tests/llength.test
@@ -53,4 +53,3 @@ return
-
diff --git a/tcl/tests/load.test b/tcl/tests/load.test
index bd746ae6fe9..9759e3d49c8 100644
--- a/tcl/tests/load.test
+++ b/tcl/tests/load.test
@@ -13,7 +13,7 @@
# RCS: @(#) $Id$
if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+ package require tcltest 2
namespace import -force ::tcltest::*
}
@@ -31,12 +31,12 @@ 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"
-set ::tcltest::testConstraints($dll) [file readable $x]
+::tcltest::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]
-set ::tcltest::testConstraints($loaded) \
+::tcltest::testConstraint $loaded \
[expr {![string match *pkga* $alreadyLoaded]}]
set alreadyTotalLoaded [info loaded]
@@ -113,7 +113,7 @@ test load-4.1 {reloading package into same interpreter} [list $dll $loaded] {
} {0 {}}
test load-4.2 {reloading package into same interpreter} [list $dll $loaded] {
list [catch {load [file join $testDir pkga$ext] pkgb} msg] $msg
-} "1 {file \"[file join $testDir pkga$ext\"] is already loaded for package \"Pkga\"}"
+} [list 1 "file \"[file join $testDir pkga$ext]\" is already loaded for package \"Pkga\""]
test load-5.1 {file name not specified and no static package: pick default} \
[list $dll $loaded] {
@@ -124,7 +124,7 @@ test load-5.1 {file name not specified and no static package: pick default} \
set result [info loaded x]
interp delete x
set result
-} "{[file join $testDir pkga$ext] Pkga}"
+} [list [list [file join $testDir pkga$ext] Pkga]]
# On some platforms, like SunOS 4.1.3, these tests can't be run because
# they cause the process to exit.
@@ -160,21 +160,21 @@ if {[info command teststaticpkg] != ""} {
teststaticpkg Double 0 1
teststaticpkg Double 0 1
info loaded
- } "{{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkge$ext] Pkge} {[file join $testDir pkgb$ext] Pkgb} {[file join $testDir pkga$ext] Pkga} $alreadyTotalLoaded"
+ } [concat [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkge$ext] Pkge] [list [file join $testDir pkgb$ext] Pkgb] [list [file join $testDir pkga$ext] Pkga]] $alreadyTotalLoaded]
test load-8.1 {TclGetLoadedPackages procedure} [list $dll $loaded] {
info loaded
- } "{{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkge$ext] Pkge} {[file join $testDir pkgb$ext] Pkgb} {[file join $testDir pkga$ext] Pkga} $alreadyTotalLoaded"
+ } [concat [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkge$ext] Pkge] [list [file join $testDir pkgb$ext] Pkgb] [list [file join $testDir pkga$ext] Pkga]] $alreadyTotalLoaded]
test load-8.2 {TclGetLoadedPackages procedure} [list $dll $loaded] {
list [catch {info loaded gorp} msg] $msg
} {1 {could not find interpreter "gorp"}}
test load-8.3 {TclGetLoadedPackages procedure} [list $dll $loaded] {
list [info loaded {}] [info loaded child]
- } "{{{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkga$ext] Pkga} $alreadyLoaded} {{{} Test} {[file join $testDir pkgb$ext] Pkgb}}"
+ } [list [concat [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded] [list {{} Test} [list [file join $testDir pkgb$ext] Pkgb]]]
test load-8.4 {TclGetLoadedPackages procedure} [list $dll $loaded] {
load [file join $testDir pkgb$ext] pkgb
list [info loaded {}] [lsort [info commands pkgb_*]]
- } "{{[file join $testDir pkgb$ext] Pkgb} {{} Double} {{} More} {{} Another} {{} Test} {[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_sub pkgb_unsafe}]
interp delete child
}
@@ -193,4 +193,3 @@ return
-
diff --git a/tcl/tests/lrange.test b/tcl/tests/lrange.test
index e4bc3be37b7..4ff54bac2a2 100644
--- a/tcl/tests/lrange.test
+++ b/tcl/tests/lrange.test
@@ -89,4 +89,3 @@ test lrange-2.6 {error conditions} {
# cleanup
::tcltest::cleanupTests
return
-
diff --git a/tcl/tests/lreplace.test b/tcl/tests/lreplace.test
index f91ed199624..7a06ea163f1 100644
--- a/tcl/tests/lreplace.test
+++ b/tcl/tests/lreplace.test
@@ -136,4 +136,3 @@ test lreplace-3.1 {lreplace won't modify shared argument objects} {
catch {unset foo}
::tcltest::cleanupTests
return
-
diff --git a/tcl/tests/lsearch.test b/tcl/tests/lsearch.test
index eeef99e1a0f..4cf863986c4 100644
--- a/tcl/tests/lsearch.test
+++ b/tcl/tests/lsearch.test
@@ -61,20 +61,20 @@ test lsearch-2.9 {search modes} {
} 1
test lsearch-2.10 {search modes} {
list [catch {lsearch -glib {b.x bx xy bcx} b.x} msg] $msg
-} {1 {bad search mode "-glib": must be -exact, -glob, or -regexp}}
+} {1 {bad option "-glib": must be -all, -ascii, -decreasing, -dictionary, -exact, -glob, -increasing, -inline, -integer, -not, -real, -regexp, -sorted, or -start}}
test lsearch-3.1 {lsearch errors} {
list [catch lsearch msg] $msg
-} {1 {wrong # args: should be "lsearch ?mode? list pattern"}}
+} {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 ?mode? list pattern"}}
+} {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 search mode "a": must be -exact, -glob, or -regexp}}
+} {1 {bad option "a": must be -all, -ascii, -decreasing, -dictionary, -exact, -glob, -increasing, -inline, -integer, -not, -real, -regexp, -sorted, or -start}}
test lsearch-3.4 {lsearch errors} {
list [catch {lsearch a b c d} msg] $msg
-} {1 {wrong # args: should be "lsearch ?mode? list pattern"}}
+} {1 {bad option "a": must be -all, -ascii, -decreasing, -dictionary, -exact, -glob, -increasing, -inline, -integer, -not, -real, -regexp, -sorted, or -start}}
test lsearch-3.5 {lsearch errors} {
list [catch {lsearch "\{" b} msg] $msg
} {1 {unmatched open brace in list}}
@@ -89,19 +89,267 @@ test lsearch-4.2 {binary data} {
lsearch -exact [list foo one\000two bar] $x
} 1
-# cleanup
-::tcltest::cleanupTests
-return
+# Make a sorted list
+set l {}
+set l2 {}
+for {set i 0} {$i < 100} {incr i} {
+ lappend l $i
+ lappend l2 [expr {double($i)/2}]
+}
+set increasingIntegers [lsort -integer $l]
+set decreasingIntegers [lsort -decreasing -integer $l]
+set increasingDoubles [lsort -real $l2]
+set decreasingDoubles [lsort -decreasing -real $l2]
+set increasingStrings [lsort {48 6a 18b 22a 21aa 35 36}]
+set decreasingStrings [lsort -decreasing {48 6a 18b 22a 21aa 35 36}]
+set increasingDictionary [lsort -dictionary {48 6a 18b 22a 21aa 35 36}]
+set decreasingDictionary [lsort -dictionary -decreasing $increasingDictionary]
+set l {}
+for {set i 0} {$i < 10} {incr i} {
+ lappend l $i $i $i $i $i
+}
+set repeatingIncreasingIntegers [lsort -integer $l]
+set repeatingDecreasingIntegers [lsort -integer -decreasing $l]
+test lsearch-5.1 {binary search} {
+ set res {}
+ for {set i 0} {$i < 100} {incr i} {
+ lappend res [lsearch -integer -sorted $increasingIntegers $i]
+ }
+ set res
+} $increasingIntegers
+test lsearch-5.2 {binary search} {
+ set res {}
+ for {set i 0} {$i < 100} {incr i} {
+ lappend res [lsearch -integer -decreasing -sorted \
+ $decreasingIntegers $i]
+ }
+ set res
+} $decreasingIntegers
+test lsearch-5.3 {binary search finds leftmost occurances} {
+ set res {}
+ for {set i 0} {$i < 10} {incr i} {
+ lappend res [lsearch -integer -sorted $repeatingIncreasingIntegers $i]
+ }
+ set res
+} [list 0 5 10 15 20 25 30 35 40 45]
+test lsearch-5.4 {binary search -decreasing finds leftmost occurances} {
+ set res {}
+ for {set i 9} {$i >= 0} {incr i -1} {
+ lappend res [lsearch -sorted -integer -decreasing \
+ $repeatingDecreasingIntegers $i]
+ }
+ set res
+} [list 0 5 10 15 20 25 30 35 40 45]
+test lsearch-6.1 {integer search} {
+ set res {}
+ for {set i 0} {$i < 100} {incr i} {
+ lappend res [lsearch -exact -integer $increasingIntegers $i]
+ }
+ set res
+} [lrange $increasingIntegers 0 99]
+test lsearch-6.2 {decreasing integer search} {
+ set res {}
+ for {set i 0} {$i < 100} {incr i} {
+ lappend res [lsearch -exact -integer -decreasing \
+ $decreasingIntegers $i]
+ }
+ set res
+} [lrange $decreasingIntegers 0 99]
+test lsearch-6.3 {sorted integer search} {
+ set res {}
+ for {set i 0} {$i < 100} {incr i} {
+ lappend res [lsearch -sorted -integer $increasingIntegers $i]
+ }
+ set res
+} [lrange $increasingIntegers 0 99]
+test lsearch-6.4 {sorted decreasing integer search} {
+ set res {}
+ for {set i 0} {$i < 100} {incr i} {
+ lappend res [lsearch -integer -sorted -decreasing \
+ $decreasingIntegers $i]
+ }
+ set res
+} [lrange $decreasingIntegers 0 99]
+test lsearch-7.1 {double search} {
+ set res {}
+ for {set i 0} {$i < 100} {incr i} {
+ lappend res [lsearch -exact -real $increasingDoubles \
+ [expr {double($i)/2}]]
+ }
+ set res
+} [lrange $increasingIntegers 0 99]
+test lsearch-7.2 {decreasing double search} {
+ set res {}
+ for {set i 0} {$i < 100} {incr i} {
+ lappend res [lsearch -exact -real -decreasing \
+ $decreasingDoubles [expr {double($i)/2}]]
+ }
+ set res
+} [lrange $decreasingIntegers 0 99]
+test lsearch-7.3 {sorted double search} {
+ set res {}
+ for {set i 0} {$i < 100} {incr i} {
+ lappend res [lsearch -sorted -real \
+ $increasingDoubles [expr {double($i)/2}]]
+ }
+ set res
+} [lrange $increasingIntegers 0 99]
+test lsearch-7.4 {sorted decreasing double search} {
+ set res {}
+ for {set i 0} {$i < 100} {incr i} {
+ lappend res [lsearch -sorted -real -decreasing \
+ $decreasingDoubles [expr {double($i)/2}]]
+ }
+ set res
+} [lrange $decreasingIntegers 0 99]
+test lsearch-8.1 {dictionary search} {
+ set res {}
+ foreach val {6a 18b 21aa 22a 35 36 48} {
+ lappend res [lsearch -exact -dictionary $increasingDictionary $val]
+ }
+ set res
+} [list 0 1 2 3 4 5 6]
+test lsearch-8.2 {decreasing dictionary search} {
+ set res {}
+ foreach val {6a 18b 21aa 22a 35 36 48} {
+ lappend res [lsearch -exact -dictionary $decreasingDictionary $val]
+ }
+ set res
+} [list 6 5 4 3 2 1 0]
+test lsearch-8.3 {sorted dictionary search} {
+ set res {}
+ foreach val {6a 18b 21aa 22a 35 36 48} {
+ lappend res [lsearch -sorted -dictionary $increasingDictionary $val]
+ }
+ set res
+} [list 0 1 2 3 4 5 6]
+test lsearch-8.4 {decreasing sorted dictionary search} {
+ set res {}
+ foreach val {6a 18b 21aa 22a 35 36 48} {
+ lappend res [lsearch -decreasing -sorted -dictionary \
+ $decreasingDictionary $val]
+ }
+ set res
+} [list 6 5 4 3 2 1 0]
+test lsearch-9.1 {ascii search} {
+ set res {}
+ foreach val {18b 21aa 22a 35 36 48 6a} {
+ lappend res [lsearch -exact -ascii $increasingStrings $val]
+ }
+ set res
+} [list 0 1 2 3 4 5 6]
+test lsearch-9.2 {decreasing ascii search} {
+ set res {}
+ foreach val {18b 21aa 22a 35 36 48 6a} {
+ lappend res [lsearch -exact -ascii $decreasingStrings $val]
+ }
+ set res
+} [list 6 5 4 3 2 1 0]
+test lsearch-9.3 {sorted ascii search} {
+ set res {}
+ foreach val {18b 21aa 22a 35 36 48 6a} {
+ lappend res [lsearch -sorted -ascii $increasingStrings $val]
+ }
+ set res
+} [list 0 1 2 3 4 5 6]
+test lsearch-9.4 {decreasing sorted ascii search} {
+ set res {}
+ foreach val {18b 21aa 22a 35 36 48 6a} {
+ lappend res [lsearch -decreasing -sorted -ascii \
+ $decreasingStrings $val]
+ }
+ set res
+} [list 6 5 4 3 2 1 0]
+test lsearch-10.1 {offset searching} {
+ lsearch -start 2 {a b c a b c} a
+} 3
+test lsearch-10.2 {offset searching} {
+ lsearch -start 2 {a b c d e f} a
+} -1
+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 or end?-integer?}}
+test lsearch-10.5 {offset searching} {
+ list [catch {lsearch -start 1 2} msg] $msg
+} {1 {missing starting index}}
+test lsearch-10.6 {binary search with offset} {
+ set res {}
+ for {set i 0} {$i < 100} {incr i} {
+ lappend res [lsearch -integer -start 2 -sorted $increasingIntegers $i]
+ }
+ set res
+} [concat -1 -1 [lrange $increasingIntegers 2 end]]
+test lsearch-11.1 {negated searches} {
+ lsearch -not {a a a b a a a} a
+} 3
+test lsearch-11.2 {negated searches} {
+ lsearch -not {a a a a a a a} a
+} -1
+test lsearch-12.1 {return values instead of indices} {
+ lsearch -glob -inline {a1 b2 c3 d4} c*
+} c3
+test lsearch-12.2 {return values instead of indices} {
+ lsearch -glob -inline {a1 b2 c3 d4} e*
+} {}
+test lsearch-13.1 {search for all matches} {
+ lsearch -all {a b a c a d} 1
+} {}
+test lsearch-13.2 {search for all matches} {
+ lsearch -all {a b a c a d} a
+} {0 2 4}
+test lsearch-13.1 {combinations: -all and -inline} {
+ lsearch -all -inline -glob {a1 b2 a3 c4 a5 d6} a*
+} {a1 a3 a5}
+test lsearch-13.2 {combinations: -all, -inline and -not} {
+ lsearch -all -inline -not -glob {a1 b2 a3 c4 a5 d6} a*
+} {b2 c4 d6}
+test lsearch-13.3 {combinations: -all and -not} {
+ lsearch -all -not -glob {a1 b2 a3 c4 a5 d6} a*
+} {1 3 5}
+test lsearch-13.4 {combinations: -inline and -not} {
+ lsearch -inline -not -glob {a1 b2 a3 c4 a5 d6} a*
+} {b2}
+test lsearch-13.5 {combinations: -start, -all and -inline} {
+ lsearch -start 2 -all -inline -glob {a1 b2 a3 c4 a5 d6} a*
+} {a3 a5}
+test lsearch-13.6 {combinations: -start, -all, -inline and -not} {
+ lsearch -start 2 -all -inline -not -glob {a1 b2 a3 c4 a5 d6} a*
+} {c4 d6}
+test lsearch-13.7 {combinations: -start, -all and -not} {
+ lsearch -start 2 -all -not -glob {a1 b2 a3 c4 a5 d6} a*
+} {3 5}
+test lsearch-13.8 {combinations: -start, -inline and -not} {
+ lsearch -start 2 -inline -not -glob {a1 b2 a3 c4 a5 d6} a*
+} {c4}
+test lsearch-14.1 {make sure no shimmering occurs} {
+ set x [expr int(sin(0))]
+ lsearch -start $x $x $x
+} 0
+# cleanup
+catch {unset res}
+catch {unset increasingIntegers}
+catch {unset decreasingIntegers}
+catch {unset increasingDoubles}
+catch {unset decreasingDoubles}
+catch {unset increasingStrings}
+catch {unset decreasingStrings}
+catch {unset increasingDictionary}
+catch {unset decreasingDictionary}
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/lset.test b/tcl/tests/lset.test
new file mode 100644
index 00000000000..6bf412f1cfb
--- /dev/null
+++ b/tcl/tests/lset.test
@@ -0,0 +1,457 @@
+# This file is a -*- tcl -*- test script
+
+# Commands covered: lset
+#
+# 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) 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$
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
+proc failTrace {name1 name2 op} {
+ error "trace failed"
+}
+
+set lset lset
+
+set noRead {}
+trace add variable noRead read failTrace
+set noWrite {a b c}
+trace add variable noWrite write failTrace
+
+test lset-1.1 {lset, not compiled, arg count} {
+ list [catch {eval $lset} msg] $msg
+} "1 {wrong \# args: should be \"lset listVar index ?index...? value\"}"
+
+test lset-1.2 {lset, not compiled, no such var} {
+ list [catch {eval [list $lset noSuchVar 0 {}]} msg] $msg
+} "1 {can't read \"noSuchVar\": no such variable}"
+
+test lset-1.3 {lset, not compiled, var not readable} {
+ list [catch {eval [list $lset noRead 0 {}]} msg] $msg
+} "1 {can't read \"noRead\": trace failed}"
+
+test lset-2.1 {lset, not compiled, 3 args, second arg a plain index} {
+ set x {0 1 2}
+ list [eval [list $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} {
+ set x {0 1 2}
+ list [catch {
+ eval [list $lset x {{bad}1} 3]
+ } msg] $msg
+} "1 {bad index \"{bad}1\": must be integer or end?-integer?}"
+
+test lset-3.1 {lset, not compiled, 3 args, data duplicated} {
+ set x {0 1 2}
+ list [eval [list $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} {
+ set x {0 1}
+ set y $x
+ list [eval [list $lset x 0 2]] $x $y
+} {{2 1} {2 1} {0 1}}
+
+test lset-3.3 {lset, not compiled, 3 args, data duplicated} {
+ set x {0 1}
+ set y $x
+ list [eval [list $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} {
+ set x {0 1 2}
+ list [eval [list $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} {
+ set x {0 1}
+ set y $x
+ list [eval [list $lset x [list 0] 2]] $x $y
+} {{2 1} {2 1} {0 1}}
+
+test lset-3.6 {lset, not compiled, 3 args, data duplicated} {
+ set x {0 1}
+ set y $x
+ list [eval [list $lset x [list 0] $x]] $x $y
+} {{{0 1} 1} {{0 1} 1} {0 1}}
+
+test lset-4.1 {lset, not compiled, 3 args, not a list} {
+ set a "x \{"
+ list [catch {
+ eval [list $lset a [list 0] y]
+ } msg] $msg
+} {1 {unmatched open brace in list}}
+
+test lset-4.2 {lset, not compiled, 3 args, bad index} {
+ set a {x y z}
+ list [catch {
+ eval [list $lset a [list 2a2] w]
+ } msg] $msg
+} {1 {bad index "2a2": must be integer or end?-integer?}}
+
+test lset-4.3 {lset, not compiled, 3 args, index out of range} {
+ set a {x y z}
+ list [catch {
+ eval [list $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} {
+ set a {x y z}
+ list [catch {
+ eval [list $lset a [list 3] w]
+ } msg] $msg
+} {1 {list index out of range}}
+
+test lset-4.5 {lset, not compiled, 3 args, index out of range} {
+ set a {x y z}
+ list [catch {
+ eval [list $lset a [list end--1] w]
+ } msg] $msg
+} {1 {list index out of range}}
+
+test lset-4.6 {lset, not compiled, 3 args, index out of range} {
+ set a {x y z}
+ list [catch {
+ eval [list $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} {
+ set a "x \{"
+ list [catch {
+ eval [list $lset a 0 y]
+ } msg] $msg
+} {1 {unmatched open brace in list}}
+
+test lset-4.8 {lset, not compiled, 3 args, bad index} {
+ set a {x y z}
+ list [catch {
+ eval [list $lset a 2a2 w]
+ } msg] $msg
+} {1 {bad index "2a2": must be integer or end?-integer?}}
+
+test lset-4.9 {lset, not compiled, 3 args, index out of range} {
+ set a {x y z}
+ list [catch {
+ eval [list $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} {
+ set a {x y z}
+ list [catch {
+ eval [list $lset a 3 w]
+ } msg] $msg
+} {1 {list index out of range}}
+
+test lset-4.11 {lset, not compiled, 3 args, index out of range} {
+ set a {x y z}
+ list [catch {
+ eval [list $lset a end--1 w]
+ } msg] $msg
+} {1 {list index out of range}}
+
+test lset-4.12 {lset, not compiled, 3 args, index out of range} {
+ set a {x y z}
+ list [catch {
+ eval [list $lset a end-3 w]
+ } msg] $msg
+} {1 {list index out of range}}
+
+test lset-5.1 {lset, not compiled, 3 args, can't set variable} {
+ list [catch {
+ eval [list $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} {
+ list [catch {
+ eval [list $lset noWrite [list 0] d]
+ } msg] $msg $noWrite
+} {1 {can't set "noWrite": trace failed} {d b c}}
+
+test lset-6.1 {lset, not compiled, 3 args, 1-d list basics} {
+ set a {x y z}
+ list [eval [list $lset a 0 a]] $a
+} {{a y z} {a y z}}
+
+test lset-6.2 {lset, not compiled, 3 args, 1-d list basics} {
+ set a {x y z}
+ list [eval [list $lset a [list 0] a]] $a
+} {{a y z} {a y z}}
+
+test lset-6.3 {lset, not compiled, 1-d list basics} {
+ set a {x y z}
+ list [eval [list $lset a 2 a]] $a
+} {{x y a} {x y a}}
+
+test lset-6.4 {lset, not compiled, 1-d list basics} {
+ set a {x y z}
+ list [eval [list $lset a [list 2] a]] $a
+} {{x y a} {x y a}}
+
+test lset-6.5 {lset, not compiled, 1-d list basics} {
+ set a {x y z}
+ list [eval [list $lset a end a]] $a
+} {{x y a} {x y a}}
+
+test lset-6.6 {lset, not compiled, 1-d list basics} {
+ set a {x y z}
+ list [eval [list $lset a [list end] a]] $a
+} {{x y a} {x y a}}
+
+test lset-6.7 {lset, not compiled, 1-d list basics} {
+ set a {x y z}
+ list [eval [list $lset a end-0 a]] $a
+} {{x y a} {x y a}}
+
+test lset-6.8 {lset, not compiled, 1-d list basics} {
+ set a {x y z}
+ list [eval [list $lset a [list end-0] a]] $a
+} {{x y a} {x y a}}
+
+test lset-6.9 {lset, not compiled, 1-d list basics} {
+ set a {x y z}
+ list [eval [list $lset a end-2 a]] $a
+} {{a y z} {a y z}}
+
+test lset-6.10 {lset, not compiled, 1-d list basics} {
+ set a {x y z}
+ list [eval [list $lset a [list end-2] a]] $a
+} {{a y z} {a y z}}
+
+test lset-7.1 {lset, not compiled, data sharing} {
+ set a 0
+ list [eval [list $lset a $a {gag me}]] $a
+} {{{gag me}} {{gag me}}}
+
+test lset-7.2 {lset, not compiled, data sharing} {
+ set a [list 0]
+ list [eval [list $lset a $a {gag me}]] $a
+} {{{gag me}} {{gag me}}}
+
+test lset-7.3 {lset, not compiled, data sharing} {
+ set a {x y}
+ list [eval [list $lset a 0 $a]] $a
+} {{{x y} y} {{x y} y}}
+
+test lset-7.4 {lset, not compiled, data sharing} {
+ set a {x y}
+ list [eval [list $lset a [list 0] $a]] $a
+} {{{x y} y} {{x y} y}}
+
+test lset-7.5 {lset, not compiled, data sharing} {
+ set n 0
+ set a {x y}
+ list [eval [list $lset a $n $n]] $a $n
+} {{0 y} {0 y} 0}
+
+test lset-7.6 {lset, not compiled, data sharing} {
+ set n [list 0]
+ set a {x y}
+ list [eval [list $lset a $n $n]] $a $n
+} {{0 y} {0 y} 0}
+
+test lset-7.7 {lset, not compiled, data sharing} {
+ set n 0
+ set a [list $n $n]
+ list [eval [list $lset a $n 1]] $a $n
+} {{1 0} {1 0} 0}
+
+test lset-7.8 {lset, not compiled, data sharing} {
+ set n [list 0]
+ set a [list $n $n]
+ list [eval [list $lset a $n 1]] $a $n
+} {{1 0} {1 0} 0}
+
+test lset-7.9 {lset, not compiled, data sharing} {
+ set a 0
+ list [eval [list $lset a $a $a]] $a
+} {0 0}
+
+test lset-7.10 {lset, not compiled, data sharing} {
+ set a [list 0]
+ list [eval [list $lset a $a $a]] $a
+} {0 0}
+
+test lset-8.1 {lset, not compiled, malformed sublist} {
+ set a [list "a \{" b]
+ list [catch {eval [list $lset a 0 1 c]} msg] $msg
+} {1 {unmatched open brace in list}}
+
+test lset-8.2 {lset, not compiled, malformed sublist} {
+ set a [list "a \{" b]
+ list [catch {eval [list $lset a {0 1} c]} msg] $msg
+} {1 {unmatched open brace in list}}
+
+test lset-8.3 {lset, not compiled, bad second index} {
+ set a {{b c} {d e}}
+ list [catch {eval [list $lset a 0 2a2 f]} msg] $msg
+} {1 {bad index "2a2": must be integer or end?-integer?}}
+
+test lset-8.4 {lset, not compiled, bad second index} {
+ set a {{b c} {d e}}
+ list [catch {eval [list $lset a {0 2a2} f]} msg] $msg
+} {1 {bad index "2a2": must be integer or end?-integer?}}
+
+test lset-8.5 {lset, not compiled, second index out of range} {
+ set a {{b c} {d e} {f g}}
+ list [catch {eval [list $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} {
+ set a {{b c} {d e} {f g}}
+ list [catch {eval [list $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} {
+ set a {{b c} {d e} {f g}}
+ list [catch {eval [list $lset a 2 2 h]} msg] $msg
+} {1 {list index out of range}}
+
+test lset-8.8 {lset, not compiled, second index out of range} {
+ set a {{b c} {d e} {f g}}
+ list [catch {eval [list $lset a {2 2} h]} msg] $msg
+} {1 {list index out of range}}
+
+test lset-8.9 {lset, not compiled, second index out of range} {
+ set a {{b c} {d e} {f g}}
+ list [catch {eval [list $lset a 2 end--1 h]} msg] $msg
+} {1 {list index out of range}}
+
+test lset-8.10 {lset, not compiled, second index out of range} {
+ set a {{b c} {d e} {f g}}
+ list [catch {eval [list $lset a {2 end--1} h]} msg] $msg
+} {1 {list index out of range}}
+
+test lset-8.11 {lset, not compiled, second index out of range} {
+ set a {{b c} {d e} {f g}}
+ list [catch {eval [list $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} {
+ set a {{b c} {d e} {f g}}
+ list [catch {eval [list $lset a {2 end-2} h]} msg] $msg
+} {1 {list index out of range}}
+
+test lset-9.1 {lset, not compiled, entire variable} {
+ set a x
+ list [eval [list $lset a y]] $a
+} {y y}
+
+test lset-9.2 {lset, not compiled, entire variable} {
+ set a x
+ list [eval [list $lset a {} y]] $a
+} {y y}
+
+test lset-10.1 {lset, not compiled, shared data} {
+ set row {p q}
+ set a [list $row $row]
+ list [eval [list $lset a 0 0 x]] $a
+} {{{x q} {p q}} {{x q} {p q}}}
+
+test lset-10.2 {lset, not compiled, shared data} {
+ set row {p q}
+ set a [list $row $row]
+ list [eval [list $lset a {0 0} x]] $a
+} {{{x q} {p q}} {{x q} {p q}}}
+
+test lset-11.1 {lset, not compiled, 2-d basics} {
+ set a {{b c} {d e}}
+ list [eval [list $lset a 0 0 f]] $a
+} {{{f c} {d e}} {{f c} {d e}}}
+
+test lset-11.2 {lset, not compiled, 2-d basics} {
+ set a {{b c} {d e}}
+ list [eval [list $lset a {0 0} f]] $a
+} {{{f c} {d e}} {{f c} {d e}}}
+
+test lset-11.3 {lset, not compiled, 2-d basics} {
+ set a {{b c} {d e}}
+ list [eval [list $lset a 0 1 f]] $a
+} {{{b f} {d e}} {{b f} {d e}}}
+
+test lset-11.4 {lset, not compiled, 2-d basics} {
+ set a {{b c} {d e}}
+ list [eval [list $lset a {0 1} f]] $a
+} {{{b f} {d e}} {{b f} {d e}}}
+
+test lset-11.5 {lset, not compiled, 2-d basics} {
+ set a {{b c} {d e}}
+ list [eval [list $lset a 1 0 f]] $a
+} {{{b c} {f e}} {{b c} {f e}}}
+
+test lset-11.6 {lset, not compiled, 2-d basics} {
+ set a {{b c} {d e}}
+ list [eval [list $lset a {1 0} f]] $a
+} {{{b c} {f e}} {{b c} {f e}}}
+
+test lset-11.7 {lset, not compiled, 2-d basics} {
+ set a {{b c} {d e}}
+ list [eval [list $lset a 1 1 f]] $a
+} {{{b c} {d f}} {{b c} {d f}}}
+
+test lset-11.8 {lset, not compiled, 2-d basics} {
+ set a {{b c} {d e}}
+ list [eval [list $lset a {1 1} f]] $a
+} {{{b c} {d f}} {{b c} {d f}}}
+
+test lset-12.0 {lset, not compiled, typical sharing pattern} {
+ set zero 0
+ set row [list $zero $zero $zero $zero]
+ set ident [list $row $row $row $row]
+ for { set i 0 } { $i < 4 } { incr i } {
+ eval [list $lset ident $i $i 1]
+ }
+ set ident
+} {{1 0 0 0} {0 1 0 0} {0 0 1 0} {0 0 0 1}}
+
+test lset-13.0 {lset, not compiled, shimmering hell} {
+ set a 0
+ list [eval [list $lset a $a $a $a $a {gag me}]] $a
+} {{{{{{gag me}}}}} {{{{{gag me}}}}}}
+
+test lset-13.1 {lset, not compiled, shimmering hell} {
+ set a [list 0]
+ list [eval [list $lset a $a $a $a $a {gag me}]] $a
+} {{{{{{gag me}}}}} {{{{{gag me}}}}}}
+
+test lset-13.2 {lset, not compiled, shimmering hell} {
+ set a [list 0 0 0 0]
+ list [eval [list $lset a $a {gag me}]] $a
+} {{{{{{gag me}}}} 0 0 0} {{{{{gag me}}}} 0 0 0}}
+
+test lset-14.1 {lset, not compiled, list args, is string rep preserved?} {
+ set a { { 1 2 } { 3 4 } }
+ catch { eval [list $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?} {
+ set a { { 1 2 } { 3 4 } }
+ catch { eval [list $lset a 1 5 5] }
+ list $a [lindex $a 1]
+} "{ { 1 2 } { 3 4 } } { 3 4 }"
+
+catch {unset noRead}
+catch {unset noWrite}
+catch {rename failTrace {}}
+catch {unset ::x}
+catch {unset ::y}
+
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/lsetComp.test b/tcl/tests/lsetComp.test
new file mode 100644
index 00000000000..6b9264c05a8
--- /dev/null
+++ b/tcl/tests/lsetComp.test
@@ -0,0 +1,433 @@
+# This file is a -*- tcl -*- test script
+
+# Commands covered: lset
+#
+# 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) 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$
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
+# Procedure to evaluate a script within a proc, to test compilation
+# functionality
+
+proc evalInProc { script } {
+ proc testProc {} $script
+ set status [catch {
+ testProc
+ } result]
+ rename testProc {}
+ return [list $status $result]
+}
+
+# Tests for the bytecode compilation of the 'lset' command
+
+test lsetComp-1.1 {lset, compiled, wrong \# args} {
+ evalInProc {
+ lset
+ }
+} "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 {
+ set y x
+ set x {{1 2} {3 4}}
+ lset $y {1 1} 5
+ }
+} "0 {{1 2} {3 5}}"
+
+test lsetComp-2.2 {lset, compiled, list of args, scalar on stack} {
+ evalInProc {
+ set ::x {{1 2} {3 4}}
+ lset ::x {1 1} 5
+ }
+} "0 {{1 2} {3 5}}"
+
+test lsetComp-2.3 {lset, compiled, list of args, scalar, one-byte offset} {
+ evalInProc {
+ set x {{1 2} {3 4}}
+ lset x {1 1} 5
+ }
+} "0 {{1 2} {3 5}}"
+
+test lsetComp-2.4 {lset, compiled, list of args, scalar, four-byte offset} {
+ evalInProc {
+ set x0 0; set x1 0; set x2 0; set x3 0;
+ set x4 0; set x5 0; set x6 0; set x7 0;
+ set x8 0; set x9 0; set x10 0; set x11 0;
+ set x12 0; set x13 0; set x14 0; set x15 0;
+ set x16 0; set x17 0; set x18 0; set x19 0;
+ set x20 0; set x21 0; set x22 0; set x23 0;
+ set x24 0; set x25 0; set x26 0; set x27 0;
+ set x28 0; set x29 0; set x30 0; set x31 0;
+ set x32 0; set x33 0; set x34 0; set x35 0;
+ set x36 0; set x37 0; set x38 0; set x39 0;
+ set x40 0; set x41 0; set x42 0; set x43 0;
+ set x44 0; set x45 0; set x46 0; set x47 0;
+ set x48 0; set x49 0; set x50 0; set x51 0;
+ set x52 0; set x53 0; set x54 0; set x55 0;
+ set x56 0; set x57 0; set x58 0; set x59 0;
+ set x60 0; set x61 0; set x62 0; set x63 0;
+ set x64 0; set x65 0; set x66 0; set x67 0;
+ set x68 0; set x69 0; set x70 0; set x71 0;
+ set x72 0; set x73 0; set x74 0; set x75 0;
+ set x76 0; set x77 0; set x78 0; set x79 0;
+ set x80 0; set x81 0; set x82 0; set x83 0;
+ set x84 0; set x85 0; set x86 0; set x87 0;
+ set x88 0; set x89 0; set x90 0; set x91 0;
+ set x92 0; set x93 0; set x94 0; set x95 0;
+ set x96 0; set x97 0; set x98 0; set x99 0;
+ set x100 0; set x101 0; set x102 0; set x103 0;
+ set x104 0; set x105 0; set x106 0; set x107 0;
+ set x108 0; set x109 0; set x110 0; set x111 0;
+ set x112 0; set x113 0; set x114 0; set x115 0;
+ set x116 0; set x117 0; set x118 0; set x119 0;
+ set x120 0; set x121 0; set x122 0; set x123 0;
+ set x124 0; set x125 0; set x126 0; set x127 0;
+ set x128 0; set x129 0; set x130 0; set x131 0;
+ set x132 0; set x133 0; set x134 0; set x135 0;
+ set x136 0; set x137 0; set x138 0; set x139 0;
+ set x140 0; set x141 0; set x142 0; set x143 0;
+ set x144 0; set x145 0; set x146 0; set x147 0;
+ set x148 0; set x149 0; set x150 0; set x151 0;
+ set x152 0; set x153 0; set x154 0; set x155 0;
+ set x156 0; set x157 0; set x158 0; set x159 0;
+ set x160 0; set x161 0; set x162 0; set x163 0;
+ set x164 0; set x165 0; set x166 0; set x167 0;
+ set x168 0; set x169 0; set x170 0; set x171 0;
+ set x172 0; set x173 0; set x174 0; set x175 0;
+ set x176 0; set x177 0; set x178 0; set x179 0;
+ set x180 0; set x181 0; set x182 0; set x183 0;
+ set x184 0; set x185 0; set x186 0; set x187 0;
+ set x188 0; set x189 0; set x190 0; set x191 0;
+ set x192 0; set x193 0; set x194 0; set x195 0;
+ set x196 0; set x197 0; set x198 0; set x199 0;
+ set x200 0; set x201 0; set x202 0; set x203 0;
+ set x204 0; set x205 0; set x206 0; set x207 0;
+ set x208 0; set x209 0; set x210 0; set x211 0;
+ set x212 0; set x213 0; set x214 0; set x215 0;
+ set x216 0; set x217 0; set x218 0; set x219 0;
+ set x220 0; set x221 0; set x222 0; set x223 0;
+ set x224 0; set x225 0; set x226 0; set x227 0;
+ set x228 0; set x229 0; set x230 0; set x231 0;
+ set x232 0; set x233 0; set x234 0; set x235 0;
+ set x236 0; set x237 0; set x238 0; set x239 0;
+ set x240 0; set x241 0; set x242 0; set x243 0;
+ set x244 0; set x245 0; set x246 0; set x247 0;
+ set x248 0; set x249 0; set x250 0; set x251 0;
+ set x252 0; set x253 0; set x254 0; set x255 0;
+ set x {{1 2} {3 4}}
+ lset x {1 1} 5
+ }
+} "0 {{1 2} {3 5}}"
+
+test lsetComp-2.5 {lset, compiled, list of args, array on stack} {
+ evalInProc {
+ set ::y(0) {{1 2} {3 4}}
+ lset ::y(0) {1 1} 5
+ }
+} "0 {{1 2} {3 5}}"
+
+test lsetComp-2.6 {lset, compiled, list of args, array, one-byte offset} {
+ evalInProc {
+ set y(0) {{1 2} {3 4}}
+ lset y(0) {1 1} 5
+ }
+} "0 {{1 2} {3 5}}"
+
+test lsetComp-2.7 {lset, compiled, list of args, array, four-byte offset} {
+ evalInProc {
+ set x0 0; set x1 0; set x2 0; set x3 0;
+ set x4 0; set x5 0; set x6 0; set x7 0;
+ set x8 0; set x9 0; set x10 0; set x11 0;
+ set x12 0; set x13 0; set x14 0; set x15 0;
+ set x16 0; set x17 0; set x18 0; set x19 0;
+ set x20 0; set x21 0; set x22 0; set x23 0;
+ set x24 0; set x25 0; set x26 0; set x27 0;
+ set x28 0; set x29 0; set x30 0; set x31 0;
+ set x32 0; set x33 0; set x34 0; set x35 0;
+ set x36 0; set x37 0; set x38 0; set x39 0;
+ set x40 0; set x41 0; set x42 0; set x43 0;
+ set x44 0; set x45 0; set x46 0; set x47 0;
+ set x48 0; set x49 0; set x50 0; set x51 0;
+ set x52 0; set x53 0; set x54 0; set x55 0;
+ set x56 0; set x57 0; set x58 0; set x59 0;
+ set x60 0; set x61 0; set x62 0; set x63 0;
+ set x64 0; set x65 0; set x66 0; set x67 0;
+ set x68 0; set x69 0; set x70 0; set x71 0;
+ set x72 0; set x73 0; set x74 0; set x75 0;
+ set x76 0; set x77 0; set x78 0; set x79 0;
+ set x80 0; set x81 0; set x82 0; set x83 0;
+ set x84 0; set x85 0; set x86 0; set x87 0;
+ set x88 0; set x89 0; set x90 0; set x91 0;
+ set x92 0; set x93 0; set x94 0; set x95 0;
+ set x96 0; set x97 0; set x98 0; set x99 0;
+ set x100 0; set x101 0; set x102 0; set x103 0;
+ set x104 0; set x105 0; set x106 0; set x107 0;
+ set x108 0; set x109 0; set x110 0; set x111 0;
+ set x112 0; set x113 0; set x114 0; set x115 0;
+ set x116 0; set x117 0; set x118 0; set x119 0;
+ set x120 0; set x121 0; set x122 0; set x123 0;
+ set x124 0; set x125 0; set x126 0; set x127 0;
+ set x128 0; set x129 0; set x130 0; set x131 0;
+ set x132 0; set x133 0; set x134 0; set x135 0;
+ set x136 0; set x137 0; set x138 0; set x139 0;
+ set x140 0; set x141 0; set x142 0; set x143 0;
+ set x144 0; set x145 0; set x146 0; set x147 0;
+ set x148 0; set x149 0; set x150 0; set x151 0;
+ set x152 0; set x153 0; set x154 0; set x155 0;
+ set x156 0; set x157 0; set x158 0; set x159 0;
+ set x160 0; set x161 0; set x162 0; set x163 0;
+ set x164 0; set x165 0; set x166 0; set x167 0;
+ set x168 0; set x169 0; set x170 0; set x171 0;
+ set x172 0; set x173 0; set x174 0; set x175 0;
+ set x176 0; set x177 0; set x178 0; set x179 0;
+ set x180 0; set x181 0; set x182 0; set x183 0;
+ set x184 0; set x185 0; set x186 0; set x187 0;
+ set x188 0; set x189 0; set x190 0; set x191 0;
+ set x192 0; set x193 0; set x194 0; set x195 0;
+ set x196 0; set x197 0; set x198 0; set x199 0;
+ set x200 0; set x201 0; set x202 0; set x203 0;
+ set x204 0; set x205 0; set x206 0; set x207 0;
+ set x208 0; set x209 0; set x210 0; set x211 0;
+ set x212 0; set x213 0; set x214 0; set x215 0;
+ set x216 0; set x217 0; set x218 0; set x219 0;
+ set x220 0; set x221 0; set x222 0; set x223 0;
+ set x224 0; set x225 0; set x226 0; set x227 0;
+ set x228 0; set x229 0; set x230 0; set x231 0;
+ set x232 0; set x233 0; set x234 0; set x235 0;
+ set x236 0; set x237 0; set x238 0; set x239 0;
+ set x240 0; set x241 0; set x242 0; set x243 0;
+ set x244 0; set x245 0; set x246 0; set x247 0;
+ set x248 0; set x249 0; set x250 0; set x251 0;
+ set x252 0; set x253 0; set x254 0; set x255 0;
+ set y(0) {{1 2} {3 4}}
+ lset y(0) {1 1} 5
+ }
+} "0 {{1 2} {3 5}}"
+
+test lsetComp-2.8 {lset, compiled, list of args, error } {
+ evalInProc {
+ set x { {1 2} {3 4} }
+ lset x {1 5} 5
+ }
+} "1 {list index out of range}"
+
+test lsetComp-2.9 {lset, compiled, list of args, error - is string preserved} {
+ set ::x { { 1 2 } { 3 4 } }
+ evalInProc {
+ lset ::x { 1 5 } 5
+ }
+ list $::x [lindex $::x 1]
+} "{ { 1 2 } { 3 4 } } { 3 4 }"
+
+test lsetComp-3.1 {lset, compiled, flat args, not a simple var name} {
+ evalInProc {
+ set y x
+ set x {{1 2} {3 4}}
+ lset $y 1 1 5
+ }
+} "0 {{1 2} {3 5}}"
+
+test lsetComp-3.2 {lset, compiled, flat args, scalar on stack} {
+ evalInProc {
+ set ::x {{1 2} {3 4}}
+ lset ::x 1 1 5
+ }
+} "0 {{1 2} {3 5}}"
+
+test lsetComp-3.3 {lset, compiled, flat args, scalar, one-byte offset} {
+ evalInProc {
+ set x {{1 2} {3 4}}
+ lset x 1 1 5
+ }
+} "0 {{1 2} {3 5}}"
+
+test lsetComp-3.4 {lset, compiled, scalar, four-byte offset} {
+ evalInProc {
+ set x0 0; set x1 0; set x2 0; set x3 0;
+ set x4 0; set x5 0; set x6 0; set x7 0;
+ set x8 0; set x9 0; set x10 0; set x11 0;
+ set x12 0; set x13 0; set x14 0; set x15 0;
+ set x16 0; set x17 0; set x18 0; set x19 0;
+ set x20 0; set x21 0; set x22 0; set x23 0;
+ set x24 0; set x25 0; set x26 0; set x27 0;
+ set x28 0; set x29 0; set x30 0; set x31 0;
+ set x32 0; set x33 0; set x34 0; set x35 0;
+ set x36 0; set x37 0; set x38 0; set x39 0;
+ set x40 0; set x41 0; set x42 0; set x43 0;
+ set x44 0; set x45 0; set x46 0; set x47 0;
+ set x48 0; set x49 0; set x50 0; set x51 0;
+ set x52 0; set x53 0; set x54 0; set x55 0;
+ set x56 0; set x57 0; set x58 0; set x59 0;
+ set x60 0; set x61 0; set x62 0; set x63 0;
+ set x64 0; set x65 0; set x66 0; set x67 0;
+ set x68 0; set x69 0; set x70 0; set x71 0;
+ set x72 0; set x73 0; set x74 0; set x75 0;
+ set x76 0; set x77 0; set x78 0; set x79 0;
+ set x80 0; set x81 0; set x82 0; set x83 0;
+ set x84 0; set x85 0; set x86 0; set x87 0;
+ set x88 0; set x89 0; set x90 0; set x91 0;
+ set x92 0; set x93 0; set x94 0; set x95 0;
+ set x96 0; set x97 0; set x98 0; set x99 0;
+ set x100 0; set x101 0; set x102 0; set x103 0;
+ set x104 0; set x105 0; set x106 0; set x107 0;
+ set x108 0; set x109 0; set x110 0; set x111 0;
+ set x112 0; set x113 0; set x114 0; set x115 0;
+ set x116 0; set x117 0; set x118 0; set x119 0;
+ set x120 0; set x121 0; set x122 0; set x123 0;
+ set x124 0; set x125 0; set x126 0; set x127 0;
+ set x128 0; set x129 0; set x130 0; set x131 0;
+ set x132 0; set x133 0; set x134 0; set x135 0;
+ set x136 0; set x137 0; set x138 0; set x139 0;
+ set x140 0; set x141 0; set x142 0; set x143 0;
+ set x144 0; set x145 0; set x146 0; set x147 0;
+ set x148 0; set x149 0; set x150 0; set x151 0;
+ set x152 0; set x153 0; set x154 0; set x155 0;
+ set x156 0; set x157 0; set x158 0; set x159 0;
+ set x160 0; set x161 0; set x162 0; set x163 0;
+ set x164 0; set x165 0; set x166 0; set x167 0;
+ set x168 0; set x169 0; set x170 0; set x171 0;
+ set x172 0; set x173 0; set x174 0; set x175 0;
+ set x176 0; set x177 0; set x178 0; set x179 0;
+ set x180 0; set x181 0; set x182 0; set x183 0;
+ set x184 0; set x185 0; set x186 0; set x187 0;
+ set x188 0; set x189 0; set x190 0; set x191 0;
+ set x192 0; set x193 0; set x194 0; set x195 0;
+ set x196 0; set x197 0; set x198 0; set x199 0;
+ set x200 0; set x201 0; set x202 0; set x203 0;
+ set x204 0; set x205 0; set x206 0; set x207 0;
+ set x208 0; set x209 0; set x210 0; set x211 0;
+ set x212 0; set x213 0; set x214 0; set x215 0;
+ set x216 0; set x217 0; set x218 0; set x219 0;
+ set x220 0; set x221 0; set x222 0; set x223 0;
+ set x224 0; set x225 0; set x226 0; set x227 0;
+ set x228 0; set x229 0; set x230 0; set x231 0;
+ set x232 0; set x233 0; set x234 0; set x235 0;
+ set x236 0; set x237 0; set x238 0; set x239 0;
+ set x240 0; set x241 0; set x242 0; set x243 0;
+ set x244 0; set x245 0; set x246 0; set x247 0;
+ set x248 0; set x249 0; set x250 0; set x251 0;
+ set x252 0; set x253 0; set x254 0; set x255 0;
+ set x {{1 2} {3 4}}
+ lset x 1 1 5
+ }
+} "0 {{1 2} {3 5}}"
+
+test lsetComp-3.5 {lset, compiled, flat args, array on stack} {
+ evalInProc {
+ set ::y(0) {{1 2} {3 4}}
+ lset ::y(0) 1 1 5
+ }
+} "0 {{1 2} {3 5}}"
+
+test lsetComp-3.6 {lset, compiled, flat args, array, one-byte offset} {
+ evalInProc {
+ set y(0) {{1 2} {3 4}}
+ lset y(0) 1 1 5
+ }
+} "0 {{1 2} {3 5}}"
+
+test lsetComp-3.7 {lset, compiled, flat args, array, four-byte offset} {
+ evalInProc {
+ set x0 0; set x1 0; set x2 0; set x3 0;
+ set x4 0; set x5 0; set x6 0; set x7 0;
+ set x8 0; set x9 0; set x10 0; set x11 0;
+ set x12 0; set x13 0; set x14 0; set x15 0;
+ set x16 0; set x17 0; set x18 0; set x19 0;
+ set x20 0; set x21 0; set x22 0; set x23 0;
+ set x24 0; set x25 0; set x26 0; set x27 0;
+ set x28 0; set x29 0; set x30 0; set x31 0;
+ set x32 0; set x33 0; set x34 0; set x35 0;
+ set x36 0; set x37 0; set x38 0; set x39 0;
+ set x40 0; set x41 0; set x42 0; set x43 0;
+ set x44 0; set x45 0; set x46 0; set x47 0;
+ set x48 0; set x49 0; set x50 0; set x51 0;
+ set x52 0; set x53 0; set x54 0; set x55 0;
+ set x56 0; set x57 0; set x58 0; set x59 0;
+ set x60 0; set x61 0; set x62 0; set x63 0;
+ set x64 0; set x65 0; set x66 0; set x67 0;
+ set x68 0; set x69 0; set x70 0; set x71 0;
+ set x72 0; set x73 0; set x74 0; set x75 0;
+ set x76 0; set x77 0; set x78 0; set x79 0;
+ set x80 0; set x81 0; set x82 0; set x83 0;
+ set x84 0; set x85 0; set x86 0; set x87 0;
+ set x88 0; set x89 0; set x90 0; set x91 0;
+ set x92 0; set x93 0; set x94 0; set x95 0;
+ set x96 0; set x97 0; set x98 0; set x99 0;
+ set x100 0; set x101 0; set x102 0; set x103 0;
+ set x104 0; set x105 0; set x106 0; set x107 0;
+ set x108 0; set x109 0; set x110 0; set x111 0;
+ set x112 0; set x113 0; set x114 0; set x115 0;
+ set x116 0; set x117 0; set x118 0; set x119 0;
+ set x120 0; set x121 0; set x122 0; set x123 0;
+ set x124 0; set x125 0; set x126 0; set x127 0;
+ set x128 0; set x129 0; set x130 0; set x131 0;
+ set x132 0; set x133 0; set x134 0; set x135 0;
+ set x136 0; set x137 0; set x138 0; set x139 0;
+ set x140 0; set x141 0; set x142 0; set x143 0;
+ set x144 0; set x145 0; set x146 0; set x147 0;
+ set x148 0; set x149 0; set x150 0; set x151 0;
+ set x152 0; set x153 0; set x154 0; set x155 0;
+ set x156 0; set x157 0; set x158 0; set x159 0;
+ set x160 0; set x161 0; set x162 0; set x163 0;
+ set x164 0; set x165 0; set x166 0; set x167 0;
+ set x168 0; set x169 0; set x170 0; set x171 0;
+ set x172 0; set x173 0; set x174 0; set x175 0;
+ set x176 0; set x177 0; set x178 0; set x179 0;
+ set x180 0; set x181 0; set x182 0; set x183 0;
+ set x184 0; set x185 0; set x186 0; set x187 0;
+ set x188 0; set x189 0; set x190 0; set x191 0;
+ set x192 0; set x193 0; set x194 0; set x195 0;
+ set x196 0; set x197 0; set x198 0; set x199 0;
+ set x200 0; set x201 0; set x202 0; set x203 0;
+ set x204 0; set x205 0; set x206 0; set x207 0;
+ set x208 0; set x209 0; set x210 0; set x211 0;
+ set x212 0; set x213 0; set x214 0; set x215 0;
+ set x216 0; set x217 0; set x218 0; set x219 0;
+ set x220 0; set x221 0; set x222 0; set x223 0;
+ set x224 0; set x225 0; set x226 0; set x227 0;
+ set x228 0; set x229 0; set x230 0; set x231 0;
+ set x232 0; set x233 0; set x234 0; set x235 0;
+ set x236 0; set x237 0; set x238 0; set x239 0;
+ set x240 0; set x241 0; set x242 0; set x243 0;
+ set x244 0; set x245 0; set x246 0; set x247 0;
+ set x248 0; set x249 0; set x250 0; set x251 0;
+ set x252 0; set x253 0; set x254 0; set x255 0;
+ set y(0) {{1 2} {3 4}}
+ lset y(0) 1 1 5
+ }
+} "0 {{1 2} {3 5}}"
+
+test lsetComp-3.8 {lset, compiled, flat args, error } {
+ evalInProc {
+ set x { {1 2} {3 4} }
+ lset x 1 5 5
+ }
+} "1 {list index out of range}"
+
+test lsetComp-3.9 {lset, compiled, flat args, error - is string preserved} {
+ set ::x { { 1 2 } { 3 4 } }
+ evalInProc {
+ lset ::x 1 5 5
+ }
+ list $::x [lindex $::x 1]
+} "{ { 1 2 } { 3 4 } } { 3 4 }"
+
+catch { rename evalInProc {} }
+catch { unset ::x }
+catch { unset ::y }
+
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/macFCmd.test b/tcl/tests/macFCmd.test
index afb1b51c26c..07360bed923 100644
--- a/tcl/tests/macFCmd.test
+++ b/tcl/tests/macFCmd.test
@@ -18,6 +18,11 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
namespace import -force ::tcltest::*
}
+# These tests really need to be run from a writable directory, which
+# it is assumed [temporaryDirectory] is.
+set oldcwd [pwd]
+cd [temporaryDirectory]
+
catch {file delete -force foo.dir}
file mkdir foo.dir
if {[catch {file attributes foo.dir -readonly 1}]} {
@@ -32,13 +37,13 @@ file delete -force foo.dir
test macFCmd-1.1 {GetFileFinderAttributes - no file} {macOnly} {
catch {file delete -force foo.file}
list [catch {file attributes foo.file -creator} msg] $msg
-} {1 {could not read ":foo.file": no such file or directory}}
+} {1 {could not read "foo.file": no such file or directory}}
test macFCmd-1.2 {GetFileFinderAttributes - creator} {macOnly} {
catch {file delete -force foo.file}
catch {close [open foo.file w]}
- list [catch {file attributes foo.file -creator} msg] $msg \
- [file delete -force foo.file]
-} {0 {MPW } {}}
+ list [catch {file attributes foo.file -creator} msg] \
+ [regexp {MPW |CWIE} $msg] [file delete -force foo.file]
+} {0 1 {}}
test macFCmd-1.3 {GetFileFinderAttributes - type} {macOnly} {
catch {file delete -force foo.file}
catch {close [open foo.file w]}
@@ -80,7 +85,7 @@ test macFCmd-1.8 {GetFileFinderAttributes - folder hidden} {macOnly} {
test macFCmd-2.1 {GetFileReadOnly - bad file} {macOnly} {
catch {file delete -force foo.file}
list [catch {file attributes foo.file -readonly} msg] $msg
-} {1 {could not read ":foo.file": no such file or directory}}
+} {1 {could not read "foo.file": no such file or directory}}
test macFCmd-2.2 {GetFileReadOnly - file not read only} {macOnly} {
catch {file delete -force foo.file}
close [open foo.file w]
@@ -111,7 +116,7 @@ test macFCmd-2.5 {GetFileReadOnly - directory read only} {macOnly fileSharing} {
test macFCmd-3.1 {SetFileFinderAttributes - bad file} {macOnly} {
catch {file delete -force foo.file}
list [catch {file attributes foo.file -creator FOOO} msg] $msg
-} {1 {could not read ":foo.file": no such file or directory}}
+} {1 {could not read "foo.file": no such file or directory}}
test macFCmd-3.2 {SetFileFinderAttributes - creator} {macOnly} {
catch {file delete -force foo.file}
close [open foo.file w]
@@ -147,12 +152,12 @@ test macFCmd-3.7 {SetFileFinderAttributes - directory} {macOnly} {
file mkdir foo.dir
list [catch {file attributes foo.dir -creator FOOO} msg] \
$msg [file delete -force foo.dir]
-} {1 {cannot set -creator: ":foo.dir" is a directory} {}}
+} {1 {cannot set -creator: "foo.dir" is a directory} {}}
test macFCmd-4.1 {SetFileReadOnly - bad file} {macOnly} {
catch {file delete -force foo.file}
list [catch {file attributes foo.file -readonly 1} msg] $msg
-} {1 {could not read ":foo.file": no such file or directory}}
+} {1 {could not read "foo.file": no such file or directory}}
test macFCmd-4.2 {SetFileReadOnly - file not readonly} {macOnly} {
catch {file delete -force foo.file}
close [open foo.file w]
@@ -193,18 +198,6 @@ test macFCmd-4.7 {SetFileReadOnly - directory readonly} {macOnly notFileSharing}
} {1 {cannot set a directory to read-only when File Sharing is turned off} {}}
# cleanup
+cd $oldcwd
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tcl/tests/main.test b/tcl/tests/main.test
new file mode 100644
index 00000000000..1c8799967cb
--- /dev/null
+++ b/tcl/tests/main.test
@@ -0,0 +1,1181 @@
+# This file contains a collection of tests for generic/tclMain.c.
+#
+# RCS: @(#) $Id$
+
+if {[catch {package require tcltest 2.0.2}]} {
+ puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required."
+ return
+}
+
+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
+
+ # Is [exec] defined?
+ testConstraint exec [llength [info commands exec]]
+
+ # Is the Tcltest package loaded?
+ # - that is, the special C-coded testing commands in tclTest.c
+ # - tests use testing commands introduced in Tcltest 8.4
+ testConstraint Tcltest [expr {
+ [llength [package provide Tcltest]]
+ && [package vsatisfies [package provide Tcltest] 8.4]}]
+
+ # Procedure to simulate interactive typing of commands, line by line
+ proc type {chan script} {
+ foreach line [split $script \n] {
+ if {[catch {
+ puts $chan $line
+ flush $chan
+ }]} {
+ return
+ }
+ # Grrr... Behavior depends on this value.
+ after 1000
+ }
+ }
+
+ cd [temporaryDirectory]
+ # Tests Tcl_Main-1.*: variable initializations
+
+ test Tcl_Main-1.1 {
+ Tcl_Main: startup script - normal
+ } -constraints {
+ stdio
+ } -setup {
+ makeFile {puts [list $argv0 $argv $tcl_interactive]} script
+ catch {set f [open "|[list [interpreter] script]" r]}
+ } -body {
+ read $f
+ } -cleanup {
+ close $f
+ removeFile script
+ } -result [list script {} 0]\n
+
+ test Tcl_Main-1.2 {
+ Tcl_Main: startup script - can't begin with '-'
+ } -constraints {
+ stdio
+ } -setup {
+ makeFile {puts [list $argv0 $argv $tcl_interactive]} -script
+ catch {set f [open "|[list [interpreter] -script]" w+]}
+ } -body {
+ puts $f {puts [list $argv0 $argv $tcl_interactive]; exit}
+ flush $f
+ read $f
+ } -cleanup {
+ close $f
+ removeFile -script
+ } -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 Patch 491789
+ } -constraints {
+ stdio
+ } -setup {
+ makeFile {puts [list $argv0 $argv $tcl_interactive]} script
+ catch {set f [open "|[list [interpreter] script \u00c0]" r]}
+ } -body {
+ read $f
+ } -cleanup {
+ close $f
+ removeFile script
+ } -result [list script [list [encoding convertfrom [encoding system] \
+ [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 Patch 491789
+ } -constraints {
+ stdio
+ } -setup {
+ makeFile {puts [list $argv0 $argv $tcl_interactive]} script
+ catch {set f [open "|[list [interpreter] script \u20ac]" r]}
+ } -body {
+ read $f
+ } -cleanup {
+ close $f
+ removeFile script
+ } -result [list script [list [encoding convertfrom [encoding system] \
+ [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 Patch 491789
+ } -constraints {
+ stdio
+ } -setup {
+ makeFile {puts [list $argv0 $argv $tcl_interactive]} \u00c0
+ catch {set f [open "|[list [interpreter] \u00c0]" r]}
+ } -body {
+ read $f
+ } -cleanup {
+ close $f
+ removeFile \u00c0
+ } -result [list [list [encoding convertfrom [encoding system] \
+ [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 Patch 491789
+ } -constraints {
+ stdio
+ } -setup {
+ makeFile {puts [list $argv0 $argv $tcl_interactive]} \u20ac
+ catch {set f [open "|[list [interpreter] \u20ac]" r]}
+ } -body {
+ read $f
+ } -cleanup {
+ close $f
+ removeFile \u20ac
+ } -result [list [list [encoding convertfrom [encoding system] \
+ [encoding convertto [encoding system] \u20ac]]] {} 0]\n
+
+ # Tests Tcl_Main-2.*: application-initialization procedure
+
+ test Tcl_Main-2.1 {
+ Tcl_Main: appInitProc returns error
+ } -constraints {
+ exec Tcltest
+ } -setup {
+ makeFile {puts "In script"} script
+ } -body {
+ exec [interpreter] script -appinitprocerror >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ removeFile script
+ } -result "application-specific initialization failed: \nIn script\n"
+
+ test Tcl_Main-2.2 {
+ Tcl_Main: appInitProc returns error
+ } -constraints {
+ exec Tcltest
+ } -body {
+ exec [interpreter] << {puts "In script"} -appinitprocerror >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "application-specific initialization failed: \nIn script\n"
+
+ test Tcl_Main-2.3 {
+ Tcl_Main: appInitProc deletes interp
+ } -constraints {
+ exec Tcltest
+ } -setup {
+ makeFile {puts "In script"} script
+ } -body {
+ exec [interpreter] script -appinitprocdeleteinterp >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ removeFile script
+ } -result "application-specific initialization failed: \n"
+
+ test Tcl_Main-2.4 {
+ Tcl_Main: appInitProc deletes interp
+ } -constraints {
+ exec Tcltest
+ } -body {
+ exec [interpreter] << {puts "In script"} \
+ -appinitprocdeleteinterp >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "application-specific initialization failed: \n"
+
+ test Tcl_Main-2.5 {
+ Tcl_Main: appInitProc closes stderr
+ } -constraints {
+ exec Tcltest
+ } -body {
+ exec [interpreter] << {puts "In script"} \
+ -appinitprocclosestderr >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "In script\n"
+
+ # Tests Tcl_Main-3.*: startup script evaluation
+
+ test Tcl_Main-3.1 {
+ Tcl_Main: startup script does not exist
+ } -constraints {
+ exec
+ } -setup {
+ catch {removeFile no-such-file}
+ } -body {
+ set code [catch {exec [interpreter] no-such-file >& result} result]
+ set f [open result]
+ list $code $result [read $f]
+ } -cleanup {
+ close $f
+ file delete result
+ } -match glob -result [list 1 {child process exited abnormally} \
+ {couldn't read file "no-such-file":*}]
+
+ test Tcl_Main-3.2 {
+ Tcl_Main: startup script raises error
+ } -constraints {
+ exec
+ } -setup {
+ makeFile {error ERROR} script
+ } -body {
+ set code [catch {exec [interpreter] script >& result} result]
+ set f [open result]
+ list $code $result [read $f]
+ } -cleanup {
+ close $f
+ file delete result
+ removeFile script
+ } -match glob -result [list 1 {child process exited abnormally} \
+ "ERROR\n while executing*"]
+
+ test Tcl_Main-3.3 {
+ Tcl_Main: startup script closes stderr
+ } -constraints {
+ exec
+ } -setup {
+ makeFile {close stderr; error ERROR} script
+ } -body {
+ set code [catch {exec [interpreter] script >& result} result]
+ set f [open result]
+ list $code $result [read $f]
+ } -cleanup {
+ close $f
+ file delete result
+ removeFile script
+ } -result [list 1 {child process exited abnormally} {}]
+
+ test Tcl_Main-3.4 {
+ Tcl_Main: startup script holds incomplete script
+ } -constraints {
+ exec
+ } -setup {
+ makeFile "if 1 \{" script
+ } -body {
+ set code [catch {exec [interpreter] script >& result} result]
+ set f [open result]
+ list $code $result [read $f]
+ } -cleanup {
+ close $f
+ file delete result
+ removeFile script
+ } -match glob -result [list 1 {child process exited abnormally}\
+ "missing close-brace\n while executing*"]
+
+ test Tcl_Main-3.5 {
+ Tcl_Main: startup script sets main loop
+ } -constraints {
+ exec Tcltest
+ } -setup {
+ makeFile {
+ rename exit _exit
+ proc exit {code} {
+ puts "In exit"
+ _exit $code
+ }
+ after 0 {
+ puts event
+ testexitmainloop
+ }
+ testexithandler create 0
+ testsetmainloop
+ } script
+ } -body {
+ exec [interpreter] script >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ removeFile script
+ } -result "event\nExit MainLoop\nIn exit\neven 0\n"
+
+ test Tcl_Main-3.6 {
+ Tcl_Main: startup script sets main loop and closes stdin
+ } -constraints {
+ exec Tcltest
+ } -setup {
+ makeFile {
+ close stdin
+ testsetmainloop
+ rename exit _exit
+ proc exit {code} {
+ puts "In exit"
+ _exit $code
+ }
+ after 0 {
+ puts event
+ testexitmainloop
+ }
+ testexithandler create 0
+ } script
+ } -body {
+ exec [interpreter] script >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ removeFile script
+ } -result "event\nExit MainLoop\nIn exit\neven 0\n"
+
+ test Tcl_Main-3.7 {
+ Tcl_Main: startup script deletes interp
+ } -constraints {
+ exec Tcltest
+ } -setup {
+ makeFile {
+ rename exit _exit
+ proc exit {code} {
+ puts "In exit"
+ _exit $code
+ }
+ testexithandler create 0
+ testinterpdelete {}
+ } script
+ } -body {
+ exec [interpreter] script >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ removeFile script
+ } -result "even 0\n"
+
+ test Tcl_Main-3.8 {
+ Tcl_Main: startup script deletes interp and sets mainloop
+ } -constraints {
+ exec Tcltest
+ } -setup {
+ makeFile {
+ testsetmainloop
+ rename exit _exit
+ proc exit {code} {
+ puts "In exit"
+ _exit $code
+ }
+ testexitmainloop
+ testexithandler create 0
+ testinterpdelete {}
+ } script
+ } -body {
+ exec [interpreter] script >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ removeFile script
+ } -result "Exit MainLoop\neven 0\n"
+
+ test Tcl_Main-3.9 {
+ Tcl_Main: startup script can set tcl_interactive without limit
+ } -constraints {
+ exec
+ } -setup {
+ makeFile {set tcl_interactive foo} script
+ } -body {
+ exec [interpreter] script >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ removeFile script
+ } -result {}
+
+ # Tests Tcl_Main-4.*: rc file evaluation
+
+ test Tcl_Main-4.1 {
+ Tcl_Main: rcFile evaluation deletes interp
+ } -constraints {
+ exec Tcltest
+ } -setup {
+ set rc [makeFile {testinterpdelete {}} rc]
+ } -body {
+ exec [interpreter] << {puts "In script"} \
+ -appinitprocsetrcfile $rc >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ removeFile rc
+ } -result "application-specific initialization failed: \n"
+
+ test Tcl_Main-4.2 {
+ Tcl_Main: rcFile evaluation closes stdin
+ } -constraints {
+ exec Tcltest
+ } -setup {
+ set rc [makeFile {close stdin} rc]
+ } -body {
+ exec [interpreter] << {puts "In script"} \
+ -appinitprocsetrcfile $rc >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ removeFile rc
+ } -result "application-specific initialization failed: \n"
+
+ test Tcl_Main-4.3 {
+ Tcl_Main: rcFile evaluation closes stdin and sets main loop
+ } -constraints {
+ exec Tcltest
+ } -setup {
+ set rc [makeFile {
+ close stdin
+ testsetmainloop
+ after 0 testexitmainloop
+ testexithandler create 0
+ rename exit _exit
+ proc exit code {
+ puts "In exit"
+ _exit $code
+ }
+ } rc]
+ } -body {
+ exec [interpreter] << {puts "In script"} \
+ -appinitprocsetrcfile $rc >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ removeFile rc
+ } -result "application-specific initialization failed:\
+ \nExit MainLoop\nIn exit\neven 0\n"
+
+ test Tcl_Main-4.4 {
+ Tcl_Main: rcFile evaluation sets main loop
+ } -constraints {
+ exec Tcltest
+ } -setup {
+ set rc [makeFile {
+ testsetmainloop
+ after 0 testexitmainloop
+ testexithandler create 0
+ rename exit _exit
+ proc exit code {
+ puts "In exit"
+ _exit $code
+ }
+ } rc]
+ } -body {
+ exec [interpreter] << {puts "In script"} \
+ -appinitprocsetrcfile $rc >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ removeFile rc
+ } -result "application-specific initialization failed:\
+ \nIn script\nExit MainLoop\nIn exit\neven 0\n"
+
+ # Tests Tcl_Main-5.*: interactive operations
+
+ test Tcl_Main-5.1 {
+ Tcl_Main: tcl_interactive must be boolean
+ } -constraints {
+ exec
+ } -body {
+ exec [interpreter] << {set tcl_interactive foo} >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "can't set \"tcl_interactive\":\
+ variable must have boolean value\n"
+
+ test Tcl_Main-5.2 {
+ Tcl_Main able to handle non-blocking stdin
+ } -constraints {
+ exec
+ } -setup {
+ catch {set f [open "|[list [interpreter]]" w+]}
+ } -body {
+ type $f {
+ fconfigure stdin -blocking 0
+ puts SUCCESS
+ }
+ list [catch {gets $f} line] $line
+ } -cleanup {
+ close $f
+ } -result [list 0 SUCCESS]
+
+ test Tcl_Main-5.3 {
+ Tcl_Main handles stdin EOF in mid-command
+ } -constraints {
+ exec
+ } -setup {
+ catch {set f [open "|[list [interpreter]]" w+]}
+ catch {fconfigure $f -blocking 0}
+ } -body {
+ type $f "fconfigure stdin -eofchar \\032
+ if 1 \{\n\032"
+ variable wait
+ fileevent $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)]} {
+ exec kill [pid $f]
+ }
+ close $f
+ } -result {child exit}
+
+ test Tcl_Main-5.4 {
+ Tcl_Main handles stdin EOF in mid-command
+ } -constraints {
+ exec
+ } -setup {
+ set cmd {makeFile "if 1 \{" script}
+ catch {set f [open "|[list [interpreter]] < [list [eval $cmd]]" r]}
+ catch {fconfigure $f -blocking 0}
+ } -body {
+ variable wait
+ fileevent $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)]} {
+ exec kill [pid $f]
+ }
+ close $f
+ removeFile script
+ } -result {child exit}
+
+ test Tcl_Main-5.5 {
+ Tcl_Main: error raised in interactive mode
+ } -constraints {
+ exec
+ } -body {
+ exec [interpreter] << {error foo} >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "foo\n"
+
+ test Tcl_Main-5.6 {
+ Tcl_Main: interactive mode: errors don't stop command loop
+ } -constraints {
+ exec
+ } -body {
+ exec [interpreter] << {
+ error foo
+ puts bar
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "foo\nbar\n"
+
+ test Tcl_Main-5.7 {
+ Tcl_Main: interactive mode: closed stderr
+ } -constraints {
+ exec
+ } -body {
+ exec [interpreter] << {
+ close stderr
+ error foo
+ puts bar
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "bar\n"
+
+ test Tcl_Main-5.8 {
+ Tcl_Main: interactive mode: close stdin
+ -> main loop & [exit] & exit handlers
+ } -constraints {
+ exec Tcltest
+ } -body {
+ exec [interpreter] << {
+ rename exit _exit
+ proc exit code {
+ puts "In exit"
+ _exit $code
+ }
+ testsetmainloop
+ testexitmainloop
+ testexithandler create 0
+ close stdin
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "Exit MainLoop\nIn exit\neven 0\n"
+
+ test Tcl_Main-5.9 {
+ Tcl_Main: interactive mode: delete interp
+ -> main loop & exit handlers, but no [exit]
+ } -constraints {
+ exec Tcltest
+ } -body {
+ exec [interpreter] << {
+ rename exit _exit
+ proc exit code {
+ puts "In exit"
+ _exit $code
+ }
+ testsetmainloop
+ testexitmainloop
+ testexithandler create 0
+ testinterpdelete {}
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "Exit MainLoop\neven 0\n"
+
+ test Tcl_Main-5.10 {
+ Tcl_Main: exit main loop in mid-interactive command
+ } -constraints {
+ exec Tcltest
+ } -setup {
+ catch {set f [open "|[list [interpreter]]" w+]}
+ catch {fconfigure $f -blocking 0}
+ } -body {
+ type $f "testsetmainloop
+ after 2000 testexitmainloop
+ puts \{1 2"
+ after 4000
+ type $f "3 4\}"
+ set code1 [catch {gets $f} line1]
+ set code2 [catch {gets $f} line2]
+ set code3 [catch {gets $f} line3]
+ list $code1 $line1 $code2 $line2 $code3 $line3
+ } -cleanup {
+ close $f
+ } -result [list 0 {Exit MainLoop} 0 {1 2} 0 {3 4}]
+
+ test Tcl_Main-5.11 {
+ Tcl_Main: EOF in interactive main loop
+ } -constraints {
+ exec Tcltest
+ } -body {
+ exec [interpreter] << {
+ rename exit _exit
+ proc exit code {
+ puts "In exit"
+ _exit $code
+ }
+ testexithandler create 0
+ after 0 testexitmainloop
+ testsetmainloop
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "Exit MainLoop\nIn exit\neven 0\n"
+
+ test Tcl_Main-5.12 {
+ Tcl_Main: close stdin in interactive main loop
+ } -constraints {
+ exec Tcltest
+ } -body {
+ exec [interpreter] << {
+ rename exit _exit
+ proc exit code {
+ puts "In exit"
+ _exit $code
+ }
+ testexithandler create 0
+ after 100 testexitmainloop
+ testsetmainloop
+ close stdin
+ puts "don't reach this"
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "Exit MainLoop\nIn exit\neven 0\n"
+
+ # Tests Tcl_Main-6.*: interactive operations with prompts
+
+ test Tcl_Main-6.1 {
+ Tcl_Main: enable prompts with tcl_interactive
+ } -constraints {
+ exec
+ } -body {
+ exec [interpreter] << {set tcl_interactive 1} >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "1\n% "
+
+ test Tcl_Main-6.2 {
+ Tcl_Main: prompt deletes interp
+ } -constraints {
+ exec Tcltest
+ } -body {
+ exec [interpreter] << {
+ set tcl_prompt1 {testinterpdelete {}}
+ set tcl_interactive 1
+ puts "not reached"
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "1\n"
+
+ test Tcl_Main-6.3 {
+ Tcl_Main: prompt closes stdin
+ } -constraints {
+ exec
+ } -body {
+ exec [interpreter] << {
+ set tcl_prompt1 {close stdin}
+ set tcl_interactive 1
+ puts "not reached"
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "1\n"
+
+ test Tcl_Main-6.4 {
+ Tcl_Main: interactive output, closed stdout
+ } -constraints {
+ exec
+ } -body {
+ exec [interpreter] << {
+ set tcl_interactive 1
+ close stdout
+ set a NO
+ puts stderr YES
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "1\n% YES\n"
+
+ test Tcl_Main-6.5 {
+ Tcl_Main: interactive entry to main loop
+ } -constraints {
+ exec Tcltest
+ } -body {
+ exec [interpreter] << {
+ set tcl_interactive 1
+ testsetmainloop
+ testexitmainloop} >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "1\n% % % Exit MainLoop\n"
+
+ test Tcl_Main-6.6 {
+ Tcl_Main: number of prompts during stdin close exit
+ } -constraints {
+ exec
+ } -body {
+ exec [interpreter] << {
+ set tcl_interactive 1
+ close stdin} >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "1\n% "
+
+ # Tests Tcl_Main-7.*: exiting
+
+ test Tcl_Main-7.1 {
+ Tcl_Main: [exit] defined as no-op -> still have exithandlers
+ } -constraints {
+ exec Tcltest
+ } -body {
+ exec [interpreter] << {
+ proc exit args {}
+ testexithandler create 0
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "even 0\n"
+
+ test Tcl_Main-7.2 {
+ Tcl_Main: [exit] defined as no-op -> still have exithandlers
+ } -constraints {
+ exec Tcltest
+ } -body {
+ exec [interpreter] << {
+ proc exit args {}
+ testexithandler create 0
+ after 0 testexitmainloop
+ testsetmainloop
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "Exit MainLoop\neven 0\n"
+
+ # Tests Tcl_Main-8.*: StdinProc operations
+
+ test Tcl_Main-8.1 {
+ StdinProc: handles non-blocking stdin
+ } -constraints {
+ exec Tcltest
+ } -body {
+ exec [interpreter] << {
+ testsetmainloop
+ fconfigure stdin -blocking 0
+ testexitmainloop
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "Exit MainLoop\n"
+
+ test Tcl_Main-8.2 {
+ StdinProc: handles stdin EOF
+ } -constraints {
+ exec Tcltest
+ } -body {
+ exec [interpreter] << {
+ testsetmainloop
+ testexithandler create 0
+ rename exit _exit
+ proc exit code {
+ puts "In exit"
+ _exit $code
+ }
+ after 100 testexitmainloop
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "Exit MainLoop\nIn exit\neven 0\n"
+
+ test Tcl_Main-8.3 {
+ StdinProc: handles interactive stdin EOF
+ } -constraints {
+ exec Tcltest
+ } -body {
+ exec [interpreter] << {
+ testsetmainloop
+ testexithandler create 0
+ rename exit _exit
+ proc exit code {
+ puts "In exit"
+ _exit $code
+ }
+ set tcl_interactive 1} >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "1\n% even 0\n"
+
+ test Tcl_Main-8.4 {
+ StdinProc: handles stdin close
+ } -constraints {
+ exec Tcltest
+ } -body {
+ exec [interpreter] << {
+ testsetmainloop
+ rename exit _exit
+ proc exit code {
+ puts "In exit"
+ _exit $code
+ }
+ after 100 testexitmainloop
+ after 0 puts 1
+ close stdin
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "1\nExit MainLoop\nIn exit\n"
+
+ test Tcl_Main-8.5 {
+ StdinProc: handles interactive stdin close
+ } -constraints {
+ exec Tcltest
+ } -body {
+ exec [interpreter] << {
+ testsetmainloop
+ set tcl_interactive 1
+ rename exit _exit
+ proc exit code {
+ puts "In exit"
+ _exit $code
+ }
+ after 100 testexitmainloop
+ after 0 puts 1
+ close stdin
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "1\n% % % after#0\n% after#1\n% 1\nExit MainLoop\nIn exit\n"
+
+ test Tcl_Main-8.6 {
+ StdinProc: handles event loop re-entry
+ } -constraints {
+ exec Tcltest
+ } -body {
+ exec [interpreter] << {
+ testsetmainloop
+ after 100 {puts 1; set delay 1}
+ vwait delay
+ puts 2
+ testexitmainloop
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "1\n2\nExit MainLoop\n"
+
+ test Tcl_Main-8.7 {
+ StdinProc: handling of errors
+ } -constraints {
+ exec Tcltest
+ } -body {
+ exec [interpreter] << {
+ testsetmainloop
+ error foo
+ testexitmainloop
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "foo\nExit MainLoop\n"
+
+ test Tcl_Main-8.8 {
+ StdinProc: handling of errors, closed stderr
+ } -constraints {
+ exec Tcltest
+ } -body {
+ exec [interpreter] << {
+ testsetmainloop
+ close stderr
+ error foo
+ testexitmainloop
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "Exit MainLoop\n"
+
+ test Tcl_Main-8.9 {
+ StdinProc: interactive output
+ } -constraints {
+ exec Tcltest
+ } -body {
+ exec [interpreter] << {
+ testsetmainloop
+ set tcl_interactive 1
+ testexitmainloop} >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "1\n% % Exit MainLoop\n"
+
+ test Tcl_Main-8.10 {
+ StdinProc: interactive output, closed stdout
+ } -constraints {
+ exec Tcltest
+ } -body {
+ exec [interpreter] << {
+ testsetmainloop
+ close stdout
+ set tcl_interactive 1
+ testexitmainloop
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result {}
+
+ test Tcl_Main-8.11 {
+ StdinProc: prompt deletes interp
+ } -constraints {
+ exec Tcltest
+ } -body {
+ exec [interpreter] << {
+ testsetmainloop
+ set tcl_prompt1 {testinterpdelete {}}
+ set tcl_interactive 1} >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "1\n"
+
+ test Tcl_Main-8.12 {
+ StdinProc: prompt closes stdin
+ } -constraints {
+ exec Tcltest
+ } -body {
+ exec [interpreter] << {
+ testsetmainloop
+ set tcl_prompt1 {close stdin}
+ after 100 testexitmainloop
+ set tcl_interactive 1
+ puts "not reached"
+ } >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "1\nExit MainLoop\n"
+
+ # Tests Tcl_Main-9.*: Prompt operations
+
+ test Tcl_Main-9.1 {
+ Prompt: custom prompt variables
+ } -constraints {
+ exec
+ } -body {
+ exec [interpreter] << {
+ set tcl_prompt1 {puts -nonewline stdout "one "}
+ set tcl_prompt2 {puts -nonewline stdout "two "}
+ set tcl_interactive 1
+ puts {This is
+ a test}} >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "1\none two This is\n\t\ta test\none "
+
+ test Tcl_Main-9.2 {
+ Prompt: error in custom prompt variables
+ } -constraints {
+ exec
+ } -body {
+ exec [interpreter] << {
+ set tcl_prompt1 {error foo}
+ set tcl_interactive 1
+ set errorInfo} >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "1\nfoo\n% foo\n while executing\n\"error foo\"\n (script\
+ that generates prompt)\nfoo\n% "
+
+ test Tcl_Main-9.3 {
+ Prompt: error in custom prompt variables, closed stderr
+ } -constraints {
+ exec
+ } -body {
+ exec [interpreter] << {
+ set tcl_prompt1 {close stderr; error foo}
+ set tcl_interactive 1} >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "1\n% "
+
+ test Tcl_Main-9.4 {
+ Prompt: error in custom prompt variables, closed stdout
+ } -constraints {
+ exec
+ } -body {
+ exec [interpreter] << {
+ set tcl_prompt1 {close stdout; error foo}
+ set tcl_interactive 1} >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "1\nfoo\n"
+
+ cd [workingDirectory]
+
+ cleanupTests
+}
+
+namespace delete ::tcl::test::main
+return
diff --git a/tcl/tests/misc.test b/tcl/tests/misc.test
index 7ba5f9736da..d3ca94e5b96 100644
--- a/tcl/tests/misc.test
+++ b/tcl/tests/misc.test
@@ -74,4 +74,3 @@ return
-
diff --git a/tcl/tests/msgcat.test b/tcl/tests/msgcat.test
index b2f0b20fcd9..f5159872a46 100644
--- a/tcl/tests/msgcat.test
+++ b/tcl/tests/msgcat.test
@@ -1,314 +1,457 @@
-# Commands covered: ::msgcat::mc ::msgcat::mclocale
-# ::msgcat::mcpreferences ::msgcat::mcload
-# ::msgcat::mcset ::msgcat::mcunknown
-#
-# This file contains a collection of tests for the msgcat script library.
+# This file contains a collection of tests for the msgcat package.
# Sourcing this file into Tcl runs the tests and
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1998 Mark Harrison.
# Copyright (c) 1998-1999 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.
#
+# 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$
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
- namespace import -force ::tcltest::*
+package require Tcl 8.2
+if {[catch {package require tcltest 2}]} {
+ puts stderr "Skipping tests in [info script]. tcltest 2 required."
+ return
}
+if {[catch {package require msgcat 1.3}]} {
+ puts stderr "Skipping tests in [info script]. No msgcat 1.3 found to test."
+ return
+}
+
+namespace eval ::msgcat::test {
+ namespace import ::msgcat::*
+ namespace import ::tcltest::test
+ namespace import ::tcltest::cleanupTests
+ namespace import ::tcltest::temporaryDirectory
+ namespace import ::tcltest::make*
+ namespace import ::tcltest::remove*
-if {[catch {package require msgcat 1.0}]} {
- if {[info exist msgcat1]} {
- catch {puts "Cannot load msgcat 1.0 package"}
- return
- } else {
- catch {puts "Running msgcat 1.0 tests in slave interp"}
- set interp [interp create msgcat1]
- $interp eval [list set msgcat1 "running"]
- $interp eval [list source [info script]]
- interp delete $interp
- return
+ # Tests msgcat-0.*: locale initialization
+
+ proc PowerSet {l} {
+ if {[llength $l] == 0} {return [list [list]]}
+ set element [lindex $l 0]
+ set rest [lrange $l 1 end]
+ set result [list]
+ foreach x [PowerSet $rest] {
+ lappend result [linsert $x 0 $element]
+ lappend result $x
+ }
+ return $result
}
-}
-set oldlocale [::msgcat::mclocale]
+ variable envVars {LC_ALL LC_MESSAGES LANG}
+ variable count 0
+ variable body
+ variable result
+ variable setVars
+ foreach setVars [PowerSet $envVars] {
+ set result [string tolower [lindex $setVars 0]]
+ if {[string length $result] == 0} {
+ set result c
+ }
+ test msgcat-0.$count {
+ locale initialization from environment variables
+ } -setup {
+ variable var
+ foreach var $envVars {
+ catch {variable $var $::env($var)}
+ catch {unset ::env($var)}
+ }
+ foreach var $setVars {
+ set ::env($var) $var
+ }
+ interp create [namespace current]::i
+ i eval [list package ifneeded msgcat [package provide msgcat] \
+ [package ifneeded msgcat [package provide msgcat]]]
+ i eval package require msgcat
+ } -cleanup {
+ interp delete [namespace current]::i
+ foreach var $envVars {
+ catch {unset ::env($var)}
+ catch {set ::env($var) [set [namespace current]::$var]}
+ }
+ } -body {i eval msgcat::mclocale} -result $result
+ incr count
+ }
+ catch {unset result}
+
+ # Could add tests of initialization from Windows registry here.
+ # Use a fake registry package.
-# some tests fail in tne environment variable LANG exists and is not C
+ # Tests msgcat-1.*: [mclocale], [mcpreferences]
-if {[info exists env(LANG)] && ($env(LANG) != "C")} {
- set ::tcltest::testConstraints(LANGisC) 0
-} else {
- set ::tcltest::testConstraints(LANGisC) 1
-}
+ test msgcat-1.3 {mclocale set, single element} -setup {
+ variable locale [mclocale]
+ } -cleanup {
+ mclocale $locale
+ } -body {
+ mclocale en
+ } -result en
-#
-# Test the various permutations of mclocale
-# and mcpreferences.
-#
+ test msgcat-1.4 {mclocale get, single element} -setup {
+ variable locale [mclocale]
+ mclocale en
+ } -cleanup {
+ mclocale $locale
+ } -body {
+ mclocale
+ } -result en
-test msgcat-1.1 {::msgcat::mclocale default} {LANGisC} {
- ::msgcat::mclocale
-} {c}
-test msgcat-1.2 {::msgcat::mcpreferences, single element} {LANGisC} {
- ::msgcat::mcpreferences
-} {c}
-test msgcat-1.3 {::msgcat::mclocale, single element} {
- ::msgcat::mclocale en
-} {en}
-test msgcat-1.4 {::msgcat::mclocale, single element} {
- ::msgcat::mclocale
-} {en}
-test msgcat-1.5 {::msgcat::mcpreferences, single element} {
- ::msgcat::mcpreferences
-} {en}
-test msgcat-1.6 {::msgcat::mclocale, two elements} {
- ::msgcat::mclocale en_US
-} {en_us}
-test msgcat-1.7 {::msgcat::mclocale, two elements} {
- ::msgcat::mclocale en_US
- ::msgcat::mclocale
-} {en_us}
-test msgcat-1.8 {::msgcat::mcpreferences, two elements} {
- ::msgcat::mcpreferences
-} {en_us en}
-test msgcat-1.9 {::msgcat::mclocale, three elements} {
- ::msgcat::mclocale en_US_funky
-} {en_us_funky}
-test msgcat-1.10 {::msgcat::mclocale, three elements} {
- ::msgcat::mclocale
-} {en_us_funky}
-test msgcat-1.11 {::msgcat::mcpreferences, three elements} {
- ::msgcat::mcpreferences
-} {en_us_funky en_us en}
+ test msgcat-1.5 {mcpreferences, single element} -setup {
+ variable locale [mclocale]
+ mclocale en
+ } -cleanup {
+ mclocale $locale
+ } -body {
+ mcpreferences
+ } -result en
-#
-# Test mcset and mcc, ensuring that namespace partitioning
-# is working.
-#
+ test msgcat-1.6 {mclocale set, two elements} -setup {
+ variable locale [mclocale]
+ } -cleanup {
+ mclocale $locale
+ } -body {
+ mclocale en_US
+ } -result en_us
-test msgcat-2.1 {::msgcat::mcset, global scope} {
- ::msgcat::mcset foo_BAR text1 text2
-} {text2}
-test msgcat-2.2 {::msgcat::mcset, global scope, default} {
- ::msgcat::mcset foo_BAR text3
-} {text3}
-test msgcat-2.2 {::msgcat::mcset, namespace overlap} {
- namespace eval bar {::msgcat::mcset foo_BAR con1 con1bar}
- namespace eval baz {::msgcat::mcset foo_BAR con1 con1baz}
-} {con1baz}
-test msgcat-2.3 {::msgcat::mcset, namespace overlap} {
- ::msgcat::mclocale foo_BAR
- namespace eval bar {::msgcat::mc con1}
-} {con1bar}
-test msgcat-2.4 {::msgcat::mcset, namespace overlap} {
- ::msgcat::mclocale foo_BAR
- namespace eval baz {::msgcat::mc con1}
-} {con1baz}
+ test msgcat-1.7 {mclocale get, two elements} -setup {
+ variable locale [mclocale]
+ mclocale en_US
+ } -cleanup {
+ mclocale $locale
+ } -body {
+ mclocale
+ } -result en_us
-#
-# Test mcset and mc, ensuring that more specific locales
-# (e.g. "en_UK") will search less specific locales
-# (e.g. "en") for translation strings.
-#
-# Do this for the 12 permutations of
-# locales: {foo foo_BAR foo_BAR_baz}
-# strings: {ov1 ov2 ov3 ov4}
-# locale foo defines ov1, ov2, ov3
-# locale foo_BAR defines ov2, ov3
-# locale foo_BAR_BAZ defines ov3
-# (ov4 is defined in none)
-# So,
-# ov3 should be resolved in foo, foo_BAR, foo_BAR_baz
-# ov2 should be resolved in foo, foo_BAR
-# ov2 should resolve to foo_BAR in foo_BAR_baz
-# ov1 should be resolved in foo
-# ov1 should resolve to foo in foo_BAR, foo_BAR_baz
-# ov4 should be resolved in none, and call mcunknown
-#
+ test msgcat-1.8 {mcpreferences, two elements} -setup {
+ variable locale [mclocale]
+ mclocale en_US
+ } -cleanup {
+ mclocale $locale
+ } -body {
+ mcpreferences
+ } -result {en_us en}
-test msgcat-3.1 {::msgcat::mcset, overlap} {
- ::msgcat::mcset foo ov1 ov1_foo
- ::msgcat::mcset foo ov2 ov2_foo
- ::msgcat::mcset foo ov3 ov3_foo
- ::msgcat::mcset foo_BAR ov2 ov2_foo_BAR
- ::msgcat::mcset foo_BAR ov3 ov3_foo_BAR
- ::msgcat::mcset foo_BAR_baz ov3 ov3_foo_BAR_baz
-} {ov3_foo_BAR_baz}
-# top level, locale foo
-test msgcat-3.2 {::msgcat::mcset, overlap} {
- ::msgcat::mclocale foo
- ::msgcat::mc ov1
-} {ov1_foo}
-test msgcat-3.3 {::msgcat::mcset, overlap} {
- ::msgcat::mclocale foo
- ::msgcat::mc ov2
-} {ov2_foo}
-test msgcat-3.4 {::msgcat::mcset, overlap} {
- ::msgcat::mclocale foo
- ::msgcat::mc ov3
-} {ov3_foo}
-test msgcat-3.5 {::msgcat::mcset, overlap} {
- ::msgcat::mclocale foo
- ::msgcat::mc ov4
-} {ov4}
-# second level, locale foo_BAR
-test msgcat-3.6 {::msgcat::mcset, overlap} {
- ::msgcat::mclocale foo_BAR
- ::msgcat::mc ov1
-} {ov1_foo}
-test msgcat-3.7 {::msgcat::mcset, overlap} {
- ::msgcat::mclocale foo_BAR
- ::msgcat::mc ov2
-} {ov2_foo_BAR}
-test msgcat-3.8 {::msgcat::mcset, overlap} {
- ::msgcat::mclocale foo_BAR
- ::msgcat::mc ov3
-} {ov3_foo_BAR}
-test msgcat-3.9 {::msgcat::mcset, overlap} {
- ::msgcat::mclocale foo_BAR
- ::msgcat::mc ov4
-} {ov4}
-# third level, locale foo_BAR_baz
-test msgcat-3.10 {::msgcat::mcset, overlap} {
- ::msgcat::mclocale foo_BAR_baz
- ::msgcat::mc ov1
-} {ov1_foo}
-test msgcat-3.11 {::msgcat::mcset, overlap} {
- ::msgcat::mclocale foo_BAR_baz
- ::msgcat::mc ov2
-} {ov2_foo_BAR}
-test msgcat-3.12 {::msgcat::mcset, overlap} {
- ::msgcat::mclocale foo_BAR_baz
- ::msgcat::mc ov3
-} {ov3_foo_BAR_baz}
-test msgcat-3.13 {::msgcat::mcset, overlap} {
- ::msgcat::mclocale foo_BAR_baz
- ::msgcat::mc ov4
-} {ov4}
+ test msgcat-1.9 {mclocale set, three elements} -setup {
+ variable locale [mclocale]
+ } -cleanup {
+ mclocale $locale
+ } -body {
+ mclocale en_US_funky
+ } -result en_us_funky
-#
-# Test mcunknown, first the default operation
-# and then with an overridden definition.
-#
+ test msgcat-1.10 {mclocale get, three elements} -setup {
+ variable locale [mclocale]
+ mclocale en_US_funky
+ } -cleanup {
+ mclocale $locale
+ } -body {
+ mclocale
+ } -result en_us_funky
+
+ test msgcat-1.11 {mcpreferences, three elements} -setup {
+ variable locale [mclocale]
+ mclocale en_US_funky
+ } -cleanup {
+ mclocale $locale
+ } -body {
+ mcpreferences
+ } -result {en_us_funky en_us en}
+
+ # Tests msgcat-2.*: [mcset], [mcmset], namespace partitioning
+
+ test msgcat-2.1 {mcset, global scope} {
+ namespace eval :: ::msgcat::mcset foo_BAR text1 text2
+ } {text2}
+
+ test msgcat-2.2 {mcset, global scope, default} {
+ namespace eval :: ::msgcat::mcset foo_BAR text3
+ } {text3}
+
+ test msgcat-2.2 {mcset, namespace overlap} {
+ namespace eval baz {::msgcat::mcset foo_BAR con1 con1baz}
+ } {con1baz}
+
+ test msgcat-2.3 {mcset, namespace overlap} -setup {
+ namespace eval bar {::msgcat::mcset foo_BAR con1 con1bar}
+ namespace eval baz {::msgcat::mcset foo_BAR con1 con1baz}
+ variable locale [mclocale]
+ mclocale foo_BAR
+ } -cleanup {
+ mclocale $locale
+ } -body {
+ namespace eval bar {::msgcat::mc con1}
+ } -result con1bar
+
+ test msgcat-2.4 {mcset, namespace overlap} -setup {
+ namespace eval bar {::msgcat::mcset foo_BAR con1 con1bar}
+ namespace eval baz {::msgcat::mcset foo_BAR con1 con1baz}
+ variable locale [mclocale]
+ mclocale foo_BAR
+ } -cleanup {
+ mclocale $locale
+ } -body {
+ namespace eval baz {::msgcat::mc con1}
+ } -result con1baz
-test msgcat-4.1 {::msgcat::mcunknown, default} {
- ::msgcat::mcset foo unk1 "unknown 1"
-} {unknown 1}
-test msgcat-4.2 {::msgcat::mcunknown, default} {
- ::msgcat::mclocale foo
- ::msgcat::mc unk1
-} {unknown 1}
-test msgcat-4.3 {::msgcat::mcunknown, default} {
- ::msgcat::mclocale foo
- ::msgcat::mc unk2
-} {unk2}
-test msgcat-4.4 {::msgcat::mcunknown, overridden} {
- rename ::msgcat::mcunknown oldproc
- proc ::msgcat::mcunknown {dom s} {
- return "unknown:$dom:$s"
+ test msgcat-2.5 {mcmset, global scope} -setup {
+ namespace eval :: {
+ ::msgcat::mcmset foo_BAR {
+ src1 trans1
+ src2 trans2
+ }
+ }
+ variable locale [mclocale]
+ mclocale foo_BAR
+ } -cleanup {
+ mclocale $locale
+ } -body {
+ namespace eval :: {
+ ::msgcat::mc src1
+ }
+ } -result trans1
+
+ test msgcat-2.6 {mcmset, namespace overlap} -setup {
+ namespace eval bar {::msgcat::mcmset foo_BAR {con2 con2bar}}
+ namespace eval baz {::msgcat::mcmset foo_BAR {con2 con2baz}}
+ variable locale [mclocale]
+ mclocale foo_BAR
+ } -cleanup {
+ mclocale $locale
+ } -body {
+ namespace eval bar {::msgcat::mc con2}
+ } -result con2bar
+
+ test msgcat-2.7 {mcmset, namespace overlap} -setup {
+ namespace eval bar {::msgcat::mcmset foo_BAR {con2 con2bar}}
+ namespace eval baz {::msgcat::mcmset foo_BAR {con2 con2baz}}
+ variable locale [mclocale]
+ mclocale foo_BAR
+ } -cleanup {
+ mclocale $locale
+ } -body {
+ namespace eval baz {::msgcat::mc con2}
+ } -result con2baz
+
+ # Tests msgcat-3.*: [mcset], [mc], catalog "inheritance"
+ #
+ # Test mcset and mc, ensuring that more specific locales
+ # (e.g. en_UK) will search less specific locales
+ # (e.g. en) for translation strings.
+ #
+ # Do this for the 12 permutations of
+ # locales: {foo foo_BAR foo_BAR_baz}
+ # strings: {ov1 ov2 ov3 ov4}
+ # locale foo defines ov1, ov2, ov3
+ # locale foo_BAR defines ov2, ov3
+ # locale foo_BAR_BAZ defines ov3
+ # (ov4 is defined in none)
+ # So,
+ # ov3 should be resolved in foo, foo_BAR, foo_BAR_baz
+ # ov2 should be resolved in foo, foo_BAR
+ # ov2 should resolve to foo_BAR in foo_BAR_baz
+ # ov1 should be resolved in foo
+ # ov1 should resolve to foo in foo_BAR, foo_BAR_baz
+ # ov4 should be resolved in none, and call mcunknown
+ #
+ variable count 2
+ variable result
+ array set result {
+ foo,ov1 ov1_foo foo,ov2 ov2_foo foo,ov3 ov3_foo foo,ov4 ov4
+ foo_BAR,ov1 ov1_foo foo_BAR,ov2 ov2_foo_BAR foo_BAR,ov3 ov3_foo_BAR
+ foo_BAR,ov4 ov4 foo_BAR_baz,ov1 ov1_foo foo_BAR_baz,ov2 ov2_foo_BAR
+ foo_BAR_baz,ov3 ov3_foo_BAR_baz foo_BAR_baz,ov4 ov4
}
- ::msgcat::mclocale foo
- set result [::msgcat::mc unk1]
- rename ::msgcat::mcunknown {}
- rename oldproc ::msgcat::mcunknown
- set result
-} {unknown 1}
-test msgcat-4.5 {::msgcat::mcunknown, overridden} {
- rename ::msgcat::mcunknown oldproc
- proc ::msgcat::mcunknown {dom s} {
- return "unknown:$dom:$s"
+ variable loc
+ variable string
+ foreach loc {foo foo_BAR foo_BAR_baz} {
+ foreach string {ov1 ov2 ov3 ov4} {
+ test msgcat-3.$count {mcset, overlap} -setup {
+ mcset foo ov1 ov1_foo
+ mcset foo ov2 ov2_foo
+ mcset foo ov3 ov3_foo
+ mcset foo_BAR ov2 ov2_foo_BAR
+ mcset foo_BAR ov3 ov3_foo_BAR
+ mcset foo_BAR_baz ov3 ov3_foo_BAR_baz
+ variable locale [mclocale]
+ mclocale $loc
+ } -cleanup {
+ mclocale $locale
+ } -body {
+ mc $string
+ } -result $result($loc,$string)
+ incr count
+ }
}
- ::msgcat::mclocale foo
- set result [::msgcat::mc unk2]
- rename ::msgcat::mcunknown {}
- rename oldproc ::msgcat::mcunknown
- set result
-} {unknown:foo:unk2}
-test msgcat-4.6 {::msgcat::mcunknown, uplevel context} {
- rename ::msgcat::mcunknown oldproc
- proc ::msgcat::mcunknown {dom s} {
- return "unknown:$dom:$s:[info level]"
+ catch {unset result}
+
+ # Tests msgcat-4.*: [mcunknown]
+
+ test msgcat-4.2 {mcunknown, default} -setup {
+ mcset foo unk1 "unknown 1"
+ variable locale [mclocale]
+ mclocale foo
+ } -cleanup {
+ mclocale $locale
+ } -body {
+ mc unk1
+ } -result {unknown 1}
+
+ test msgcat-4.3 {mcunknown, default} -setup {
+ mcset foo unk1 "unknown 1"
+ variable locale [mclocale]
+ mclocale foo
+ } -cleanup {
+ mclocale $locale
+ } -body {
+ mc unk2
+ } -result unk2
+
+ test msgcat-4.4 {mcunknown, overridden} -setup {
+ rename ::msgcat::mcunknown SavedMcunknown
+ proc ::msgcat::mcunknown {dom s} {
+ return unknown:$dom:$s
+ }
+ mcset foo unk1 "unknown 1"
+ variable locale [mclocale]
+ mclocale foo
+ } -cleanup {
+ mclocale $locale
+ rename ::msgcat::mcunknown {}
+ rename SavedMcunknown ::msgcat::mcunknown
+ } -body {
+ mc unk1
+ } -result {unknown 1}
+
+ test msgcat-4.5 {mcunknown, overridden} -setup {
+ rename ::msgcat::mcunknown SavedMcunknown
+ proc ::msgcat::mcunknown {dom s} {
+ return unknown:$dom:$s
+ }
+ mcset foo unk1 "unknown 1"
+ variable locale [mclocale]
+ mclocale foo
+ } -cleanup {
+ mclocale $locale
+ rename ::msgcat::mcunknown {}
+ rename SavedMcunknown ::msgcat::mcunknown
+ } -body {
+ mc unk2
+ } -result {unknown:foo:unk2}
+
+ test msgcat-4.6 {mcunknown, uplevel context} -setup {
+ rename ::msgcat::mcunknown SavedMcunknown
+ proc ::msgcat::mcunknown {dom s} {
+ return "unknown:$dom:$s:[expr {[info level] - 1}]"
+ }
+ mcset foo unk1 "unknown 1"
+ variable locale [mclocale]
+ mclocale foo
+ } -cleanup {
+ mclocale $locale
+ rename ::msgcat::mcunknown {}
+ rename SavedMcunknown ::msgcat::mcunknown
+ } -body {
+ mc unk2
+ } -result unknown:foo:unk2:[info level]
+
+ # Tests msgcat-5.*: [mcload]
+
+ variable locales {foo foo_BAR foo_BAR_baz}
+ makeDirectory msgdir
+ foreach loc $locales {
+ makeFile "::msgcat::mcset $loc abc abc-$loc" \
+ [string tolower [file join msgdir $loc.msg]]
+ }
+ variable count 1
+ foreach loc {foo foo_BAR foo_BAR_baz} {
+ test msgcat-5.$count {mcload} -setup {
+ variable locale [mclocale]
+ mclocale $loc
+ } -cleanup {
+ mclocale $locale
+ } -body {
+ mcload [file join [temporaryDirectory] msgdir]
+ } -result $count
+ incr count
}
- ::msgcat::mclocale foo
- set result [::msgcat::mc unk2]
- rename ::msgcat::mcunknown {}
- rename oldproc ::msgcat::mcunknown
- set result
-} {unknown:foo:unk2:1}
-
-#
-# Test mcload. Need to set up an environment for
-# these tests by creating a temporary directory and
-# message files.
-#
+ # Even though foo_BAR_notexist does not exist,
+ # foo_BAR and foo should be loaded.
+ test msgcat-5.4 {mcload} -setup {
+ variable locale [mclocale]
+ mclocale foo_BAR_notexist
+ } -cleanup {
+ mclocale $locale
+ } -body {
+ mcload [file join [temporaryDirectory] msgdir]
+ } -result 2
-set locales {en en_US en_US_funky}
+ test msgcat-5.5 {mcload} -setup {
+ variable locale [mclocale]
+ mclocale no_FI_notexist
+ } -cleanup {
+ mclocale $locale
+ } -body {
+ mcload [file join [temporaryDirectory] msgdir]
+ } -result 0
-catch {file mkdir msgdir}
-foreach l $locales {
- set fd [open [string tolower [file join msgdir $l.msg]] w]
- puts $fd "::msgcat::mcset $l abc abc-$l"
- close $fd
-}
+ test msgcat-5.6 {mcload} -setup {
+ variable locale [mclocale]
+ mclocale foo
+ } -cleanup {
+ mclocale $locale
+ } -body {
+ mc abc
+ } -result abc-foo
+
+ test msgcat-5.7 {mcload} -setup {
+ variable locale [mclocale]
+ mclocale foo_BAR
+ } -cleanup {
+ mclocale $locale
+ } -body {
+ mc abc
+ } -result abc-foo_BAR
+
+ test msgcat-5.8 {mcload} -setup {
+ variable locale [mclocale]
+ mclocale foo_BAR_baz
+ } -cleanup {
+ mclocale $locale
+ } -body {
+ mc abc
+ } -result abc-foo_BAR_baz
+
+ test msgcat-5.9 {mcload} -setup {
+ rename ::msgcat::mcunknown SavedMcunknown
+ proc ::msgcat::mcunknown {dom s} {
+ return unknown:$dom:$s
+ }
+ variable locale [mclocale]
+ mclocale no_FI_notexist
+ } -cleanup {
+ mclocale $locale
+ rename ::msgcat::mcunknown {}
+ rename SavedMcunknown ::msgcat::mcunknown
+ } -body {
+ mc abc
+ } -result unknown:no_fi_notexist:abc
-test msgcat-5.1 {::msgcat::mcload} {
- ::msgcat::mclocale en
- ::msgcat::mcload msgdir
-} {1}
-test msgcat-5.2 {::msgcat::mcload} {
- ::msgcat::mclocale en_US
- ::msgcat::mcload msgdir
-} {2}
-test msgcat-5.3 {::msgcat::mcload} {
- ::msgcat::mclocale en_US_funky
- ::msgcat::mcload msgdir
-} {3}
-
-# Even though en_US_notexist does not exist,
-# en_US and en should be loaded.
-
-test msgcat-5.4 {::msgcat::mcload} {
- ::msgcat::mclocale en_US_notexist
- ::msgcat::mcload msgdir
-} {2}
-test msgcat-5.5 {::msgcat::mcload} {
- ::msgcat::mclocale no_FI_notexist
- ::msgcat::mcload msgdir
-} {0}
-test msgcat-5.6 {::msgcat::mcload} {
- ::msgcat::mclocale en
- ::msgcat::mc abc
-} {abc-en}
-test msgcat-5.7 {::msgcat::mcload} {
- ::msgcat::mclocale en_US
- ::msgcat::mc abc
-} {abc-en_US}
-test msgcat-5.8 {::msgcat::mcload} {
- ::msgcat::mclocale en_US_funky
- ::msgcat::mc abc
-} {abc-en_US_funky}
-test msgcat-5.9 {::msgcat::mcload} {
- rename ::msgcat::mcunknown oldproc
- proc ::msgcat::mcunknown {dom s} {
- return "unknown:$dom:$s"
+
+ foreach loc $locales {
+ removeFile [string tolower [file join msgdir $loc.msg]]
}
- ::msgcat::mclocale no_FI_notexist
- set result [::msgcat::mc abc]
- rename ::msgcat::mcunknown {}
- rename oldproc ::msgcat::mcunknown
- set result
-} {unknown:no_fi_notexist:abc}
-
-# cleanup temp files
-foreach l $locales {
- file delete [string tolower [file join msgdir $l.msg]]
-}
-# Clean out the msg catalogs
-file delete msgdir
+ removeDirectory msgdir
+ # Tests msgcat-6.*: [mcset], [mc] namespace inheritance
#
# Test mcset and mc, ensuring that resolution for messages
# proceeds from the current ns to its parent and so on to the
@@ -316,7 +459,7 @@ file delete msgdir
#
# Do this for the 12 permutations of
# locales: foo
-# namespaces: ::foo ::foo::bar ::foo::bar::baz
+# namespaces: foo foo::bar foo::bar::baz
# strings: {ov1 ov2 ov3 ov4}
# namespace ::foo defines ov1, ov2, ov3
# namespace ::foo::bar defines ov2, ov3
@@ -331,83 +474,96 @@ file delete msgdir
# ov4 should be resolved in none, and call mcunknown
#
-namespace eval ::foo {
- ::msgcat::mcset foo ov1 "ov1_foo"
- ::msgcat::mcset foo ov2 "ov2_foo"
- ::msgcat::mcset foo ov3 "ov3_foo"
+ variable result
+ array set result {
+ foo,ov1 ov1_foo foo,ov2 ov2_foo foo,ov3 ov3_foo foo,ov4 ov4
+ foo::bar,ov1 ov1_foo foo::bar,ov2 ov2_foo_bar
+ foo::bar,ov3 ov3_foo_bar foo::bar,ov4 ov4 foo::bar::baz,ov1 ov1_foo
+ foo::bar::baz,ov2 ov2_foo_bar foo::bar::baz,ov3 ov3_foo_bar_baz
+ foo::bar::baz,ov4 ov4
+ }
+ variable count 1
+ variable ns
+ foreach ns {foo foo::bar foo::bar::baz} {
+ foreach string {ov1 ov2 ov3 ov4} {
+ test msgcat-6.$count {mcset, overlap} -setup {
+ namespace eval foo {
+ ::msgcat::mcset foo ov1 ov1_foo
+ ::msgcat::mcset foo ov2 ov2_foo
+ ::msgcat::mcset foo ov3 ov3_foo
+ namespace eval bar {
+ ::msgcat::mcset foo ov2 ov2_foo_bar
+ ::msgcat::mcset foo ov3 ov3_foo_bar
+ namespace eval baz {
+ ::msgcat::mcset foo ov3 "ov3_foo_bar_baz"
+ }
+ }
+
+ }
+ variable locale [mclocale]
+ mclocale foo
+ } -cleanup {
+ mclocale $locale
+ namespace delete foo
+ } -body {
+ namespace eval $ns [list ::msgcat::mc $string]
+ } -result $result($ns,$string)
+ incr count
+ }
+ }
+
+ # Tests msgcat-7.*: [mc] extra args processed by [format]
+
+ test msgcat-7.1 {mc extra args go through to format} -setup {
+ mcset foo format1 "this is a test"
+ mcset foo format2 "this is a %s"
+ mcset foo format3 "this is a %s %s"
+ variable locale [mclocale]
+ mclocale foo
+ } -cleanup {
+ mclocale $locale
+ } -body {
+ mc format1 "good test"
+ } -result "this is a test"
+
+ test msgcat-7.2 {mc extra args go through to format} -setup {
+ mcset foo format1 "this is a test"
+ mcset foo format2 "this is a %s"
+ mcset foo format3 "this is a %s %s"
+ variable locale [mclocale]
+ mclocale foo
+ } -cleanup {
+ mclocale $locale
+ } -body {
+ mc format2 "good test"
+ } -result "this is a good test"
+
+ test msgcat-7.3 {mc errors from format are propagated} -setup {
+ mcset foo format1 "this is a test"
+ mcset foo format2 "this is a %s"
+ mcset foo format3 "this is a %s %s"
+ variable locale [mclocale]
+ mclocale foo
+ } -cleanup {
+ mclocale $locale
+ } -body {
+ catch {mc format3 "good test"}
+ } -result 1
+
+ test msgcat-7.4 {mc, extra args are given to unknown} -setup {
+ mcset foo format1 "this is a test"
+ mcset foo format2 "this is a %s"
+ mcset foo format3 "this is a %s %s"
+ variable locale [mclocale]
+ mclocale foo
+ } -cleanup {
+ mclocale $locale
+ } -body {
+ mc "this is a %s" "good test"
+ } -result "this is a good test"
+
+ cleanupTests
}
-namespace eval ::foo::bar {
- ::msgcat::mcset foo ov2 "ov2_foo_bar"
- ::msgcat::mcset foo ov3 "ov3_foo_bar"
-}
-namespace eval ::foo::bar::baz {
- ::msgcat::mcset foo ov3 "ov3_foo_bar_baz"
-}
-::msgcat::mclocale foo
-
-# namespace ::foo
-test msgcat-6.1 {::msgcat::mc, namespace resolution} {
- namespace eval ::foo {::msgcat::mc ov1}
-} {ov1_foo}
-test msgcat-6.2 {::msgcat::mc, namespace resolution} {
- namespace eval ::foo {::msgcat::mc ov2}
-} {ov2_foo}
-test msgcat-6.3 {::msgcat::mc, namespace resolution} {
- namespace eval ::foo {::msgcat::mc ov3}
-} {ov3_foo}
-test msgcat-6.4 {::msgcat::mc, namespace resolution} {
- namespace eval ::foo {::msgcat::mc ov4}
-} {ov4}
-# namespace ::foo::bar
-test msgcat-6.5 {::msgcat::mc, namespace resolution} {
- namespace eval ::foo::bar {::msgcat::mc ov1}
-} {ov1_foo}
-test msgcat-6.6 {::msgcat::mc, namespace resolution} {
- namespace eval ::foo::bar {::msgcat::mc ov2}
-} {ov2_foo_bar}
-test msgcat-6.7 {::msgcat::mc, namespace resolution} {
- namespace eval ::foo::bar {::msgcat::mc ov3}
-} {ov3_foo_bar}
-test msgcat-6.8 {::msgcat::mc, namespace resolution} {
- namespace eval ::foo::bar {::msgcat::mc ov4}
-} {ov4}
-# namespace ::foo
-test msgcat-6.9 {::msgcat::mc, namespace resolution} {
- namespace eval ::foo::bar::baz {::msgcat::mc ov1}
-} {ov1_foo}
-test msgcat-6.10 {::msgcat::mc, namespace resolution} {
- namespace eval ::foo::bar::baz {::msgcat::mc ov2}
-} {ov2_foo_bar}
-test msgcat-6.11 {::msgcat::mc, namespace resolution} {
- namespace eval ::foo::bar::baz {::msgcat::mc ov3}
-} {ov3_foo_bar_baz}
-test msgcat-6.12 {::msgcat::mc, namespace resolution} {
- namespace eval ::foo::bar::baz {::msgcat::mc ov4}
-} {ov4}
-
-namespace delete ::foo::bar::baz ::foo::bar ::foo
-
-::msgcat::mclocale foo
-::msgcat::mcset foo format1 "this is a test"
-::msgcat::mcset foo format2 "this is a %s"
-::msgcat::mcset foo format3 "this is a %s %s"
-
-test msgcat-7.1 {::msgcat::mc, extra args go through to format} {
- ::msgcat::mc format1 "good test"
-} "this is a test"
-test msgcat-7.2 {::msgcat::mc, extra args go through to format} {
- ::msgcat::mc format2 "good test"
-} "this is a good test"
-test msgcat-7.3 {::msgcat::mc, errors from format are propagated} {
- catch {::msgcat::mc format3 "good test"}
-} 1
-test msgcat-7.4 {::msgcat::mc, extra args are given to unknown} {
- ::msgcat::mc "this is a %s" "good test"
-} "this is a good test"
-
-# Reset the locale
-::msgcat::mclocale $oldlocale
-
-::tcltest::cleanupTests
+namespace delete ::msgcat::test
return
diff --git a/tcl/tests/namespace-old.test b/tcl/tests/namespace-old.test
index 76febca8681..86b86e4172a 100644
--- a/tcl/tests/namespace-old.test
+++ b/tcl/tests/namespace-old.test
@@ -804,17 +804,17 @@ 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}}
+} {::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}}
+} {::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}
+} {::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}]
@@ -862,4 +862,3 @@ return
-
diff --git a/tcl/tests/namespace.test b/tcl/tests/namespace.test
index 0e32f270a5a..3a1c1ccb4fc 100644
--- a/tcl/tests/namespace.test
+++ b/tcl/tests/namespace.test
@@ -6,7 +6,7 @@
# errors. No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# 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.
@@ -14,7 +14,7 @@
# RCS: @(#) $Id$
if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+ package require tcltest 2
namespace import -force ::tcltest::*
}
@@ -641,7 +641,7 @@ test namespace-20.1 {Tcl_NamespaceObjCmd, bad subcommand} {
} {1 {wrong # args: should be "namespace subcommand ?arg ...?"}}
test namespace-20.2 {Tcl_NamespaceObjCmd, bad subcommand} {
list [catch {namespace wombat {}} msg] $msg
-} {1 {bad option "wombat": must be children, code, current, delete, eval, export, forget, import, inscope, origin, parent, qualifiers, tail, or which}}
+} {1 {bad option "wombat": must be children, code, current, delete, eval, exists, export, forget, import, inscope, origin, parent, qualifiers, tail, or which}}
test namespace-20.3 {Tcl_NamespaceObjCmd, abbreviations are okay} {
namespace ch :: test_ns_*
} {}
@@ -694,12 +694,23 @@ test namespace-22.3 {NamespaceCodeCmd, arg is already scoped value} {
} {namespace inscope ::test_ns_1 cmd}
test namespace-22.4 {NamespaceCodeCmd, in :: namespace} {
namespace code unknown
-} {namespace inscope :: unknown}
+} {::namespace inscope :: unknown}
test namespace-22.5 {NamespaceCodeCmd, in other namespace} {
namespace eval test_ns_1 {
namespace code cmd
}
-} {namespace inscope ::test_ns_1 cmd}
+} {::namespace inscope ::test_ns_1 cmd}
+test namespace-22.6 {NamespaceCodeCmd, in other namespace} {
+ namespace eval test_ns_1 {
+ variable v 42
+ }
+ namespace eval test_ns_2 {
+ proc namespace args {}
+ }
+ namespace eval test_ns_2 [namespace eval test_ns_1 {
+ namespace code {set v}
+ }]
+} {42}
test namespace-23.1 {NamespaceCurrentCmd, bad args} {
catch {eval namespace delete [namespace children :: test_ns_*]}
@@ -737,7 +748,7 @@ test namespace-25.1 {NamespaceEvalCmd, bad args} {
} {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
test namespace-25.2 {NamespaceEvalCmd, bad args} {
list [catch {namespace test_ns_1} msg] $msg
-} {1 {bad option "test_ns_1": must be children, code, current, delete, eval, export, forget, import, inscope, origin, parent, qualifiers, tail, or which}}
+} {1 {bad option "test_ns_1": must be children, code, current, delete, eval, exists, export, forget, import, inscope, origin, parent, qualifiers, tail, or which}}
catch {unset v}
test namespace-25.3 {NamespaceEvalCmd, new namespace} {
set v 123
@@ -1094,6 +1105,85 @@ test namespace-38.1 {UpdateStringOfNsName} {
[namespace eval {} {namespace current}]
} {:: ::}
+test namespace-39.1 {NamespaceExistsCmd} {
+ catch {eval namespace delete [namespace children :: test_ns_*]}
+ namespace eval ::test_ns_z::test_me { variable foo }
+ list [namespace exists ::] \
+ [namespace exists ::bogus_namespace] \
+ [namespace exists ::test_ns_z] \
+ [namespace exists test_ns_z] \
+ [namespace exists ::test_ns_z::foo] \
+ [namespace exists ::test_ns_z::test_me] \
+ [namespace eval ::test_ns_z { namespace exists ::test_me }] \
+ [namespace eval ::test_ns_z { namespace exists test_me }] \
+ [namespace exists :::::test_ns_z]
+} {1 0 1 1 0 1 0 1 1}
+test namespace-39.2 {NamespaceExistsCmd error} {
+ list [catch {namespace exists} msg] $msg
+} {1 {wrong # args: should be "namespace exists name"}}
+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"} {
+ rename unknown _unknown
+ 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]]
+ rename unknown {}
+ rename _unknown unknown
+ namespace delete ns
+ set l
+} {global global}
+
+test namespace-41.1 {Shadowing byte-compiled commands, Bug: 231259} {
+ set res {}
+ namespace eval ns {
+ set res {}
+ proc test {} {
+ set ::g 0
+ }
+ lappend ::res [test]
+ proc set {a b} {
+ ::set a [incr b]
+ }
+ lappend ::res [test]
+ }
+ namespace delete ns
+ set res
+} {0 1}
+
+test namespace-41.2 {Shadowing byte-compiled commands, Bug: 231259} {
+ set res {}
+ namespace eval ns {}
+ proc ns::a {i} {
+ variable b
+ proc set args {return "New proc is called"}
+ return [set b $i]
+ }
+ ns::a 1
+ set res [ns::a 2]
+ namespace delete ns
+ set res
+} {New proc is called}
+
+test namespace-41.3 {Shadowing byte-compiled commands, Bug: 231259} {knownBug} {
+ 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
+} {{New proc is called} 0}
+
# cleanup
catch {rename cmd1 {}}
catch {unset l}
@@ -1114,4 +1204,3 @@ return
-
diff --git a/tcl/tests/obj.test b/tcl/tests/obj.test
index 74ec8685e00..2f26ed36acc 100644
--- a/tcl/tests/obj.test
+++ b/tcl/tests/obj.test
@@ -27,7 +27,20 @@ if {[info commands testobj] == {}} {
test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} {
set r 1
- foreach {t} {list boolean cmdName bytecode string int double} {
+ foreach {t} {
+ {array search}
+ boolean
+ bytearray
+ bytecode
+ double
+ end-offset
+ index
+ int
+ list
+ nsName
+ procbody
+ string
+ } {
set first [string first $t [testobj types]]
set r [expr {$r && ($first != -1)}]
}
@@ -184,6 +197,18 @@ test obj-11.4 {Tcl_GetBooleanFromObj, error converting from "empty string"} {
lappend result [catch {testbooleanobj not 1} msg]
lappend result $msg
} {{} 1 {expected boolean value but got ""}}
+test obj-11.5 {Tcl_GetBooleanFromObj, convert hex to boolean} {
+ set result ""
+ lappend result [teststringobj set 1 0xac]
+ lappend result [testbooleanobj not 1]
+ lappend result [testobj type 1]
+} {0xac 0 boolean}
+test obj-11.6 {Tcl_GetBooleanFromObj, convert float to boolean} {
+ set result ""
+ lappend result [teststringobj set 1 5.42]
+ lappend result [testbooleanobj not 1]
+ lappend result [testobj type 1]
+} {5.42 0 boolean}
test obj-12.1 {DupBooleanInternalRep} {
set result ""
@@ -528,21 +553,52 @@ test obj-30.1 {Ref counting and object deletion, simple types} {
lappend result [testobj refcount 2]
} {{} 1024 1024 int 4 4 0 boolean 3 2}
+
+test obj-31.1 {regenerate string rep of "end"} {
+ testobj freeallvars
+ teststringobj set 1 end
+ testobj convert 1 end-offset
+ testobj invalidateStringRep 1
+} end
+
+test obj-31.2 {regenerate string rep of "end-1"} {
+ testobj freeallvars
+ teststringobj set 1 end-0x1
+ testobj convert 1 end-offset
+ testobj invalidateStringRep 1
+} end-1
+
+test obj-31.3 {regenerate string rep of "end--1"} {
+ testobj freeallvars
+ teststringobj set 1 end--0x1
+ testobj convert 1 end-offset
+ testobj invalidateStringRep 1
+} end--1
+
+test obj-31.4 {regenerate string rep of "end-bigInteger"} {
+ testobj freeallvars
+ teststringobj set 1 end-0x7fffffff
+ testobj convert 1 end-offset
+ testobj invalidateStringRep 1
+} end-2147483647
+
+test obj-31.5 {regenerate string rep of "end--bigInteger"} {
+ testobj freeallvars
+ teststringobj set 1 end--0x7fffffff
+ testobj convert 1 end-offset
+ testobj invalidateStringRep 1
+} end--2147483647
+
+
+test obj-31.6 {regenerate string rep of "end--bigInteger"} {nonPortable} {
+ testobj freeallvars
+ teststringobj set 1 end--0x80000000
+ testobj convert 1 end-offset
+ testobj invalidateStringRep 1
+} end--2147483648
+
testobj freeallvars
# cleanup
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tcl/tests/opt.test b/tcl/tests/opt.test
index 55a565685eb..adb6cf1cf12 100644
--- a/tcl/tests/opt.test
+++ b/tcl/tests/opt.test
@@ -280,4 +280,3 @@ return
-
diff --git a/tcl/tests/osa.test b/tcl/tests/osa.test
index df6935af23e..c820846a313 100644
--- a/tcl/tests/osa.test
+++ b/tcl/tests/osa.test
@@ -46,4 +46,3 @@ return
-
diff --git a/tcl/tests/package.test b/tcl/tests/package.test
index 13c06e43b09..0bab8f66c99 100644
--- a/tcl/tests/package.test
+++ b/tcl/tests/package.test
@@ -69,4 +69,3 @@ test package-1.16 {pkg::create gives correct output for 1 direct, 1 lazy} {
::tcltest::cleanupTests
return
-
diff --git a/tcl/tests/parse.test b/tcl/tests/parse.test
index 3d399828c17..1037b790c9e 100644
--- a/tcl/tests/parse.test
+++ b/tcl/tests/parse.test
@@ -732,6 +732,10 @@ test parse-16.1 {Tcl_EvalEx, check termOffset is set correctly for non TCL_OK ca
subst {[eval {return foo}]bar}
} foobar
+test parse-17.1 {Correct return codes from errors during substitution} {
+ catch {eval {w[continue]}}
+} 4
+
# cleanup
catch {unset a}
::tcltest::cleanupTests
@@ -749,4 +753,3 @@ return
-
diff --git a/tcl/tests/parseExpr.test b/tcl/tests/parseExpr.test
index 49d2ff73572..9d0e034bbb7 100644
--- a/tcl/tests/parseExpr.test
+++ b/tcl/tests/parseExpr.test
@@ -27,35 +27,40 @@ if {[info commands testexprparser] == {}} {
return
}
+# Some tests only work if wide integers (>32bit) are not found to be
+# integers at all.
+set ::tcltest::testConstraints(wideIntegerUnparsed) \
+ [expr {-1 == 0xffffffff}]
+
test parseExpr-1.1 {Tcl_ParseExpr procedure, computing string length} {
testexprparser [bytestring "1+2\0 +3"] -1
} {- {} 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}}
test parseExpr-1.2 {Tcl_ParseExpr procedure, computing string length} {
testexprparser "1 + 2" -1
} {- {} 0 subexpr {1 + 2} 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}}
-test parseExpr-1.3 {Tcl_ParseExpr procedure, error getting initial lexeme} {nonPortable} {
+test parseExpr-1.3 {Tcl_ParseExpr procedure, error getting initial lexeme} {wideIntegerUnparsed} {
list [catch {testexprparser {12345678901234567890} -1} msg] $msg
} {1 {integer value too large to represent}}
test parseExpr-1.4 {Tcl_ParseExpr procedure, error in conditional expression} {
list [catch {testexprparser {foo+} -1} msg] $msg
-} {1 {syntax error in expression "foo+"}}
+} {1 {syntax error in expression "foo+": variable references require preceding $}}
test parseExpr-1.5 {Tcl_ParseExpr procedure, lexemes after the expression} {
list [catch {testexprparser {1+2 345} -1} msg] $msg
-} {1 {syntax error in expression "1+2 345"}}
+} {1 {syntax error in expression "1+2 345": extra tokens at end of expression}}
test parseExpr-2.1 {ParseCondExpr procedure, valid test subexpr} {
testexprparser {2>3? 1 : 0} -1
} {- {} 0 subexpr {2>3? 1 : 0} 11 operator ? 0 subexpr 2>3 5 operator > 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
test parseExpr-2.2 {ParseCondExpr procedure, error in test subexpr} {
list [catch {testexprparser {0 || foo} -1} msg] $msg
-} {1 {syntax error in expression "0 || foo"}}
+} {1 {syntax error in expression "0 || foo": variable references require preceding $}}
test parseExpr-2.3 {ParseCondExpr procedure, next lexeme isn't "?"} {
testexprparser {1+2} -1
} {- {} 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}}
test parseExpr-2.4 {ParseCondExpr procedure, next lexeme is "?"} {
testexprparser {1+2 ? 3 : 4} -1
} {- {} 0 subexpr {1+2 ? 3 : 4} 11 operator ? 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
-test parseExpr-2.5 {ParseCondExpr procedure, bad lexeme after "?"} {nonPortable} {
+test parseExpr-2.5 {ParseCondExpr procedure, bad lexeme after "?"} {wideIntegerUnparsed} {
list [catch {testexprparser {1+2 ? 12345678901234567890} -1} msg] $msg
} {1 {integer value too large to represent}}
test parseExpr-2.6 {ParseCondExpr procedure, valid "then" subexpression} {
@@ -63,30 +68,30 @@ test parseExpr-2.6 {ParseCondExpr procedure, valid "then" subexpression} {
} {- {} 0 subexpr {1? 3 : 4} 7 operator ? 0 subexpr 1 1 text 1 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
test parseExpr-2.7 {ParseCondExpr procedure, error in "then" subexpression} {
list [catch {testexprparser {1? fred : martha} -1} msg] $msg
-} {1 {syntax error in expression "1? fred : martha"}}
+} {1 {syntax error in expression "1? fred : martha": variable references require preceding $}}
test parseExpr-2.8 {ParseCondExpr procedure, lexeme after "then" subexpr isn't ":"} {
list [catch {testexprparser {1? 2 martha 3} -1} msg] $msg
-} {1 {syntax error in expression "1? 2 martha 3"}}
+} {1 {syntax error in expression "1? 2 martha 3": missing colon from ternary conditional}}
test parseExpr-2.9 {ParseCondExpr procedure, valid "else" subexpression} {
testexprparser {27||3? 3 : 4&&9} -1
} {- {} 0 subexpr {27||3? 3 : 4&&9} 15 operator ? 0 subexpr 27||3 5 operator || 0 subexpr 27 1 text 27 0 subexpr 3 1 text 3 0 subexpr 3 1 text 3 0 subexpr 4&&9 5 operator && 0 subexpr 4 1 text 4 0 subexpr 9 1 text 9 0 {}}
test parseExpr-2.10 {ParseCondExpr procedure, error in "else" subexpression} {
list [catch {testexprparser {1? 2 : martha} -1} msg] $msg
-} {1 {syntax error in expression "1? 2 : martha"}}
+} {1 {syntax error in expression "1? 2 : martha": variable references require preceding $}}
test parseExpr-3.1 {ParseLorExpr procedure, valid logical and subexpr} {
testexprparser {1&&2 || 3} -1
} {- {} 0 subexpr {1&&2 || 3} 9 operator || 0 subexpr 1&&2 5 operator && 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
test parseExpr-3.2 {ParseLorExpr procedure, error in logical and subexpr} {
list [catch {testexprparser {1&&foo || 3} -1} msg] $msg
-} {1 {syntax error in expression "1&&foo || 3"}}
+} {1 {syntax error in expression "1&&foo || 3": variable references require preceding $}}
test parseExpr-3.3 {ParseLorExpr procedure, next lexeme isn't "||"} {
testexprparser {1&&2? 1 : 0} -1
} {- {} 0 subexpr {1&&2? 1 : 0} 11 operator ? 0 subexpr 1&&2 5 operator && 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
test parseExpr-3.4 {ParseLorExpr procedure, next lexeme is "||"} {
testexprparser {1&&2 || 3} -1
} {- {} 0 subexpr {1&&2 || 3} 9 operator || 0 subexpr 1&&2 5 operator && 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-3.5 {ParseLorExpr procedure, bad lexeme after "||"} {nonPortable} {
+test parseExpr-3.5 {ParseLorExpr procedure, bad lexeme after "||"} {wideIntegerUnparsed} {
list [catch {testexprparser {1&&2 || 12345678901234567890} -1} msg] $msg
} {1 {integer value too large to represent}}
test parseExpr-3.6 {ParseLorExpr procedure, valid RHS subexpression} {
@@ -94,21 +99,21 @@ test parseExpr-3.6 {ParseLorExpr procedure, valid RHS subexpression} {
} {- {} 0 subexpr {1&&2 || 3 || 4} 13 operator || 0 subexpr {1&&2 || 3} 9 operator || 0 subexpr 1&&2 5 operator && 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
test parseExpr-3.7 {ParseLorExpr procedure, error in RHS subexpression} {
list [catch {testexprparser {1&&2 || 3 || martha} -1} msg] $msg
-} {1 {syntax error in expression "1&&2 || 3 || martha"}}
+} {1 {syntax error in expression "1&&2 || 3 || martha": variable references require preceding $}}
test parseExpr-4.1 {ParseLandExpr procedure, valid LHS "|" subexpr} {
testexprparser {1|2 && 3} -1
} {- {} 0 subexpr {1|2 && 3} 9 operator && 0 subexpr 1|2 5 operator | 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
test parseExpr-4.2 {ParseLandExpr procedure, error in LHS "|" subexpr} {
list [catch {testexprparser {1&&foo && 3} -1} msg] $msg
-} {1 {syntax error in expression "1&&foo && 3"}}
+} {1 {syntax error in expression "1&&foo && 3": variable references require preceding $}}
test parseExpr-4.3 {ParseLandExpr procedure, next lexeme isn't "&&"} {
testexprparser {1|2? 1 : 0} -1
} {- {} 0 subexpr {1|2? 1 : 0} 11 operator ? 0 subexpr 1|2 5 operator | 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
test parseExpr-4.4 {ParseLandExpr procedure, next lexeme is "&&"} {
testexprparser {1|2 && 3} -1
} {- {} 0 subexpr {1|2 && 3} 9 operator && 0 subexpr 1|2 5 operator | 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-4.5 {ParseLandExpr procedure, bad lexeme after "&&"} {nonPortable} {
+test parseExpr-4.5 {ParseLandExpr procedure, bad lexeme after "&&"} {wideIntegerUnparsed} {
list [catch {testexprparser {1|2 && 12345678901234567890} -1} msg] $msg
} {1 {integer value too large to represent}}
test parseExpr-4.6 {ParseLandExpr procedure, valid RHS subexpression} {
@@ -116,21 +121,21 @@ test parseExpr-4.6 {ParseLandExpr procedure, valid RHS subexpression} {
} {- {} 0 subexpr {1|2 && 3 && 4} 13 operator && 0 subexpr {1|2 && 3} 9 operator && 0 subexpr 1|2 5 operator | 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
test parseExpr-4.7 {ParseLandExpr procedure, error in RHS subexpression} {
list [catch {testexprparser {1|2 && 3 && martha} -1} msg] $msg
-} {1 {syntax error in expression "1|2 && 3 && martha"}}
+} {1 {syntax error in expression "1|2 && 3 && martha": variable references require preceding $}}
test parseExpr-5.1 {ParseBitOrExpr procedure, valid LHS "^" subexpr} {
testexprparser {1^2 | 3} -1
} {- {} 0 subexpr {1^2 | 3} 9 operator | 0 subexpr 1^2 5 operator ^ 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
test parseExpr-5.2 {ParseBitOrExpr procedure, error in LHS "^" subexpr} {
list [catch {testexprparser {1|foo | 3} -1} msg] $msg
-} {1 {syntax error in expression "1|foo | 3"}}
+} {1 {syntax error in expression "1|foo | 3": variable references require preceding $}}
test parseExpr-5.3 {ParseBitOrExpr procedure, next lexeme isn't "|"} {
testexprparser {1^2? 1 : 0} -1
} {- {} 0 subexpr {1^2? 1 : 0} 11 operator ? 0 subexpr 1^2 5 operator ^ 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
test parseExpr-5.4 {ParseBitOrExpr procedure, next lexeme is "|"} {
testexprparser {1^2 | 3} -1
} {- {} 0 subexpr {1^2 | 3} 9 operator | 0 subexpr 1^2 5 operator ^ 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-5.5 {ParseBitOrExpr procedure, bad lexeme after "|"} {nonPortable} {
+test parseExpr-5.5 {ParseBitOrExpr procedure, bad lexeme after "|"} {wideIntegerUnparsed} {
list [catch {testexprparser {1^2 | 12345678901234567890} -1} msg] $msg
} {1 {integer value too large to represent}}
test parseExpr-5.6 {ParseBitOrExpr procedure, valid RHS subexpression} {
@@ -138,21 +143,21 @@ test parseExpr-5.6 {ParseBitOrExpr procedure, valid RHS subexpression} {
} {- {} 0 subexpr {1^2 | 3 | 4} 13 operator | 0 subexpr {1^2 | 3} 9 operator | 0 subexpr 1^2 5 operator ^ 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
test parseExpr-5.7 {ParseBitOrExpr procedure, error in RHS subexpression} {
list [catch {testexprparser {1^2 | 3 | martha} -1} msg] $msg
-} {1 {syntax error in expression "1^2 | 3 | martha"}}
+} {1 {syntax error in expression "1^2 | 3 | martha": variable references require preceding $}}
test parseExpr-6.1 {ParseBitXorExpr procedure, valid LHS "&" subexpr} {
testexprparser {1&2 ^ 3} -1
} {- {} 0 subexpr {1&2 ^ 3} 9 operator ^ 0 subexpr 1&2 5 operator & 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
test parseExpr-6.2 {ParseBitXorExpr procedure, error in LHS "&" subexpr} {
list [catch {testexprparser {1^foo ^ 3} -1} msg] $msg
-} {1 {syntax error in expression "1^foo ^ 3"}}
+} {1 {syntax error in expression "1^foo ^ 3": variable references require preceding $}}
test parseExpr-6.3 {ParseBitXorExpr procedure, next lexeme isn't "^"} {
testexprparser {1&2? 1 : 0} -1
} {- {} 0 subexpr {1&2? 1 : 0} 11 operator ? 0 subexpr 1&2 5 operator & 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
test parseExpr-6.4 {ParseBitXorExpr procedure, next lexeme is "^"} {
testexprparser {1&2 ^ 3} -1
} {- {} 0 subexpr {1&2 ^ 3} 9 operator ^ 0 subexpr 1&2 5 operator & 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-6.5 {ParseBitXorExpr procedure, bad lexeme after "^"} {nonPortable} {
+test parseExpr-6.5 {ParseBitXorExpr procedure, bad lexeme after "^"} {wideIntegerUnparsed} {
list [catch {testexprparser {1&2 ^ 12345678901234567890} -1} msg] $msg
} {1 {integer value too large to represent}}
test parseExpr-6.6 {ParseBitXorExpr procedure, valid RHS subexpression} {
@@ -160,21 +165,21 @@ test parseExpr-6.6 {ParseBitXorExpr procedure, valid RHS subexpression} {
} {- {} 0 subexpr {1&2 ^ 3 ^ 4} 13 operator ^ 0 subexpr {1&2 ^ 3} 9 operator ^ 0 subexpr 1&2 5 operator & 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
test parseExpr-6.7 {ParseBitXorExpr procedure, error in RHS subexpression} {
list [catch {testexprparser {1&2 ^ 3 ^ martha} -1} msg] $msg
-} {1 {syntax error in expression "1&2 ^ 3 ^ martha"}}
+} {1 {syntax error in expression "1&2 ^ 3 ^ martha": variable references require preceding $}}
test parseExpr-7.1 {ParseBitAndExpr procedure, valid LHS equality subexpr} {
testexprparser {1==2 & 3} -1
} {- {} 0 subexpr {1==2 & 3} 9 operator & 0 subexpr 1==2 5 operator == 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
test parseExpr-7.2 {ParseBitAndExpr procedure, error in LHS equality subexpr} {
list [catch {testexprparser {1!=foo & 3} -1} msg] $msg
-} {1 {syntax error in expression "1!=foo & 3"}}
+} {1 {syntax error in expression "1!=foo & 3": variable references require preceding $}}
test parseExpr-7.3 {ParseBitAndExpr procedure, next lexeme isn't "&"} {
testexprparser {1==2? 1 : 0} -1
} {- {} 0 subexpr {1==2? 1 : 0} 11 operator ? 0 subexpr 1==2 5 operator == 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
test parseExpr-7.4 {ParseBitAndExpr procedure, next lexeme is "&"} {
testexprparser {1>2 & 3} -1
} {- {} 0 subexpr {1>2 & 3} 9 operator & 0 subexpr 1>2 5 operator > 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-7.5 {ParseBitAndExpr procedure, bad lexeme after "&"} {nonPortable} {
+test parseExpr-7.5 {ParseBitAndExpr procedure, bad lexeme after "&"} {wideIntegerUnparsed} {
list [catch {testexprparser {1==2 & 12345678901234567890} -1} msg] $msg
} {1 {integer value too large to represent}}
test parseExpr-7.6 {ParseBitAndExpr procedure, valid RHS subexpression} {
@@ -182,458 +187,456 @@ test parseExpr-7.6 {ParseBitAndExpr procedure, valid RHS subexpression} {
} {- {} 0 subexpr {1<2 & 3 & 4} 13 operator & 0 subexpr {1<2 & 3} 9 operator & 0 subexpr 1<2 5 operator < 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
test parseExpr-7.7 {ParseBitAndExpr procedure, error in RHS subexpression} {
list [catch {testexprparser {1==2 & 3>2 & martha} -1} msg] $msg
-} {1 {syntax error in expression "1==2 & 3>2 & martha"}}
+} {1 {syntax error in expression "1==2 & 3>2 & martha": variable references require preceding $}}
-test parseExpr-7.1 {ParseEqualityExpr procedure, valid LHS relational subexpr} {
+test parseExpr-8.1 {ParseEqualityExpr procedure, valid LHS relational subexpr} {
testexprparser {1<2 == 3} -1
} {- {} 0 subexpr {1<2 == 3} 9 operator == 0 subexpr 1<2 5 operator < 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-7.2 {ParseEqualityExpr procedure, error in LHS relational subexpr} {
+test parseExpr-8.2 {ParseEqualityExpr procedure, error in LHS relational subexpr} {
list [catch {testexprparser {1>=foo == 3} -1} msg] $msg
-} {1 {syntax error in expression "1>=foo == 3"}}
-test parseExpr-7.3 {ParseEqualityExpr procedure, next lexeme isn't "==" or "!="} {
+} {1 {syntax error in expression "1>=foo == 3": variable references require preceding $}}
+test parseExpr-8.3 {ParseEqualityExpr procedure, next lexeme isn't "==" or "!="} {
testexprparser {1<2? 1 : 0} -1
} {- {} 0 subexpr {1<2? 1 : 0} 11 operator ? 0 subexpr 1<2 5 operator < 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
-test parseExpr-7.4 {ParseEqualityExpr procedure, next lexeme is "==" or "!=} {
+test parseExpr-8.4 {ParseEqualityExpr procedure, next lexeme is "==" or "!="} {
testexprparser {1<2 == 3} -1
} {- {} 0 subexpr {1<2 == 3} 9 operator == 0 subexpr 1<2 5 operator < 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-7.5 {ParseEqualityExpr procedure, next lexeme is "==" or "!="} {
+test parseExpr-8.5 {ParseEqualityExpr procedure, next lexeme is "==" or "!="} {
testexprparser {1<2 != 3} -1
} {- {} 0 subexpr {1<2 != 3} 9 operator != 0 subexpr 1<2 5 operator < 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-7.6 {ParseEqualityExpr procedure, bad lexeme after "==" or "!="} {nonPortable} {
+test parseExpr-8.6 {ParseEqualityExpr procedure, bad lexeme after "==" or "!="} {wideIntegerUnparsed} {
list [catch {testexprparser {1<2 == 12345678901234567890} -1} msg] $msg
} {1 {integer value too large to represent}}
-test parseExpr-7.7 {ParseEqualityExpr procedure, valid RHS subexpression} {
+test parseExpr-8.7 {ParseEqualityExpr procedure, valid RHS subexpression} {
testexprparser {1<2 == 3 == 4} -1
} {- {} 0 subexpr {1<2 == 3 == 4} 13 operator == 0 subexpr {1<2 == 3} 9 operator == 0 subexpr 1<2 5 operator < 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
-test parseExpr-7.8 {ParseEqualityExpr procedure, error in RHS subexpression} {
+test parseExpr-8.8 {ParseEqualityExpr procedure, error in RHS subexpression} {
list [catch {testexprparser {1<2 == 3 != martha} -1} msg] $msg
-} {1 {syntax error in expression "1<2 == 3 != martha"}}
+} {1 {syntax error in expression "1<2 == 3 != martha": variable references require preceding $}}
-test parseExpr-8.1 {ParseRelationalExpr procedure, valid LHS shift subexpr} {
+test parseExpr-9.1 {ParseRelationalExpr procedure, valid LHS shift subexpr} {
testexprparser {1<<2 < 3} -1
} {- {} 0 subexpr {1<<2 < 3} 9 operator < 0 subexpr 1<<2 5 operator << 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-8.2 {ParseRelationalExpr procedure, error in LHS shift subexpr} {
+test parseExpr-9.2 {ParseRelationalExpr procedure, error in LHS shift subexpr} {
list [catch {testexprparser {1>=foo < 3} -1} msg] $msg
-} {1 {syntax error in expression "1>=foo < 3"}}
-test parseExpr-8.3 {ParseRelationalExpr procedure, next lexeme isn't relational op} {
+} {1 {syntax error in expression "1>=foo < 3": variable references require preceding $}}
+test parseExpr-9.3 {ParseRelationalExpr procedure, next lexeme isn't relational op} {
testexprparser {1<<2? 1 : 0} -1
} {- {} 0 subexpr {1<<2? 1 : 0} 11 operator ? 0 subexpr 1<<2 5 operator << 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
-test parseExpr-8.4 {ParseRelationalExpr procedure, next lexeme is relational op} {
+test parseExpr-9.4 {ParseRelationalExpr procedure, next lexeme is relational op} {
testexprparser {1<<2 < 3} -1
} {- {} 0 subexpr {1<<2 < 3} 9 operator < 0 subexpr 1<<2 5 operator << 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-8.5 {ParseRelationalExpr procedure, next lexeme is relational op} {
+test parseExpr-9.5 {ParseRelationalExpr procedure, next lexeme is relational op} {
testexprparser {1>>2 > 3} -1
} {- {} 0 subexpr {1>>2 > 3} 9 operator > 0 subexpr 1>>2 5 operator >> 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-8.6 {ParseRelationalExpr procedure, next lexeme is relational op} {
+test parseExpr-9.6 {ParseRelationalExpr procedure, next lexeme is relational op} {
testexprparser {1<<2 <= 3} -1
} {- {} 0 subexpr {1<<2 <= 3} 9 operator <= 0 subexpr 1<<2 5 operator << 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-8.7 {ParseRelationalExpr procedure, next lexeme is relational op} {
+test parseExpr-9.7 {ParseRelationalExpr procedure, next lexeme is relational op} {
testexprparser {1<<2 >= 3} -1
} {- {} 0 subexpr {1<<2 >= 3} 9 operator >= 0 subexpr 1<<2 5 operator << 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-8.8 {ParseRelationalExpr procedure, bad lexeme after relational op} {nonPortable} {
+test parseExpr-9.8 {ParseRelationalExpr procedure, bad lexeme after relational op} {wideIntegerUnparsed} {
list [catch {testexprparser {1<<2 < 12345678901234567890} -1} msg] $msg
} {1 {integer value too large to represent}}
-test parseExpr-8.9 {ParseRelationalExpr procedure, valid RHS subexpression} {
+test parseExpr-9.9 {ParseRelationalExpr procedure, valid RHS subexpression} {
testexprparser {1<<2 < 3 < 4} -1
} {- {} 0 subexpr {1<<2 < 3 < 4} 13 operator < 0 subexpr {1<<2 < 3} 9 operator < 0 subexpr 1<<2 5 operator << 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
-test parseExpr-8.8 {ParseRelationalExpr procedure, error in RHS subexpression} {
+test parseExpr-9.10 {ParseRelationalExpr procedure, error in RHS subexpression} {
list [catch {testexprparser {1<<2 < 3 > martha} -1} msg] $msg
-} {1 {syntax error in expression "1<<2 < 3 > martha"}}
+} {1 {syntax error in expression "1<<2 < 3 > martha": variable references require preceding $}}
-test parseExpr-9.1 {ParseShiftExpr procedure, valid LHS add subexpr} {
+test parseExpr-10.1 {ParseShiftExpr procedure, valid LHS add subexpr} {
testexprparser {1+2 << 3} -1
} {- {} 0 subexpr {1+2 << 3} 9 operator << 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-9.2 {ParseShiftExpr procedure, error in LHS add subexpr} {
+test parseExpr-10.2 {ParseShiftExpr procedure, error in LHS add subexpr} {
list [catch {testexprparser {1-foo << 3} -1} msg] $msg
-} {1 {syntax error in expression "1-foo << 3"}}
-test parseExpr-9.3 {ParseShiftExpr procedure, next lexeme isn't "<<" or ">>"} {
+} {1 {syntax error in expression "1-foo << 3": variable references require preceding $}}
+test parseExpr-10.3 {ParseShiftExpr procedure, next lexeme isn't "<<" or ">>"} {
testexprparser {1+2? 1 : 0} -1
} {- {} 0 subexpr {1+2? 1 : 0} 11 operator ? 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
-test parseExpr-9.4 {ParseShiftExpr procedure, next lexeme is "<<" or ">>} {
+test parseExpr-10.4 {ParseShiftExpr procedure, next lexeme is "<<" or ">>"} {
testexprparser {1+2 << 3} -1
} {- {} 0 subexpr {1+2 << 3} 9 operator << 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-9.5 {ParseShiftExpr procedure, next lexeme is "<<" or ">>"} {
+test parseExpr-10.5 {ParseShiftExpr procedure, next lexeme is "<<" or ">>"} {
testexprparser {1+2 >> 3} -1
} {- {} 0 subexpr {1+2 >> 3} 9 operator >> 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-9.6 {ParseShiftExpr procedure, bad lexeme after "<<" or ">>"} {nonPortable} {
+test parseExpr-10.6 {ParseShiftExpr procedure, bad lexeme after "<<" or ">>"} {wideIntegerUnparsed} {
list [catch {testexprparser {1+2 << 12345678901234567890} -1} msg] $msg
} {1 {integer value too large to represent}}
-test parseExpr-9.7 {ParseShiftExpr procedure, valid RHS subexpression} {
+test parseExpr-10.7 {ParseShiftExpr procedure, valid RHS subexpression} {
testexprparser {1+2 << 3 << 4} -1
} {- {} 0 subexpr {1+2 << 3 << 4} 13 operator << 0 subexpr {1+2 << 3} 9 operator << 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
-test parseExpr-9.8 {ParseShiftExpr procedure, error in RHS subexpression} {
+test parseExpr-10.8 {ParseShiftExpr procedure, error in RHS subexpression} {
list [catch {testexprparser {1+2 << 3 >> martha} -1} msg] $msg
-} {1 {syntax error in expression "1+2 << 3 >> martha"}}
+} {1 {syntax error in expression "1+2 << 3 >> martha": variable references require preceding $}}
-test parseExpr-10.1 {ParseAddExpr procedure, valid LHS multiply subexpr} {
+test parseExpr-11.1 {ParseAddExpr procedure, valid LHS multiply subexpr} {
testexprparser {1*2 + 3} -1
} {- {} 0 subexpr {1*2 + 3} 9 operator + 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-10.2 {ParseAddExpr procedure, error in LHS multiply subexpr} {
+test parseExpr-11.2 {ParseAddExpr procedure, error in LHS multiply subexpr} {
list [catch {testexprparser {1/foo + 3} -1} msg] $msg
-} {1 {syntax error in expression "1/foo + 3"}}
-test parseExpr-10.3 {ParseAddExpr procedure, next lexeme isn't "+" or "-"} {
+} {1 {syntax error in expression "1/foo + 3": variable references require preceding $}}
+test parseExpr-11.3 {ParseAddExpr procedure, next lexeme isn't "+" or "-"} {
testexprparser {1*2? 1 : 0} -1
} {- {} 0 subexpr {1*2? 1 : 0} 11 operator ? 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
-test parseExpr-10.4 {ParseAddExpr procedure, next lexeme is "+" or "-} {
+test parseExpr-11.4 {ParseAddExpr procedure, next lexeme is "+" or "-"} {
testexprparser {1*2 + 3} -1
} {- {} 0 subexpr {1*2 + 3} 9 operator + 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-10.5 {ParseAddExpr procedure, next lexeme is "+" or "-"} {
+test parseExpr-11.5 {ParseAddExpr procedure, next lexeme is "+" or "-"} {
testexprparser {1*2 - 3} -1
} {- {} 0 subexpr {1*2 - 3} 9 operator - 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-10.6 {ParseAddExpr procedure, bad lexeme after "+" or "-"} {nonPortable} {
+test parseExpr-11.6 {ParseAddExpr procedure, bad lexeme after "+" or "-"} {wideIntegerUnparsed} {
list [catch {testexprparser {1*2 + 12345678901234567890} -1} msg] $msg
} {1 {integer value too large to represent}}
-test parseExpr-10.7 {ParseAddExpr procedure, valid RHS subexpression} {
+test parseExpr-11.7 {ParseAddExpr procedure, valid RHS subexpression} {
testexprparser {1*2 + 3 + 4} -1
} {- {} 0 subexpr {1*2 + 3 + 4} 13 operator + 0 subexpr {1*2 + 3} 9 operator + 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
-test parseExpr-10.8 {ParseAddExpr procedure, error in RHS subexpression} {
+test parseExpr-11.8 {ParseAddExpr procedure, error in RHS subexpression} {
list [catch {testexprparser {1*2 + 3 - martha} -1} msg] $msg
-} {1 {syntax error in expression "1*2 + 3 - martha"}}
+} {1 {syntax error in expression "1*2 + 3 - martha": variable references require preceding $}}
-test parseExpr-10.1 {ParseAddExpr procedure, valid LHS multiply subexpr} {
+test parseExpr-12.1 {ParseAddExpr procedure, valid LHS multiply subexpr} {
testexprparser {1*2 + 3} -1
} {- {} 0 subexpr {1*2 + 3} 9 operator + 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-10.2 {ParseAddExpr procedure, error in LHS multiply subexpr} {
+test parseExpr-12.2 {ParseAddExpr procedure, error in LHS multiply subexpr} {
list [catch {testexprparser {1/foo + 3} -1} msg] $msg
-} {1 {syntax error in expression "1/foo + 3"}}
-test parseExpr-10.3 {ParseAddExpr procedure, next lexeme isn't "+" or "-"} {
+} {1 {syntax error in expression "1/foo + 3": variable references require preceding $}}
+test parseExpr-12.3 {ParseAddExpr procedure, next lexeme isn't "+" or "-"} {
testexprparser {1*2? 1 : 0} -1
} {- {} 0 subexpr {1*2? 1 : 0} 11 operator ? 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
-test parseExpr-10.4 {ParseAddExpr procedure, next lexeme is "+" or "-} {
+test parseExpr-12.4 {ParseAddExpr procedure, next lexeme is "+" or "-"} {
testexprparser {1*2 + 3} -1
} {- {} 0 subexpr {1*2 + 3} 9 operator + 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-10.5 {ParseAddExpr procedure, next lexeme is "+" or "-"} {
+test parseExpr-12.5 {ParseAddExpr procedure, next lexeme is "+" or "-"} {
testexprparser {1*2 - 3} -1
} {- {} 0 subexpr {1*2 - 3} 9 operator - 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-10.6 {ParseAddExpr procedure, bad lexeme after "+" or "-"} {nonPortable} {
+test parseExpr-12.6 {ParseAddExpr procedure, bad lexeme after "+" or "-"} {wideIntegerUnparsed} {
list [catch {testexprparser {1*2 + 12345678901234567890} -1} msg] $msg
} {1 {integer value too large to represent}}
-test parseExpr-10.7 {ParseAddExpr procedure, valid RHS subexpression} {
+test parseExpr-12.7 {ParseAddExpr procedure, valid RHS subexpression} {
testexprparser {1*2 + 3 + 4} -1
} {- {} 0 subexpr {1*2 + 3 + 4} 13 operator + 0 subexpr {1*2 + 3} 9 operator + 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
-test parseExpr-10.8 {ParseAddExpr procedure, error in RHS subexpression} {
+test parseExpr-12.8 {ParseAddExpr procedure, error in RHS subexpression} {
list [catch {testexprparser {1*2 + 3 - martha} -1} msg] $msg
-} {1 {syntax error in expression "1*2 + 3 - martha"}}
+} {1 {syntax error in expression "1*2 + 3 - martha": variable references require preceding $}}
-test parseExpr-11.1 {ParseMultiplyExpr procedure, valid LHS unary subexpr} {
+test parseExpr-13.1 {ParseMultiplyExpr procedure, valid LHS unary subexpr} {
testexprparser {+2 * 3} -1
} {- {} 0 subexpr {+2 * 3} 7 operator * 0 subexpr +2 3 operator + 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-11.2 {ParseMultiplyExpr procedure, error in LHS unary subexpr} {nonPortable} {
+test parseExpr-13.2 {ParseMultiplyExpr procedure, error in LHS unary subexpr} {wideIntegerUnparsed} {
list [catch {testexprparser {-12345678901234567890 * 3} -1} msg] $msg
} {1 {integer value too large to represent}}
-test parseExpr-11.3 {ParseMultiplyExpr procedure, next lexeme isn't "*", "/", or "%"} {
+test parseExpr-13.3 {ParseMultiplyExpr procedure, next lexeme isn't "*", "/", or "%"} {
testexprparser {+2? 1 : 0} -1
} {- {} 0 subexpr {+2? 1 : 0} 9 operator ? 0 subexpr +2 3 operator + 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
-test parseExpr-11.4 {ParseMultiplyExpr procedure, next lexeme is "*", "/", or "%"} {
+test parseExpr-13.4 {ParseMultiplyExpr procedure, next lexeme is "*", "/", or "%"} {
testexprparser {-123 * 3} -1
} {- {} 0 subexpr {-123 * 3} 7 operator * 0 subexpr -123 3 operator - 0 subexpr 123 1 text 123 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-11.5 {ParseMultiplyExpr procedure, next lexeme is "*", "/", or "%"} {
+test parseExpr-13.5 {ParseMultiplyExpr procedure, next lexeme is "*", "/", or "%"} {
testexprparser {+-456 / 3} -1
} {- {} 0 subexpr {+-456 / 3} 9 operator / 0 subexpr +-456 5 operator + 0 subexpr -456 3 operator - 0 subexpr 456 1 text 456 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-11.6 {ParseMultiplyExpr procedure, next lexeme is "*", "/", or "%"} {
+test parseExpr-13.6 {ParseMultiplyExpr procedure, next lexeme is "*", "/", or "%"} {
testexprparser {+-456 % 3} -1
} {- {} 0 subexpr {+-456 % 3} 9 operator % 0 subexpr +-456 5 operator + 0 subexpr -456 3 operator - 0 subexpr 456 1 text 456 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-11.7 {ParseMultiplyExpr procedure, bad lexeme after "*", "/", or "%"} {nonPortable} {
+test parseExpr-13.7 {ParseMultiplyExpr procedure, bad lexeme after "*", "/", or "%"} {wideIntegerUnparsed} {
list [catch {testexprparser {--++5 / 12345678901234567890} -1} msg] $msg
} {1 {integer value too large to represent}}
-test parseExpr-11.8 {ParseMultiplyExpr procedure, valid RHS subexpression} {
+test parseExpr-13.8 {ParseMultiplyExpr procedure, valid RHS subexpression} {
testexprparser {-2 / 3 % 4} -1
} {- {} 0 subexpr {-2 / 3 % 4} 11 operator % 0 subexpr {-2 / 3} 7 operator / 0 subexpr -2 3 operator - 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
-test parseExpr-11.9 {ParseMultiplyExpr procedure, error in RHS subexpression} {
+test parseExpr-13.9 {ParseMultiplyExpr procedure, error in RHS subexpression} {
list [catch {testexprparser {++2 / 3 * martha} -1} msg] $msg
-} {1 {syntax error in expression "++2 / 3 * martha"}}
+} {1 {syntax error in expression "++2 / 3 * martha": variable references require preceding $}}
-test parseExpr-12.1 {ParseUnaryExpr procedure, first token is unary operator} {
+test parseExpr-14.1 {ParseUnaryExpr procedure, first token is unary operator} {
testexprparser {+2} -1
} {- {} 0 subexpr +2 3 operator + 0 subexpr 2 1 text 2 0 {}}
-test parseExpr-12.2 {ParseUnaryExpr procedure, first token is unary operator} {
+test parseExpr-14.2 {ParseUnaryExpr procedure, first token is unary operator} {
testexprparser {-2} -1
} {- {} 0 subexpr -2 3 operator - 0 subexpr 2 1 text 2 0 {}}
-test parseExpr-12.3 {ParseUnaryExpr procedure, first token is unary operator} {
+test parseExpr-14.3 {ParseUnaryExpr procedure, first token is unary operator} {
testexprparser {~2} -1
} {- {} 0 subexpr ~2 3 operator ~ 0 subexpr 2 1 text 2 0 {}}
-test parseExpr-12.4 {ParseUnaryExpr procedure, first token is unary operator} {
+test parseExpr-14.4 {ParseUnaryExpr procedure, first token is unary operator} {
testexprparser {!2} -1
} {- {} 0 subexpr !2 3 operator ! 0 subexpr 2 1 text 2 0 {}}
-test parseExpr-12.5 {ParseUnaryExpr procedure, error in lexeme after unary op} {nonPortable} {
+test parseExpr-14.5 {ParseUnaryExpr procedure, error in lexeme after unary op} {wideIntegerUnparsed} {
list [catch {testexprparser {-12345678901234567890} -1} msg] $msg
} {1 {integer value too large to represent}}
-test parseExpr-12.6 {ParseUnaryExpr procedure, simple unary expr after unary op} {
+test parseExpr-14.6 {ParseUnaryExpr procedure, simple unary expr after unary op} {
testexprparser {+"1234"} -1
} {- {} 0 subexpr +\"1234\" 3 operator + 0 subexpr {"1234"} 1 text 1234 0 {}}
-test parseExpr-12.7 {ParseUnaryExpr procedure, another unary expr after unary op} {
+test parseExpr-14.7 {ParseUnaryExpr procedure, another unary expr after unary op} {
testexprparser {~!{fred}} -1
} {- {} 0 subexpr ~!{fred} 5 operator ~ 0 subexpr !{fred} 3 operator ! 0 subexpr {{fred}} 1 text fred 0 {}}
-test parseExpr-12.8 {ParseUnaryExpr procedure, error in unary expr after unary op} {
+test parseExpr-14.8 {ParseUnaryExpr procedure, error in unary expr after unary op} {
list [catch {testexprparser {+-||27} -1} msg] $msg
-} {1 {syntax error in expression "+-||27"}}
-test parseExpr-12.9 {ParseUnaryExpr procedure, error in unary expr after unary op} {
+} {1 {syntax error in expression "+-||27": unexpected operator ||}}
+test parseExpr-14.9 {ParseUnaryExpr procedure, error in unary expr after unary op} {
list [catch {testexprparser {+-||27} -1} msg] $msg
-} {1 {syntax error in expression "+-||27"}}
-test parseExpr-12.10 {ParseUnaryExpr procedure, first token is not unary op} {
+} {1 {syntax error in expression "+-||27": unexpected operator ||}}
+test parseExpr-14.10 {ParseUnaryExpr procedure, first token is not unary op} {
testexprparser {123} -1
} {- {} 0 subexpr 123 1 text 123 0 {}}
-test parseExpr-12.11 {ParseUnaryExpr procedure, not unary expr, complex primary expr} {
+test parseExpr-14.11 {ParseUnaryExpr procedure, not unary expr, complex primary expr} {
testexprparser {(1+2)} -1
} {- {} 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}}
-test parseExpr-12.12 {ParseUnaryExpr procedure, not unary expr, error in primary expr} {nonPortable} {
+test parseExpr-14.12 {ParseUnaryExpr procedure, not unary expr, error in primary expr} {wideIntegerUnparsed} {
list [catch {testexprparser {(12345678901234567890)} -1} msg] $msg
} {1 {integer value too large to represent}}
-test parseExpr-13.1 {ParsePrimaryExpr procedure, just parenthesized subexpr} {
+test parseExpr-15.1 {ParsePrimaryExpr procedure, just parenthesized subexpr} {
testexprparser {({abc}/{def})} -1
} {- {} 0 subexpr {{abc}/{def}} 5 operator / 0 subexpr {{abc}} 1 text abc 0 subexpr {{def}} 1 text def 0 {}}
-test parseExpr-13.2 {ParsePrimaryExpr procedure, bad lexeme after "("} {nonPortable} {
+test parseExpr-15.2 {ParsePrimaryExpr procedure, bad lexeme after "("} {wideIntegerUnparsed} {
list [catch {testexprparser {(12345678901234567890)} -1} msg] $msg
} {1 {integer value too large to represent}}
-test parseExpr-13.3 {ParsePrimaryExpr procedure, valid parenthesized subexpr} {
+test parseExpr-15.3 {ParsePrimaryExpr procedure, valid parenthesized subexpr} {
testexprparser {({abc}? 2*4 : -6)} -1
} {- {} 0 subexpr {{abc}? 2*4 : -6} 13 operator ? 0 subexpr {{abc}} 1 text abc 0 subexpr 2*4 5 operator * 0 subexpr 2 1 text 2 0 subexpr 4 1 text 4 0 subexpr -6 3 operator - 0 subexpr 6 1 text 6 0 {}}
-test parseExpr-13.4 {ParsePrimaryExpr procedure, error in parenthesized subexpr} {
+test parseExpr-15.4 {ParsePrimaryExpr procedure, error in parenthesized subexpr} {
list [catch {testexprparser {(? 123 : 456)} -1} msg] $msg
-} {1 {syntax error in expression "(? 123 : 456)"}}
-test parseExpr-13.5 {ParsePrimaryExpr procedure, missing ")" after in parenthesized subexpr} {
+} {1 {syntax error in expression "(? 123 : 456)": unexpected ternary 'then' separator}}
+test parseExpr-15.5 {ParsePrimaryExpr procedure, missing ")" after in parenthesized subexpr} {
list [catch {testexprparser {({abc}/{def}} -1} msg] $msg
-} {1 {syntax error in expression "({abc}/{def}"}}
-test parseExpr-13.6 {ParsePrimaryExpr procedure, primary is literal} {
+} {1 {syntax error in expression "({abc}/{def}": looking for close parenthesis}}
+test parseExpr-15.6 {ParsePrimaryExpr procedure, primary is literal} {
testexprparser {12345} -1
} {- {} 0 subexpr 12345 1 text 12345 0 {}}
-test parseExpr-13.7 {ParsePrimaryExpr procedure, primary is literal} {
+test parseExpr-15.7 {ParsePrimaryExpr procedure, primary is literal} {
testexprparser {12345.6789} -1
} {- {} 0 subexpr 12345.6789 1 text 12345.6789 0 {}}
-test parseExpr-13.8 {ParsePrimaryExpr procedure, primary is var reference} {
+test parseExpr-15.8 {ParsePrimaryExpr procedure, primary is var reference} {
testexprparser {$a} -1
} {- {} 0 subexpr {$a} 2 variable {$a} 1 text a 0 {}}
-test parseExpr-13.9 {ParsePrimaryExpr procedure, primary is var reference} {
+test parseExpr-15.9 {ParsePrimaryExpr procedure, primary is var reference} {
testexprparser {$a(hello$there)} -1
} {- {} 0 subexpr {$a(hello$there)} 5 variable {$a(hello$there)} 4 text a 0 text hello 0 variable {$there} 1 text there 0 {}}
-test parseExpr-13.10 {ParsePrimaryExpr procedure, primary is var reference} {
+test parseExpr-15.10 {ParsePrimaryExpr procedure, primary is var reference} {
testexprparser {$a()} -1
} {- {} 0 subexpr {$a()} 3 variable {$a()} 2 text a 0 text {} 0 {}}
-test parseExpr-13.11 {ParsePrimaryExpr procedure, error in var reference} {
+test parseExpr-15.11 {ParsePrimaryExpr procedure, error in var reference} {
list [catch {testexprparser {$a(} -1} msg] $msg
} {1 {missing )}}
-test parseExpr-13.12 {ParsePrimaryExpr procedure, primary is quoted string} {
+test parseExpr-15.12 {ParsePrimaryExpr procedure, primary is quoted string} {
testexprparser {"abc $xyz def"} -1
} {- {} 0 subexpr {"abc $xyz def"} 5 word {"abc $xyz def"} 4 text {abc } 0 variable {$xyz} 1 text xyz 0 text { def} 0 {}}
-test parseExpr-13.13 {ParsePrimaryExpr procedure, error in quoted string} {
+test parseExpr-15.13 {ParsePrimaryExpr procedure, error in quoted string} {
list [catch {testexprparser {"$a(12"} -1} msg] $msg
} {1 {missing )}}
-test parseExpr-13.14 {ParsePrimaryExpr procedure, quoted string has multiple tokens} {
+test parseExpr-15.14 {ParsePrimaryExpr procedure, quoted string has multiple tokens} {
testexprparser {"abc [xyz] $def"} -1
} {- {} 0 subexpr {"abc [xyz] $def"} 6 word {"abc [xyz] $def"} 5 text {abc } 0 command {[xyz]} 0 text { } 0 variable {$def} 1 text def 0 {}}
-test parseExpr-13.15 {ParsePrimaryExpr procedure, primary is command} {
+test parseExpr-15.15 {ParsePrimaryExpr procedure, primary is command} {
testexprparser {[def]} -1
} {- {} 0 subexpr {[def]} 1 command {[def]} 0 {}}
-test parseExpr-13.16 {ParsePrimaryExpr procedure, primary is multiple commands} {
+test parseExpr-15.16 {ParsePrimaryExpr procedure, primary is multiple commands} {
testexprparser {[one; two; three; four;]} -1
} {- {} 0 subexpr {[one; two; three; four;]} 1 command {[one; two; three; four;]} 0 {}}
-test parseExpr-13.17 {ParsePrimaryExpr procedure, primary is multiple commands} {
+test parseExpr-15.17 {ParsePrimaryExpr procedure, primary is multiple commands} {
testexprparser {[one; two; three; four;]} -1
} {- {} 0 subexpr {[one; two; three; four;]} 1 command {[one; two; three; four;]} 0 {}}
-test parseExpr-13.18 {ParsePrimaryExpr procedure, missing close bracket} {
+test parseExpr-15.18 {ParsePrimaryExpr procedure, missing close bracket} {
list [catch {testexprparser {[one} -1} msg] $msg
} {1 {missing close-bracket}}
-test parseExpr-13.19 {ParsePrimaryExpr procedure, primary is braced string} {
+test parseExpr-15.19 {ParsePrimaryExpr procedure, primary is braced string} {
testexprparser {{hello world}} -1
} {- {} 0 subexpr {{hello world}} 1 text {hello world} 0 {}}
-test parseExpr-13.20 {ParsePrimaryExpr procedure, error in primary, which is braced string} {
+test parseExpr-15.20 {ParsePrimaryExpr procedure, error in primary, which is braced string} {
list [catch {testexprparser "\{abc\\\n" -1} msg] $msg
} {1 {missing close-brace}}
-test parseExpr-13.21 {ParsePrimaryExpr procedure, primary is braced string with multiple tokens} {
+test parseExpr-15.21 {ParsePrimaryExpr procedure, primary is braced string with multiple tokens} {
testexprparser "\{ \\
+123 \}" -1
} {- {} 0 subexpr \{\ \ \\\n\ +123\ \} 4 word \{\ \ \\\n\ +123\ \} 3 text { } 0 backslash \\\n\ 0 text {+123 } 0 {}}
-test parseExpr-13.22 {ParsePrimaryExpr procedure, primary is function call} {
+test parseExpr-15.22 {ParsePrimaryExpr procedure, primary is function call} {
testexprparser {foo(123)} -1
} {- {} 0 subexpr foo(123) 3 operator foo 0 subexpr 123 1 text 123 0 {}}
-test parseExpr-13.23 {ParsePrimaryExpr procedure, bad lexeme after function name} {nonPortable} {
+test parseExpr-15.23 {ParsePrimaryExpr procedure, bad lexeme after function name} {wideIntegerUnparsed} {
list [catch {testexprparser {foo 12345678901234567890 123)} -1} msg] $msg
} {1 {integer value too large to represent}}
-test parseExpr-13.24 {ParsePrimaryExpr procedure, lexeme after function name isn't "("} {
+test parseExpr-15.24 {ParsePrimaryExpr procedure, lexeme after function name isn't "("} {
list [catch {testexprparser {foo 27.4 123)} -1} msg] $msg
-} {1 {syntax error in expression "foo 27.4 123)"}}
-test parseExpr-13.25 {ParsePrimaryExpr procedure, bad lexeme after "("} {nonPortable} {
+} {1 {syntax error in expression "foo 27.4 123)": variable references require preceding $}}
+test parseExpr-15.25 {ParsePrimaryExpr procedure, bad lexeme after "("} {wideIntegerUnparsed} {
list [catch {testexprparser {foo(12345678901234567890)} -1} msg] $msg
} {1 {integer value too large to represent}}
-test parseExpr-13.26 {ParsePrimaryExpr procedure, function call, one arg} {
+test parseExpr-15.26 {ParsePrimaryExpr procedure, function call, one arg} {
testexprparser {foo(27*4)} -1
} {- {} 0 subexpr foo(27*4) 7 operator foo 0 subexpr 27*4 5 operator * 0 subexpr 27 1 text 27 0 subexpr 4 1 text 4 0 {}}
-test parseExpr-13.27 {ParsePrimaryExpr procedure, error in function arg} {
+test parseExpr-15.27 {ParsePrimaryExpr procedure, error in function arg} {
list [catch {testexprparser {foo(*1-2)} -1} msg] $msg
-} {1 {syntax error in expression "foo(*1-2)"}}
-test parseExpr-13.28 {ParsePrimaryExpr procedure, error in function arg} {
+} {1 {syntax error in expression "foo(*1-2)": unexpected operator *}}
+test parseExpr-15.28 {ParsePrimaryExpr procedure, error in function arg} {
list [catch {testexprparser {foo(*1-2)} -1} msg] $msg
-} {1 {syntax error in expression "foo(*1-2)"}}
-test parseExpr-13.29 {ParsePrimaryExpr procedure, function call, comma after arg} {
+} {1 {syntax error in expression "foo(*1-2)": unexpected operator *}}
+test parseExpr-15.29 {ParsePrimaryExpr procedure, function call, comma after arg} {
testexprparser {foo(27-2, (-2*[foo]))} -1
} {- {} 0 subexpr {foo(27-2, (-2*[foo]))} 15 operator foo 0 subexpr 27-2 5 operator - 0 subexpr 27 1 text 27 0 subexpr 2 1 text 2 0 subexpr {-2*[foo]} 7 operator * 0 subexpr -2 3 operator - 0 subexpr 2 1 text 2 0 subexpr {[foo]} 1 command {[foo]} 0 {}}
-test parseExpr-13.30 {ParsePrimaryExpr procedure, bad lexeme after comma} {nonPortable} {
+test parseExpr-15.30 {ParsePrimaryExpr procedure, bad lexeme after comma} {wideIntegerUnparsed} {
list [catch {testexprparser {foo(123, 12345678901234567890)} -1} msg] $msg
} {1 {integer value too large to represent}}
-test parseExpr-13.31 {ParsePrimaryExpr procedure, lexeme not "," or ")" after arg} {
+test parseExpr-15.31 {ParsePrimaryExpr procedure, lexeme not "," or ")" after arg} {
list [catch {testexprparser {foo(123 [foo])} -1} msg] $msg
-} {1 {syntax error in expression "foo(123 [foo])"}}
-test parseExpr-13.32 {ParsePrimaryExpr procedure, bad lexeme after primary} {nonPortable} {
+} {1 {syntax error in expression "foo(123 [foo])": missing close parenthesis at end of function call}}
+test parseExpr-15.32 {ParsePrimaryExpr procedure, bad lexeme after primary} {wideIntegerUnparsed} {
list [catch {testexprparser {123 12345678901234567890} -1} msg] $msg
} {1 {integer value too large to represent}}
-
-test parseExpr-14.1 {GetLexeme procedure, whitespace before lexeme} {
+test parseExpr-15.33 {ParsePrimaryExpr procedure, comma-specific message} {
+ list [catch {testexprparser {123+,456} -1} msg] $msg
+} {1 {syntax error in expression "123+,456": commas can only separate function arguments}}
+test parseExpr-15.34 {ParsePrimaryExpr procedure, single equal-specific message} {
+ list [catch {testexprparser {123+=456} -1} msg] $msg
+} {1 {syntax error in expression "123+=456": single equality character not legal in expressions}}
+test parseExpr-15.35 {ParsePrimaryExpr procedure, error in parenthesized subexpr} {
+ list [catch {testexprparser {(: 123 : 456)} -1} msg] $msg
+} {1 {syntax error in expression "(: 123 : 456)": unexpected ternary 'else' separator}}
+
+test parseExpr-16.1 {GetLexeme procedure, whitespace before lexeme} {
testexprparser { 123} -1
} {- {} 0 subexpr 123 1 text 123 0 {}}
-test parseExpr-14.2 {GetLexeme procedure, whitespace before lexeme} {
+test parseExpr-16.2 {GetLexeme procedure, whitespace before lexeme} {
testexprparser { \
456} -1
} {- {} 0 subexpr 456 1 text 456 0 {}}
-test parseExpr-14.3 {GetLexeme procedure, no lexeme after whitespace} {
+test parseExpr-16.3 {GetLexeme procedure, no lexeme after whitespace} {
testexprparser { 123 \
} -1
} {- {} 0 subexpr 123 1 text 123 0 {}}
-test parseExpr-14.4 {GetLexeme procedure, integer lexeme} {
+test parseExpr-16.4 {GetLexeme procedure, integer lexeme} {
testexprparser {000} -1
} {- {} 0 subexpr 000 1 text 000 0 {}}
-test parseExpr-14.5 {GetLexeme procedure, integer lexeme too big} {nonPortable} {
+test parseExpr-16.5 {GetLexeme procedure, integer lexeme too big} {wideIntegerUnparsed} {
list [catch {testexprparser {12345678901234567890} -1} msg] $msg
} {1 {integer value too large to represent}}
-test parseExpr-14.6 {GetLexeme procedure, bad integer lexeme} {
- list [catch {testexprparser {0999} -1} msg] $msg
-} {1 {"0999" is an invalid octal number}}
-test parseExpr-14.7 {GetLexeme procedure, double lexeme} {
+
+test parseExpr-16.6 {GetLexeme procedure, bad integer lexeme} -body {
+ testexprparser {0999} -1
+} -returnCodes error -match glob -result {*invalid octal number*}
+
+test parseExpr-16.7 {GetLexeme procedure, double lexeme} {
testexprparser {0.999} -1
} {- {} 0 subexpr 0.999 1 text 0.999 0 {}}
-test parseExpr-14.8 {GetLexeme procedure, double lexeme} {
+test parseExpr-16.8 {GetLexeme procedure, double lexeme} {
testexprparser {.123} -1
} {- {} 0 subexpr .123 1 text .123 0 {}}
-test parseExpr-14.9 {GetLexeme procedure, double lexeme} {nonPortable unixOnly} {
+test parseExpr-16.9 {GetLexeme procedure, double lexeme} {nonPortable unixOnly} {
testexprparser {nan} -1
} {- {} 0 subexpr nan 1 text nan 0 {}}
-test parseExpr-14.10 {GetLexeme procedure, double lexeme} {nonPortable unixOnly} {
+test parseExpr-16.10 {GetLexeme procedure, double lexeme} {nonPortable unixOnly} {
testexprparser {NaN} -1
} {- {} 0 subexpr NaN 1 text NaN 0 {}}
-test parseExpr-14.11 {GetLexeme procedure, bad double lexeme too big} {
+test parseExpr-16.11 {GetLexeme procedure, bad double lexeme too big} {
list [catch {testexprparser {123.e+99999999999999} -1} msg] $msg
} {1 {floating-point value too large to represent}}
-test parseExpr-14.12 {GetLexeme procedure, bad double lexeme} {
+test parseExpr-16.12 {GetLexeme procedure, bad double lexeme} {
list [catch {testexprparser {123.4x56} -1} msg] $msg
-} {1 {syntax error in expression "123.4x56"}}
-test parseExpr-14.13 {GetLexeme procedure, lexeme is "["} {
+} {1 {syntax error in expression "123.4x56": extra tokens at end of expression}}
+test parseExpr-16.13 {GetLexeme procedure, lexeme is "["} {
testexprparser {[foo]} -1
} {- {} 0 subexpr {[foo]} 1 command {[foo]} 0 {}}
-test parseExpr-14.14 {GetLexeme procedure, lexeme is open brace} {
+test parseExpr-16.14 {GetLexeme procedure, lexeme is open brace} {
testexprparser {{bar}} -1
} {- {} 0 subexpr {{bar}} 1 text bar 0 {}}
-test parseExpr-14.15 {GetLexeme procedure, lexeme is "("} {
+test parseExpr-16.15 {GetLexeme procedure, lexeme is "("} {
testexprparser {(123)} -1
} {- {} 0 subexpr 123 1 text 123 0 {}}
-test parseExpr-14.16 {GetLexeme procedure, lexeme is ")"} {
+test parseExpr-16.16 {GetLexeme procedure, lexeme is ")"} {
testexprparser {(2*3)} -1
} {- {} 0 subexpr 2*3 5 operator * 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-14.17 {GetLexeme procedure, lexeme is "$"} {
+test parseExpr-16.17 {GetLexeme procedure, lexeme is "$"} {
testexprparser {$wombat} -1
} {- {} 0 subexpr {$wombat} 2 variable {$wombat} 1 text wombat 0 {}}
-test parseExpr-14.18 {GetLexeme procedure, lexeme is '"'} {
+test parseExpr-16.18 "GetLexeme procedure, lexeme is '\"'" {
testexprparser {"fred"} -1
} {- {} 0 subexpr {"fred"} 1 text fred 0 {}}
-test parseExpr-14.19 {GetLexeme procedure, lexeme is ","} {
+test parseExpr-16.19 {GetLexeme procedure, lexeme is ","} {
testexprparser {foo(1,2)} -1
} {- {} 0 subexpr foo(1,2) 5 operator foo 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}}
-test parseExpr-14.20 {GetLexeme procedure, lexeme is "*"} {
+test parseExpr-16.20 {GetLexeme procedure, lexeme is "*"} {
testexprparser {$a*$b} -1
} {- {} 0 subexpr {$a*$b} 7 operator * 0 subexpr {$a} 2 variable {$a} 1 text a 0 subexpr {$b} 2 variable {$b} 1 text b 0 {}}
-test parseExpr-14.21 {GetLexeme procedure, lexeme is "/"} {
+test parseExpr-16.21 {GetLexeme procedure, lexeme is "/"} {
testexprparser {5/6} -1
} {- {} 0 subexpr 5/6 5 operator / 0 subexpr 5 1 text 5 0 subexpr 6 1 text 6 0 {}}
-test parseExpr-14.22 {GetLexeme procedure, lexeme is "%"} {
+test parseExpr-16.22 {GetLexeme procedure, lexeme is "%"} {
testexprparser {5%[xxx]} -1
} {- {} 0 subexpr {5%[xxx]} 5 operator % 0 subexpr 5 1 text 5 0 subexpr {[xxx]} 1 command {[xxx]} 0 {}}
-test parseExpr-14.23 {GetLexeme procedure, lexeme is "+"} {
+test parseExpr-16.23 {GetLexeme procedure, lexeme is "+"} {
testexprparser {1+2} -1
} {- {} 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}}
-test parseExpr-14.24 {GetLexeme procedure, lexeme is "-"} {
+test parseExpr-16.24 {GetLexeme procedure, lexeme is "-"} {
testexprparser {.12-0e27} -1
} {- {} 0 subexpr .12-0e27 5 operator - 0 subexpr .12 1 text .12 0 subexpr 0e27 1 text 0e27 0 {}}
-test parseExpr-14.25 {GetLexeme procedure, lexeme is "?" or ":"} {
+test parseExpr-16.25 {GetLexeme procedure, lexeme is "?" or ":"} {
testexprparser {$b? 1 : 0} -1
} {- {} 0 subexpr {$b? 1 : 0} 8 operator ? 0 subexpr {$b} 2 variable {$b} 1 text b 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
-test parseExpr-14.26 {GetLexeme procedure, lexeme is "<"} {
+test parseExpr-16.26 {GetLexeme procedure, lexeme is "<"} {
testexprparser {2<3} -1
} {- {} 0 subexpr 2<3 5 operator < 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-14.27 {GetLexeme procedure, lexeme is "<<"} {
+test parseExpr-16.27 {GetLexeme procedure, lexeme is "<<"} {
testexprparser {2<<3} -1
} {- {} 0 subexpr 2<<3 5 operator << 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-14.28 {GetLexeme procedure, lexeme is "<="} {
+test parseExpr-16.28 {GetLexeme procedure, lexeme is "<="} {
testexprparser {2<=3} -1
} {- {} 0 subexpr 2<=3 5 operator <= 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-14.29 {GetLexeme procedure, lexeme is ">"} {
+test parseExpr-16.29 {GetLexeme procedure, lexeme is ">"} {
testexprparser {2>3} -1
} {- {} 0 subexpr 2>3 5 operator > 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-14.30 {GetLexeme procedure, lexeme is ">>"} {
+test parseExpr-16.30 {GetLexeme procedure, lexeme is ">>"} {
testexprparser {2>>3} -1
} {- {} 0 subexpr 2>>3 5 operator >> 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-14.31 {GetLexeme procedure, lexeme is ">="} {
+test parseExpr-16.31 {GetLexeme procedure, lexeme is ">="} {
testexprparser {2>=3} -1
} {- {} 0 subexpr 2>=3 5 operator >= 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-14.32 {GetLexeme procedure, lexeme is "=="} {
+test parseExpr-16.32 {GetLexeme procedure, lexeme is "=="} {
testexprparser {2==3} -1
} {- {} 0 subexpr 2==3 5 operator == 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-14.33 {GetLexeme procedure, bad lexeme starting with "="} {
+test parseExpr-16.33 {GetLexeme procedure, bad lexeme starting with "="} {
list [catch {testexprparser {2=+3} -1} msg] $msg
-} {1 {syntax error in expression "2=+3"}}
-test parseExpr-14.34 {GetLexeme procedure, lexeme is "!="} {
+} {1 {syntax error in expression "2=+3": extra tokens at end of expression}}
+test parseExpr-16.34 {GetLexeme procedure, lexeme is "!="} {
testexprparser {2!=3} -1
} {- {} 0 subexpr 2!=3 5 operator != 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-14.35 {GetLexeme procedure, lexeme is "!"} {
+test parseExpr-16.35 {GetLexeme procedure, lexeme is "!"} {
testexprparser {!2} -1
} {- {} 0 subexpr !2 3 operator ! 0 subexpr 2 1 text 2 0 {}}
-test parseExpr-14.36 {GetLexeme procedure, lexeme is "&&"} {
+test parseExpr-16.36 {GetLexeme procedure, lexeme is "&&"} {
testexprparser {2&&3} -1
} {- {} 0 subexpr 2&&3 5 operator && 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-14.37 {GetLexeme procedure, lexeme is "&"} {
+test parseExpr-16.37 {GetLexeme procedure, lexeme is "&"} {
testexprparser {1&2} -1
} {- {} 0 subexpr 1&2 5 operator & 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}}
-test parseExpr-14.38 {GetLexeme procedure, lexeme is "^"} {
+test parseExpr-16.38 {GetLexeme procedure, lexeme is "^"} {
testexprparser {1^2} -1
} {- {} 0 subexpr 1^2 5 operator ^ 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}}
-test parseExpr-14.39 {GetLexeme procedure, lexeme is "||"} {
+test parseExpr-16.39 {GetLexeme procedure, lexeme is "||"} {
testexprparser {2||3} -1
} {- {} 0 subexpr 2||3 5 operator || 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-14.40 {GetLexeme procedure, lexeme is "|"} {
+test parseExpr-16.40 {GetLexeme procedure, lexeme is "|"} {
testexprparser {1|2} -1
} {- {} 0 subexpr 1|2 5 operator | 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}}
-test parseExpr-14.41 {GetLexeme procedure, lexeme is "~"} {
+test parseExpr-16.41 {GetLexeme procedure, lexeme is "~"} {
testexprparser {~2} -1
} {- {} 0 subexpr ~2 3 operator ~ 0 subexpr 2 1 text 2 0 {}}
-test parseExpr-14.42 {GetLexeme procedure, lexeme is func name} {
+test parseExpr-16.42 {GetLexeme procedure, lexeme is func name} {
testexprparser {george()} -1
} {- {} 0 subexpr george() 1 operator george 0 {}}
-test parseExpr-14.43 {GetLexeme procedure, lexeme is func name} {
+test parseExpr-16.43 {GetLexeme procedure, lexeme is func name} {
testexprparser {harmonic_ratio(2,3)} -1
} {- {} 0 subexpr harmonic_ratio(2,3) 5 operator harmonic_ratio 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-14.44 {GetLexeme procedure, unknown lexeme} {
+test parseExpr-16.44 {GetLexeme procedure, unknown lexeme} {
list [catch {testexprparser {@27} -1} msg] $msg
-} {1 {syntax error in expression "@27"}}
+} {1 {syntax error in expression "@27": character not legal in expressions}}
-test parseExpr-15.1 {PrependSubExprTokens procedure, expand token array} {
+test parseExpr-17.1 {PrependSubExprTokens procedure, expand token array} {
testexprparser {[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
} {- {} 0 subexpr {[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]]} 13 operator && 0 subexpr {[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]]} 9 operator && 0 subexpr {[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]} 5 operator && 0 subexpr {[string compare [format %c $i] [string index $a $i]]} 1 command {[string compare [format %c $i] [string index $a $i]]} 0 subexpr {[string compare [format %c $i] [string index $a $i]]} 1 command {[string compare [format %c $i] [string index $a $i]]} 0 subexpr {[string compare [format %c $i] [string index $a $i]]} 1 command {[string compare [format %c $i] [string index $a $i]]} 0 subexpr {[string compare [format %c $i] [string index $a $i]]} 1 command {[string compare [format %c $i] [string index $a $i]]} 0 {}}
-test parse-16.1 {LogSyntaxError procedure, error in expr longer than 60 chars} {
+test parseExpr-18.1 {LogSyntaxError procedure, error in expr longer than 60 chars} {
list [catch {testexprparser {(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)/} -1} msg] $msg
-} {1 {syntax error in expression "(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+012"}}
+} {1 {syntax error in expression "(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+012...": premature end of expression}}
# cleanup
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tcl/tests/parseOld.test b/tcl/tests/parseOld.test
index 516c2b2fa4a..40804d3cc2c 100644
--- a/tcl/tests/parseOld.test
+++ b/tcl/tests/parseOld.test
@@ -20,6 +20,12 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
namespace import -force ::tcltest::*
}
+tcltest::testConstraint testwordend \
+ [string equal "testwordend" [info commands testwordend]]
+
+# Save the argv value for restoration later
+set savedArgv $argv
+
proc fourArgs {a b c d} {
global arg1 arg2 arg3 arg4
set arg1 $a
@@ -450,71 +456,69 @@ expr 1+1
]"
} {2}
-if {[info command testwordend] == "testwordend"} {
- test parseOld-14.1 {TclWordEnd procedure} {
- testwordend " \n abc"
- } {c}
- test parseOld-14.2 {TclWordEnd procedure} {
- testwordend " \\\n"
- } {}
- test parseOld-14.3 {TclWordEnd procedure} {
- testwordend " \\\n "
- } { }
- test parseOld-14.4 {TclWordEnd procedure} {
- testwordend {"abc"}
- } {"}
- test parseOld-14.5 {TclWordEnd procedure} {
- testwordend {{xyz}}
- } \}
- test parseOld-14.6 {TclWordEnd procedure} {
- testwordend {{a{}b{}\}} xyz}
- } "\} xyz"
- test parseOld-14.7 {TclWordEnd procedure} {
- testwordend {abc[this is a]def ghi}
- } {f ghi}
- test parseOld-14.8 {TclWordEnd procedure} {
- testwordend "puts\\\n\n "
- } "s\\\n\n "
- test parseOld-14.9 {TclWordEnd procedure} {
- testwordend "puts\\\n "
- } "s\\\n "
- test parseOld-14.10 {TclWordEnd procedure} {
- testwordend "puts\\\n xyz"
- } "s\\\n xyz"
- test parseOld-14.11 {TclWordEnd procedure} {
- testwordend {a$x.$y(a long index) foo}
- } ") foo"
- test parseOld-14.12 {TclWordEnd procedure} {
- testwordend {abc; def}
- } {; def}
- test parseOld-14.13 {TclWordEnd procedure} {
- testwordend {abc def}
- } {c def}
- test parseOld-14.14 {TclWordEnd procedure} {
- testwordend {abc def}
- } {c def}
- test parseOld-14.15 {TclWordEnd procedure} {
- testwordend "abc\ndef"
- } "c\ndef"
- test parseOld-14.16 {TclWordEnd procedure} {
- testwordend "abc"
- } {c}
- test parseOld-14.17 {TclWordEnd procedure} {
- testwordend "a\000bc"
- } {c}
- test parseOld-14.18 {TclWordEnd procedure} {
- testwordend \[a\000\]
- } {]}
- test parseOld-14.19 {TclWordEnd procedure} {
- testwordend \"a\000\"
- } {"}
- test parseOld-14.20 {TclWordEnd procedure} {
- testwordend a{\000}b
- } {b}
- test parseOld-14.21 {TclWordEnd procedure} {
- testwordend " \000b"
- } {b}
-}
+test parseOld-14.1 {TclWordEnd procedure} {testwordend} {
+ testwordend " \n abc"
+} {c}
+test parseOld-14.2 {TclWordEnd procedure} {testwordend} {
+ testwordend " \\\n"
+} {}
+test parseOld-14.3 {TclWordEnd procedure} {testwordend} {
+ testwordend " \\\n "
+} { }
+test parseOld-14.4 {TclWordEnd procedure} {testwordend} {
+ testwordend {"abc"}
+} {"}
+test parseOld-14.5 {TclWordEnd procedure} {testwordend} {
+ testwordend {{xyz}}
+} \}
+test parseOld-14.6 {TclWordEnd procedure} {testwordend} {
+ testwordend {{a{}b{}\}} xyz}
+} "\} xyz"
+test parseOld-14.7 {TclWordEnd procedure} {testwordend} {
+ testwordend {abc[this is a]def ghi}
+} {f ghi}
+test parseOld-14.8 {TclWordEnd procedure} {testwordend} {
+ testwordend "puts\\\n\n "
+} "s\\\n\n "
+test parseOld-14.9 {TclWordEnd procedure} {testwordend} {
+ testwordend "puts\\\n "
+} "s\\\n "
+test parseOld-14.10 {TclWordEnd procedure} {testwordend} {
+ testwordend "puts\\\n xyz"
+} "s\\\n xyz"
+test parseOld-14.11 {TclWordEnd procedure} {testwordend} {
+ testwordend {a$x.$y(a long index) foo}
+} ") foo"
+test parseOld-14.12 {TclWordEnd procedure} {testwordend} {
+ testwordend {abc; def}
+} {; def}
+test parseOld-14.13 {TclWordEnd procedure} {testwordend} {
+ testwordend {abc def}
+} {c def}
+test parseOld-14.14 {TclWordEnd procedure} {testwordend} {
+ testwordend {abc def}
+} {c def}
+test parseOld-14.15 {TclWordEnd procedure} {testwordend} {
+ testwordend "abc\ndef"
+} "c\ndef"
+test parseOld-14.16 {TclWordEnd procedure} {testwordend} {
+ testwordend "abc"
+} {c}
+test parseOld-14.17 {TclWordEnd procedure} {testwordend} {
+ testwordend "a\000bc"
+} {c}
+test parseOld-14.18 {TclWordEnd procedure} {testwordend} {
+ testwordend \[a\000\]
+} {]}
+test parseOld-14.19 {TclWordEnd procedure} {testwordend} {
+ testwordend \"a\000\"
+} {"}
+test parseOld-14.20 {TclWordEnd procedure} {testwordend} {
+ testwordend a{\000}b
+} {b}
+test parseOld-14.21 {TclWordEnd procedure} {testwordend} {
+ testwordend " \000b"
+} {b}
test parseOld-15.1 {TclScriptEnd procedure} {
info complete {puts [
@@ -535,6 +539,7 @@ test parseOld-15.5 {TclScriptEnd procedure} {
} {0}
# cleanup
+set argv $savedArgv
::tcltest::cleanupTests
return
@@ -549,4 +554,3 @@ return
-
diff --git a/tcl/tests/pid.test b/tcl/tests/pid.test
index bd4ea090ecb..bab49ba3cef 100644
--- a/tcl/tests/pid.test
+++ b/tcl/tests/pid.test
@@ -27,12 +27,13 @@ if {[info commands pid] == ""} {
}
catch {removeFile test1}
+set path(test1) [makeFile {} test1]
test pid-1.1 {pid command} {
regexp {(^[0-9]+$)|(^0x[0-9a-fA-F]+$)} [pid]
} 1
test pid-1.2 {pid command} {unixOrPc unixExecs} {
- set f [open {| echo foo | cat >test1} w]
+ set f [open [format {| echo foo | cat >%s} $path(test1)] w]
set pids [pid $f]
close $f
catch {removeFile test1}
@@ -41,7 +42,7 @@ test pid-1.2 {pid command} {unixOrPc unixExecs} {
[expr {[lindex $pids 0] == [lindex $pids 1]}]
} {2 1 1 0}
test pid-1.3 {pid command} {
- set f [open test1 w]
+ set f [open $path(test1) w]
set pids [pid $f]
close $f
set pids
@@ -69,4 +70,3 @@ return
-
diff --git a/tcl/tests/pkg.test b/tcl/tests/pkg.test
index 77848537b59..eed4dc0fcda 100644
--- a/tcl/tests/pkg.test
+++ b/tcl/tests/pkg.test
@@ -301,6 +301,14 @@ test pkg-3.5 {Tcl_PackageCmd procedure, "forget" option} {
package forget a c
lappend result [lsort [package names]]
} {{a b c} b}
+test pkg-3.5.1 {Tcl_PackageCmd procedure, "forget" option} {
+ # Test for Bug 415273
+ package ifneeded a 1 "I should have been forgotten"
+ package forget no-such-package a
+ set x [package ifneeded a 1]
+ package forget a
+ set x
+} {}
test pkg-3.6 {Tcl_PackageCmd procedure, "ifneeded" option} {
list [catch {package ifneeded a} msg] $msg
} {1 {wrong # args: should be "package ifneeded package version ?script?"}}
@@ -655,4 +663,3 @@ return
-
diff --git a/tcl/tests/pkgMkIndex.test b/tcl/tests/pkgMkIndex.test
index 0acb34a0b1f..aef646e9b86 100644
--- a/tcl/tests/pkgMkIndex.test
+++ b/tcl/tests/pkgMkIndex.test
@@ -11,20 +11,12 @@
# RCS: @(#) $Id$
if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+ package require tcltest 2
namespace import -force ::tcltest::*
}
-set origDir [pwd]
-cd $::tcltest::testsDirectory
+set fullPkgPath [makeDirectory pkg]
-set fullPkgPath [file join $::tcltest::testsDirectory pkg]
-
-# Add the pkg1 directory to auto_path, so that its packages can be found.
-# packages in pkg1 are used to test indexing of packages in pkg.
-# Make sure that the path to pkg1 is absolute.
-
-lappend auto_path [file join $::tcltest::testsDirectory pkg1]
namespace eval pkgtest {
# Namespace for procs we can discard
@@ -162,10 +154,10 @@ proc pkgtest::createIndex { args } {
set patternList [lindex $parsed 2]
file mkdir $dirPath
-
+
if {[catch {
file delete [file join $dirPath pkgIndex.tcl]
- eval pkg_mkIndex $options $dirPath $patternList
+ eval pkg_mkIndex $options [list $dirPath] $patternList
} err]} {
return [list 1 $err]
}
@@ -237,8 +229,7 @@ proc makePkgList { inList } {
# returned by pkgtest::parseIndex.
# If error, this is the error result.
-proc pkgtest::runIndex { args } {
- set rv [eval createIndex $args]
+proc pkgtest::runCreatedIndex {rv args} {
if {[lindex $rv 0] == 0} {
set parsed [eval parseArgs $args]
set dirPath [lindex $parsed 1]
@@ -256,6 +247,10 @@ proc pkgtest::runIndex { args } {
return $result
}
+proc pkgtest::runIndex { args } {
+ set rv [eval createIndex $args]
+ return [eval [list runCreatedIndex $rv] $args]
+}
# If there is no match to the patterns, make sure the directory hasn't
# changed on us
@@ -264,48 +259,188 @@ test pkgMkIndex-1.1 {nothing matches pattern - current dir is the same} {
list [pkgtest::runIndex -lazy $fullPkgPath nomatch.tcl] [pwd]
} [list {1 {no files matched glob pattern "nomatch.tcl"}} [pwd]]
+makeFile {
+# This is a simple package, just to check basic functionality.
+package provide simple 1.0
+namespace eval simple {
+ namespace export lower upper
+}
+proc simple::lower { stg } {
+ return [string tolower $stg]
+}
+proc simple::upper { stg } {
+ return [string toupper $stg]
+}
+} [file join pkg simple.tcl]
+
test pkgMkIndex-2.1 {simple package} {
pkgtest::runIndex -lazy $fullPkgPath simple.tcl
} {0 {{simple:1.0 {tclPkgSetup {simple.tcl source {::simple::lower ::simple::upper}}}}}}
test pkgMkIndex-2.2 {simple package - use -direct} {
pkgtest::runIndex -direct $fullPkgPath simple.tcl
-} "0 {{simple:1.0 {source [file join $fullPkgPath simple.tcl]}}}"
+} "0 {{simple:1.0 {[list source [file join $fullPkgPath simple.tcl]]}}}"
test pkgMkIndex-2.3 {simple package - direct loading is default} {
pkgtest::runIndex $fullPkgPath simple.tcl
-} "0 {{simple:1.0 {source [file join $fullPkgPath simple.tcl]}}}"
+} "0 {{simple:1.0 {[list source [file join $fullPkgPath simple.tcl]]}}}"
+
+removeFile [file join pkg simple.tcl]
+
+makeFile {
+# Contains global symbols, used to check that they don't have a leading ::
+package provide global 1.0
+proc global_lower { stg } {
+ return [string tolower $stg]
+}
+proc global_upper { stg } {
+ return [string toupper $stg]
+}
+} [file join pkg global.tcl]
test pkgMkIndex-3.1 {simple package with global symbols} {
pkgtest::runIndex -lazy $fullPkgPath global.tcl
} {0 {{global:1.0 {tclPkgSetup {global.tcl source {global_lower global_upper}}}}}}
+removeFile [file join pkg global.tcl]
+
+makeFile {
+# This package is required by pkg1.
+# This package is split into two files, to test packages that are split
+# over multiple files.
+package provide pkg2 1.0
+namespace eval pkg2 {
+ namespace export p2-1
+}
+proc pkg2::p2-1 { num } {
+ return [expr $num * 2]
+}
+} [file join pkg pkg2_a.tcl]
+
+makeFile {
+# This package is required by pkg1.
+# This package is split into two files, to test packages that are split
+# over multiple files.
+package provide pkg2 1.0
+namespace eval pkg2 {
+ namespace export p2-2
+}
+proc pkg2::p2-2 { num } {
+ return [expr $num * 3]
+}
+} [file join pkg pkg2_b.tcl]
+
test pkgMkIndex-4.1 {split package} {
pkgtest::runIndex -lazy $fullPkgPath pkg2_a.tcl pkg2_b.tcl
} {0 {{pkg2:1.0 {tclPkgSetup {pkg2_a.tcl source ::pkg2::p2-1} {pkg2_b.tcl source ::pkg2::p2-2}}}}}
test pkgMkIndex-4.2 {split package - direct loading} {
pkgtest::runIndex -direct $fullPkgPath pkg2_a.tcl pkg2_b.tcl
-} "0 {{pkg2:1.0 {source [file join $fullPkgPath pkg2_a.tcl]
-source [file join $fullPkgPath pkg2_b.tcl]}}}"
-
-# This will fail, with "direct1" procedures in the list of procedures
-# provided by std.
-# It may also fail, if tclblend is in the auto_path, with an additional
-# command "loadJava" which comes from the tclblend pkgIndex.tcl file.
-# Both failures are caused by Tcl code executed in pkgIndex.tcl.
+} "0 {{pkg2:1.0 {[list source [file join $fullPkgPath pkg2_a.tcl]]
+[list source [file join $fullPkgPath pkg2_b.tcl]]}}}"
+
+# Add the direct1 directory to auto_path, so that the direct1 package
+# can be found.
+set direct1 [makeDirectory direct1]
+lappend auto_path $direct1
+makeFile {
+# This is referenced by pkgIndex.tcl as a -direct script.
+package provide direct1 1.0
+namespace eval direct1 {
+ namespace export pd1 pd2
+}
+proc direct1::pd1 { stg } {
+ return [string tolower $stg]
+}
+proc direct1::pd2 { stg } {
+ return [string toupper $stg]
+}
+} [file join direct1 direct1.tcl]
+pkg_mkIndex -direct $direct1 direct1.tcl
+
+makeFile {
+# Does a package require of direct1, whose pkgIndex.tcl entry
+# is created above with option -direct. This tests that pkg_mkIndex
+# can handle code that is sourced in pkgIndex.tcl files.
+package require direct1
+package provide std 1.0
+namespace eval std {
+ namespace export p1 p2
+}
+proc std::p1 { stg } {
+ return [string tolower $stg]
+}
+proc std::p2 { stg } {
+ return [string toupper $stg]
+}
+} [file join pkg std.tcl]
test pkgMkIndex-5.1 {requires -direct package} {
pkgtest::runIndex -lazy $fullPkgPath std.tcl
} {0 {{std:1.0 {tclPkgSetup {std.tcl source {::std::p1 ::std::p2}}}}}}
+removeFile [file join direct1 direct1.tcl]
+file delete [file join $direct1 pkgIndex.tcl]
+removeDirectory direct1
+removeFile [file join pkg std.tcl]
+
+makeFile {
+# This package requires pkg3, but it does
+# not use any of pkg3's procs in the code that is executed by the file
+# (i.e. references to pkg3's procs are in the proc bodies only).
+package require pkg3 1.0
+package provide pkg1 1.0
+namespace eval pkg1 {
+ namespace export p1-1 p1-2
+}
+proc pkg1::p1-1 { num } {
+ return [pkg3::p3-1 $num]
+}
+proc pkg1::p1-2 { num } {
+ return [pkg3::p3-2 $num]
+}
+} [file join pkg pkg1.tcl]
+
+makeFile {
+package provide pkg3 1.0
+namespace eval pkg3 {
+ namespace export p3-1 p3-2
+}
+proc pkg3::p3-1 { num } {
+ return {[expr $num * 2]}
+}
+proc pkg3::p3-2 { num } {
+ return {[expr $num * 3]}
+}
+} [file join pkg pkg3.tcl]
+
test pkgMkIndex-6.1 {pkg1 requires pkg3} {
pkgtest::runIndex -lazy $fullPkgPath pkg1.tcl pkg3.tcl
} {0 {{pkg1:1.0 {tclPkgSetup {pkg1.tcl source {::pkg1::p1-1 ::pkg1::p1-2}}}} {pkg3:1.0 {tclPkgSetup {pkg3.tcl source {::pkg3::p3-1 ::pkg3::p3-2}}}}}}
test pkgMkIndex-6.2 {pkg1 requires pkg3 - use -direct} {
pkgtest::runIndex -direct $fullPkgPath pkg1.tcl pkg3.tcl
-} "0 {{pkg1:1.0 {source [file join $fullPkgPath pkg1.tcl]}} {pkg3:1.0 {source [file join $fullPkgPath pkg3.tcl]}}}"
+} "0 {{pkg1:1.0 {[list source [file join $fullPkgPath pkg1.tcl]]}} {pkg3:1.0 {[list source [file join $fullPkgPath pkg3.tcl]]}}}"
+
+removeFile [file join pkg pkg1.tcl]
+
+makeFile {
+# This package requires pkg3, and it calls
+# a pkg3 proc in the code that is executed by the file
+package require pkg3 1.0
+package provide pkg4 1.0
+namespace eval pkg4 {
+ namespace export p4-1 p4-2
+ variable m2 [pkg3::p3-1 10]
+}
+proc pkg4::p4-1 { num } {
+ variable m2
+ return [expr {$m2 * $num}]
+}
+proc pkg4::p4-2 { num } {
+ return [pkg3::p3-2 $num]
+}
+} [file join pkg pkg4.tcl]
test pkgMkIndex-7.1 {pkg4 uses pkg3} {
pkgtest::runIndex -lazy $fullPkgPath pkg4.tcl pkg3.tcl
@@ -313,7 +448,31 @@ test pkgMkIndex-7.1 {pkg4 uses pkg3} {
test pkgMkIndex-7.2 {pkg4 uses pkg3 - use -direct} {
pkgtest::runIndex -direct $fullPkgPath pkg4.tcl pkg3.tcl
-} "0 {{pkg3:1.0 {source [file join $fullPkgPath pkg3.tcl]}} {pkg4:1.0 {source [file join $fullPkgPath pkg4.tcl]}}}"
+} "0 {{pkg3:1.0 {[list source [file join $fullPkgPath pkg3.tcl]]}} {pkg4:1.0 {[list source [file join $fullPkgPath pkg4.tcl]]}}}"
+
+removeFile [file join pkg pkg4.tcl]
+removeFile [file join pkg pkg3.tcl]
+
+makeFile {
+# This package requires pkg2, and it calls
+# a pkg2 proc in the code that is executed by the file.
+# Pkg2 is a split package.
+package require pkg2 1.0
+package provide pkg5 1.0
+namespace eval pkg5 {
+ namespace export p5-1 p5-2
+ variable m2 [pkg2::p2-1 10]
+ variable m3 [pkg2::p2-2 10]
+}
+proc pkg5::p5-1 { num } {
+ variable m2
+ return [expr {$m2 * $num}]
+}
+proc pkg5::p5-2 { num } {
+ variable m2
+ return [expr {$m2 * $num}]
+}
+} [file join pkg pkg5.tcl]
test pkgMkIndex-8.1 {pkg5 uses pkg2} {
pkgtest::runIndex -lazy $fullPkgPath pkg5.tcl pkg2_a.tcl pkg2_b.tcl
@@ -321,52 +480,216 @@ test pkgMkIndex-8.1 {pkg5 uses pkg2} {
test pkgMkIndex-8.2 {pkg5 uses pkg2 - use -direct} {
pkgtest::runIndex -direct $fullPkgPath pkg5.tcl pkg2_a.tcl pkg2_b.tcl
-} "0 {{pkg2:1.0 {source [file join $fullPkgPath pkg2_a.tcl]
-source [file join $fullPkgPath pkg2_b.tcl]}} {pkg5:1.0 {source [file join $fullPkgPath pkg5.tcl]}}}"
+} "0 {{pkg2:1.0 {[list source [file join $fullPkgPath pkg2_a.tcl]]
+[list source [file join $fullPkgPath pkg2_b.tcl]]}} {pkg5:1.0 {[list source [file join $fullPkgPath pkg5.tcl]]}}}"
+
+removeFile [file join pkg pkg5.tcl]
+removeFile [file join pkg pkg2_a.tcl]
+removeFile [file join pkg pkg2_b.tcl]
+
+makeFile {
+# This package requires circ2, and circ2
+# requires circ3, which in turn requires circ1.
+# In case of cirularities, pkg_mkIndex should give up when it gets stuck.
+package require circ2 1.0
+package provide circ1 1.0
+namespace eval circ1 {
+ namespace export c1-1 c1-2 c1-3 c1-4
+}
+proc circ1::c1-1 { num } {
+ return [circ2::c2-1 $num]
+}
+proc circ1::c1-2 { num } {
+ return [circ2::c2-2 $num]
+}
+proc circ1::c1-3 {} {
+ return 10
+}
+proc circ1::c1-4 {} {
+ return 20
+}
+} [file join pkg circ1.tcl]
+
+makeFile {
+# This package is required by circ1, and
+# requires circ3. Circ3, in turn, requires circ1 to give us a circularity.
+package require circ3 1.0
+package provide circ2 1.0
+namespace eval circ2 {
+ namespace export c2-1 c2-2
+}
+proc circ2::c2-1 { num } {
+ return [expr $num * [circ3::c3-1]]
+}
+proc circ2::c2-2 { num } {
+ return [expr $num * [circ3::c3-2]]
+}
+} [file join pkg circ2.tcl]
+
+makeFile {
+# This package is required by circ2, and in
+# turn requires circ1. This closes the circularity.
+package require circ1 1.0
+package provide circ3 1.0
+namespace eval circ3 {
+ namespace export c3-1 c3-4
+}
+proc circ3::c3-1 {} {
+ return [circ1::c1-3]
+}
+proc circ3::c3-2 {} {
+ return [circ1::c1-4]
+}
+} [file join pkg circ3.tcl]
test pkgMkIndex-9.1 {circular packages} {
pkgtest::runIndex -lazy $fullPkgPath circ1.tcl circ2.tcl circ3.tcl
} {0 {{circ1:1.0 {tclPkgSetup {circ1.tcl source {::circ1::c1-1 ::circ1::c1-2 ::circ1::c1-3 ::circ1::c1-4}}}} {circ2:1.0 {tclPkgSetup {circ2.tcl source {::circ2::c2-1 ::circ2::c2-2}}}} {circ3:1.0 {tclPkgSetup {circ3.tcl source ::circ3::c3-1}}}}}
+removeFile [file join pkg circ1.tcl]
+removeFile [file join pkg circ2.tcl]
+removeFile [file join pkg circ3.tcl]
+
# Some tests require the existence of one of the DLLs in the dltest directory
set x [file join [file dirname [info nameofexecutable]] dltest \
pkga[info sharedlibextension]]
set dll "[file tail $x]Required"
-set ::tcltest::testConstraints($dll) [file exists $x]
-
-test pkgMkIndex-10.1 {package in DLL and script} $dll {
- file copy -force $x $fullPkgPath
- pkgtest::runIndex -lazy $fullPkgPath pkga[info sharedlibextension] pkga.tcl
+::tcltest::testConstraint $dll [file exists $x]
+
+if {[testConstraint $dll]} {
+makeFile {
+# This package provides Pkga, which is also provided by a DLL.
+package provide Pkga 1.0
+proc pkga_neq { x } {
+ return [expr {! [pkgq_eq $x]}]
+}
+} [file join pkg pkga.tcl]
+file copy -force $x $fullPkgPath
+}
+testConstraint exec [llength [info commands ::exec]]
+
+test pkgMkIndex-10.1 {package in DLL and script} [list exec $dll] {
+ # Do all [load]ing of shared libraries in another process, so
+ # we can delete the file and not get stuck because we're holding
+ # a reference to it.
+ set cmd [list pkg_mkIndex -lazy $fullPkgPath [file tail $x] pkga.tcl]
+ exec [interpreter] << $cmd
+ pkgtest::runCreatedIndex {0 {}} -lazy $fullPkgPath pkga[info sharedlibextension] pkga.tcl
} "0 {{Pkga:1.0 {tclPkgSetup {pkga[info sharedlibextension] load {pkga_eq pkga_quote}} {pkga.tcl source pkga_neq}}}}"
-test pkgMkIndex-10.2 {package in DLL hidden by -load} $dll {
- pkgtest::runIndex -lazy -load Pkg* -- $fullPkgPath pkga[info sharedlibextension]
+test pkgMkIndex-10.2 {package in DLL hidden by -load} [list exec $dll] {
+ # Do all [load]ing of shared libraries in another process, so
+ # we can delete the file and not get stuck because we're holding
+ # a reference to it.
+ #
+ # This test depends on context from prior test, so repeat it.
+ set script "[list pkg_mkIndex -lazy $fullPkgPath [file tail $x] pkga.tcl]\n"
+ append script \
+ "[list pkg_mkIndex -lazy -load Pkg* $fullPkgPath [file tail $x]]"
+ exec [interpreter] << $script
+ pkgtest::runCreatedIndex {0 {}} -lazy -load Pkg* -- $fullPkgPath pkga[info sharedlibextension]
} {0 {}}
+if {[testConstraint $dll]} {
+file delete -force [file join $fullPkgPath [file tail $x]]
+removeFile [file join pkg pkga.tcl]
+}
+
# Tolerate "namespace import" at the global scope
+makeFile {
+package provide fubar 1.0
+namespace eval ::fubar:: {
+ #
+ # export only public functions.
+ #
+ namespace export {[a-z]*}
+}
+proc ::fubar::foo {bar} {
+ puts "$bar"
+ return true
+}
+namespace import ::fubar::foo
+} [file join pkg import.tcl]
+
test pkgMkIndex-11.1 {conflicting namespace imports} {
pkgtest::runIndex -lazy $fullPkgPath import.tcl
} {0 {{fubar:1.0 {tclPkgSetup {import.tcl source ::fubar::foo}}}}}
+removeFile [file join pkg import.tcl]
+
# Verify that the auto load list generated is correct even when there
# is a proc name conflict between two namespaces (ie, ::foo::baz and
# ::bar::baz)
+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]
+
test pkgMkIndex-12.1 {same name procs in different namespace} {
pkgtest::runIndex -lazy $fullPkgPath samename.tcl
} {0 {{football:1.0 {tclPkgSetup {samename.tcl source {::college::team ::pro::team}}}}}}
+removeFile [file join pkg samename.tcl]
+
# Proc names with embedded spaces are properly listed (ie, correct number of
# braces) in result
+makeFile {
+package provide spacename 1.0
+proc {a b} {} {}
+proc {c d} {} {}
+} [file join pkg spacename.tcl]
+
test pkgMkIndex-13.1 {proc names with embedded spaces} {
pkgtest::runIndex -lazy $fullPkgPath spacename.tcl
} {0 {{spacename:1.0 {tclPkgSetup {spacename.tcl source {{a b} {c d}}}}}}}
+removeFile [file join pkg spacename.tcl]
+
+# Test the pkg_compareExtension helper function
+test pkgMkIndex-14.1 {pkg_compareExtension} {unixOnly} {
+ pkg_compareExtension foo.so .so
+} 1
+test pkgMkIndex-14.2 {pkg_compareExtension} {unixOnly} {
+ pkg_compareExtension foo.so.bar .so
+} 0
+test pkgMkIndex-14.3 {pkg_compareExtension} {unixOnly} {
+ pkg_compareExtension foo.so.1 .so
+} 1
+test pkgMkIndex-14.4 {pkg_compareExtension} {unixOnly} {
+ pkg_compareExtension foo.so.1.2 .so
+} 1
+test pkgMkIndex-14.5 {pkg_compareExtension} {unixOnly} {
+ pkg_compareExtension foo .so
+} 0
+test pkgMkIndex-14.6 {pkg_compareExtension} {unixOnly} {
+ pkg_compareExtension foo.so.1.2.bar .so
+} 0
+
# cleanup
+removeDirectory pkg
+
namespace delete pkgtest
-cd $origDir
::tcltest::cleanupTests
return
-
diff --git a/tcl/tests/platform.test b/tcl/tests/platform.test
index 9c7dec51a5d..19001ee3b4c 100644
--- a/tcl/tests/platform.test
+++ b/tcl/tests/platform.test
@@ -23,19 +23,19 @@ test platform-1.1 {TclpSetVariables: tcl_platform} {
set result [i eval {lsort [array names tcl_platform]}]
interp delete i
set result
-} {byteOrder machine os osVersion platform user}
+} {byteOrder machine os osVersion platform user wordSize}
+
+# Test assumes twos-complement arithmetic, which is true of virtually
+# everything these days. Note that this does *not* use wide(), and
+# this is intentional since that could make Tcl's numbers wider than
+# the machine-integer on some platforms...
+test platform-2.1 {tcl_platform(wordSize) indicates size of native word} {
+ set result [expr {1 << (8 * $tcl_platform(wordSize) - 1)}]
+ # Result must be the largest bit in a machine word, which this checks
+ # without assuming how wide the word really is
+ list [expr {$result < 0}] [expr {$result ^ ($result - 1)}]
+} {1 -1}
# cleanup
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tcl/tests/proc-old.test b/tcl/tests/proc-old.test
index eec85d2b91e..a2c0c6d605a 100644
--- a/tcl/tests/proc-old.test
+++ b/tcl/tests/proc-old.test
@@ -160,80 +160,80 @@ test proc-old-3.9 {local and global arrays} {
} {{w t1}}
catch {unset a}
-test proc-old-3.1 {arguments and defaults} {
+test proc-old-30.1 {arguments and defaults} {
proc tproc {x y z} {
return [list $x $y $z]
}
tproc 11 12 13
} {11 12 13}
-test proc-old-3.2 {arguments and defaults} {
+test proc-old-30.2 {arguments and defaults} {
proc tproc {x y z} {
return [list $x $y $z]
}
list [catch {tproc 11 12} msg] $msg
-} {1 {no value given for parameter "z" to "tproc"}}
-test proc-old-3.3 {arguments and defaults} {
+} {1 {wrong # args: should be "tproc x y z"}}
+test proc-old-30.3 {arguments and defaults} {
proc tproc {x y z} {
return [list $x $y $z]
}
list [catch {tproc 11 12 13 14} msg] $msg
-} {1 {called "tproc" with too many arguments}}
-test proc-old-3.4 {arguments and defaults} {
+} {1 {wrong # args: should be "tproc x y z"}}
+test proc-old-30.4 {arguments and defaults} {
proc tproc {x {y y-default} {z z-default}} {
return [list $x $y $z]
}
tproc 11 12 13
} {11 12 13}
-test proc-old-3.5 {arguments and defaults} {
+test proc-old-30.5 {arguments and defaults} {
proc tproc {x {y y-default} {z z-default}} {
return [list $x $y $z]
}
tproc 11 12
} {11 12 z-default}
-test proc-old-3.6 {arguments and defaults} {
+test proc-old-30.6 {arguments and defaults} {
proc tproc {x {y y-default} {z z-default}} {
return [list $x $y $z]
}
tproc 11
} {11 y-default z-default}
-test proc-old-3.7 {arguments and defaults} {
+test proc-old-30.7 {arguments and defaults} {
proc tproc {x {y y-default} {z z-default}} {
return [list $x $y $z]
}
list [catch {tproc} msg] $msg
-} {1 {no value given for parameter "x" to "tproc"}}
-test proc-old-3.8 {arguments and defaults} {
+} {1 {wrong # args: should be "tproc x ?y? ?z?"}}
+test proc-old-30.8 {arguments and defaults} {
list [catch {
proc tproc {x {y y-default} z} {
return [list $x $y $z]
}
tproc 2 3
} msg] $msg
-} {1 {no value given for parameter "z" to "tproc"}}
-test proc-old-3.9 {arguments and defaults} {
+} {1 {wrong # args: should be "tproc x ?y? z"}}
+test proc-old-30.9 {arguments and defaults} {
proc tproc {x {y y-default} args} {
return [list $x $y $args]
}
tproc 2 3 4 5
} {2 3 {4 5}}
-test proc-old-3.10 {arguments and defaults} {
+test proc-old-30.10 {arguments and defaults} {
proc tproc {x {y y-default} args} {
return [list $x $y $args]
}
tproc 2 3
} {2 3 {}}
-test proc-old-3.11 {arguments and defaults} {
+test proc-old-30.11 {arguments and defaults} {
proc tproc {x {y y-default} args} {
return [list $x $y $args]
}
tproc 2
} {2 y-default {}}
-test proc-old-3.12 {arguments and defaults} {
+test proc-old-30.12 {arguments and defaults} {
proc tproc {x {y y-default} args} {
return [list $x $y $args]
}
list [catch {tproc} msg] $msg
-} {1 {no value given for parameter "x" to "tproc"}}
+} {1 {wrong # args: should be "tproc x ?y? args"}}
test proc-old-4.1 {variable numbers of arguments} {
proc tproc args {return $args}
@@ -258,7 +258,7 @@ test proc-old-4.5 {variable numbers of arguments} {
test proc-old-4.6 {variable numbers of arguments} {
proc tproc {x missing args} {return $args}
list [catch {tproc 1} msg] $msg
-} {1 {no value given for parameter "missing" to "tproc"}}
+} {1 {wrong # args: should be "tproc x missing args"}}
test proc-old-5.1 {error conditions} {
list [catch {proc} msg] $msg
@@ -332,7 +332,8 @@ test proc-old-5.14 {error conditions} {
catch tproc msg
set errorInfo
} {invoked "break" outside of a loop
- while executing
+ (procedure "tproc" line 1)
+ invoked from within
"tproc"}
test proc-old-5.15 {error conditions} {
proc tproc {} {
@@ -343,7 +344,8 @@ test proc-old-5.15 {error conditions} {
catch tproc msg
set errorInfo
} {invoked "continue" outside of a loop
- while executing
+ (procedure "tproc" line 1)
+ invoked from within
"tproc"}
test proc-old-5.16 {error conditions} {
proc foo args {
@@ -433,7 +435,9 @@ test proc-old-7.11 {return with special completion code} {
catch {open _bad_file_name r} msg
return -code error -errorinfo $errorInfo -errorcode $errorCode $msg
}
- normalizeMsg [list [catch tproc2 msg] $msg $errorInfo $errorCode]
+ set msg [list [catch tproc2 msg] $msg $errorInfo $errorCode]
+ regsub -all [file join {} _bad_file_name] $msg "_bad_file_name" msg
+ normalizeMsg $msg
} {1 {couldn't open "_bad_file_name": no such file or directory} {couldn't open "_bad_file_name": no such file or directory
while executing
"open _bad_file_name r"
@@ -445,7 +449,9 @@ test proc-old-7.12 {return with special completion code} {
catch {open _bad_file_name r} msg
return -code error -errorcode $errorCode $msg
}
- normalizeMsg [list [catch tproc2 msg] $msg $errorInfo $errorCode]
+ set msg [list [catch tproc2 msg] $msg $errorInfo $errorCode]
+ regsub -all [file join {} _bad_file_name] $msg "_bad_file_name" msg
+ normalizeMsg $msg
} {1 {couldn't open "_bad_file_name": no such file or directory} {couldn't open "_bad_file_name": no such file or directory
while executing
"tproc2"} {posix enoent {no such file or directory}}}
@@ -455,7 +461,9 @@ test proc-old-7.13 {return with special completion code} {
catch {open _bad_file_name r} msg
return -code error -errorinfo $errorInfo $msg
}
- normalizeMsg [list [catch tproc2 msg] $msg $errorInfo $errorCode]
+ set msg [list [catch tproc2 msg] $msg $errorInfo $errorCode]
+ regsub -all [file join {} _bad_file_name] $msg "_bad_file_name" msg
+ normalizeMsg $msg
} {1 {couldn't open "_bad_file_name": no such file or directory} {couldn't open "_bad_file_name": no such file or directory
while executing
"open _bad_file_name r"
@@ -467,7 +475,9 @@ test proc-old-7.14 {return with special completion code} {
catch {open _bad_file_name r} msg
return -code error $msg
}
- normalizeMsg [list [catch tproc2 msg] $msg $errorInfo $errorCode]
+ set msg [list [catch tproc2 msg] $msg $errorInfo $errorCode]
+ regsub -all [file join {} _bad_file_name] $msg "_bad_file_name" msg
+ normalizeMsg $msg
} {1 {couldn't open "_bad_file_name": no such file or directory} {couldn't open "_bad_file_name": no such file or directory
while executing
"tproc2"} none}
@@ -522,4 +532,3 @@ return
-
diff --git a/tcl/tests/proc.test b/tcl/tests/proc.test
index 7820404e357..e89e440d78a 100644
--- a/tcl/tests/proc.test
+++ b/tcl/tests/proc.test
@@ -96,6 +96,11 @@ test proc-1.7 {Tcl_ProcObjCmd, check that formal parameter names are not array e
puts "$z=z, $a(1)=$a(1)"
}} msg] $msg
} {1 {procedure "p" has formal parameter "a(1)" that is an array element}}
+test proc-1.8 {Tcl_ProcObjCmd, check that formal parameter names are simple names} {
+ catch {rename p ""}
+ list [catch {proc p {b:a b::a} {
+ }} msg] $msg
+} {1 {procedure "p" has formal parameter "b::a" that is not a simple name}}
test proc-2.1 {TclFindProc, simple proc name and proc not in namespace} {
catch {eval namespace delete [namespace children :: test_ns_*]}
@@ -159,7 +164,7 @@ test proc-3.4 {TclObjInterpProc, procs execute in the namespace in which they we
test proc-3.5 {TclObjInterpProc, any old result is reset before appending error msg about missing arguments} {
proc p {x} {info commands 3m}
list [catch {p} msg] $msg
-} {1 {no value given for parameter "x" to "p"}}
+} {1 {wrong # args: should be "p x"}}
catch {eval namespace delete [namespace children :: test_ns_*]}
catch {rename p ""}
@@ -294,6 +299,23 @@ test proc-4.7 {TclCreateProc, procbody obj, inconsitent arg default value} {
set result
} {procedure "t": formal parameter "z" has default value inconsistent with precompiled body}
+test proc-5.1 {Bytecompiling noop; test for correct argument substitution} {
+ proc p args {} ; # this will be bytecompiled into t
+ proc t {} {
+ set res {}
+ set a 0
+ set b 0
+ trace add variable a read {append res a ;#}
+ trace add variable b write {append res b ;#}
+ p $a ccccccw {bfe} {$a} [incr b] [incr a] {[incr b]} {$a} hello
+ set res
+ }
+ set result [t]
+ catch {rename p ""}
+ catch {rename t ""}
+ set result
+} {aba}
+
# cleanup
catch {rename p ""}
catch {rename t ""}
@@ -311,4 +333,3 @@ return
-
diff --git a/tcl/tests/pwd.test b/tcl/tests/pwd.test
index 6cf000753d2..474afc8e211 100644
--- a/tcl/tests/pwd.test
+++ b/tcl/tests/pwd.test
@@ -40,4 +40,3 @@ return
-
diff --git a/tcl/tests/reg.test b/tcl/tests/reg.test
index acc250cae23..dc8ff775264 100644
--- a/tcl/tests/reg.test
+++ b/tcl/tests/reg.test
@@ -12,16 +12,16 @@
# RCS: @(#) $Id$
if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+ package require tcltest 2
namespace import -force ::tcltest::*
}
# All tests require the testregexp command, return if this
# command doesn't exist
-set ::tcltest::testConstraints(testregexp) \
+::tcltest::testConstraint testregexp \
[expr {[info commands testregexp] != {}}]
-set ::tcltest::testConstraints(localeRegexp) 0
+::tcltest::testConstraint localeRegexp 0
# This file uses some custom procedures, defined below, for regexp regression
# testing. The name of the procedure indicates the general nature of the
@@ -267,7 +267,7 @@ proc matchexpected {opts testid flags re target args} {
if {[info exists regBug] && $regBug} {
# This will register as a skipped test
- test $prefix.[tno $testid] [desc $testid] knownBug {} {}
+ test $prefix.[tno $testid] [desc $testid] knownBug {format 0} {1}
return
}
@@ -987,9 +987,14 @@ m 9 HLP {(?n)^(?![t#])\S+} "tk\n\n#\n#\nit0" it0
# flush any leftover complaints
doing 0 "flush"
+# Tests resulting from bugs reported by users
+test reg-31.1 {[[:xdigit:]] behaves correctly when followed by [[:space:]]} {
+ set str {2:::DebugWin32}
+ set re {([[:xdigit:]])([[:space:]]*)}
+ list [regexp $re $str match xdigit spaces] $match $xdigit $spaces
+ # Code used to produce {1 2:::DebugWin32 2 :::DebugWin32} !!!
+} {1 2 2 {}}
+
# cleanup
::tcltest::cleanupTests
return
-
-
-
diff --git a/tcl/tests/regexp.test b/tcl/tests/regexp.test
index c05ae964e13..247d4d7c84d 100644
--- a/tcl/tests/regexp.test
+++ b/tcl/tests/regexp.test
@@ -84,6 +84,16 @@ test regexp-2.8 {getting substrings back from regexp} {
set match {}
list [regexp {^a*b} aaaab match] $match
} {1 aaaab}
+test regexp-2.9 {getting substrings back from regexp} {
+ set foo {}
+ set f2 {}
+ list [regexp f\352te(b*)c f\352tebbbbc foo f2] $foo $f2
+} [list 1 f\352tebbbbc bbbb]
+test regexp-2.10 {getting substrings back from regexp} {
+ set foo {}
+ set f2 {}
+ list [regexp f\352te(b*)c eff\352tebbbbc foo f2] $foo $f2
+} [list 1 f\352tebbbbc bbbb]
test regexp-3.1 {-indices option to regexp} {
set foo {}
@@ -343,17 +353,17 @@ test regexp-10.5 {inverse partial newline sensitivity in regsub} {
} "1 {da\nb123\nxb}"
test regexp-11.1 {regsub errors} {
- list [catch {regsub a b c} msg] $msg
-} {1 {wrong # args: should be "regsub ?switches? exp string subSpec varName"}}
+ list [catch {regsub a b} msg] $msg
+} {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}}
test regexp-11.2 {regsub errors} {
- list [catch {regsub -nocase a b c} msg] $msg
-} {1 {wrong # args: should be "regsub ?switches? exp string subSpec varName"}}
+ list [catch {regsub -nocase a b} msg] $msg
+} {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}}
test regexp-11.3 {regsub errors} {
- list [catch {regsub -nocase -all a b c} msg] $msg
-} {1 {wrong # args: should be "regsub ?switches? exp string subSpec varName"}}
+ list [catch {regsub -nocase -all a b} msg] $msg
+} {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}}
test regexp-11.4 {regsub errors} {
list [catch {regsub a b c d e f} msg] $msg
-} {1 {wrong # args: should be "regsub ?switches? exp string subSpec varName"}}
+} {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}}
test regexp-11.5 {regsub errors} {
list [catch {regsub -gorp a b c} msg] $msg
} {1 {bad switch "-gorp": must be -all, -nocase, -expanded, -line, -linestop, -lineanchor, -start, or --}}
@@ -368,6 +378,18 @@ test regexp-11.7 {regsub errors} {
test regexp-11.8 {regsub errors, -start bad int check} {
list [catch {regsub -start bogus pattern string rep var} msg] $msg
} {1 {expected integer but got "bogus"}}
+test regexp-11.9 {regsub without final variable name returns value} {
+ regsub b abaca X
+} {aXaca}
+test regexp-11.10 {regsub without final variable name returns value} {
+ regsub -all a abaca X
+} {XbXcX}
+test regexp-11.11 {regsub without final variable name returns value} {
+ regsub b(.*?)d abcdeabcfde {,&,\1,}
+} {a,bcd,c,eabcfde}
+test regexp-11.12 {regsub without final variable name returns value} {
+ regsub -all b(.*?)d abcdeabcfde {,&,\1,}
+} {a,bcd,c,ea,bcfd,cf,e}
# This test crashes on the Mac unless you increase the Stack Space to about 1
# Meg. This is probably bigger than most users want...
@@ -411,11 +433,11 @@ test regexp-14.2 {CompileRegexp: regexp cache, different flags} {
regexp -nocase $x bbba
} 1
-# There is no exec on the Mac ...
-
-test regexp-14.3 {CompileRegexp: regexp cache, empty regexp and empty cache} {unixOrPc} {
- makeFile {puts [regexp {} foo]} junk.tcl
- exec $::tcltest::tcltest junk.tcl
+testConstraint exec [llength [info commands exec]]
+test regexp-14.3 {CompileRegexp: regexp cache, empty regexp and empty cache} {
+ exec
+} {
+ exec [interpreter] [makeFile {puts [regexp {} foo]} junk.tcl]
} 1
test regexp-15.1 {regexp -start} {
@@ -526,22 +548,30 @@ test regexp-18.10 {regexp -all} {
# Go to index 3; this is past the end of the string, so stop.
regexp -all -inline {a*} aba
} {a {} a}
+test regexp-18.11 {regexp -all} {
+ regexp -all -inline {^a} aaaa
+} {a}
+test regexp-18.12 {regexp -all -inline -indices} {
+ regexp -all -inline -indices a(b(c)d|e(f)g)h abcdhaefgh
+} {{0 4} {1 3} {2 2} {-1 -1} {5 9} {6 8} {-1 -1} {7 7}}
+
+test regexp-19.1 {regsub null replacement} {
+ regsub -all {@} {@hel@lo@} "\0a\0" result
+ list $result [string length $result]
+} "\0a\0hel\0a\0lo\0a\0 14"
+
+test regexp-20.1 {regsub shared object shimmering} {
+ # Bug #461322
+ set a abcdefghijklmnopqurstuvwxyz
+ set b $a
+ set c abcdefghijklmnopqurstuvwxyz0123456789
+ regsub $a $c $b d
+ list $d [string length $d] [string bytelength $d]
+} [list abcdefghijklmnopqurstuvwxyz0123456789 37 37]
+test regexp-20.2 {regsub shared object shimmering with -about} {
+ eval regexp -about abc
+} {0 {}}
# cleanup
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tcl/tests/regexpComp.test b/tcl/tests/regexpComp.test
new file mode 100644
index 00000000000..3ae78b247ef
--- /dev/null
+++ b/tcl/tests/regexpComp.test
@@ -0,0 +1,803 @@
+# Commands covered: regexp, regsub
+#
+# 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) 1998 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$
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
+# Procedure to evaluate a script within a proc, to test compilation
+# functionality
+
+proc evalInProc { script } {
+ proc testProc {} $script
+ set status [catch {
+ testProc
+ } result]
+ rename testProc {}
+ return $result
+ #return [list $status $result]
+}
+
+catch {unset foo}
+test regexp-1.1 {basic regexp operation} {
+ evalInProc {
+ regexp ab*c abbbc
+ }
+} 1
+test regexp-1.2 {basic regexp operation} {
+ evalInProc {
+ regexp ab*c ac
+ }
+} 1
+test regexp-1.3 {basic regexp operation} {
+ evalInProc {
+ regexp ab*c ab
+ }
+} 0
+test regexp-1.4 {basic regexp operation} {
+ evalInProc {
+ regexp -- -gorp abc-gorpxxx
+ }
+} 1
+test regexp-1.5 {basic regexp operation} {
+ evalInProc {
+ regexp {^([^ ]*)[ ]*([^ ]*)} "" a
+ }
+} 1
+test regexp-1.6 {basic regexp operation} {
+ list [catch {regexp {} abc} msg] $msg
+} {0 1}
+test regexp-1.7 {regexp utf compliance} {
+ # if not UTF-8 aware, result is "0 1"
+ evalInProc {
+ set foo "\u4e4eb q"
+ regexp "\u4e4eb q" "a\u4e4eb qw\u5e4e\x4e wq" bar
+ list [string compare $foo $bar] [regexp 4 $bar]
+ }
+} {0 0}
+
+test regexp-2.1 {getting substrings back from regexp} {
+ evalInProc {
+ set foo {}
+ list [regexp ab*c abbbbc foo] $foo
+ }
+} {1 abbbbc}
+test regexp-2.2 {getting substrings back from regexp} {
+ evalInProc {
+ set foo {}
+ set f2 {}
+ list [regexp a(b*)c abbbbc foo f2] $foo $f2
+ }
+} {1 abbbbc bbbb}
+test regexp-2.3 {getting substrings back from regexp} {
+ evalInProc {
+ set foo {}
+ set f2 {}
+ list [regexp a(b*)(c) abbbbc foo f2] $foo $f2
+ }
+} {1 abbbbc bbbb}
+test regexp-2.4 {getting substrings back from regexp} {
+ evalInProc {
+ set foo {}
+ set f2 {}
+ set f3 {}
+ list [regexp a(b*)(c) abbbbc foo f2 f3] $foo $f2 $f3
+ }
+} {1 abbbbc bbbb c}
+test regexp-2.5 {getting substrings back from regexp} {
+ evalInProc {
+ set foo {}; set f1 {}; set f2 {}; set f3 {}; set f4 {}; set f5 {};
+ set f6 {}; set f7 {}; set f8 {}; set f9 {}; set fa {}; set fb {};
+ list [regexp (1*)(2*)(3*)(4*)(5*)(6*)(7*)(8*)(9*)(a*)(b*) \
+ 12223345556789999aabbb \
+ foo f1 f2 f3 f4 f5 f6 f7 f8 f9 fa fb] $foo $f1 $f2 $f3 $f4 $f5 \
+ $f6 $f7 $f8 $f9 $fa $fb
+ }
+} {1 12223345556789999aabbb 1 222 33 4 555 6 7 8 9999 aa bbb}
+test regexp-2.6 {getting substrings back from regexp} {
+ evalInProc {
+ set foo 2; set f2 2; set f3 2; set f4 2
+ list [regexp (a)(b)? xay foo f2 f3 f4] $foo $f2 $f3 $f4
+ }
+} {1 a a {} {}}
+test regexp-2.7 {getting substrings back from regexp} {
+ evalInProc {
+ set foo 1; set f2 1; set f3 1; set f4 1
+ list [regexp (a)(b)?(c) xacy foo f2 f3 f4] $foo $f2 $f3 $f4
+ }
+} {1 ac a {} c}
+test regexp-2.8 {getting substrings back from regexp} {
+ evalInProc {
+ set match {}
+ list [regexp {^a*b} aaaab match] $match
+ }
+} {1 aaaab}
+
+test regexp-3.1 {-indices option to regexp} {
+ evalInProc {
+ set foo {}
+ list [regexp -indices ab*c abbbbc foo] $foo
+ }
+} {1 {0 5}}
+test regexp-3.2 {-indices option to regexp} {
+ evalInProc {
+ set foo {}
+ set f2 {}
+ list [regexp -indices a(b*)c abbbbc foo f2] $foo $f2
+ }
+} {1 {0 5} {1 4}}
+test regexp-3.3 {-indices option to regexp} {
+ evalInProc {
+ set foo {}
+ set f2 {}
+ list [regexp -indices a(b*)(c) abbbbc foo f2] $foo $f2
+ }
+} {1 {0 5} {1 4}}
+test regexp-3.4 {-indices option to regexp} {
+ evalInProc {
+ set foo {}
+ set f2 {}
+ set f3 {}
+ list [regexp -indices a(b*)(c) abbbbc foo f2 f3] $foo $f2 $f3
+ }
+} {1 {0 5} {1 4} {5 5}}
+test regexp-3.5 {-indices option to regexp} {
+ evalInProc {
+ set foo {}; set f1 {}; set f2 {}; set f3 {}; set f4 {}; set f5 {};
+ set f6 {}; set f7 {}; set f8 {}; set f9 {}
+ list [regexp -indices (1*)(2*)(3*)(4*)(5*)(6*)(7*)(8*)(9*) \
+ 12223345556789999 \
+ foo f1 f2 f3 f4 f5 f6 f7 f8 f9] $foo $f1 $f2 $f3 $f4 $f5 \
+ $f6 $f7 $f8 $f9
+ }
+} {1 {0 16} {0 0} {1 3} {4 5} {6 6} {7 9} {10 10} {11 11} {12 12} {13 16}}
+test regexp-3.6 {getting substrings back from regexp} {
+ evalInProc {
+ set foo 2; set f2 2; set f3 2; set f4 2
+ list [regexp -indices (a)(b)? xay foo f2 f3 f4] $foo $f2 $f3 $f4
+ }
+} {1 {1 1} {1 1} {-1 -1} {-1 -1}}
+test regexp-3.7 {getting substrings back from regexp} {
+ evalInProc {
+ set foo 1; set f2 1; set f3 1; set f4 1
+ list [regexp -indices (a)(b)?(c) xacy foo f2 f3 f4] $foo $f2 $f3 $f4
+ }
+} {1 {1 2} {1 1} {-1 -1} {2 2}}
+
+test regexp-4.1 {-nocase option to regexp} {
+ evalInProc {
+ regexp -nocase foo abcFOo
+ }
+} 1
+test regexp-4.2 {-nocase option to regexp} {
+ evalInProc {
+ set f1 22
+ set f2 33
+ set f3 44
+ list [regexp -nocase {a(b*)([xy]*)z} aBbbxYXxxZ22 f1 f2 f3] $f1 $f2 $f3
+ }
+} {1 aBbbxYXxxZ Bbb xYXxx}
+test regexp-4.3 {-nocase option to regexp} {
+ evalInProc {
+ regexp -nocase FOo abcFOo
+ }
+} 1
+set ::x abcdefghijklmnopqrstuvwxyz1234567890
+set ::x $x$x$x$x$x$x$x$x$x$x$x$x
+test regexp-4.4 {case conversion in regexp} {
+ evalInProc {
+ list [regexp -nocase $::x $::x foo] $foo
+ }
+} "1 $x"
+catch {unset ::x}
+
+test regexp-5.1 {exercise cache of compiled expressions} {
+ evalInProc {
+ regexp .*a b
+ regexp .*b c
+ regexp .*c d
+ regexp .*d e
+ regexp .*e f
+ regexp .*a bbba
+ }
+} 1
+test regexp-5.2 {exercise cache of compiled expressions} {
+ evalInProc {
+ regexp .*a b
+ regexp .*b c
+ regexp .*c d
+ regexp .*d e
+ regexp .*e f
+ regexp .*b xxxb
+ }
+} 1
+test regexp-5.3 {exercise cache of compiled expressions} {
+ evalInProc {
+ regexp .*a b
+ regexp .*b c
+ regexp .*c d
+ regexp .*d e
+ regexp .*e f
+ regexp .*c yyyc
+ }
+} 1
+test regexp-5.4 {exercise cache of compiled expressions} {
+ evalInProc {
+ regexp .*a b
+ regexp .*b c
+ regexp .*c d
+ regexp .*d e
+ regexp .*e f
+ regexp .*d 1d
+ }
+} 1
+test regexp-5.5 {exercise cache of compiled expressions} {
+ evalInProc {
+ regexp .*a b
+ regexp .*b c
+ regexp .*c d
+ regexp .*d e
+ regexp .*e f
+ regexp .*e xe
+ }
+} 1
+
+test regexp-6.1 {regexp errors} {
+ evalInProc {
+ list [catch {regexp a} msg] $msg
+ }
+} {1 {wrong # args: should be "regexp ?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?"}}
+test regexp-6.2 {regexp errors} {
+ evalInProc {
+ list [catch {regexp -nocase a} msg] $msg
+ }
+} {1 {wrong # args: should be "regexp ?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?"}}
+test regexp-6.3 {regexp errors} {
+ evalInProc {
+ list [catch {regexp -gorp a} msg] $msg
+ }
+} {1 {bad switch "-gorp": must be -all, -about, -indices, -inline, -expanded, -line, -linestop, -lineanchor, -nocase, -start, or --}}
+test regexp-6.4 {regexp errors} {
+ evalInProc {
+ list [catch {regexp a( b} msg] $msg
+ }
+} {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
+test regexp-6.5 {regexp errors} {
+ evalInProc {
+ list [catch {regexp a( b} msg] $msg
+ }
+} {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
+test regexp-6.6 {regexp errors} {
+ evalInProc {
+ list [catch {regexp a a f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1} msg] $msg
+ }
+} {0 1}
+test regexp-6.7 {regexp errors} {
+ evalInProc {
+ list [catch {regexp (x)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.) xyzzy} msg] $msg
+ }
+} {0 0}
+test regexp-6.8 {regexp errors} {
+ evalInProc {
+ catch {unset f1}
+ set f1 44
+ list [catch {regexp abc abc f1(f2)} msg] $msg
+ }
+} {1 {couldn't set variable "f1(f2)"}}
+test regexp-6.9 {regexp errors, -start bad int check} {
+ evalInProc {
+ list [catch {regexp -start bogus {^$} {}} msg] $msg
+ }
+} {1 {expected integer but got "bogus"}}
+
+test regexp-7.1 {basic regsub operation} {
+ evalInProc {
+ list [regsub aa+ xaxaaaxaa 111&222 foo] $foo
+ }
+} {1 xax111aaa222xaa}
+test regexp-7.2 {basic regsub operation} {
+ evalInProc {
+ list [regsub aa+ aaaxaa &111 foo] $foo
+ }
+} {1 aaa111xaa}
+test regexp-7.3 {basic regsub operation} {
+ evalInProc {
+ list [regsub aa+ xaxaaa 111& foo] $foo
+ }
+} {1 xax111aaa}
+test regexp-7.4 {basic regsub operation} {
+ evalInProc {
+ list [regsub aa+ aaa 11&2&333 foo] $foo
+ }
+} {1 11aaa2aaa333}
+test regexp-7.5 {basic regsub operation} {
+ evalInProc {
+ list [regsub aa+ xaxaaaxaa &2&333 foo] $foo
+ }
+} {1 xaxaaa2aaa333xaa}
+test regexp-7.6 {basic regsub operation} {
+ evalInProc {
+ list [regsub aa+ xaxaaaxaa 1&22& foo] $foo
+ }
+} {1 xax1aaa22aaaxaa}
+test regexp-7.7 {basic regsub operation} {
+ evalInProc {
+ list [regsub a(a+) xaxaaaxaa {1\122\1} foo] $foo
+ }
+} {1 xax1aa22aaxaa}
+test regexp-7.8 {basic regsub operation} {
+ evalInProc {
+ list [regsub a(a+) xaxaaaxaa {1\\\122\1} foo] $foo
+ }
+} "1 {xax1\\aa22aaxaa}"
+test regexp-7.9 {basic regsub operation} {
+ evalInProc {
+ list [regsub a(a+) xaxaaaxaa {1\\122\1} foo] $foo
+ }
+} "1 {xax1\\122aaxaa}"
+test regexp-7.10 {basic regsub operation} {
+ evalInProc {
+ list [regsub a(a+) xaxaaaxaa {1\\&\1} foo] $foo
+ }
+} "1 {xax1\\aaaaaxaa}"
+test regexp-7.11 {basic regsub operation} {
+ evalInProc {
+ list [regsub a(a+) xaxaaaxaa {1\&\1} foo] $foo
+ }
+} {1 xax1&aaxaa}
+test regexp-7.12 {basic regsub operation} {
+ evalInProc {
+ list [regsub a(a+) xaxaaaxaa {\1\1\1\1&&} foo] $foo
+ }
+} {1 xaxaaaaaaaaaaaaaaxaa}
+test regexp-7.13 {basic regsub operation} {
+ evalInProc {
+ set foo xxx
+ list [regsub abc xyz 111 foo] $foo
+ }
+} {0 xyz}
+test regexp-7.14 {basic regsub operation} {
+ evalInProc {
+ set foo xxx
+ list [regsub ^ xyz "111 " foo] $foo
+ }
+} {1 {111 xyz}}
+test regexp-7.15 {basic regsub operation} {
+ evalInProc {
+ set foo xxx
+ list [regsub -- -foo abc-foodef "111 " foo] $foo
+ }
+} {1 {abc111 def}}
+test regexp-7.16 {basic regsub operation} {
+ evalInProc {
+ set foo xxx
+ list [regsub x "" y foo] $foo
+ }
+} {0 {}}
+test regexp-7.17 {regsub utf compliance} {
+ evalInProc {
+ # if not UTF-8 aware, result is "0 1"
+ set foo "xyz555ijka\u4e4ebpqr"
+ regsub a\u4e4eb xyza\u4e4ebijka\u4e4ebpqr 555 bar
+ list [string compare $foo $bar] [regexp 4 $bar]
+ }
+} {0 0}
+
+test regexp-8.1 {case conversion in regsub} {
+ evalInProc {
+ list [regsub -nocase a(a+) xaAAaAAay & foo] $foo
+ }
+} {1 xaAAaAAay}
+test regexp-8.2 {case conversion in regsub} {
+ evalInProc {
+ list [regsub -nocase a(a+) xaAAaAAay & foo] $foo
+ }
+} {1 xaAAaAAay}
+test regexp-8.3 {case conversion in regsub} {
+ evalInProc {
+ set foo 123
+ list [regsub a(a+) xaAAaAAay & foo] $foo
+ }
+} {0 xaAAaAAay}
+test regexp-8.4 {case conversion in regsub} {
+ evalInProc {
+ set foo 123
+ list [regsub -nocase a CaDE b foo] $foo
+ }
+} {1 CbDE}
+test regexp-8.5 {case conversion in regsub} {
+ evalInProc {
+ set foo 123
+ list [regsub -nocase XYZ CxYzD b foo] $foo
+ }
+} {1 CbD}
+test regexp-8.6 {case conversion in regsub} {
+ evalInProc {
+ set x abcdefghijklmnopqrstuvwxyz1234567890
+ set x $x$x$x$x$x$x$x$x$x$x$x$x
+ set foo 123
+ list [regsub -nocase $x $x b foo] $foo
+ }
+} {1 b}
+
+test regexp-9.1 {-all option to regsub} {
+ evalInProc {
+ set foo 86
+ list [regsub -all x+ axxxbxxcxdx |&| foo] $foo
+ }
+} {4 a|xxx|b|xx|c|x|d|x|}
+test regexp-9.2 {-all option to regsub} {
+ evalInProc {
+ set foo 86
+ list [regsub -nocase -all x+ aXxXbxxcXdx |&| foo] $foo
+ }
+} {4 a|XxX|b|xx|c|X|d|x|}
+test regexp-9.3 {-all option to regsub} {
+ evalInProc {
+ set foo 86
+ list [regsub x+ axxxbxxcxdx |&| foo] $foo
+ }
+} {1 a|xxx|bxxcxdx}
+test regexp-9.4 {-all option to regsub} {
+ evalInProc {
+ set foo 86
+ list [regsub -all bc axxxbxxcxdx |&| foo] $foo
+ }
+} {0 axxxbxxcxdx}
+test regexp-9.5 {-all option to regsub} {
+ evalInProc {
+ set foo xxx
+ list [regsub -all node "node node more" yy foo] $foo
+ }
+} {2 {yy yy more}}
+test regexp-9.6 {-all option to regsub} {
+ evalInProc {
+ set foo xxx
+ list [regsub -all ^ xxx 123 foo] $foo
+ }
+} {1 123xxx}
+
+test regexp-10.1 {expanded syntax in regsub} {
+ evalInProc {
+ set foo xxx
+ list [regsub -expanded ". \#comment\n . \#comment2" abc def foo] $foo
+ }
+} {1 defc}
+test regexp-10.2 {newline sensitivity in regsub} {
+ evalInProc {
+ set foo xxx
+ list [regsub -line {^a.*b$} "dabc\naxyb\n" 123 foo] $foo
+ }
+} "1 {dabc\n123\n}"
+test regexp-10.3 {newline sensitivity in regsub} {
+ evalInProc {
+ set foo xxx
+ list [regsub -line {^a.*b$} "dabc\naxyb\nxb" 123 foo] $foo
+ }
+} "1 {dabc\n123\nxb}"
+test regexp-10.4 {partial newline sensitivity in regsub} {
+ evalInProc {
+ set foo xxx
+ list [regsub -lineanchor {^a.*b$} "da\naxyb\nxb" 123 foo] $foo
+ }
+} "1 {da\n123}"
+test regexp-10.5 {inverse partial newline sensitivity in regsub} {
+ evalInProc {
+ set foo xxx
+ list [regsub -linestop {a.*b} "da\nbaxyb\nxb" 123 foo] $foo
+ }
+} "1 {da\nb123\nxb}"
+
+test regexp-11.1 {regsub errors} {
+ evalInProc {
+ list [catch {regsub a b} msg] $msg
+ }
+} {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}}
+test regexp-11.2 {regsub errors} {
+ evalInProc {
+ list [catch {regsub -nocase a b} msg] $msg
+ }
+} {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}}
+test regexp-11.3 {regsub errors} {
+ evalInProc {
+ list [catch {regsub -nocase -all a b} msg] $msg
+ }
+} {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}}
+test regexp-11.4 {regsub errors} {
+ evalInProc {
+ list [catch {regsub a b c d e f} msg] $msg
+ }
+} {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}}
+test regexp-11.5 {regsub errors} {
+ evalInProc {
+ list [catch {regsub -gorp a b c} msg] $msg
+ }
+} {1 {bad switch "-gorp": must be -all, -nocase, -expanded, -line, -linestop, -lineanchor, -start, or --}}
+test regexp-11.6 {regsub errors} {
+ evalInProc {
+ list [catch {regsub -nocase a( b c d} msg] $msg
+ }
+} {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
+test regexp-11.7 {regsub errors} {
+ evalInProc {
+ catch {unset f1}
+ set f1 44
+ list [catch {regsub -nocase aaa aaa xxx f1(f2)} msg] $msg
+ }
+} {1 {couldn't set variable "f1(f2)"}}
+test regexp-11.8 {regsub errors, -start bad int check} {
+ evalInProc {
+ list [catch {regsub -start bogus pattern string rep var} msg] $msg
+ }
+} {1 {expected integer but got "bogus"}}
+
+# This test crashes on the Mac unless you increase the Stack Space to about 1
+# Meg. This is probably bigger than most users want...
+# 8.2.3 regexp reduced stack space requirements, but this should be
+# tested again
+test regexp-12.1 {Tcl_RegExpExec: large number of subexpressions} {macCrash} {
+ evalInProc {
+ list [regexp (.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.) abcdefghijklmnopqrstuvwxyz all 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] $all $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
+ }
+} {1 abcdefghijklmnopqrstuvwxyz 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}
+
+test regexp-13.1 {regsub of a very large string} {
+ # This test is designed to stress the memory subsystem in order
+ # to catch Bug #933. It only fails if the Tcl memory allocator
+ # is in use.
+
+ set line {BEGIN_TABLE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; END_TABLE}
+ set filedata [string repeat $line 200]
+ for {set i 1} {$i<10} {incr i} {
+ regsub -all "BEGIN_TABLE " $filedata "" newfiledata
+ }
+ set x done
+} {done}
+
+test regexp-14.1 {CompileRegexp: regexp cache} {
+ evalInProc {
+ regexp .*a b
+ regexp .*b c
+ regexp .*c d
+ regexp .*d e
+ regexp .*e f
+ set x .
+ append x *a
+ regexp $x bbba
+ }
+} 1
+test regexp-14.2 {CompileRegexp: regexp cache, different flags} {
+ evalInProc {
+ regexp .*a b
+ regexp .*b c
+ regexp .*c d
+ regexp .*d e
+ regexp .*e f
+ set x .
+ append x *a
+ regexp -nocase $x bbba
+ }
+} 1
+
+testConstraint exec [llength [info commands exec]]
+test regexp-14.3 {CompileRegexp: regexp cache, empty regexp and empty cache} {
+ exec
+} {
+ exec [interpreter] [makeFile {puts [regexp {} foo]} junk.tcl]
+} 1
+
+test regexp-15.1 {regexp -start} {
+ catch {unset x}
+ list [regexp -start -10 {\d} 1abc2de3 x] $x
+} {1 1}
+test regexp-15.2 {regexp -start} {
+ catch {unset x}
+ list [regexp -start 2 {\d} 1abc2de3 x] $x
+} {1 2}
+test regexp-15.3 {regexp -start} {
+ catch {unset x}
+ list [regexp -start 4 {\d} 1abc2de3 x] $x
+} {1 2}
+test regexp-15.4 {regexp -start} {
+ catch {unset x}
+ list [regexp -start 5 {\d} 1abc2de3 x] $x
+} {1 3}
+test regexp-15.5 {regexp -start, over end of string} {
+ catch {unset x}
+ list [regexp -start [string length 1abc2de3] {\d} 1abc2de3 x] [info exists x]
+} {0 0}
+test regexp-15.6 {regexp -start, loss of ^$ behavior} {
+ list [regexp -start 2 {^$} {}]
+} {0}
+
+test regexp-16.1 {regsub -start} {
+ catch {unset x}
+ list [regsub -all -start 2 {\d} a1b2c3d4e5 {/&} x] $x
+} {4 a1b/2c/3d/4e/5}
+test regexp-16.2 {regsub -start} {
+ catch {unset x}
+ list [regsub -all -start -25 {z} hello {/&} x] $x
+} {0 hello}
+test regexp-16.3 {regsub -start} {
+ catch {unset x}
+ list [regsub -all -start 3 {z} hello {/&} x] $x
+} {0 hello}
+test regexp-16.4 {regsub -start, \A behavior} {
+ set out {}
+ lappend out [regsub -start 0 -all {\A(\w)} {abcde} {/\1} x] $x
+ lappend out [regsub -start 2 -all {\A(\w)} {abcde} {/\1} x] $x
+} {5 /a/b/c/d/e 3 ab/c/d/e}
+
+test regexp-17.1 {regexp -inline} {
+ regexp -inline b ababa
+} {b}
+test regexp-17.2 {regexp -inline} {
+ regexp -inline (b) ababa
+} {b b}
+test regexp-17.3 {regexp -inline -indices} {
+ regexp -inline -indices (b) ababa
+} {{1 1} {1 1}}
+test regexp-17.4 {regexp -inline} {
+ regexp -inline {\w(\d+)\w} " hello 23 there456def "
+} {e456d 456}
+test regexp-17.5 {regexp -inline no matches} {
+ regexp -inline {\w(\d+)\w} ""
+} {}
+test regexp-17.6 {regexp -inline no matches} {
+ regexp -inline hello goodbye
+} {}
+test regexp-17.7 {regexp -inline, no matchvars allowed} {
+ list [catch {regexp -inline b abc match} msg] $msg
+} {1 {regexp match variables not allowed when using -inline}}
+
+test regexp-18.1 {regexp -all} {
+ regexp -all b bbbbb
+} {5}
+test regexp-18.2 {regexp -all} {
+ regexp -all b abababbabaaaaaaaaaab
+} {6}
+test regexp-18.3 {regexp -all -inline} {
+ regexp -all -inline b abababbabaaaaaaaaaab
+} {b b b b b b}
+test regexp-18.4 {regexp -all -inline} {
+ regexp -all -inline {\w(\w)} abcdefg
+} {ab b cd d ef f}
+test regexp-18.5 {regexp -all -inline} {
+ regexp -all -inline {\w(\w)$} abcdefg
+} {fg g}
+test regexp-18.6 {regexp -all -inline} {
+ regexp -all -inline {\d+} 10:20:30:40
+} {10 20 30 40}
+test regexp-18.7 {regexp -all -inline} {
+ list [catch {regexp -all -inline b abc match} msg] $msg
+} {1 {regexp match variables not allowed when using -inline}}
+test regexp-18.8 {regexp -all} {
+ # This should not cause an infinite loop
+ regexp -all -inline {a*} a
+} {a}
+test regexp-18.9 {regexp -all} {
+ # Yes, the expected result is {a {}}. Here's why:
+ # Start at index 0; a* matches the "a" there then stops.
+ # Go to index 1; a* matches the lambda (or {}) there then stops. Recall
+ # that a* matches zero or more "a"'s; thus it matches the string "b", as
+ # there are zero or more "a"'s there.
+ # Go to index 2; this is past the end of the string, so stop.
+ regexp -all -inline {a*} ab
+} {a {}}
+test regexp-18.10 {regexp -all} {
+ # Yes, the expected result is {a {} a}. Here's why:
+ # Start at index 0; a* matches the "a" there then stops.
+ # Go to index 1; a* matches the lambda (or {}) there then stops. Recall
+ # that a* matches zero or more "a"'s; thus it matches the string "b", as
+ # there are zero or more "a"'s there.
+ # Go to index 2; a* matches the "a" there then stops.
+ # Go to index 3; this is past the end of the string, so stop.
+ regexp -all -inline {a*} aba
+} {a {} a}
+test regexp-18.11 {regexp -all} {
+ evalInProc {
+ regexp -all -inline {^a} aaaa
+ }
+} {a}
+test regexp-18.12 {regexp -all -inline -indices} {
+ evalInProc {
+ regexp -all -inline -indices a(b(c)d|e(f)g)h abcdhaefgh
+ }
+} {{0 4} {1 3} {2 2} {-1 -1} {5 9} {6 8} {-1 -1} {7 7}}
+
+test regexp-19.1 {regsub null replacement} {
+ evalInProc {
+ regsub -all {@} {@hel@lo@} "\0a\0" result
+ list $result [string length $result]
+ }
+} "\0a\0hel\0a\0lo\0a\0 14"
+
+test regexp-20.1 {regsub shared object shimmering} {
+ evalInProc {
+ # Bug #461322
+ set a abcdefghijklmnopqurstuvwxyz
+ set b $a
+ set c abcdefghijklmnopqurstuvwxyz0123456789
+ regsub $a $c $b d
+ list $d [string length $d] [string bytelength $d]
+ }
+} [list abcdefghijklmnopqurstuvwxyz0123456789 37 37]
+test regexp-20.2 {regsub shared object shimmering with -about} {
+ evalInProc {
+ eval regexp -about abc
+ }
+} {0 {}}
+
+test regexp-21.1 {regexp command compiling tests} {
+ evalInProc {
+ regexp foo bar
+ }
+} 0
+test regexp-21.2 {regexp command compiling tests} {
+ evalInProc {
+ regexp {^foo$} dogfood
+ }
+} 0
+test regexp-21.3 {regexp command compiling tests} {
+ evalInProc {
+ set a foo
+ regexp {^foo$} $a
+ }
+} 1
+test regexp-21.4 {regexp command compiling tests} {
+ evalInProc {
+ regexp foo dogfood
+ }
+} 1
+test regexp-21.5 {regexp command compiling tests} {
+ evalInProc {
+ regexp -nocase FOO dogfod
+ }
+} 0
+test regexp-21.6 {regexp command compiling tests} {
+ evalInProc {
+ regexp -n foo dogfoOd
+ }
+} 1
+test regexp-21.7 {regexp command compiling tests} {
+ evalInProc {
+ regexp -no -- FoO dogfood
+ }
+} 1
+test regexp-21.8 {regexp command compiling tests} {
+ evalInProc {
+ regexp -- foo dogfod
+ }
+} 0
+test regexp-21.9 {regexp command compiling tests} {
+ evalInProc {
+ list [catch {regexp -- -nocase foo dogfod} msg] $msg
+ }
+} {0 0}
+test regexp-21.10 {regexp command compiling tests} {
+ evalInProc {
+ list [regsub -all "" foo bar str] $str
+ }
+} {3 barfbarobaro}
+test regexp-21.11 {regexp command compiling tests} {
+ evalInProc {
+ list [regsub -all "" "" bar str] $str
+ }
+} {0 {}}
+
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/registry.test b/tcl/tests/registry.test
index 8bf11678719..2dc6e343d89 100644
--- a/tcl/tests/registry.test
+++ b/tcl/tests/registry.test
@@ -19,8 +19,8 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
if {$tcl_platform(platform) == "windows"} {
if [catch {
- set lib [lindex [glob [file join [pwd] [file dirname \
- [info nameofexecutable]] tclreg*.dll]] 0]
+ set lib [lindex [glob -directory [file join [pwd] [file dirname \
+ [info nameofexecutable]]] tclreg*.dll] 0]
load $lib registry
}] {
puts "Unable to find the registry package. Skipping registry tests."
@@ -600,4 +600,3 @@ return
-
diff --git a/tcl/tests/rename.test b/tcl/tests/rename.test
index d2b1332433f..2c967d84218 100644
--- a/tcl/tests/rename.test
+++ b/tcl/tests/rename.test
@@ -75,6 +75,7 @@ test rename-3.5 {error conditions} {
catch {rename unknown {}}
catch {rename unknown.old unknown}
+catch {rename bar {}}
if {[info command testdel] == "testdel"} {
test rename-4.1 {reentrancy issues with command deletion and renaming} {
@@ -168,7 +169,7 @@ test rename-6.1 {old code invalidated (epoch incremented) when cmd with compile
proc incr {} {puts "new incr called!"}
catch {x} msg
set msg
-} {called "incr" with too many arguments}
+} {wrong # args: should be "incr"}
if {[info commands incr.old] != {}} {
catch {rename incr {}}
@@ -176,4 +177,3 @@ if {[info commands incr.old] != {}} {
}
::tcltest::cleanupTests
return
-
diff --git a/tcl/tests/resource.test b/tcl/tests/resource.test
index c593f1b695c..ae44f1b393f 100644
--- a/tcl/tests/resource.test
+++ b/tcl/tests/resource.test
@@ -363,4 +363,3 @@ return
-
diff --git a/tcl/tests/result.test b/tcl/tests/result.test
index e8418e271ed..f0fb9e388ef 100644
--- a/tcl/tests/result.test
+++ b/tcl/tests/result.test
@@ -13,13 +13,13 @@
# SCCS: @(#) result.test 1.4 97/12/08 15:07:49
if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+ package require tcltest 2
namespace import -force ::tcltest::*
}
# Some tests require the testsaveresult command
-set ::tcltest::testConstraints(testsaveresult) \
+::tcltest::testConstraint testsaveresult \
[expr {[info commands testsaveresult] != {}}]
test result-1.1 {Tcl_SaveInterpResult} {testsaveresult} {
diff --git a/tcl/tests/safe.test b/tcl/tests/safe.test
index 2520b24d9e7..63b68f973e0 100644
--- a/tcl/tests/safe.test
+++ b/tcl/tests/safe.test
@@ -122,7 +122,7 @@ test safe-4.3 {safe::interpDelete, state array (not a public api)} {
catch {namespace eval safe {set [InterpStateName a](foo)}} m2
list $m1 $m2
} "{}\
- {can't read \"[safe::InterpStateName a]\": no such variable}"
+ {can't read \"[safe::InterpStateName a](foo)\": no such variable}"
test safe-4.4 {safe::interpDelete, state array, indirectly (not a public api)} {
@@ -185,7 +185,7 @@ test safe-6.3 {test safe interpreters knowledge of the world} {
set r [lreplace $r $threaded $threaded]
}
set r
-} {byteOrder platform}
+} {byteOrder platform wordSize}
# more test should be added to check that hostname, nameofexecutable,
# aren't leaking infos, but they still do...
@@ -271,6 +271,8 @@ test safe-8.4 {safe source control on file} {
test safe-8.5 {safe source control on file} {
+ # This tested filename == *.tcl or tclIndex, but that restriction
+ # was removed in 8.4a4 - hobbs
set i "a";
catch {safe::interpDelete $i}
safe::interpCreate $i;
@@ -283,7 +285,7 @@ test safe-8.5 {safe source control on file} {
$log \
[safe::setLogCmd $prevlog; unset log] \
[safe::interpDelete $i] ;
-} "1 {blah: must be a *.tcl or tclIndex} {{ERROR for slave a : [file join [info library] blah]:blah: must be a *.tcl or tclIndex}} {} {}"
+} [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] blah]:no such file or directory"] {} {}]
test safe-8.6 {safe source control on file} {
@@ -299,10 +301,12 @@ test safe-8.6 {safe source control on file} {
$log \
[safe::setLogCmd $prevlog; unset log] \
[safe::interpDelete $i] ;
-} "1 {no such file or directory} {{ERROR for slave a : [file join [info library] blah.tcl]:no such file or directory}} {} {}"
+} [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] blah.tcl]:no such file or directory"] {} {}]
test safe-8.7 {safe source control on file} {
+ # This tested length of filename, but that restriction
+ # was removed in 8.4a4 - hobbs
set i "a";
catch {safe::interpDelete $i}
safe::interpCreate $i;
@@ -316,7 +320,7 @@ test safe-8.7 {safe source control on file} {
$log \
[safe::setLogCmd $prevlog; unset log] \
[safe::interpDelete $i] ;
-} "1 {xxxxxxxxxxx.tcl: filename too long} {{ERROR for slave a : [file join [info library] xxxxxxxxxxx.tcl]:xxxxxxxxxxx.tcl: filename too long}} {} {}"
+} [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] xxxxxxxxxxx.tcl]:no such file or directory"] {} {}]
test safe-8.8 {safe source forbids -rsrc} {
set i "a";
@@ -518,16 +522,3 @@ test safe-11.8 {testing safe encoding} {
# cleanup
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tcl/tests/scan.test b/tcl/tests/scan.test
index 1296d9cf3d7..4ff4841d1e6 100644
--- a/tcl/tests/scan.test
+++ b/tcl/tests/scan.test
@@ -14,10 +14,12 @@
# RCS: @(#) $Id$
if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+ package require tcltest 2
namespace import -force ::tcltest::*
}
+::tcltest::testConstraint 64bitInts [expr {0x80000000 > 0}]
+
test scan-1.1 {BuildCharSet, CharInSet} {
list [scan foo {%[^o]} x] $x
} {1 f}
@@ -231,9 +233,20 @@ test scan-4.39 {Tcl_ScanObjCmd, base-16 integer scanning} {
list [scan {+1238 -123a 0123} {%x%x%x} x y z] $x $y $z
} {3 4664 -4666 291}
test scan-4.40 {Tcl_ScanObjCmd, base-16 integer scanning} {
+ # The behavior changed in 8.4a4/8.3.4cvs (6 Feb) to correctly
+ # return '1' for 0x1 scanned via %x, to comply with 8.0 and C scanf.
+ # Bug #495213
set x {}
list [scan {aBcDeF AbCdEf 0x1} {%x%x%x} x y z] $x $y $z
-} {3 11259375 11259375 0}
+} {3 11259375 11259375 1}
+test scan-4.40.1 {Tcl_ScanObjCmd, base-16 integer scanning} {
+ set x {}
+ list [scan {0xF 0x00A0B 0X0XF} {%x %x %x} x y z] $x $y $z
+} {3 15 2571 0}
+test scan-4.40.2 {Tcl_ScanObjCmd, base-16 integer scanning} {
+ catch {unset x}
+ list [scan {xF} {%x} x] [info exists x]
+} {0 0}
test scan-4.41 {Tcl_ScanObjCmd, base-unknown integer scanning} {
set x {}
list [scan {10 010 0x10} {%i%i%i} x y z] $x $y $z
@@ -324,6 +337,35 @@ test scan-4.61 {Tcl_ScanObjCmd, set errors} {
set result
} {1 {couldn't set variable "z"couldn't set variable "y"} abc}
+# procedure that returns the range of integers
+
+proc int_range {} {
+ for { set MIN_INT 1 } { $MIN_INT > 0 } {} {
+ set MIN_INT [expr { $MIN_INT << 1 }]
+ }
+ set MAX_INT [expr { ~ $MIN_INT }]
+ return [list $MIN_INT $MAX_INT]
+}
+
+test scan-4.62 {scanning of large and negative octal integers} {
+ foreach { MIN_INT MAX_INT } [int_range] {}
+ set scanstring [format {%o %o %o} -1 $MIN_INT $MAX_INT]
+ list [scan $scanstring {%o %o %o} a b c] \
+ [expr { $a == -1 }] [expr { $b == $MIN_INT }] [expr { $c == $MAX_INT }]
+} {3 1 1 1}
+test scan-4.63 {scanning of large and negative hex integers} {
+ foreach { MIN_INT MAX_INT } [int_range] {}
+ set scanstring [format {%x %x %x} -1 $MIN_INT $MAX_INT]
+ list [scan $scanstring {%x %x %x} a b c] \
+ [expr { $a == -1 }] [expr { $b == $MIN_INT }] [expr { $c == $MAX_INT }]
+} {3 1 1 1}
+
+# clean up from last two tests
+
+catch {
+ rename int_range {}
+}
+
test scan-5.1 {integer scanning} {
set a {}; set b {}; set c {}; set d {}
list [scan "-20 1476 \n33 0" "%d %d %d %d" a b c d] $a $b $c $d
@@ -376,6 +418,12 @@ test scan-5.11 {integer scanning} {nonPortable} {
[expr {$b == -16 || $b == 0x7fffffff}]
} {2 4294967280 1}
+test scan-5.12 {integer scanning} {64bitInts} {
+ set a {}; set b {}; set c {}
+ list [scan "7810179016327718216,6c63546f6c6c6548,661432506755433062510" \
+ %ld,%lx,%lo a b c] $a $b $c
+} {3 7810179016327718216 7810179016327718216 7810179016327718216}
+
test scan-6.1 {floating-point scanning} {
set a {}; set b {}; set c {}; set d {}
list [scan "2.1 -3.0e8 .99962 a" "%f%g%e%f" a b c d] $a $b $c $d
@@ -630,18 +678,3 @@ test scan-13.8 {Tcl_ScanObjCmd, inline XPG case lots of arguments} {
# cleanup
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tcl/tests/security.test b/tcl/tests/security.test
index e3dae8bab9b..51e2824b154 100644
--- a/tcl/tests/security.test
+++ b/tcl/tests/security.test
@@ -52,4 +52,3 @@ return
-
diff --git a/tcl/tests/set-old.test b/tcl/tests/set-old.test
index d5203a80f23..985fd797d9d 100644
--- a/tcl/tests/set-old.test
+++ b/tcl/tests/set-old.test
@@ -204,7 +204,9 @@ test set-old-7.1 {unset command} {
} {0 0 0 1}
test set-old-7.2 {unset command} {
list [catch {unset} msg] $msg
-} {1 {wrong # args: should be "unset varName ?varName ...?"}}
+} {0 {}}
+# Used to return:
+#{1 {wrong # args: should be "unset ?-nocomplain? ?--? ?varName varName ...?"}}
test set-old-7.3 {unset command} {
catch {unset a}
list [catch {unset a} msg] $msg
@@ -266,6 +268,45 @@ test set-old-7.11 {unset command} {
unset a
list [catch {set a(14)} msg] $msg [catch {array names a} msg2] $msg2
} {1 {can't read "a(14)": no such variable} 0 {}}
+test set-old-7.12 {unset command, -nocomplain} {
+ catch {unset a}
+ list [info exists a] [catch {unset -nocomplain a}] [info exists a]
+} {0 0 0}
+test set-old-7.13 {unset command, -nocomplain} {
+ set -nocomplain abc
+ list [info exists -nocomplain] [catch {unset -nocomplain}] \
+ [info exists -nocomplain] [catch {unset -- -nocomplain}] \
+ [info exists -nocomplain]
+} {1 0 1 0 0}
+test set-old-7.14 {unset command, --} {
+ set -- abc
+ list [info exists --] [catch {unset --}] \
+ [info exists --] [catch {unset -- --}] \
+ [info exists --]
+} {1 0 1 0 0}
+test set-old-7.15 {unset command, -nocomplain} {
+ set -nocomplain abc
+ set -- abc
+ list [info exists -nocomplain] [catch {unset -- -nocomplain}] \
+ [info exists -nocomplain] [info exists --] \
+ [catch {unset -- -nocomplain}] [info exists --] \
+ [catch {unset -- --}] [info exists --]
+} {1 0 0 1 1 1 0 0}
+test set-old-7.16 {unset command, -nocomplain} {
+ set -nocomplain abc
+ set var abc
+ list [info exists bogus] [catch {unset -nocomplain bogus var bogus}] \
+ [info exists -nocomplain] [info exists var] \
+ [catch {unset -nocomplain -nocomplain}] [info exists -nocomplain]
+} {0 0 1 0 0 0}
+test set-old-7.17 {unset command, -nocomplain (no abbreviation)} {
+ set -nocomp abc
+ list [info exists -nocomp] [catch {unset -nocomp}] [info exists -nocomp]
+} {1 0 0}
+test set-old-7.18 {unset command, -nocomplain (no abbreviation)} {
+ catch {unset -nocomp}
+ list [info exists -nocomp] [catch {unset -nocomp}]
+} {0 1}
# Array command.
@@ -296,7 +337,7 @@ test set-old-8.6 {array command} {
catch {unset a}
set a(22) 3
list [catch {array gorp a} msg] $msg
-} {1 {bad option "gorp": must be anymore, donesearch, exists, get, names, nextelement, set, size, startsearch, or unset}}
+} {1 {bad option "gorp": must be anymore, donesearch, exists, get, names, nextelement, set, size, startsearch, statistics, or unset}}
test set-old-8.7 {array command, anymore option} {
catch {unset a}
list [catch {array anymore a x} msg] $msg
@@ -388,7 +429,7 @@ test set-old-8.22 {array command, names option} {
catch {unset a}
set a(22) 3
list [catch {array names a 4 5} msg] $msg
-} {1 {wrong # args: should be "array names arrayName ?pattern?"}}
+} {1 {bad option "4": must be -exact, -glob, or -regexp}}
test set-old-8.19 {array command, names option} {
catch {unset a}
array names a
@@ -506,7 +547,7 @@ test set-old-8.37.5 {array command, set with non-existent namespace} {
} {1 {can't set "bogusnamespace::var": parent namespace doesn't exist}}
test set-old-8.37.6 {array command, set with non-existent namespace} {
list [catch {array set bogusnamespace::var {a b}} msg] $msg
-} {1 {can't set "bogusnamespace::var(a)": parent namespace doesn't exist}}
+} {1 {can't set "bogusnamespace::var": parent namespace doesn't exist}}
test set-old-8.37.7 {array command, set with non-existent namespace} {
list [catch {array set bogusnamespace::var(0) {a b}} msg] $msg
} {1 {can't set "bogusnamespace::var(0)": variable isn't array}}
@@ -564,11 +605,80 @@ test set-old-8.47 {array command, startsearch option, array doesn't exist yet bu
}
list [catch {p 1} msg] $msg
} {1 {"a" isn't an array}}
+test set-old-8.48 {array command, statistics option} {
+ catch {unset a}
+ set a(abc) 1
+ set a(def) 2
+ set a(ghi) 3
+ set a(jkl) 4
+ set a(mno) 5
+ set a(pqr) 6
+ set a(stu) 7
+ set a(vwx) 8
+ set a(yz) 9
+ array statistics a
+} "9 entries in table, 4 buckets
+number of buckets with 0 entries: 0
+number of buckets with 1 entries: 0
+number of buckets with 2 entries: 3
+number of buckets with 3 entries: 1
+number of buckets with 4 entries: 0
+number of buckets with 5 entries: 0
+number of buckets with 6 entries: 0
+number of buckets with 7 entries: 0
+number of buckets with 8 entries: 0
+number of buckets with 9 entries: 0
+number of buckets with 10 or more entries: 0
+average search distance for entry: 1.7"
+test set-old-8.49 {array command, array names -exact on glob pattern} {
+ catch {unset a}
+ set a(1*2) 1
+ list [catch {array names a -exact 1*2} msg] $msg
+} {0 1*2}
+test set-old-8.48 {array command, array names -glob on glob pattern} {
+ catch {unset a}
+ set a(1*2) 1
+ set a(12) 1
+ set a(11) 1
+ list [catch {lsort [array names a -glob 1*2]} msg] $msg
+} {0 {1*2 12}}
+test set-old-8.49 {array command, array names -regexp on regexp pattern} {
+ catch {unset a}
+ set a(1*2) 1
+ set a(12) 1
+ set a(11) 1
+ list [catch {lsort [array names a -regexp ^1]} msg] $msg
+} {0 {1*2 11 12}}
+test set-old-8.50 {array command, array names -regexp} {
+ catch {unset a}
+ set a(-glob) 1
+ set a(-regexp) 1
+ set a(-exact) 1
+ list [catch {array names a -regexp} msg] $msg
+} {0 -regexp}
+test set-old-8.51 {array command, array names -exact} {
+ catch {unset a}
+ set a(-glob) 1
+ set a(-regexp) 1
+ set a(-exact) 1
+ list [catch {array names a -exact} msg] $msg
+} {0 -exact}
+test set-old-8.52 {array command, array names -glob} {
+ catch {unset a}
+ set a(-glob) 1
+ set a(-regexp) 1
+ set a(-exact) 1
+ list [catch {array names a -glob} msg] $msg
+} {0 -glob}
+test set-old-8.53 {array command, array statistics on a non-array} {
+ catch {unset a}
+ list [catch {array statistics a} msg] $msg
+} [list 1 "\"a\" isn't an array"]
test set-old-9.1 {ids for array enumeration} {
catch {unset a}
set a(a) 1
- list [array st a] [array st a] [array done a s-1-a; array st a] \
+ list [array star a] [array star a] [array done a s-1-a; array star a] \
[array done a s-2-a; array d a s-3-a; array start a]
} {s-1-a s-2-a s-3-a s-1-a}
test set-old-9.2 {array enumeration} {
@@ -807,16 +917,3 @@ catch {unset aVaRnAmE}
# cleanup
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tcl/tests/set.test b/tcl/tests/set.test
index 07a20825a6c..564ce0ebc46 100644
--- a/tcl/tests/set.test
+++ b/tcl/tests/set.test
@@ -518,4 +518,3 @@ catch {unset x}
catch {unset z}
::tcltest::cleanupTests
return
-
diff --git a/tcl/tests/socket.test b/tcl/tests/socket.test
index aff5cffcb92..6fd08659c29 100644
--- a/tcl/tests/socket.test
+++ b/tcl/tests/socket.test
@@ -62,18 +62,13 @@
# listening at port 2048. If all fails, a message is printed and the tests
# using the remote server are not performed.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
- namespace import -force ::tcltest::*
-}
+package require tcltest 2
+namespace import -force ::tcltest::*
# Some tests require the testthread and exec commands
+testConstraint testthread [llength [info commands testthread]]
+testConstraint exec [llength [info commands exec]]
-set ::tcltest::testConstraints(testthread) \
- [expr {[info commands testthread] != {}}]
-set ::tcltest::testConstraints(exec) [expr {[info commands exec] != {}}]
-
-#
# If remoteServerIP or remoteServerPort are not set, check in the
# environment variables for externally set values.
#
@@ -123,9 +118,12 @@ if {$doTestsWithRemoteServer} {
set doTestsWithRemoteServer 0
} else {
set remoteServerIP 127.0.0.1
- set remoteFile [file join [pwd] remote.tcl]
+ # Be *extra* careful in case this file is sourced from
+ # a directory other than the current one...
+ set remoteFile [file join [pwd] [file dirname [info script]] \
+ remote.tcl]
if {[catch {set remoteProcChan \
- [open "|[list $::tcltest::tcltest $remoteFile \
+ [open "|[list [interpreter] $remoteFile \
-serverIsSilent \
-port $remoteServerPort \
-address $remoteServerIP]" \
@@ -140,7 +138,7 @@ if {$doTestsWithRemoteServer} {
set doTestsWithRemoteServer 0
}
} else {
- set noRemoteTestReason "$msg $::tcltest::tcltest"
+ set noRemoteTestReason "$msg [interpreter]"
set doTestsWithRemoteServer 0
}
}
@@ -245,27 +243,31 @@ test socket-1.12 {arg parsing for socket command} {socket} {
list [catch {socket foo badport} msg] $msg
} {1 {expected integer but got "badport"}}
+set path(script) [makeFile {} script]
+
test socket-2.1 {tcp connection} {socket stdio} {
removeFile script
- set f [open script w]
+ set f [open $path(script) w]
puts $f {
- set timer [after 2000 "set x timed_out"]
- set f [socket -server accept 2828]
+ set timer [after 10000 "set x timed_out"]
+ set f [socket -server accept 0]
proc accept {file addr port} {
global x
set x done
close $file
}
puts ready
+ puts [lindex [fconfigure $f -sockname] 2]
vwait x
after cancel $timer
close $f
puts $x
}
close $f
- set f [open "|[list $::tcltest::tcltest script]" r]
+ set f [open "|[list [interpreter] $path(script)]" r]
gets $f x
- if {[catch {socket 127.0.0.1 2828} msg]} {
+ gets $f listen
+ if {[catch {socket 127.0.0.1 $listen} msg]} {
set x $msg
} else {
lappend x [gets $f]
@@ -283,10 +285,10 @@ if [info exists port] {
}
test socket-2.2 {tcp connection with client port specified} {socket stdio} {
removeFile script
- set f [open script w]
+ set f [open $path(script) w]
puts $f {
- set timer [after 2000 "set x done"]
- set f [socket -server accept 2829]
+ set timer [after 10000 "set x timeout"]
+ set f [socket -server accept 0]
proc accept {file addr port} {
global x
puts "[gets $file] $port"
@@ -294,17 +296,19 @@ test socket-2.2 {tcp connection with client port specified} {socket stdio} {
set x done
}
puts ready
+ puts [lindex [fconfigure $f -sockname] 2]
vwait x
after cancel $timer
close $f
}
close $f
- set f [open "|[list $::tcltest::tcltest script]" r]
+ set f [open "|[list [interpreter] $path(script)]" r]
gets $f x
+ gets $f listen
global port
- if {[catch {socket -myport $port 127.0.0.1 2829} sock]} {
+ if {[catch {socket -myport $port 127.0.0.1 $listen} sock]} {
set x $sock
- close [socket 127.0.0.1 2829]
+ close [socket 127.0.0.1 $listen]
puts stderr $sock
} else {
puts $sock hello
@@ -317,7 +321,7 @@ test socket-2.2 {tcp connection with client port specified} {socket stdio} {
} [list ready "hello $port"]
test socket-2.3 {tcp connection with client interface specified} {socket stdio} {
removeFile script
- set f [open script w]
+ set f [open $path(script) w]
puts $f {
set timer [after 2000 "set x done"]
set f [socket -server accept 2830]
@@ -333,7 +337,7 @@ test socket-2.3 {tcp connection with client interface specified} {socket stdio}
close $f
}
close $f
- set f [open "|[list $::tcltest::tcltest script]" r]
+ set f [open "|[list [interpreter] $path(script)]" r]
gets $f x
if {[catch {socket -myaddr 127.0.0.1 127.0.0.1 2830} sock]} {
set x $sock
@@ -348,10 +352,10 @@ test socket-2.3 {tcp connection with client interface specified} {socket stdio}
} {ready {hello 127.0.0.1}}
test socket-2.4 {tcp connection with server interface specified} {socket stdio} {
removeFile script
- set f [open script w]
+ set f [open $path(script) w]
puts $f {
set timer [after 2000 "set x done"]
- set f [socket -server accept -myaddr [info hostname] 2831]
+ set f [socket -server accept -myaddr 127.0.0.1 0]
proc accept {file addr port} {
global x
puts "[gets $file]"
@@ -359,14 +363,16 @@ test socket-2.4 {tcp connection with server interface specified} {socket stdio}
set x done
}
puts ready
+ puts [lindex [fconfigure $f -sockname] 2]
vwait x
after cancel $timer
close $f
}
close $f
- set f [open "|[list $::tcltest::tcltest script]" r]
+ set f [open "|[list [interpreter] $path(script)]" r]
gets $f x
- if {[catch {socket [info hostname] 2831} sock]} {
+ gets $f listen
+ if {[catch {socket 127.0.0.1 $listen} sock]} {
set x $sock
} else {
puts $sock hello
@@ -379,10 +385,10 @@ test socket-2.4 {tcp connection with server interface specified} {socket stdio}
} {ready hello}
test socket-2.5 {tcp connection with redundant server port} {socket stdio} {
removeFile script
- set f [open script w]
+ set f [open $path(script) w]
puts $f {
- set timer [after 2000 "set x done"]
- set f [socket -server accept 2832]
+ set timer [after 10000 "set x timeout"]
+ set f [socket -server accept 0]
proc accept {file addr port} {
global x
puts "[gets $file]"
@@ -390,14 +396,16 @@ test socket-2.5 {tcp connection with redundant server port} {socket stdio} {
set x done
}
puts ready
+ puts [lindex [fconfigure $f -sockname] 2]
vwait x
after cancel $timer
close $f
}
close $f
- set f [open "|[list $::tcltest::tcltest script]" r]
+ set f [open "|[list [interpreter] $path(script)]" r]
gets $f x
- if {[catch {socket 127.0.0.1 2832} sock]} {
+ gets $f listen
+ if {[catch {socket 127.0.0.1 $listen} sock]} {
set x $sock
} else {
puts $sock hello
@@ -420,10 +428,10 @@ test socket-2.6 {tcp connection} {socket} {
} ok
test socket-2.7 {echo server, one line} {socket stdio} {
removeFile script
- set f [open script w]
+ set f [open $path(script) w]
puts $f {
- set timer [after 2000 "set x done"]
- set f [socket -server accept 2834]
+ set timer [after 10000 "set x timeout"]
+ set f [socket -server accept 0]
proc accept {s a p} {
fileevent $s readable [list echo $s]
fconfigure $s -translation lf -buffering line
@@ -439,15 +447,17 @@ test socket-2.7 {echo server, one line} {socket stdio} {
}
}
puts ready
+ puts [lindex [fconfigure $f -sockname] 2]
vwait x
after cancel $timer
close $f
- puts done
+ puts $x
}
close $f
- set f [open "|[list $::tcltest::tcltest script]" r]
+ set f [open "|[list [interpreter] $path(script)]" r]
gets $f
- set s [socket 127.0.0.1 2834]
+ gets $f listen
+ set s [socket 127.0.0.1 $listen]
fconfigure $s -buffering line -translation lf
puts $s "hello abcdefghijklmnop"
after 1000
@@ -459,7 +469,7 @@ test socket-2.7 {echo server, one line} {socket stdio} {
} {{hello abcdefghijklmnop} done}
test socket-2.8 {echo server, loop 50 times, single connection} {socket stdio} {
makeFile {
- set f [socket -server accept 2835]
+ set f [socket -server accept 0]
proc accept {s a p} {
fileevent $s readable [list echo $s]
fconfigure $s -buffering line
@@ -478,15 +488,17 @@ test socket-2.8 {echo server, loop 50 times, single connection} {socket stdio} {
}
set i 0
puts ready
+ puts [lindex [fconfigure $f -sockname] 2]
set timer [after 20000 "set x done"]
vwait x
after cancel $timer
close $f
puts "done $i"
} script
- set f [open "|[list $::tcltest::tcltest script]" r]
+ set f [open "|[list [interpreter] $path(script)]" r]
gets $f
- set s [socket 127.0.0.1 2835]
+ gets $f listen
+ set s [socket 127.0.0.1 $listen]
fconfigure $s -buffering line
catch {
for {set x 0} {$x < 50} {incr x} {
@@ -500,25 +512,24 @@ test socket-2.8 {echo server, loop 50 times, single connection} {socket stdio} {
set x
} {done 50}
test socket-2.9 {socket conflict} {socket stdio} {
- set s [socket -server accept 2828]
+ set s [socket -server accept 0]
removeFile script
- set f [open script w]
- puts -nonewline $f {socket -server accept 2828}
+ set f [open $path(script) w]
+ puts -nonewline $f "socket -server accept [lindex [fconfigure $s -sockname] 2]"
close $f
- set f [open "|[list $::tcltest::tcltest script]" r]
+ set f [open "|[list [interpreter] $path(script)]" r]
gets $f
after 100
- set x [list [catch {close $f} msg] $msg]
+ set x [list [catch {close $f} msg]]
+ regsub "\n.*$" $msg {} msg ; # cut part of the error message containing the port number
+ lappend x $msg
close $s
set x
-} {1 {couldn't open socket: address already in use
- while executing
-"socket -server accept 2828"
- (file "script" line 1)}}
+} {1 {couldn't open socket: address already in use}}
test socket-2.10 {close on accept, accepted socket lives} {socket} {
set done 0
set timer [after 20000 "set done timed_out"]
- set ss [socket -server accept 2830]
+ set ss [socket -server accept 0]
proc accept {s a p} {
global ss
close $ss
@@ -531,7 +542,7 @@ test socket-2.10 {close on accept, accepted socket lives} {socket} {
close $s
set done 1
}
- set cs [socket [info hostname] 2830]
+ set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
puts $cs hello
close $cs
vwait done
@@ -544,9 +555,9 @@ test socket-2.11 {detecting new data} {socket} {
set sock $s
}
- set s [socket -server accept 2400]
+ set s [socket -server accept 0]
set sock ""
- set s2 [socket 127.0.0.1 2400]
+ set s2 [socket 127.0.0.1 [lindex [fconfigure $s -sockname] 2]]
vwait sock
puts $s2 one
flush $s2
@@ -569,17 +580,19 @@ test socket-2.11 {detecting new data} {socket} {
test socket-3.1 {socket conflict} {socket stdio} {
removeFile script
- set f [open script w]
+ set f [open $path(script) w]
puts $f {
- set f [socket -server accept 2828]
+ set f [socket -server accept 0]
puts ready
+ puts [lindex [fconfigure $f -sockname] 2]
gets stdin
close $f
}
close $f
- set f [open "|[list $::tcltest::tcltest script]" r+]
+ set f [open "|[list [interpreter] $path(script)]" r+]
gets $f
- set x [list [catch {socket -server accept 2828} msg] \
+ gets $f listen
+ set x [list [catch {socket -server accept $listen} msg] \
$msg]
puts $f bye
close $f
@@ -587,13 +600,13 @@ test socket-3.1 {socket conflict} {socket stdio} {
} {1 {couldn't open socket: address already in use}}
test socket-3.2 {server with several clients} {socket stdio} {
removeFile script
- set f [open script w]
+ set f [open $path(script) w]
puts $f {
set t1 [after 30000 "set x timed_out"]
set t2 [after 31000 "set x timed_out"]
set t3 [after 32000 "set x timed_out"]
set counter 0
- set s [socket -server accept 2828]
+ set s [socket -server accept 0]
proc accept {s a p} {
fileevent $s readable [list echo $s]
fconfigure $s -buffering line
@@ -609,6 +622,7 @@ test socket-3.2 {server with several clients} {socket stdio} {
}
}
puts ready
+ puts [lindex [fconfigure $s -sockname] 2]
vwait x
after cancel $t1
vwait x
@@ -619,13 +633,14 @@ test socket-3.2 {server with several clients} {socket stdio} {
puts $x
}
close $f
- set f [open "|[list $::tcltest::tcltest script]" r+]
+ set f [open "|[list [interpreter] $path(script)]" r+]
set x [gets $f]
- set s1 [socket 127.0.0.1 2828]
+ gets $f listen
+ set s1 [socket 127.0.0.1 $listen]
fconfigure $s1 -buffering line
- set s2 [socket 127.0.0.1 2828]
+ set s2 [socket 127.0.0.1 $listen]
fconfigure $s2 -buffering line
- set s3 [socket 127.0.0.1 2828]
+ set s3 [socket 127.0.0.1 $listen]
fconfigure $s3 -buffering line
for {set i 0} {$i < 100} {incr i} {
puts $s1 hello,s1
@@ -645,10 +660,10 @@ test socket-3.2 {server with several clients} {socket stdio} {
test socket-4.1 {server with several clients} {socket stdio} {
removeFile script
- set f [open script w]
+ set f [open $path(script) w]
puts $f {
- gets stdin
- set s [socket 127.0.0.1 2828]
+ set port [gets stdin]
+ set s [socket 127.0.0.1 $port]
fconfigure $s -buffering line
for {set i 0} {$i < 100} {incr i} {
puts $s hello
@@ -659,11 +674,11 @@ test socket-4.1 {server with several clients} {socket stdio} {
gets stdin
}
close $f
- set p1 [open "|[list $::tcltest::tcltest script]" r+]
+ set p1 [open "|[list [interpreter] $path(script)]" r+]
fconfigure $p1 -buffering line
- set p2 [open "|[list $::tcltest::tcltest script]" r+]
+ set p2 [open "|[list [interpreter] $path(script)]" r+]
fconfigure $p2 -buffering line
- set p3 [open "|[list $::tcltest::tcltest script]" r+]
+ set p3 [open "|[list [interpreter] $path(script)]" r+]
fconfigure $p3 -buffering line
proc accept {s a p} {
fconfigure $s -buffering line
@@ -682,10 +697,11 @@ test socket-4.1 {server with several clients} {socket stdio} {
set t1 [after 30000 "set x timed_out"]
set t2 [after 31000 "set x timed_out"]
set t3 [after 32000 "set x timed_out"]
- set s [socket -server accept 2828]
- puts $p1 open
- puts $p2 open
- puts $p3 open
+ set s [socket -server accept 0]
+ set listen [lindex [fconfigure $s -sockname] 2]
+ puts $p1 $listen
+ puts $p2 $listen
+ puts $p3 $listen
vwait x
vwait x
vwait x
@@ -744,20 +760,20 @@ test socket-5.3 {byte order problems, socket numbers, htons} \
test socket-6.1 {accept callback error} {socket stdio} {
removeFile script
- set f [open script w]
+ set f [open $path(script) w]
puts $f {
- gets stdin
- socket 127.0.0.1 2848
+ gets stdin port
+ socket 127.0.0.1 $port
}
close $f
- set f [open "|[list $::tcltest::tcltest script]" r+]
+ set f [open "|[list [interpreter] $path(script)]" r+]
proc bgerror args {
global x
set x $args
}
proc accept {s a p} {expr 10 / 0}
- set s [socket -server accept 2848]
- puts $f hello
+ set s [socket -server accept 0]
+ puts $f [lindex [fconfigure $s -sockname] 2]
close $f
set timer [after 10000 "set x timed_out"]
vwait x
@@ -769,95 +785,100 @@ test socket-6.1 {accept callback error} {socket stdio} {
test socket-7.1 {testing socket specific options} {socket stdio} {
removeFile script
- set f [open script w]
+ set f [open $path(script) w]
puts $f {
- socket -server accept 2820
+ set ss [socket -server accept 0]
proc accept args {
global x
set x done
}
puts ready
+ puts [lindex [fconfigure $ss -sockname] 2]
set timer [after 10000 "set x timed_out"]
vwait x
after cancel $timer
}
close $f
- set f [open "|[list $::tcltest::tcltest script]" r]
+ set f [open "|[list [interpreter] $path(script)]" r]
gets $f
- set s [socket 127.0.0.1 2820]
+ gets $f listen
+ set s [socket 127.0.0.1 $listen]
set p [fconfigure $s -peername]
close $s
close $f
set l ""
lappend l [string compare [lindex $p 0] 127.0.0.1]
- lappend l [string compare [lindex $p 2] 2820]
+ lappend l [string compare [lindex $p 2] $listen]
lappend l [llength $p]
} {0 0 3}
test socket-7.2 {testing socket specific options} {socket stdio} {
removeFile script
- set f [open script w]
+ set f [open $path(script) w]
puts $f {
- socket -server accept 2821
+ set ss [socket -server accept 2821]
proc accept args {
global x
set x done
}
puts ready
+ puts [lindex [fconfigure $ss -sockname] 2]
set timer [after 10000 "set x timed_out"]
vwait x
after cancel $timer
}
close $f
- set f [open "|[list $::tcltest::tcltest script]" r]
+ set f [open "|[list [interpreter] $path(script)]" r]
gets $f
- set s [socket 127.0.0.1 2821]
+ gets $f listen
+ set s [socket 127.0.0.1 $listen]
set p [fconfigure $s -sockname]
close $s
close $f
- set l ""
- lappend l [llength $p]
- lappend l [lindex $p 0]
- lappend l [expr [lindex $p 2] == 2821]
-} {3 127.0.0.1 0}
+ list [llength $p] \
+ [regexp {^(127\.0\.0\.1|0\.0\.0\.0)$} [lindex $p 0]] \
+ [expr {[lindex $p 2] == $listen}]
+} {3 1 0}
test socket-7.3 {testing socket specific options} {socket} {
- set s [socket -server accept 2822]
+ set s [socket -server accept 0]
set l [fconfigure $s]
close $s
update
llength $l
-} 12
+} 14
test socket-7.4 {testing socket specific options} {socket} {
- set s [socket -server accept 2823]
+ set s [socket -server accept 0]
proc accept {s a p} {
global x
set x [fconfigure $s -sockname]
close $s
}
- set s1 [socket [info hostname] 2823]
+ set listen [lindex [fconfigure $s -sockname] 2]
+ set s1 [socket [info hostname] $listen]
set timer [after 10000 "set x timed_out"]
vwait x
after cancel $timer
close $s
close $s1
set l ""
- lappend l [lindex $x 2] [llength $x]
-} {2823 3}
+ lappend l [expr {[lindex $x 2] == $listen}] [llength $x]
+} {1 3}
test socket-7.5 {testing socket specific options} {socket unixOrPc} {
- set s [socket -server accept 2829]
+ set s [socket -server accept 0]
proc accept {s a p} {
global x
set x [fconfigure $s -sockname]
close $s
}
- set s1 [socket 127.0.0.1 2829]
+ set listen [lindex [fconfigure $s -sockname] 2]
+ set s1 [socket 127.0.0.1 $listen]
set timer [after 10000 "set x timed_out"]
vwait x
after cancel $timer
close $s
close $s1
set l ""
- lappend l [lindex $x 0] [lindex $x 2] [llength $x]
-} {127.0.0.1 2829 3}
+ lappend l [lindex $x 0] [expr {[lindex $x 2] == $listen}] [llength $x]
+} {127.0.0.1 1 3}
test socket-8.1 {testing -async flag on sockets} {socket} {
# NOTE: This test may fail on some Solaris 2.4 systems. If it does,
@@ -874,14 +895,14 @@ test socket-8.1 {testing -async flag on sockets} {socket} {
# problem, please email jyl@eng.sun.com. We have not observed this
# failure on Solaris 2.5, so another option (instead of installing
# these patches) is to upgrade to Solaris 2.5.
- set s [socket -server accept 2830]
+ set s [socket -server accept 0]
proc accept {s a p} {
global x
puts $s bye
close $s
set x done
}
- set s1 [socket -async [info hostname] 2830]
+ set s1 [socket -async [info hostname] [lindex [fconfigure $s -sockname] 2]]
vwait x
set z [gets $s1]
close $s
@@ -911,8 +932,8 @@ test socket-9.1 {testing spurious events} {socket} {
fconfigure $s -buffering none -blocking off
fileevent $s readable [list readlittle $s]
}
- set s [socket -server accept 2831]
- set c [socket [info hostname] 2831]
+ set s [socket -server accept 0]
+ set c [socket [info hostname] [lindex [fconfigure $s -sockname] 2]]
puts -nonewline $c 01234567890123456789012345678901234567890123456789
close $c
set timer [after 10000 "set done timed_out"]
@@ -928,7 +949,7 @@ test socket-9.2 {testing async write, fileevents, flush on close} {socket} {
for {set i 0} {$i < 16} {incr i} {
set secondblock "b$secondblock$secondblock"
}
- set l [socket -server accept 2832]
+ set l [socket -server accept 0]
proc accept {s a p} {
fconfigure $s -blocking 0 -translation lf -buffersize 16384 \
-buffering line
@@ -949,7 +970,7 @@ test socket-9.2 {testing async write, fileevents, flush on close} {socket} {
puts -nonewline $s $secondblock
close $s
}
- set s [socket [info hostname] 2832]
+ set s [socket [info hostname] [lindex [fconfigure $l -sockname] 2]]
fconfigure $s -blocking 0 -trans lf -buffering line
set count 0
puts $s hello
@@ -999,8 +1020,8 @@ test socket-9.3 {testing EOF stickyness} {socket} {
fconfigure $s -buffering line -translation lf
fileevent $s writable "write_then_close $s"
}
- set s [socket -server accept 2833]
- set c [socket [info hostname] 2833]
+ set s [socket -server accept 0]
+ set c [socket [info hostname] [lindex [fconfigure $s -sockname] 2]]
fconfigure $c -blocking off -buffering line -translation lf
fileevent $c readable "count_to_eof $c"
set timer [after 1000 timerproc]
@@ -1014,9 +1035,9 @@ removeFile script
test socket-10.1 {testing socket accept callback error handling} {socket} {
set goterror 0
proc bgerror args {global goterror; set goterror 1}
- set s [socket -server accept 2898]
+ set s [socket -server accept 0]
proc accept {s a p} {close $s; error}
- set c [socket 127.0.0.1 2898]
+ set c [socket 127.0.0.1 [lindex [fconfigure $s -sockname] 2]]
vwait goterror
close $s
close $c
@@ -1366,14 +1387,17 @@ test socket-11.13 {testing async write, async flush, async close} \
set count
} 65566
-test socket-12.1 {testing inheritance of server sockets} {socket exec} {
+set path(script1) [makeFile {} script1]
+set path(script2) [makeFile {} script2]
+
+test socket-12.1 {testing inheritance of server sockets} {socket stdio exec} {
removeFile script1
removeFile script2
# Script1 is just a 10 second delay. If the server socket
# is inherited, it will be held open for 10 seconds
- set f [open script1 w]
+ set f [open $path(script1) w]
puts $f {
after 10000 exit
vwait forever
@@ -1384,29 +1408,33 @@ test socket-12.1 {testing inheritance of server sockets} {socket exec} {
# waits a second, and exits. The server socket will now
# be closed unless script1 inherited it.
- set f [open script2 w]
- puts $f [list set tclsh $::tcltest::tcltest]
- puts $f {
- set f [socket -server accept 2828]
+ set f [open $path(script2) w]
+ puts $f [list set tcltest [interpreter]]
+ puts $f [format {
+ set f [socket -server accept 0]
+ puts [lindex [fconfigure $f -sockname] 2]
proc accept { file addr port } {
close $file
}
- exec $tclsh script1 &
+ exec $tcltest "%s" &
close $f
after 1000 exit
vwait forever
- }
+ } $path(script1)]
close $f
# Launch script2 and wait 5 seconds
- exec $::tcltest::tcltest script2 &
+ ### exec [interpreter] script2 &
+ set p [open "|[list [interpreter] $path(script2)]" r]
+ gets $p listen
+
after 5000 { set ok_to_proceed 1 }
vwait ok_to_proceed
# If we can still connect to the server, the socket got inherited.
- if {[catch {socket 127.0.0.1 2828} msg]} {
+ if {[catch {socket 127.0.0.1 $listen} msg]} {
set x {server socket was not inherited}
} else {
close $msg
@@ -1415,18 +1443,19 @@ test socket-12.1 {testing inheritance of server sockets} {socket exec} {
removeFile script1
removeFile script2
+ close $p
set x
} {server socket was not inherited}
-test socket-12.2 {testing inheritance of client sockets} {socket exec} {
+test socket-12.2 {testing inheritance of client sockets} {socket stdio exec} {
removeFile script1
removeFile script2
- # Script1 is just a 10 second delay. If the server socket
+ # Script1 is just a 20 second delay. If the server socket
# is inherited, it will be held open for 10 seconds
- set f [open script1 w]
+ set f [open $path(script1) w]
puts $f {
- after 10000 exit
+ after 20000 exit
vwait forever
}
close $f
@@ -1435,21 +1464,22 @@ test socket-12.2 {testing inheritance of client sockets} {socket exec} {
# launches script1 and exits. If the child process inherited the
# client socket, the socket will still be open.
- set f [open script2 w]
- puts $f [list set tclsh $::tcltest::tcltest]
- puts $f {
- set f [socket 127.0.0.1 2829]
- exec $tclsh script1 &
+ set f [open $path(script2) w]
+ puts $f [list set tcltest [interpreter]]
+ puts $f [format {
+ gets stdin port
+ set f [socket 127.0.0.1 $port]
+ exec $tcltest "%s" &
puts $f testing
flush $f
after 1000 exit
vwait forever
- }
+ } $path(script1)]
close $f
# Create the server socket
- set server [socket -server accept 2829]
+ set server [socket -server accept 0]
proc accept { file host port } {
# When the client connects, establish the read handler
global server
@@ -1482,15 +1512,17 @@ test socket-12.2 {testing inheritance of client sockets} {socket exec} {
return
}
- # If the socket doesn't hit end-of-file in 5 seconds, the
+ # If the socket doesn't hit end-of-file in 10 seconds, the
# script1 process must have inherited the client.
set failed 0
- after 5000 [list set failed 1]
+ after 10000 [list set failed 1]
# Launch the script2 process
+ ### exec [interpreter] script2 &
- exec $::tcltest::tcltest script2 &
+ set p [open "|[list [interpreter] $path(script2)]" w]
+ puts $p [lindex [fconfigure $server -sockname] 2] ; flush $p
vwait x
if {!$failed} {
@@ -1498,42 +1530,46 @@ test socket-12.2 {testing inheritance of client sockets} {socket exec} {
}
removeFile script1
removeFile script2
+ close $p
set x
} {client socket was not inherited}
-test socket-12.3 {testing inheritance of accepted sockets} {socket exec} {
+test socket-12.3 {testing inheritance of accepted sockets} {socket stdio exec} {
removeFile script1
removeFile script2
- set f [open script1 w]
+ set f [open $path(script1) w]
puts $f {
after 10000 exit
vwait forever
}
close $f
- set f [open script2 w]
- puts $f [list set tclsh $::tcltest::tcltest]
- puts $f {
- set server [socket -server accept 2931]
+ set f [open $path(script2) w]
+ puts $f [list set tcltest [interpreter]]
+ puts $f [format {
+ set server [socket -server accept 0]
+ puts stdout [lindex [fconfigure $server -sockname] 2]
proc accept { file host port } {
- global tclsh
+ global tcltest
puts $file {test data on socket}
- exec $tclsh script1 &
+ exec $tcltest "%s" &
after 1000 exit
}
vwait forever
- }
+ } $path(script1)]
close $f
# Launch the script2 process and connect to it. See how long
# the socket stays open
- exec $::tcltest::tcltest script2 &
+ ## exec [interpreter] script2 &
+ set p [open "|[list [interpreter] $path(script2)]" r]
+ gets $p listen
after 1000 set ok_to_proceed 1
vwait ok_to_proceed
- set f [socket 127.0.0.1 2931]
+ set f [socket 127.0.0.1 $listen]
fconfigure $f -buffering full -blocking 0
fileevent $f readable [list getdata $f]
@@ -1571,6 +1607,7 @@ test socket-12.3 {testing inheritance of accepted sockets} {socket exec} {
removeFile script1
removeFile script2
+ close $p
set x
} {accepted socket was not inherited}
@@ -1581,7 +1618,8 @@ test socket-13.1 {Testing use of shared socket between two threads} \
threadReap
makeFile {
- set f [socket -server accept 2828]
+ set f [socket -server accept 0]
+ set listen [lindex [fconfigure $f -sockname] 2]
proc accept {s a p} {
fileevent $s readable [list echo $s]
fconfigure $s -buffering line
@@ -1609,9 +1647,11 @@ test socket-13.1 {Testing use of shared socket between two threads} \
# create a thread
set serverthread [testthread create { source script } ]
update
-
+ set port [testthread send $serverthread {set listen}]
+ update
+
after 1000
- set s [socket 127.0.0.1 2828]
+ set s [socket 127.0.0.1 $port]
fconfigure $s -buffering line
catch {
@@ -1638,4 +1678,3 @@ catch {close $remoteProcChan}
::tcltest::cleanupTests
flush stdout
return
-
diff --git a/tcl/tests/source.test b/tcl/tests/source.test
index 8ab5755d6f3..2a8d34cbc00 100644
--- a/tcl/tests/source.test
+++ b/tcl/tests/source.test
@@ -6,7 +6,7 @@
#
# 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) 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.
@@ -18,6 +18,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
namespace import -force ::tcltest::*
}
+set sourcefile [makeFile "" source.file]
test source-1.1 {source command} {
set x "old x value"
set y "old y value"
@@ -27,24 +28,24 @@ test source-1.1 {source command} {
set y 33
set z 44
} source.file
- source source.file
+ source $sourcefile
list $x $y $z
} {22 33 44}
test source-1.2 {source command} {
makeFile {list result} source.file
- source source.file
+ source $sourcefile
} result
test source-1.3 {source command} {
set y {\ }
- set fd [open source.file w]
+ set fd [open $sourcefile w]
fconfigure $fd -translation lf
puts -nonewline $fd "list a b c "
puts $fd [string index $y 0]
puts $fd "d e f"
close $fd
- source source.file
+ source $sourcefile
} {a b c d e f}
test source-2.3 {source error conditions} {
@@ -53,20 +54,20 @@ test source-2.3 {source error conditions} {
error "error in sourced file"
set y $x
} source.file
- list [catch {source source.file} msg] $msg $errorInfo
-} {1 {error in sourced file} {error in sourced file
+ list [catch {source $sourcefile} msg] $msg $errorInfo
+} [list 1 {error in sourced file} "error in sourced file
while executing
-"error "error in sourced file""
- (file "source.file" line 3)
+\"error \"error in sourced file\"\"
+ (file \"$sourcefile\" line 3)
invoked from within
-"source source.file"}}
+\"source \$sourcefile\""]
test source-2.4 {source error conditions} {
makeFile {break} source.file
- catch {source source.file}
+ catch {source $sourcefile}
} 3
test source-2.5 {source error conditions} {
makeFile {continue} source.file
- catch {source source.file}
+ catch {source $sourcefile}
} 4
test source-2.6 {source error conditions} {
normalizeMsg [list [catch {source _non_existent_} msg] $msg $errorCode]
@@ -80,7 +81,7 @@ test source-3.1 {return in middle of source file} {
} source.file
set x old-x
set y old-y
- set z [source source.file]
+ set z [source $sourcefile]
list $x $y $z
} {new-x old-y allDone}
test source-3.2 {return with special code etc.} {
@@ -89,7 +90,7 @@ test source-3.2 {return with special code etc.} {
return -code break "Silly result"
set y new-y
} source.file
- list [catch {source source.file} msg] $msg
+ list [catch {source $sourcefile} msg] $msg
} {3 {Silly result}}
test source-3.3 {return with special code etc.} {
makeFile {
@@ -97,20 +98,20 @@ test source-3.3 {return with special code etc.} {
return -code error "Simulated error"
set y new-y
} source.file
- list [catch {source source.file} msg] $msg $errorInfo $errorCode
+ list [catch {source $sourcefile} msg] $msg $errorInfo $errorCode
} {1 {Simulated error} {Simulated error
while executing
-"source source.file"} NONE}
+"source $sourcefile"} NONE}
test source-3.4 {return with special code etc.} {
makeFile {
set x new-x
return -code error -errorinfo "Simulated errorInfo stuff"
set y new-y
} source.file
- list [catch {source source.file} msg] $msg $errorInfo $errorCode
+ list [catch {source $sourcefile} msg] $msg $errorInfo $errorCode
} {1 {} {Simulated errorInfo stuff
invoked from within
-"source source.file"} NONE}
+"source $sourcefile"} NONE}
test source-3.5 {return with special code etc.} {
makeFile {
set x new-x
@@ -118,10 +119,10 @@ test source-3.5 {return with special code etc.} {
-errorcode {a b c}
set y new-y
} source.file
- list [catch {source source.file} msg] $msg $errorInfo $errorCode
+ list [catch {source $sourcefile} msg] $msg $errorInfo $errorCode
} {1 {} {Simulated errorInfo stuff
invoked from within
-"source source.file"} {a b c}}
+"source $sourcefile"} {a b c}}
# Test for the Macintosh specfic features of the source command
test source-4.1 {source error conditions} {macOnly} {
@@ -144,8 +145,8 @@ test source-5.1 {source resource files} {macOnly} {
} [list 1 "Error finding the file: \"bad_file\"."]
test source-5.2 {source resource files} {macOnly} {
makeFile {return} source.file
- list [catch {source -rsrc rsrcName source.file} msg] $msg
-} [list 1 "Error reading the file: \"source.file\"."]
+ list [catch {source -rsrc rsrcName $sourcefile} msg] $msg
+} [list 1 "Error reading the file: \"$sourcefile\"."]
test source-5.3 {source resource files} {macOnly} {
testWriteTextResource -rsrc rsrcName -file rsrc.file {set msg2 ok; return}
set result [catch {source -rsrc rsrcName rsrc.file} msg]
@@ -176,24 +177,17 @@ test source-5.6 {source resource files} {macOnly} {
test source-6.1 {source is binary ok} {
set x {}
makeFile [list set x "a b\0c"] source.file
- source source.file
+ source $sourcefile
string length $x
} 5
+test source-6.2 {source skips everything after Ctrl-Z: Bug 2040} {
+ set x {}
+ makeFile [list set x "ab\32c"] source.file
+ source $sourcefile
+ string length $x
+} 2
# cleanup
catch {::tcltest::removeFile source.file}
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tcl/tests/split.test b/tcl/tests/split.test
index 54aa0b949d1..8a6924678fb 100644
--- a/tcl/tests/split.test
+++ b/tcl/tests/split.test
@@ -69,6 +69,7 @@ test split-2.2 {split errors} {
} {1 {wrong # args: should be "split string ?splitChars?"} NONE}
# cleanup
+catch {rename foo {}}
::tcltest::cleanupTests
return
@@ -83,4 +84,3 @@ return
-
diff --git a/tcl/tests/stack.test b/tcl/tests/stack.test
index a78bb1d7cec..3fb876291e3 100644
--- a/tcl/tests/stack.test
+++ b/tcl/tests/stack.test
@@ -4,7 +4,7 @@
# 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) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 1998-2000 Ajuba Solutions.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -12,20 +12,49 @@
# RCS: @(#) $Id$
if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+ package require tcltest 2
namespace import -force ::tcltest::*
}
# Note that a failure in this test results in a crash of the executable.
+# In order to avoid that, we do a basic check of the current stacksize.
+# This size can be changed with ulimit (ksh/bash/sh) or limit (csh/tcsh).
-test stack-1.1 {maxNestingDepth reached on infinite recursion} {
+# This doesn't catch all cases, for example threads of lower stacksize
+# can still squeak through. A core check is really needed. -- JH
+
+if {[string equal $::tcl_platform(platform) "unix"]} {
+ set stackSize [exec /bin/sh -c "ulimit -s"]
+ if {[string is integer $stackSize] && ($stackSize < 2400)} {
+ puts stderr "WARNING: the default application stacksize of $stackSize\
+ may cause Tcl to\ncrash due to stack overflow before the\
+ recursion limit is reached.\nA minimum stacksize of 2400\
+ kbytes is recommended.\nSkipping infinite recursion test."
+ ::tcltest::testConstraint minStack2400 0
+ } else {
+ ::tcltest::testConstraint minStack2400 1
+ }
+} else {
+ ::tcltest::testConstraint minStack2400 1
+}
+
+test stack-1.1 {maxNestingDepth reached on infinite recursion} {minStack2400} {
proc recurse {} { return [recurse] }
catch {recurse} rv
rename recurse {}
set rv
-} {too many nested calls to Tcl_EvalObj (infinite loop?)}
+} {too many nested evaluations (infinite loop?)}
+
+test stack-2.1 {maxNestingDepth reached on infinite recursion} {minStack2400} {
+ # do this in a slave to not mess with parent
+ set slave stack-2.1
+ interp create $slave
+ $slave eval { interp alias {} unknown {} notaknownproc }
+ set msg [$slave eval { catch {foo} msg ; set msg }]
+ interp delete $slave
+ set msg
+} {too many nested evaluations (infinite loop?)}
# cleanup
::tcltest::cleanupTests
return
-
diff --git a/tcl/tests/string.test b/tcl/tests/string.test
index 786f726ffde..5bca19ca115 100644
--- a/tcl/tests/string.test
+++ b/tcl/tests/string.test
@@ -7,6 +7,7 @@
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
+# 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.
@@ -119,12 +120,29 @@ test string-2.26 {string compare -nocase, null strings} {
test string-2.27 {string compare -nocase, null strings} {
string compare -nocase foo ""
} 1
-test string-2.28 {string equal with length, unequal strings} {
+test string-2.28 {string compare with length, unequal strings} {
string compare -length 2 abc abde
} 0
-test string-2.29 {string equal with length, unequal strings} {
+test string-2.29 {string compare with length, unequal strings} {
string compare -length 2 ab abde
} 0
+test string-2.30 {string compare with NUL character vs. other ASCII} {
+ # Be careful here, since UTF-8 rep comparison with memcmp() of
+ # these puts chars in the wrong order
+ string compare \x00 \x01
+} -1
+test string-2.31 {string compare, high bit} {
+ proc foo {} {string compare "a\x80" "a@"}
+ foo
+} 1
+test string-2.32 {string compare, high bit} {
+ proc foo {} {string compare "a\x00" "a\x01"}
+ foo
+} -1
+test string-2.33 {string compare, high bit} {
+ proc foo {} {string compare "\x00\x00" "\x00\x01"}
+ foo
+} -1
# only need a few tests on equal, since it uses the same code as
# string compare, but just modifies the return output
@@ -155,13 +173,13 @@ test string-3.8 {string equal with length, unequal strings} {
test string-4.1 {string first, too few args} {
list [catch {string first a} msg] $msg
-} {1 {wrong # args: should be "string first string1 string2 ?startIndex?"}}
+} {1 {wrong # args: should be "string first subString string ?startIndex?"}}
test string-4.2 {string first, bad args} {
list [catch {string first a b c} msg] $msg
} {1 {bad index "c": must be integer or end?-integer?}}
test string-4.3 {string first, too many args} {
list [catch {string first a b 5 d} msg] $msg
-} {1 {wrong # args: should be "string first string1 string2 ?startIndex?"}}
+} {1 {wrong # args: should be "string first subString string ?startIndex?"}}
test string-4.4 {string first} {
string first bq abcdefgbcefgbqrs
} 12
@@ -192,9 +210,9 @@ test string-4.12 {string first, start index} {
test string-4.13 {string first, start index} {
string first \u7266 abc\u7266x end-2
} 3
-test string-4.14 {string first, start index} {
- string first a abcabc end-4
-} 3
+test string-4.14 {string first, negative start index} {
+ string first b abc -1
+} 1
test string-5.1 {string index} {
list [catch {string index} msg] $msg
@@ -254,7 +272,13 @@ test string-5.17 {string index, bad integer} {
} {1 {bad index "08": must be integer or end?-integer? (looks like invalid octal number)}}
test string-5.18 {string index, bad integer} {
list [catch {string index "abc" end-00289} msg] $msg
-} {1 {expected integer but got "-00289" (looks like invalid octal number)}}
+} {1 {bad index "end-00289": must be integer or end?-integer? (looks like invalid octal number)}}
+test string-5.19 {string index, bytearray object out of bounds} {
+ string index [binary format I* {0x50515253 0x52}] -1
+} {}
+test string-5.20 {string index, bytearray object out of bounds} {
+ string index [binary format I* {0x50515253 0x52}] 20
+} {}
proc largest_int {} {
@@ -262,7 +286,7 @@ proc largest_int {} {
# so we can test for overflow properly below on >32 bit systems
set int 1
set exp 7; # assume we get at least 8 bits
- while {$int > 0} { set int [expr {1 << [incr exp]}] }
+ while {$int > 0} { set int [expr {wide(1) << [incr exp]}] }
return [expr {$int-1}]
}
@@ -554,13 +578,13 @@ catch {rename largest_int {}}
test string-7.1 {string last, too few args} {
list [catch {string last a} msg] $msg
-} {1 {wrong # args: should be "string last string1 string2 ?startIndex?"}}
+} {1 {wrong # args: should be "string last subString string ?startIndex?"}}
test string-7.2 {string last, bad args} {
list [catch {string last a b c} msg] $msg
} {1 {bad index "c": must be integer or end?-integer?}}
test string-7.3 {string last, too many args} {
list [catch {string last a b c d} msg] $msg
-} {1 {wrong # args: should be "string last string1 string2 ?startIndex?"}}
+} {1 {wrong # args: should be "string last subString string ?startIndex?"}}
test string-7.4 {string last} {
string la xxx xxxx123xx345x678
} 1
@@ -680,6 +704,21 @@ test string-10.13 {string map, -nocase unicode} {
test string-10.14 {string map, -nocase null arguments} {
string map -nocase {{} abc} foo
} foo
+test string-10.15 {string map, one pair case} {
+ string map -nocase {abc 32} aAbCaBaAbAbcAb
+} {a32aBaAb32Ab}
+test string-10.16 {string map, one pair case} {
+ string map -nocase {ab 4321} aAbCaBaAbAbcAb
+} {a4321C4321a43214321c4321}
+test string-10.17 {string map, one pair case} {
+ string map {Ab 4321} aAbCaBaAbAbcAb
+} {a4321CaBa43214321c4321}
+test string-10.18 {string map, empty argument} {
+ string map -nocase {{} abc} foo
+} foo
+test string-10.19 {string map, empty arguments} {
+ string map -nocase {{} abc f bar {} def} foo
+} baroo
test string-11.1 {string match, too few args} {
list [catch {string match a} msg] $msg
@@ -798,6 +837,47 @@ test string-11.37 {string match nocase} {
test string-11.38 {string match case, reverse range} {
string match {[A-fh-Z]} g
} 1
+test string-11.39 {string match, *\ case} {
+ string match {*\abc} abc
+} 1
+test string-11.40 {string match, *special case} {
+ string match {*[ab]} abc
+} 0
+test string-11.41 {string match, *special case} {
+ string match {*[ab]*} abc
+} 1
+test string-11.42 {string match, *special case} {
+ string match "*\\" "\\"
+} 0
+test string-11.43 {string match, *special case} {
+ string match "*\\\\" "\\"
+} 1
+test string-11.44 {string match, *special case} {
+ string match "*???" "12345"
+} 1
+test string-11.45 {string match, *special case} {
+ string match "*???" "12"
+} 0
+test string-11.46 {string match, *special case} {
+ string match "*\\*" "abc*"
+} 1
+test string-11.47 {string match, *special case} {
+ string match "*\\*" "*"
+} 1
+test string-11.48 {string match, *special case} {
+ string match "*\\*" "*abc"
+} 0
+test string-11.49 {string match, *special case} {
+ string match "?\\*" "a*"
+} 1
+test string-11.50 {string match, *special case} {
+ string match "\\" "\\"
+} 0
+test string-11.51 {string match; *, -nocase and UTF-8} {
+ string match -nocase [binary format I 717316707] \
+ [binary format I 2028036707]
+} 1
+
test string-12.1 {string range} {
list [catch {string range} msg] $msg
@@ -857,8 +937,8 @@ test string-12.19 {string range, bytearray object} {
set b [binary format I* {0x50515253 0x52}]
set r1 [string range $b 1 end-1]
set r2 [string range $b 1 6]
- string compare $r1 $r2
-} 0
+ string equal $r1 $r2
+} 1
test string-12.20 {string range, out of bounds indices} {
string range \u00ff 0 1
} \u00ff
@@ -884,6 +964,28 @@ test string-13.6 {string repeat} {
test string-13.7 {string repeat} {
list [catch {string repeat abc end} msg] $msg
} {1 {expected integer but got "end"}}
+test string-13.8 {string repeat} {
+ string repeat {} -1000
+} {}
+test string-13.9 {string repeat} {
+ string repeat {} 0
+} {}
+test string-13.10 {string repeat} {
+ string repeat def 0
+} {}
+test string-13.11 {string repeat} {
+ string repeat def 1
+} def
+test string-13.12 {string repeat} {
+ string repeat ab\u7266cd 3
+} ab\u7266cdab\u7266cdab\u7266cd
+test string-13.13 {string repeat} {
+ string repeat \x00 3
+} \x00\x00\x00
+test string-13.14 {string repeat} {
+ # The string range will ensure us that string repeat gets a unicode string
+ string repeat [string range ab\u7266cd 2 3] 3
+} \u7266c\u7266c\u7266c
test string-14.1 {string replace} {
list [catch {string replace} msg] $msg
@@ -1163,10 +1265,3 @@ test string-22.13 {string wordstart, unicode} {
# cleanup
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
diff --git a/tcl/tests/stringComp.test b/tcl/tests/stringComp.test
new file mode 100644
index 00000000000..3af35500e39
--- /dev/null
+++ b/tcl/tests/stringComp.test
@@ -0,0 +1,673 @@
+# Commands covered: string
+#
+# 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 differs from the original string tests in that the tests call
+# things in procs, which uses the compiled string code instead of
+# the runtime parse string code. The tests of import should match
+# their equivalent number in string.test.
+#
+# Copyright (c) 2001 by ActiveState Corporation.
+# 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$
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
+# Some tests require the testobj command
+
+set ::tcltest::testConstraints(testobj) \
+ [expr {[info commands testobj] != {}}]
+
+test string-1.1 {error conditions} {
+ proc foo {} {string gorp a b}
+ list [catch {foo} msg] $msg
+} {1 {bad option "gorp": must be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, tolower, toupper, totitle, trim, trimleft, trimright, wordend, or wordstart}}
+test string-1.2 {error conditions} {
+ proc foo {} {string}
+ list [catch {foo} msg] $msg
+} {1 {wrong # args: should be "string option arg ?arg ...?"}}
+test string-1.3 {error condition - undefined method during compile} {
+ # We don't want this to complain about 'never' because it may never
+ # be called, or string may get redefined. This must compile OK.
+ proc foo {str i} {
+ if {"yes" == "no"} { string never called but complains here }
+ string index $str $i
+ }
+ foo abc 0
+} a
+
+test string-2.1 {string compare, too few args} {
+ proc foo {} {string compare a}
+ list [catch {foo} msg] $msg
+} {1 {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"}}
+test string-2.2 {string compare, bad args} {
+ proc foo {} {string compare a b c}
+ list [catch {foo} msg] $msg
+} {1 {bad option "a": must be -nocase or -length}}
+test string-2.3 {string compare, bad args} {
+ list [catch {string compare -length -nocase str1 str2} msg] $msg
+} {1 {expected integer but got "-nocase"}}
+test string-2.4 {string compare, too many args} {
+ list [catch {string compare -length 10 -nocase str1 str2 str3} msg] $msg
+} {1 {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"}}
+test string-2.5 {string compare with length unspecified} {
+ list [catch {string compare -length 10 10} msg] $msg
+} {1 {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"}}
+test string-2.6 {string compare} {
+ proc foo {} {string compare abcde abdef}
+ foo
+} -1
+test string-2.7 {string compare, shortest method name} {
+ proc foo {} {string c abcde ABCDE}
+ foo
+} 1
+test string-2.8 {string compare} {
+ proc foo {} {string compare abcde abcde}
+ foo
+} 0
+test string-2.9 {string compare with length} {
+ proc foo {} {string compare -length 2 abcde abxyz}
+ foo
+} 0
+test string-2.10 {string compare with special index} {
+ proc foo {} {string compare -length end-3 abcde abxyz}
+ list [catch {foo} msg] $msg
+} {1 {expected integer but got "end-3"}}
+test string-2.11 {string compare, unicode} {
+ proc foo {} {string compare ab\u7266 ab\u7267}
+ foo
+} -1
+test string-2.12 {string compare, high bit} {
+ # This test will fail if the underlying comparaison
+ # is using signed chars instead of unsigned chars.
+ # (like SunOS's default memcmp thus the compat/memcmp.c)
+ proc foo {} {string compare "\x80" "@"}
+ foo
+ # Nb this tests works also in utf8 space because \x80 is
+ # translated into a 2 or more bytelength but whose first byte has
+ # the high bit set.
+} 1
+test string-2.13 {string compare -nocase} {
+ proc foo {} {string compare -nocase abcde abdef}
+ foo
+} -1
+test string-2.14 {string compare -nocase} {
+ proc foo {} {string c -nocase abcde ABCDE}
+ foo
+} 0
+test string-2.15 {string compare -nocase} {
+ proc foo {} {string compare -nocase abcde abcde}
+ foo
+} 0
+test string-2.16 {string compare -nocase with length} {
+ proc foo {} {string compare -length 2 -nocase abcde Abxyz}
+ foo
+} 0
+test string-2.17 {string compare -nocase with length} {
+ proc foo {} {string compare -nocase -length 3 abcde Abxyz}
+ foo
+} -1
+test string-2.18 {string compare -nocase with length <= 0} {
+ proc foo {} {string compare -nocase -length -1 abcde AbCdEf}
+ foo
+} -1
+test string-2.19 {string compare -nocase with excessive length} {
+ proc foo {} {string compare -nocase -length 50 AbCdEf abcde}
+ foo
+} 1
+test string-2.20 {string compare -len unicode} {
+ # These are strings that are 6 BYTELENGTH long, but the length
+ # shouldn't make a different because there are actually 3 CHARS long
+ proc foo {} {string compare -len 5 \334\334\334 \334\334\374}
+ foo
+} -1
+test string-2.21 {string compare -nocase with special index} {
+ proc foo {} {string compare -nocase -length end-3 Abcde abxyz}
+ list [catch {foo} msg] $msg
+} {1 {expected integer but got "end-3"}}
+test string-2.22 {string compare, null strings} {
+ proc foo {} {string compare "" ""}
+ foo
+} 0
+test string-2.23 {string compare, null strings} {
+ proc foo {} {string compare "" foo}
+ foo
+} -1
+test string-2.24 {string compare, null strings} {
+ proc foo {} {string compare foo ""}
+ foo
+} 1
+test string-2.25 {string compare -nocase, null strings} {
+ proc foo {} {string compare -nocase "" ""}
+ foo
+} 0
+test string-2.26 {string compare -nocase, null strings} {
+ proc foo {} {string compare -nocase "" foo}
+ foo
+} -1
+test string-2.27 {string compare -nocase, null strings} {
+ proc foo {} {string compare -nocase foo ""}
+ foo
+} 1
+test string-2.28 {string compare with length, unequal strings} {
+ proc foo {} {string compare -length 2 abc abde}
+ foo
+} 0
+test string-2.29 {string compare with length, unequal strings} {
+ proc foo {} {string compare -length 2 ab abde}
+ foo
+} 0
+test string-2.30 {string compare with NUL character vs. other ASCII} {
+ # Be careful here, since UTF-8 rep comparison with memcmp() of
+ # these puts chars in the wrong order
+ proc foo {} {string compare \x00 \x01}
+ foo
+} -1
+test string-2.31 {string compare, high bit} {
+ proc foo {} {string compare "a\x80" "a@"}
+ foo
+} 1
+test string-2.32 {string compare, high bit} {
+ proc foo {} {string compare "a\x00" "a\x01"}
+ foo
+} -1
+test string-2.33 {string compare, high bit} {
+ proc foo {} {string compare "\x00\x00" "\x00\x01"}
+ foo
+} -1
+
+# only need a few tests on equal, since it uses the same code as
+# string compare, but just modifies the return output
+test string-3.1 {string equal} {
+ proc foo {} {string equal abcde abdef}
+ foo
+} 0
+test string-3.2 {string equal} {
+ proc foo {} {string eq abcde ABCDE}
+ foo
+} 0
+test string-3.3 {string equal} {
+ proc foo {} {string equal abcde abcde}
+ foo
+} 1
+test string-3.4 {string equal -nocase} {
+ proc foo {} {string equal -nocase \334\334\334\334\374\374\374\374 \334\334\334\334\334\334\334\334}
+ foo
+} 1
+test string-3.5 {string equal -nocase} {
+ proc foo {} {string equal -nocase abcde abdef}
+ foo
+} 0
+test string-3.6 {string equal -nocase} {
+ proc foo {} {string eq -nocase abcde ABCDE}
+ foo
+} 1
+test string-3.7 {string equal -nocase} {
+ proc foo {} {string equal -nocase abcde abcde}
+ foo
+} 1
+test string-3.8 {string equal with length, unequal strings} {
+ proc foo {} {string equal -length 2 abc abde}
+ foo
+} 1
+
+test string-4.1 {string first, too few args} {
+ proc foo {} {string first a}
+ list [catch {foo} msg] $msg
+} {1 {wrong # args: should be "string first subString string ?startIndex?"}}
+test string-4.2 {string first, bad args} {
+ proc foo {} {string first a b c}
+ list [catch {foo} msg] $msg
+} {1 {bad index "c": must be integer or end?-integer?}}
+test string-4.3 {string first, too many args} {
+ proc foo {} {string first a b 5 d}
+ list [catch {foo} msg] $msg
+} {1 {wrong # args: should be "string first subString string ?startIndex?"}}
+test string-4.4 {string first} {
+ proc foo {} {string first bq abcdefgbcefgbqrs}
+ foo
+} 12
+test string-4.5 {string first} {
+ proc foo {} {string fir bcd abcdefgbcefgbqrs}
+ foo
+} 1
+test string-4.6 {string first} {
+ proc foo {} {string f b abcdefgbcefgbqrs}
+ foo
+} 1
+test string-4.7 {string first} {
+ proc foo {} {string first xxx x123xx345xxx789xxx012}
+ foo
+} 9
+test string-4.8 {string first} {
+ proc foo {} {string first "" x123xx345xxx789xxx012}
+ foo
+} -1
+test string-4.9 {string first, unicode} {
+ proc foo {} {string first x abc\u7266x}
+ foo
+} 4
+test string-4.10 {string first, unicode} {
+ proc foo {} {string first \u7266 abc\u7266x}
+ foo
+} 3
+test string-4.11 {string first, start index} {
+ proc foo {} {string first \u7266 abc\u7266x 3}
+ foo
+} 3
+test string-4.12 {string first, start index} {
+ proc foo {} {string first \u7266 abc\u7266x 4}
+ foo
+} -1
+test string-4.13 {string first, start index} {
+ proc foo {} {string first \u7266 abc\u7266x end-2}
+ foo
+} 3
+test string-4.14 {string first, negative start index} {
+ proc foo {} {string first b abc -1}
+ foo
+} 1
+
+test string-5.1 {string index} {
+ proc foo {} {string index}
+ list [catch {foo} msg] $msg
+} {1 {wrong # args: should be "string index string charIndex"}}
+test string-5.2 {string index} {
+ proc foo {} {string index a b c}
+ list [catch {foo} msg] $msg
+} {1 {wrong # args: should be "string index string charIndex"}}
+test string-5.3 {string index} {
+ proc foo {} {string index abcde 0}
+ foo
+} a
+test string-5.4 {string index} {
+ proc foo {} {string in abcde 4}
+ foo
+} e
+test string-5.5 {string index} {
+ proc foo {} {string index abcde 5}
+ foo
+} {}
+test string-5.6 {string index} {
+ proc foo {} {string index abcde -10}
+ list [catch {foo} msg] $msg
+} {0 {}}
+test string-5.7 {string index} {
+ proc foo {} {string index a xyz}
+ list [catch {foo} msg] $msg
+} {1 {bad index "xyz": must be integer or end?-integer?}}
+test string-5.8 {string index} {
+ proc foo {} {string index abc end}
+ foo
+} c
+test string-5.9 {string index} {
+ proc foo {} {string index abc end-1}
+ foo
+} b
+test string-5.10 {string index, unicode} {
+ proc foo {} {string index abc\u7266d 4}
+ foo
+} d
+test string-5.11 {string index, unicode} {
+ proc foo {} {string index abc\u7266d 3}
+ foo
+} \u7266
+test string-5.12 {string index, unicode over char length, under byte length} {
+ proc foo {} {string index \334\374\334\374 6}
+ foo
+} {}
+test string-5.13 {string index, bytearray object} {
+ proc foo {} {string index [binary format a5 fuz] 0}
+ foo
+} f
+test string-5.14 {string index, bytearray object} {
+ proc foo {} {string index [binary format I* {0x50515253 0x52}] 3}
+ foo
+} S
+test string-5.15 {string index, bytearray object} {
+ proc foo {} {
+ set b [binary format I* {0x50515253 0x52}]
+ set i1 [string index $b end-6]
+ set i2 [string index $b 1]
+ string compare $i1 $i2
+ }
+ foo
+} 0
+test string-5.16 {string index, bytearray object with string obj shimmering} {
+ proc foo {} {
+ set str "0123456789\x00 abcdedfghi"
+ binary scan $str H* dump
+ string compare [string index $str 10] \x00
+ }
+ foo
+} 0
+test string-5.17 {string index, bad integer} {
+ proc foo {} {string index "abc" 08}
+ list [catch {foo} msg] $msg
+} {1 {bad index "08": must be integer or end?-integer? (looks like invalid octal number)}}
+test string-5.18 {string index, bad integer} {
+ proc foo {} {string index "abc" end-00289}
+ list [catch {foo} msg] $msg
+} {1 {bad index "end-00289": must be integer or end?-integer? (looks like invalid octal number)}}
+test string-5.19 {string index, bytearray object out of bounds} {
+ proc foo {} {string index [binary format I* {0x50515253 0x52}] -1}
+ foo
+} {}
+test string-5.20 {string index, bytearray object out of bounds} {
+ proc foo {} {string index [binary format I* {0x50515253 0x52}] 20}
+ foo
+} {}
+
+
+proc largest_int {} {
+ # This will give us what the largest valid int on this machine is,
+ # so we can test for overflow properly below on >32 bit systems
+ set int 1
+ set exp 7; # assume we get at least 8 bits
+ while {$int > 0} { set int [expr {1 << [incr exp]}] }
+ return [expr {$int-1}]
+}
+
+## string is
+## not yet bc
+
+catch {rename largest_int {}}
+
+## string last
+## not yet bc
+
+## string length
+## not yet bc
+test string-8.1 {string bytelength} {
+ proc foo {} {string bytelength}
+ list [catch {foo} msg] $msg
+} {1 {wrong # args: should be "string bytelength string"}}
+test string-8.2 {string bytelength} {
+ proc foo {} {string bytelength a b}
+ list [catch {foo} msg] $msg
+} {1 {wrong # args: should be "string bytelength string"}}
+test string-8.3 {string bytelength} {
+ proc foo {} {string bytelength "\u00c7"}
+ foo
+} 2
+test string-8.4 {string bytelength} {
+ proc foo {} {string b ""}
+ foo
+} 0
+
+## string length
+##
+test string-9.1 {string length} {
+ proc foo {} {string length}
+ list [catch {foo} msg] $msg
+} {1 {wrong # args: should be "string length string"}}
+test string-9.2 {string length} {
+ proc foo {} {string length a b}
+ list [catch {foo} msg] $msg
+} {1 {wrong # args: should be "string length string"}}
+test string-9.3 {string length} {
+ proc foo {} {string length "a little string"}
+ foo
+} 15
+test string-9.4 {string length} {
+ proc foo {} {string le ""}
+ foo
+} 0
+test string-9.5 {string length, unicode} {
+ proc foo {} {string le "abcd\u7266"}
+ foo
+} 5
+test string-9.6 {string length, bytearray object} {
+ proc foo {} {string length [binary format a5 foo]}
+ foo
+} 5
+test string-9.7 {string length, bytearray object} {
+ proc foo {} {string length [binary format I* {0x50515253 0x52}]}
+ foo
+} 8
+
+## string map
+## not yet bc
+
+## string match
+##
+test string-11.1 {string match, too few args} {
+ proc foo {} {string match a}
+ list [catch {foo} msg] $msg
+} {1 {wrong # args: should be "string match ?-nocase? pattern string"}}
+test string-11.2 {string match, too many args} {
+ proc foo {} {string match a b c d}
+ list [catch {foo} msg] $msg
+} {1 {wrong # args: should be "string match ?-nocase? pattern string"}}
+test string-11.3 {string match} {
+ proc foo {} {string match abc abc}
+ foo
+} 1
+test string-11.4 {string match} {
+ proc foo {} {string mat abc abd}
+ foo
+} 0
+test string-11.5 {string match} {
+ proc foo {} {string match ab*c abc}
+ foo
+} 1
+test string-11.6 {string match} {
+ proc foo {} {string match ab**c abc}
+ foo
+} 1
+test string-11.7 {string match} {
+ proc foo {} {string match ab* abcdef}
+ foo
+} 1
+test string-11.8 {string match} {
+ proc foo {} {string match *c abc}
+ foo
+} 1
+test string-11.9 {string match} {
+ proc foo {} {string match *3*6*9 0123456789}
+ foo
+} 1
+test string-11.10 {string match} {
+ proc foo {} {string match *3*6*9 01234567890}
+ foo
+} 0
+test string-11.11 {string match} {
+ proc foo {} {string match a?c abc}
+ foo
+} 1
+test string-11.12 {string match} {
+ proc foo {} {string match a??c abc}
+ foo
+} 0
+test string-11.13 {string match} {
+ proc foo {} {string match ?1??4???8? 0123456789}
+ foo
+} 1
+test string-11.14 {string match} {
+ proc foo {} {string match {[abc]bc} abc}
+ foo
+} 1
+test string-11.15 {string match} {
+ proc foo {} {string match {a[abc]c} abc}
+ foo
+} 1
+test string-11.16 {string match} {
+ proc foo {} {string match {a[xyz]c} abc}
+ foo
+} 0
+test string-11.17 {string match} {
+ proc foo {} {string match {12[2-7]45} 12345}
+ foo
+} 1
+test string-11.18 {string match} {
+ proc foo {} {string match {12[ab2-4cd]45} 12345}
+ foo
+} 1
+test string-11.19 {string match} {
+ proc foo {} {string match {12[ab2-4cd]45} 12b45}
+ foo
+} 1
+test string-11.20 {string match} {
+ proc foo {} {string match {12[ab2-4cd]45} 12d45}
+ foo
+} 1
+test string-11.21 {string match} {
+ proc foo {} {string match {12[ab2-4cd]45} 12145}
+ foo
+} 0
+test string-11.22 {string match} {
+ proc foo {} {string match {12[ab2-4cd]45} 12545}
+ foo
+} 0
+test string-11.23 {string match} {
+ proc foo {} {string match {a\*b} a*b}
+ foo
+} 1
+test string-11.24 {string match} {
+ proc foo {} {string match {a\*b} ab}
+ foo
+} 0
+test string-11.25 {string match} {
+ proc foo {} {string match {a\*\?\[\]\\\x} "a*?\[\]\\x"}
+ foo
+} 1
+test string-11.26 {string match} {
+ proc foo {} {string match ** ""}
+ foo
+} 1
+test string-11.27 {string match} {
+ proc foo {} {string match *. ""}
+ foo
+} 0
+test string-11.28 {string match} {
+ proc foo {} {string match "" ""}
+ foo
+} 1
+test string-11.29 {string match} {
+ proc foo {} {string match \[a a}
+ foo
+} 1
+test string-11.30 {string match, bad args} {
+ proc foo {} {string match - b c}
+ list [catch {foo} msg] $msg
+} {1 {bad option "-": must be -nocase}}
+test string-11.31 {string match case} {
+ proc foo {} {string match a A}
+ foo
+} 0
+test string-11.32 {string match nocase} {
+ proc foo {} {string match -n a A}
+ foo
+} 1
+test string-11.33 {string match nocase} {
+ proc foo {} {string match -nocase a\334 A\374}
+ foo
+} 1
+test string-11.34 {string match nocase} {
+ proc foo {} {string match -nocase a*f ABCDEf}
+ foo
+} 1
+test string-11.35 {string match case, false hope} {
+ # This is true because '_' lies between the A-Z and a-z ranges
+ proc foo {} {string match {[A-z]} _}
+ foo
+} 1
+test string-11.36 {string match nocase range} {
+ # This is false because although '_' lies between the A-Z and a-z ranges,
+ # we lower case the end points before checking the ranges.
+ proc foo {} {string match -nocase {[A-z]} _}
+ foo
+} 0
+test string-11.37 {string match nocase} {
+ proc foo {} {string match -nocase {[A-fh-Z]} g}
+ foo
+} 0
+test string-11.38 {string match case, reverse range} {
+ proc foo {} {string match {[A-fh-Z]} g}
+ foo
+} 1
+test string-11.39 {string match, *\ case} {
+ proc foo {} {string match {*\abc} abc}
+ foo
+} 1
+test string-11.40 {string match, *special case} {
+ proc foo {} {string match {*[ab]} abc}
+ foo
+} 0
+test string-11.41 {string match, *special case} {
+ proc foo {} {string match {*[ab]*} abc}
+ foo
+} 1
+test string-11.42 {string match, *special case} {
+ proc foo {} {string match "*\\" "\\"}
+ foo
+} 0
+test string-11.43 {string match, *special case} {
+ proc foo {} {string match "*\\\\" "\\"}
+ foo
+} 1
+test string-11.44 {string match, *special case} {
+ proc foo {} {string match "*???" "12345"}
+ foo
+} 1
+test string-11.45 {string match, *special case} {
+ proc foo {} {string match "*???" "12"}
+ foo
+} 0
+test string-11.46 {string match, *special case} {
+ proc foo {} {string match "*\\*" "abc*"}
+ foo
+} 1
+test string-11.47 {string match, *special case} {
+ proc foo {} {string match "*\\*" "*"}
+ foo
+} 1
+test string-11.48 {string match, *special case} {
+ proc foo {} {string match "*\\*" "*abc"}
+ foo
+} 0
+test string-11.49 {string match, *special case} {
+ proc foo {} {string match "?\\*" "a*"}
+ foo
+} 1
+test string-11.50 {string match, *special case} {
+ proc foo {} {string match "\\" "\\"}
+ foo
+} 0
+
+## string range
+## not yet bc
+
+## string repeat
+## not yet bc
+
+## string replace
+## not yet bc
+
+## string tolower
+## not yet bc
+
+## string toupper
+## not yet bc
+
+## string totitle
+## not yet bc
+
+## string trim*
+## not yet bc
+
+## string word*
+## not yet bc
+
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/stringObj.test b/tcl/tests/stringObj.test
index 7368fe2240a..e8cb6ea1852 100644
--- a/tcl/tests/stringObj.test
+++ b/tcl/tests/stringObj.test
@@ -432,4 +432,3 @@ return
-
diff --git a/tcl/tests/subst.test b/tcl/tests/subst.test
index e4e8b8eff09..3d92cce8c5c 100644
--- a/tcl/tests/subst.test
+++ b/tcl/tests/subst.test
@@ -6,7 +6,7 @@
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 1998-2000 Ajuba Solutions.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -23,7 +23,7 @@ test subst-1.1 {basics} {
} {1 {wrong # args: should be "subst ?-nobackslashes? ?-nocommands? ?-novariables? string"}}
test subst-1.2 {basics} {
list [catch {subst a b c} msg] $msg
-} {1 {wrong # args: should be "subst ?-nobackslashes? ?-nocommands? ?-novariables? string"}}
+} {1 {bad switch "a": must be -nobackslashes, -nocommands, or -novariables}}
test subst-2.1 {simple strings} {
subst {}
@@ -38,6 +38,11 @@ test subst-2.3 {simple strings} {
test subst-3.1 {backslash substitutions} {
subst {\x\$x\[foo bar]\\}
} "x\$x\[foo bar]\\"
+test subst-3.2 {backslash substitutions with utf chars} {
+ # 'j' is just a char that doesn't mean anything, and \344 is 'ä'
+ # that also doesn't mean anything, but is multi-byte in UTF-8.
+ list [subst \j] [subst \\j] [subst \\344] [subst \\\344]
+} "j j \344 \344"
test subst-4.1 {variable substitutions} {
set a 44
@@ -77,6 +82,32 @@ test subst-5.3 {command substitutions} {
test subst-5.4 {command substitutions} {
list [catch {subst {$long [set long] [bogus_command]}} msg] $msg
} {1 {invalid command name "bogus_command"}}
+test subst-5.5 {command substitutions} {
+ set a 0
+ list [catch {subst {[set a 1}} msg] $a $msg
+} {1 0 {missing close-bracket}}
+test subst-5.6 {command substitutions} {
+ set a 0
+ list [catch {subst {0[set a 1}} msg] $a $msg
+} {1 0 {missing close-bracket}}
+test subst-5.7 {command substitutions} {
+ set a 0
+ list [catch {subst {0[set a 1; set a 2}} msg] $a $msg
+} {1 1 {missing close-bracket}}
+
+# repeat the tests above simulating cmd line input
+test subst-5.8 {command substitutions} {
+ set script {[subst {[set a 1}]}
+ list [catch {exec [info nameofexecutable] << $script} msg] $msg
+} {1 {missing close-bracket}}
+test subst-5.9 {command substitutions} {
+ set script {[subst {0[set a 1}]}
+ list [catch {exec [info nameofexecutable] << $script} msg] $msg
+} {1 {missing close-bracket}}
+test subst-5.10 {command substitutions} {
+ set script {[subst {0[set a 1; set a 2}]}
+ list [catch {exec [info nameofexecutable] << $script} msg] $msg
+} {1 {missing close-bracket}}
test subst-6.1 {clear the result after command substitution} {
catch {unset a}
@@ -85,7 +116,7 @@ test subst-6.1 {clear the result after command substitution} {
test subst-7.1 {switches} {
list [catch {subst foo bar} msg] $msg
-} {1 {wrong # args: should be "subst ?-nobackslashes? ?-nocommands? ?-novariables? string"}}
+} {1 {bad switch "foo": must be -nobackslashes, -nocommands, or -novariables}}
test subst-7.2 {switches} {
list [catch {subst -no bar} msg] $msg
} {1 {ambiguous switch "-no": must be -nobackslashes, -nocommands, or -novariables}}
@@ -109,19 +140,82 @@ test subst-7.7 {switches} {
subst -nov -nob -noc {abc $x [expr 1+2] \\\x41}
} {abc $x [expr 1+2] \\\x41}
+test subst-8.1 {return in a subst} {
+ subst {foo [return {x}; bogus code] bar}
+} {foo x bar}
+test subst-8.2 {return in a subst} {
+ subst {foo [return x ; bogus code] bar}
+} {foo x bar}
+test subst-8.3 {return in a subst} {
+ subst {foo [if 1 { return {x}; bogus code }] bar}
+} {foo x bar}
+test subst-8.4 {return in a subst} {
+ subst {[eval {return hi}] there}
+} {hi there}
+test subst-8.5 {return in a subst} {
+ subst {foo [return {]}; bogus code] bar}
+} {foo ] bar}
+test subst-8.6 {return in a subst} {
+ subst {foo [return {x}; bogus code bar}
+} {foo x}
+test subst-8.7 {return in a subst, parse error} {
+ subst {foo [return {x} ; set a {}" ; stuff] bar}
+} {foo xset a {}" ; stuff] bar}
+test subst-8.8 {return in a subst, parse error} {
+ subst {foo [return {x} ; set bar baz ; set a {}" ; stuff] bar}
+} {foo xset bar baz ; set a {}" ; stuff] bar}
+test subst-8.9 {return in a variable subst} {
+ subst {foo $var([return {x}]) bar}
+} {foo x bar}
+
+test subst-9.1 {error in a subst} {
+ list [catch {subst {[error foo; bogus code]bar}} msg] $msg
+} {1 foo}
+test subst-9.2 {error in a subst} {
+ list [catch {subst {[if 1 { error foo; bogus code}]bar}} msg] $msg
+} {1 foo}
+test subst-9.3 {error in a variable subst} {
+ list [catch {subst {foo $var([error foo]) bar}} msg] $msg
+} {1 foo}
+
+test subst-10.1 {break in a subst} {
+ subst {foo [break; bogus code] bar}
+} {foo }
+test subst-10.2 {break in a subst} {
+ subst {foo [break; return x; bogus code] bar}
+} {foo }
+test subst-10.3 {break in a subst} {
+ subst {foo [if 1 { break; bogus code}] bar}
+} {foo }
+test subst-10.4 {break in a subst, parse error} {
+ subst {foo [break ; set a {}{} ; stuff] bar}
+} {foo }
+test subst-10.5 {break in a subst, parse error} {
+ subst {foo [break ;set bar baz ;set a {}{} ; stuff] bar}
+} {foo }
+test subst-10.6 {break in a variable subst} {
+ subst {foo $var([break]) bar}
+} {foo }
+
+test subst-11.1 {continue in a subst} {
+ subst {foo [continue; bogus code] bar}
+} {foo bar}
+test subst-11.2 {continue in a subst} {
+ subst {foo [continue; return x; bogus code] bar}
+} {foo bar}
+test subst-11.3 {continue in a subst} {
+ subst {foo [if 1 { continue; bogus code}] bar}
+} {foo bar}
+test subst-11.4 {continue in a subst, parse error} {
+ subst {foo [continue ; set a {}{} ; stuff] bar}
+} {foo set a {}{} ; stuff] bar}
+test subst-11.5 {continue in a subst, parse error} {
+ subst {foo [continue ;set bar baz ;set a {}{} ; stuff] bar}
+} {foo set bar baz ;set a {}{} ; stuff] bar}
+test subst-11.6 {continue in a variable subst} {
+ subst {foo $var([continue]) bar}
+} {foo bar}
+
# cleanup
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tcl/tests/switch.test b/tcl/tests/switch.test
index c8ecbe7e72c..4cc007e48df 100644
--- a/tcl/tests/switch.test
+++ b/tcl/tests/switch.test
@@ -162,7 +162,7 @@ test switch-7.2 {"-" bodies} {
c -
}
} msg] $msg
-} {1 {no body specified for pattern "a"}}
+} {1 {no body specified for pattern "c"}}
test switch-7.3 {"-" bodies} {
list [catch {
switch a {
@@ -171,7 +171,7 @@ test switch-7.3 {"-" bodies} {
c -
}
} msg] $msg
-} {1 {invalid command name "-foo"}}
+} {1 {no body specified for pattern "c"}}
test switch-8.1 {empty body} {
set msg {}
@@ -182,19 +182,37 @@ test switch-8.1 {empty body} {
}
} {}
+test switch-9.1 {empty pattern/body list} {
+ list [catch {switch x} msg] $msg
+} {1 {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"}}
+test switch-9.2 {empty pattern/body list} {
+ list [catch {switch -- x} msg] $msg
+} {1 {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"}}
+test switch-9.3 {empty pattern/body list} {
+ list [catch {switch x {}} msg] $msg
+} {1 {wrong # args: should be "switch ?switches? string {pattern body ... ?default body?}"}}
+test switch-9.4 {empty pattern/body list} {
+ list [catch {switch -- x {}} msg] $msg
+} {1 {wrong # args: should be "switch ?switches? string {pattern body ... ?default body?}"}}
+test switch-9.5 {unpaired pattern} {
+ list [catch {switch x a {} b} msg] $msg
+} {1 {extra switch pattern with no body}}
+test switch-9.6 {unpaired pattern} {
+ list [catch {switch x {a {} b}} msg] $msg
+} {1 {extra switch pattern with no body}}
+test switch-9.7 {unpaired pattern} {
+ list [catch {switch x a {} # comment b} msg] $msg
+} {1 {extra switch pattern with no body}}
+test switch-9.8 {unpaired pattern} {
+ list [catch {switch x {a {} # comment b}} msg] $msg
+} {1 {extra switch pattern with no body, this may be due to a comment incorrectly placed outside of a switch body - see the "switch" documentation}}
+test switch-9.9 {unpaired pattern} {
+ list [catch {switch x a {} x {} # comment b} msg] $msg
+} {1 {extra switch pattern with no body}}
+test switch-9.10 {unpaired pattern} {
+ list [catch {switch x {a {} x {} # comment b}} msg] $msg
+} {1 {extra switch pattern with no body, this may be due to a comment incorrectly placed outside of a switch body - see the "switch" documentation}}
+
# cleanup
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tcl/tests/tcltest.test b/tcl/tests/tcltest.test
index c51c420d474..fac5b9cac59 100644
--- a/tcl/tests/tcltest.test
+++ b/tcl/tests/tcltest.test
@@ -1,25 +1,36 @@
-# Command line options covered:
-# -help, -verbose, -match, -skip, -file, -notfile, -constraints,
-# -limitconstraints, -preservecore, -tmpdir, -debug, -outfile,
-# -errfile, -args
-#
# 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) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 2000 by Ajuba Solutions
# All rights reserved.
#
# RCS: @(#) $Id$
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
- namespace import -force ::tcltest::*
+# Note that there are several places where the value of
+# tcltest::currentFailure is stored/reset in the -setup/-cleanup
+# of a test that has a body that runs [test] that will fail.
+# This is a workaround of using the same tcltest code that we are
+# testing to run the test itself. Ditto on things like [verbose].
+#
+# It would be better to have the -body of the tests run the tcltest
+# commands in a slave interp so the [test] being tested would not
+# interfere with the [test] doing the testing.
+#
+
+if {[catch {package require tcltest 2.1}]} {
+ puts stderr "Skipping tests in [info script]. tcltest 2.1 required."
+ return
}
+namespace eval ::tcltest::test {
+
+namespace import ::tcltest::*
+
makeFile {
package require tcltest
- namespace import -force ::tcltest::*
+ namespace import ::tcltest::test
test a-1.0 {test a} {
list 0
} {0}
@@ -28,128 +39,312 @@ makeFile {
} {0}
test c-1.0 {test c} {knownBug} {
} {}
- ::tcltest::cleanupTests
+ test d-1.0 {test d} {
+ error "foo" foo 9
+ } {}
+ tcltest::cleanupTests
exit
} test.tcl
+cd [temporaryDirectory]
+testConstraint exec [llength [info commands exec]]
# test -help
-test tcltest-1.1 {tcltest -help} {unixOrPc} {
- set result [catch {exec $::tcltest::tcltest test.tcl -help} msg]
- set result [catch {runCmd $cmd}]
+# Child processes because -help [exit]s.
+test tcltest-1.1 {tcltest -help} {exec} {
+ set result [catch {exec [interpreter] test.tcl -help} msg]
list $result [regexp Usage $msg]
} {1 1}
-test tcltest-1.2 {tcltest -help -something} {unixOrPc} {
- set result [catch {exec $::tcltest::tcltest test.tcl -help -something} msg]
+test tcltest-1.2 {tcltest -help -something} {exec} {
+ set result [catch {exec [interpreter] test.tcl -help -something} msg]
list $result [regexp Usage $msg]
} {1 1}
-test tcltest-1.3 {tcltest -h} {unixOrPc} {
- set result [catch {exec $::tcltest::tcltest test.tcl -h} msg]
+test tcltest-1.3 {tcltest -h} {exec} {
+ set result [catch {exec [interpreter] test.tcl -h} msg]
list $result [regexp Usage $msg]
-} {1 1}
+} {1 0}
+
+# -verbose, implicit & explicit testing of [verbose]
+proc slave {msgVar args} {
+ upvar 1 $msgVar msg
+
+ interp create [namespace current]::i
+ # Fake the slave interp into dumping output to a file
+ i eval {namespace eval ::tcltest {}}
+ i eval "set tcltest::outputChannel \[open [makeFile {} output] w]"
+ i eval "set tcltest::errorChannel \[open [makeFile {} error] w]"
+ i eval [list set argv0 [lindex $args 0]]
+ i eval [list set argv [lrange $args 1 end]]
+ i eval [list package ifneeded tcltest [package provide tcltest] \
+ [package ifneeded tcltest [package provide tcltest]]]
+ i eval {proc exit args {}}
+
+ # Need to capture output in msg
-# -verbose
+ set code [catch {i eval {source $argv0}} foo]
+if $code {
+#puts "$code: $foo\n$::errorInfo"
+}
+ i eval {close $tcltest::outputChannel}
+ interp delete [namespace current]::i
+ set f [open [file join [temporaryDirectory] output]]
+ set msg [read -nonewline $f]
+ close $f
+ set f [open [file join [temporaryDirectory] error]]
+ set err [read -nonewline $f]
+ close $f
+ if {[string length $err]} {
+ set code 1
+ append msg \n$err
+ }
+ return $code
+
+# return [catch {uplevel 1 [linsert $args 0 exec [interpreter]]} msg]
+}
test tcltest-2.0 {tcltest (verbose default - 'b')} {unixOrPc} {
- set result [catch {exec $::tcltest::tcltest test.tcl} msg]
+ set result [slave msg test.tcl]
list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
[regexp c-1.0 $msg] \
- [regexp "Total.+3.+Passed.+1.+Skipped.+1.+Failed.+1" $msg]
+ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 1 0 0 1}
-test tcltest-2.1 {tcltest -v 'b'} {unixOrPc} {
- set result [catch {exec $::tcltest::tcltest test.tcl -v 'b'} msg]
+test tcltest-2.1 {tcltest -verbose 'b'} {unixOrPc} {
+ set result [slave msg test.tcl -verbose 'b']
list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
[regexp c-1.0 $msg] \
- [regexp "Total.+3.+Passed.+1.+Skipped.+1.+Failed.+1" $msg]
+ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 1 0 0 1}
-test tcltest-2.2 {tcltest -v 'p'} {unixOrPc} {
- set result [catch {exec $::tcltest::tcltest test.tcl -v 'p'} msg]
+test tcltest-2.2 {tcltest -verbose 'p'} {unixOrPc} {
+ set result [slave msg test.tcl -verbose 'p']
list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
[regexp c-1.0 $msg] \
- [regexp "Total.+3.+Passed.+1.+Skipped.+1.+Failed.+1" $msg]
+ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 0 1 0 1}
-test tcltest-2.3 {tcltest -v 's'} {unixOrPc} {
- set result [catch {exec $::tcltest::tcltest test.tcl -v 's'} msg]
+test tcltest-2.3 {tcltest -verbose 's'} {unixOrPc} {
+ set result [slave msg test.tcl -verbose 's']
list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
[regexp c-1.0 $msg] \
- [regexp "Total.+3.+Passed.+1.+Skipped.+1.+Failed.+1" $msg]
+ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 0 0 1 1}
-test tcltest-2.4 {tcltest -v 'ps'} {unixOrPc} {
- set result [catch {exec $::tcltest::tcltest test.tcl -verbose 'ps'} msg]
+test tcltest-2.4 {tcltest -verbose 'ps'} {unixOrPc} {
+ set result [slave msg test.tcl -verbose 'ps']
list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
[regexp c-1.0 $msg] \
- [regexp "Total.+3.+Passed.+1.+Skipped.+1.+Failed.+1" $msg]
+ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 0 1 1 1}
-test tcltest-2.5 {tcltest -v 'psb'} {unixOrPc} {
- set result [catch {exec $::tcltest::tcltest test.tcl -v 'psb'} msg]
+test tcltest-2.5 {tcltest -verbose 'psb'} {unixOrPc} {
+ set result [slave msg test.tcl -verbose 'psb']
list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
[regexp c-1.0 $msg] \
- [regexp "Total.+3.+Passed.+1.+Skipped.+1.+Failed.+1" $msg]
+ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 1 1 1 1}
-# -match
+test tcltest-2.5a {tcltest -verbose 'pass skip body'} {unixOrPc} {
+ set result [slave msg test.tcl -verbose "pass skip body"]
+ list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
+ [regexp c-1.0 $msg] \
+ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
+} {0 1 1 1 1}
+
+test tcltest-2.6 {tcltest -verbose 't'} {
+ -constraints {unixOrPc}
+ -body {
+ set result [slave msg test.tcl -verbose 't']
+ list $result $msg
+ }
+ -result {^0 .*a-1.0 start.*b-1.0 start}
+ -match regexp
+}
+
+test tcltest-2.6a {tcltest -verbose 'start'} {
+ -constraints {unixOrPc}
+ -body {
+ set result [slave msg test.tcl -verbose start]
+ list $result $msg
+ }
+ -result {^0 .*a-1.0 start.*b-1.0 start}
+ -match regexp
+}
+
+test tcltest-2.7 {tcltest::verbose} {
+ -body {
+ set oldVerbosity [verbose]
+ verbose bar
+ set currentVerbosity [verbose]
+ verbose foo
+ set newVerbosity [verbose]
+ verbose $oldVerbosity
+ list $currentVerbosity $newVerbosity
+ }
+ -result {body {}}
+}
+
+test tcltest-2.8 {tcltest -verbose 'error'} {
+ -constraints {unixOrPc}
+ -body {
+ set result [slave msg test.tcl -verbose error]
+ list $result $msg
+ }
+ -result {errorInfo: foo.*errorCode: 9}
+ -match regexp
+}
+# -match, [match]
test tcltest-3.1 {tcltest -match 'a*'} {unixOrPc} {
- set result [catch {exec $::tcltest::tcltest test.tcl -match a* -v 'ps'} msg]
+ set result [slave msg test.tcl -match a* -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
- [regexp "Total.+3.+Passed.+1.+Skipped.+2.+Failed.+0" $msg]
+ [regexp "Total.+4.+Passed.+1.+Skipped.+3.+Failed.+0" $msg]
} {0 1 0 0 1}
test tcltest-3.2 {tcltest -match 'b*'} {unixOrPc} {
- set result [catch {exec $::tcltest::tcltest test.tcl -m b* -v 'ps'} msg]
+ set result [slave msg test.tcl -match b* -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
- [regexp "Total.+3.+Passed.+0.+Skipped.+2.+Failed.+1" $msg]
+ [regexp "Total.+4.+Passed.+0.+Skipped.+3.+Failed.+1" $msg]
} {0 0 1 0 1}
test tcltest-3.3 {tcltest -match 'c*'} {unixOrPc} {
- set result [catch {exec $::tcltest::tcltest test.tcl -match c* -v 'ps'} msg]
+ set result [slave msg test.tcl -match c* -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
- [regexp "Total.+3.+Passed.+0.+Skipped.+3.+Failed.+0" $msg]
+ [regexp "Total.+4.+Passed.+0.+Skipped.+4.+Failed.+0" $msg]
} {0 0 0 1 1}
test tcltest-3.4 {tcltest -match 'a* b*'} {unixOrPc} {
- set result [catch {exec $::tcltest::tcltest test.tcl -match {a* b*} -v 'ps'} msg]
+ set result [slave msg test.tcl -match {a* b*} -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
- [regexp "Total.+3.+Passed.+1.+Skipped.+1.+Failed.+1" $msg]
+ [regexp "Total.+4.+Passed.+1.+Skipped.+2.+Failed.+1" $msg]
} {0 1 1 0 1}
-# -skip
+test tcltest-3.5 {tcltest::match} {
+ -body {
+ set oldMatch [match]
+ match foo
+ set currentMatch [match]
+ match bar
+ set newMatch [match]
+ match $oldMatch
+ list $currentMatch $newMatch
+ }
+ -result {foo bar}
+}
+
+# -skip, [skip]
test tcltest-4.1 {tcltest -skip 'a*'} {unixOrPc} {
- set result [catch {exec $::tcltest::tcltest test.tcl -skip a* -v 'ps'} msg]
+ set result [slave msg test.tcl -skip a* -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
- [regexp "Total.+3.+Passed.+0.+Skipped.+2.+Failed.+1" $msg]
+ [regexp "Total.+4.+Passed.+0.+Skipped.+2.+Failed.+1" $msg]
} {0 0 1 1 1}
test tcltest-4.2 {tcltest -skip 'b*'} {unixOrPc} {
- set result [catch {exec $::tcltest::tcltest test.tcl -s b* -v 'ps'} msg]
+ set result [slave msg test.tcl -skip b* -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
- [regexp "Total.+3.+Passed.+1.+Skipped.+2.+Failed.+0" $msg]
+ [regexp "Total.+4.+Passed.+1.+Skipped.+2.+Failed.+1" $msg]
} {0 1 0 1 1}
test tcltest-4.3 {tcltest -skip 'c*'} {unixOrPc} {
- set result [catch {exec $::tcltest::tcltest test.tcl -skip c* -v 'ps'} msg]
+ set result [slave msg test.tcl -skip c* -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
- [regexp "Total.+3.+Passed.+1.+Skipped.+1.+Failed.+1" $msg]
+ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 1 1 0 1}
test tcltest-4.4 {tcltest -skip 'a* b*'} {unixOrPc} {
- set result [catch {exec $::tcltest::tcltest test.tcl -skip {a* b*} -v 'ps'} msg]
+ set result [slave msg test.tcl -skip {a* b*} -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
- [regexp "Total.+3.+Passed.+0.+Skipped.+3.+Failed.+0" $msg]
+ [regexp "Total.+4.+Passed.+0.+Skipped.+3.+Failed.+1" $msg]
} {0 0 0 1 1}
test tcltest-4.5 {tcltest -match 'a* b*' -skip 'b*'} {unixOrPc} {
- set result [catch {exec $::tcltest::tcltest test.tcl -match {a* b*} -skip b* -v 'ps'} msg]
+ set result [slave msg test.tcl -match {a* b*} -skip b* -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
- [regexp "Total.+3.+Passed.+1.+Skipped.+2.+Failed.+0" $msg]
+ [regexp "Total.+4.+Passed.+1.+Skipped.+3.+Failed.+0" $msg]
} {0 1 0 0 1}
-# -constraints, -limitconstraints
+test tcltest-4.6 {tcltest::skip} {
+ -body {
+ set oldSkip [skip]
+ skip foo
+ set currentSkip [skip]
+ skip bar
+ set newSkip [skip]
+ skip $oldSkip
+ list $currentSkip $newSkip
+ }
+ -result {foo bar}
+}
+
+# -constraints, -limitconstraints, [testConstraint],
+# $constraintsSpecified, [limitConstraints]
test tcltest-5.1 {tcltest -constraints 'knownBug'} {unixOrPc} {
- set result [catch {exec $::tcltest::tcltest test.tcl -constraints knownBug -v 'ps'} msg]
+ set result [slave msg test.tcl -constraints knownBug -verbose 'ps']
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
- [regexp "Total.+3.+Passed.+2.+Skipped.+0.+Failed.+1" $msg]
+ [regexp "Total.+4.+Passed.+2.+Skipped.+0.+Failed.+2" $msg]
} {0 1 1 1 1}
-test tcltest-5.1 {tcltest -constraints 'knownBug'} {unixOrPc} {
- set result [catch {exec $::tcltest::tcltest test.tcl -constraints knownBug -v 'p' -limitconstraints 1} msg]
+test tcltest-5.2 {tcltest -constraints 'knownBug' -limitconstraints 1} {unixOrPc} {
+ set result [slave msg test.tcl -constraints knownBug -verbose 'p' -limitconstraints 1]
list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
- [regexp "Total.+3.+Passed.+1.+Skipped.+2.+Failed.+0" $msg]
+ [regexp "Total.+4.+Passed.+1.+Skipped.+3.+Failed.+0" $msg]
} {0 0 0 1 1}
-makeFile {
+test tcltest-5.3 {testConstraint - constraint empty (tcltest::safeFetch)} {
+ -body {
+ set r1 [testConstraint tcltestFakeConstraint]
+ set r2 [testConstraint tcltestFakeConstraint 4]
+ set r3 [testConstraint tcltestFakeConstraint]
+ list $r1 $r2 $r3
+ }
+ -result {0 4 4}
+ -cleanup {unset ::tcltest::testConstraints(tcltestFakeConstraint)}
+}
+
+# Removed this test of internals of tcltest. Those internals have changed.
+#test tcltest-5.4 {tcltest::constraintsSpecified} {
+# -setup {
+# set constraintlist $::tcltest::constraintsSpecified
+# set ::tcltest::constraintsSpecified {}
+# }
+# -body {
+# set r1 $::tcltest::constraintsSpecified
+# testConstraint tcltestFakeConstraint1 1
+# set r2 $::tcltest::constraintsSpecified
+# testConstraint tcltestFakeConstraint2 1
+# set r3 $::tcltest::constraintsSpecified
+# list $r1 $r2 $r3
+# }
+# -result {{} tcltestFakeConstraint1 {tcltestFakeConstraint1 tcltestFakeConstraint2}}
+# -cleanup {
+# set ::tcltest::constraintsSpecified $constraintlist
+# unset ::tcltest::testConstraints(tcltestFakeConstraint1)
+# unset ::tcltest::testConstraints(tcltestFakeConstraint2)
+# }
+#}
+
+test tcltest-5.5 {InitConstraints: list of built-in constraints} \
+ -constraints {!singleTestInterp} \
+ -setup {tcltest::InitConstraints} \
+ -body { lsort [array names ::tcltest::testConstraints] } \
+ -result [lsort {
+ 95 98 asyncPipeClose eformat emptyTest exec hasIsoLocale interactive
+ knownBug mac macCrash macOnly macOrPc macOrUnix macOrWin nonBlockFiles
+ nonPortable notRoot nt pc pcCrash pcOnly root singleTestInterp socket
+ stdio tempNotMac tempNotPc tempNotUnix tempNotWin unix unixCrash unixExecs
+ unixOnly unixOrPc unixOrWin userInteraction win winCrash winOnly
+}]
+
+# Removed this broken test. Its usage of [limitConstraints] was not
+# in agreement with the documentation. [limitConstraints] is supposed
+# to take an optional boolean argument, and "knownBug" ain't no boolean!
+#test tcltest-5.6 {tcltest::limitConstraints} {
+# -setup {
+# set keeplc $::tcltest::limitConstraints
+# set keepkb [testConstraint knownBug]
+# }
+# -body {
+# set r1 [limitConstraints]
+# set r2 [limitConstraints knownBug]
+# set r3 [limitConstraints]
+# list $r1 $r2 $r3
+# }
+# -cleanup {
+# limitConstraints $keeplc
+# testConstraint knownBug $keepkb
+# }
+# -result {false knownBug knownBug}
+#}
+
+# -outfile, -errfile, [outputChannel], [outputFile], [errorChannel], [errorFile]
+set printerror [makeFile {
package require tcltest
- namespace import -force ::tcltest::*
- puts $::tcltest::outputChannel "a test"
+ namespace import ::tcltest::*
+ puts [outputChannel] "a test"
::tcltest::PrintError "a really short string"
::tcltest::PrintError "a really really really really really really long \
string containing \"quotes\" and other bad bad stuff"
@@ -159,29 +354,33 @@ makeFile {
\"Really/Long/Path/that/contains/no/spaces/and/is/longer/than/eighty/characters/to/see/what/happens\""
::tcltest::PrintError "Problem renaming file: error renaming \"Z:/ws/tcl8.2/win32-ix86/tests/core\" to \"Z:/ws/tcl8.2/win32-ix86/tests/movecore-core\""
exit
-} printerror.tcl
+} printerror.tcl]
-# -outfile, -errfile
-test tcltest-6.1 {tcltest -outfile, -errfile defaults} {unixOrPc} {
- catch {exec $::tcltest::tcltest printerror.tcl} msg
- list [regexp "a test" $msg] [regexp "a really" $msg]
-} {1 1}
-test tcltest-6.2 {tcltest -outfile a.tmp} {unixOrPc} {
- catch {exec $::tcltest::tcltest printerror.tcl -outfile a.tmp} msg
+test tcltest-6.1 {tcltest -outfile, -errfile defaults} {
+ -constraints unixOrPc
+ -body {
+ slave msg $printerror
+ return $msg
+ }
+ -result {a test.*a really}
+ -match regexp
+}
+test tcltest-6.2 {tcltest -outfile a.tmp} {unixOrPc unixExecs} {
+ slave msg $printerror -outfile a.tmp
set result1 [catch {exec grep "a test" a.tmp}]
set result2 [catch {exec grep "a really" a.tmp}]
list [regexp "a test" $msg] [regexp "a really" $msg] \
$result1 $result2 [file exists a.tmp] [file delete a.tmp]
} {0 1 0 1 1 {}}
-test tcltest-6.3 {tcltest -errfile a.tmp} {unixOrPc} {
- catch {exec $::tcltest::tcltest printerror.tcl -errfile a.tmp} msg
+test tcltest-6.3 {tcltest -errfile a.tmp} {unixOrPc unixExecs} {
+ slave msg $printerror -errfile a.tmp
set result1 [catch {exec grep "a test" a.tmp}]
set result2 [catch {exec grep "a really" a.tmp}]
list [regexp "a test" $msg] [regexp "a really" $msg] \
$result1 $result2 [file exists a.tmp] [file delete a.tmp]
} {1 0 1 0 1 {}}
-test tcltest-6.4 {tcltest -outfile a.tmp -errfile b.tmp} {unixOrPc} {
- catch {exec $::tcltest::tcltest printerror.tcl -o a.tmp -e b.tmp} msg
+test tcltest-6.4 {tcltest -outfile a.tmp -errfile b.tmp} {unixOrPc unixExecs} {
+ slave msg printerror.tcl -outfile a.tmp -errfile b.tmp
set result1 [catch {exec grep "a test" a.tmp}]
set result2 [catch {exec grep "a really" b.tmp}]
list [regexp "a test" $msg] [regexp "a really" $msg] \
@@ -190,58 +389,162 @@ test tcltest-6.4 {tcltest -outfile a.tmp -errfile b.tmp} {unixOrPc} {
[file exists b.tmp] [file delete b.tmp]
} {0 0 0 0 1 {} 1 {}}
-# -debug
-test tcltest-7.1 {tcltest test.tcl -d 0} {unixOrPc} {
- catch {exec $::tcltest::tcltest test.tcl -d 0} msg
+test tcltest-6.5 {tcltest::errorChannel - retrieval} {
+ -setup {
+ set of [errorChannel]
+ set ::tcltest::errorChannel stderr
+ }
+ -body {
+ errorChannel
+ }
+ -result {stderr}
+ -cleanup {
+ set ::tcltest::errorChannel $of
+ }
+}
+
+test tcltest-6.6 {tcltest::errorFile (implicit errorChannel)} {
+ -setup {
+ set ef [makeFile {} efile]
+ set of [errorFile]
+ set ::tcltest::errorChannel stderr
+ set ::tcltest::errorFile stderr
+ }
+ -body {
+ set f0 [errorChannel]
+ set f1 [errorFile]
+ set f2 [errorFile $ef]
+ set f3 [errorChannel]
+ set f4 [errorFile]
+ subst {$f0;$f1;$f2;$f3;$f4}
+ }
+ -result {stderr;stderr;.*efile;file[0-9a-f]+;.*efile}
+ -match regexp
+ -cleanup {
+ errorFile $of
+ }
+}
+test tcltest-6.7 {tcltest::outputChannel - retrieval} {
+ -setup {
+ set of [outputChannel]
+ set ::tcltest::outputChannel stdout
+ }
+ -body {
+ outputChannel
+ }
+ -result {stdout}
+ -cleanup {
+ set tcltest::outputChannel $of
+ }
+}
+
+test tcltest-6.8 {tcltest::outputFile (implicit outputFile)} {
+ -setup {
+ set ef [makeFile {} efile]
+ set of [outputFile]
+ set ::tcltest::outputChannel stdout
+ set ::tcltest::outputFile stdout
+ }
+ -body {
+ set f0 [outputChannel]
+ set f1 [outputFile]
+ set f2 [outputFile $ef]
+ set f3 [outputChannel]
+ set f4 [outputFile]
+ subst {$f0;$f1;$f2;$f3;$f4}
+ }
+ -result {stdout;stdout;.*efile;file[0-9a-f]+;.*efile}
+ -match regexp
+ -cleanup {
+ outputFile $of
+ }
+}
+
+# -debug, [debug]
+# Must use child processes to test -debug because it always writes
+# messages to stdout, and we have no way to capture stdout of a
+# slave interp
+test tcltest-7.1 {tcltest test.tcl -debug 0} {unixOrPc} {
+ catch {exec [interpreter] test.tcl -debug 0} msg
regexp "Flags passed into tcltest" $msg
} {0}
-test tcltest-7.2 {tcltest test.tcl -d 1} {unixOrPc} {
- catch {exec $::tcltest::tcltest test.tcl -d 1 -s b*} msg
+test tcltest-7.2 {tcltest test.tcl -debug 1} {unixOrPc} {
+ catch {exec [interpreter] test.tcl -debug 1 -skip b*} msg
list [regexp userSpecifiedSkip $msg] \
[regexp "Flags passed into tcltest" $msg]
} {1 0}
-test tcltest-7.3 {tcltest test.tcl -d 1} {unixOrPc} {
- catch {exec $::tcltest::tcltest test.tcl -d 1 -m b*} msg
+test tcltest-7.3 {tcltest test.tcl -debug 1} {unixOrPc} {
+ catch {exec [interpreter] test.tcl -debug 1 -match b*} msg
list [regexp userSpecifiedNonMatch $msg] \
[regexp "Flags passed into tcltest" $msg]
} {1 0}
-test tcltest-7.4 {tcltest test.tcl -d 2} {unixOrPc} {
- catch {exec $::tcltest::tcltest test.tcl -d 2} msg
+test tcltest-7.4 {tcltest test.tcl -debug 2} {unixOrPc} {
+ catch {exec [interpreter] test.tcl -debug 2} msg
list [regexp "Flags passed into tcltest" $msg] [regexp "Running" $msg]
} {1 0}
-test tcltest-7.5 {tcltest test.tcl -d 3} {unixOrPc} {
- catch {exec $::tcltest::tcltest test.tcl -d 3} msg
+test tcltest-7.5 {tcltest test.tcl -debug 3} {unixOrPc} {
+ catch {exec [interpreter] test.tcl -debug 3} msg
list [regexp "Flags passed into tcltest" $msg] [regexp "Running" $msg]
} {1 1}
+test tcltest-7.6 {tcltest::debug} {
+ -setup {
+ set old $::tcltest::debug
+ set ::tcltest::debug 0
+ }
+ -body {
+ set f1 [debug]
+ set f2 [debug 1]
+ set f3 [debug]
+ set f4 [debug 2]
+ set f5 [debug]
+ list $f1 $f2 $f3 $f4 $f5
+ }
+ -result {0 1 1 2 2}
+ -cleanup {
+ set ::tcltest::debug $old
+ }
+}
+
+# directory tests
+
makeFile {
package require tcltest
- namespace import -force ::tcltest::*
- makeFile {} a.tmp
+ tcltest::makeFile {} a.tmp
+ puts [tcltest::outputChannel] "testdir: [tcltest::testsDirectory]"
exit
} a.tcl
-makeFile {} thisdirectoryisafile
+makeFile {} thisdirectoryisafile
-# -tmpdir
+set normaldirectory [makeDirectory normaldirectory]
+if {$::tcl_platform(platform) == "macintosh"} {
+set normaldirectory [file normalize $normaldirectory]
+}
+
+# -tmpdir, [temporaryDirectory]
test tcltest-8.1 {tcltest a.tcl -tmpdir a} {unixOrPc} {
file delete -force thisdirectorydoesnotexist
- exec $::tcltest::tcltest a.tcl -tmpdir thisdirectorydoesnotexist
+ slave msg a.tcl -tmpdir thisdirectorydoesnotexist
list [file exists [file join thisdirectorydoesnotexist a.tmp]] \
[file delete -force thisdirectorydoesnotexist]
} {1 {}}
-test tcltest-8.2 {tcltest a.tcl -tmpdir thisdirectoryisafile} {unixOrPc} {
- catch {exec $::tcltest::tcltest a.tcl -tmpdir thisdirectoryisafile} msg
- # The join is necessary because the message can be split on multiple lines
- list [regexp "not a directory" [join $msg]]
-} {1}
+test tcltest-8.2 {tcltest a.tcl -tmpdir thisdirectoryisafile} {
+ -constraints unixOrPc
+ -body {
+ slave msg a.tcl -tmpdir thisdirectoryisafile
+ set msg
+ }
+ -result {*not a directory*}
+ -match glob
+}
-# Test non-writeable directories, non-readable directories with tmpdir
-set notReadableDir [file join $::tcltest::temporaryDirectory notreadable]
-set notWriteableDir [file join $::tcltest::temporaryDirectory notwriteable]
+# Test non-writeable directories, non-readable directories with directory flags
+set notReadableDir [file join [temporaryDirectory] notreadable]
+set notWriteableDir [file join [temporaryDirectory] notwriteable]
-::tcltest::makeDirectory notreadable
-::tcltest::makeDirectory notwriteable
+makeDirectory notreadable
+makeDirectory notwriteable
switch $tcl_platform(platform) {
"unix" {
@@ -249,73 +552,185 @@ switch $tcl_platform(platform) {
file attributes $notWriteableDir -permissions 00555
}
default {
- file attributes $notWriteableDir -readonly 1
+ catch {file attributes $notWriteableDir -readonly 1}
}
}
-test tcltest-8.3 {tcltest a.tcl -tmpdir notReadableDir} {unixOnly} {
- catch {exec $::tcltest::tcltest a.tcl -tmpdir $notReadableDir} msg
- # The join is necessary because the message can be split on multiple lines
- list [regexp {not readable} [join $msg]]
+test tcltest-8.3 {tcltest a.tcl -tmpdir notReadableDir} {unixOnly nonRoot} {
+ slave msg a.tcl -tmpdir $notReadableDir
+ string match {*not readable*} $msg
} {1}
-test tcltest-8.4 {tcltest a.tcl -tmpdir notWriteableDir} {unixOrPc} {
- catch {exec $::tcltest::tcltest a.tcl -tmpdir $notWriteableDir} msg
- # The join is necessary because the message can be split on multiple lines
- list [regexp {not writeable} [join $msg]]
+test tcltest-8.4 {tcltest a.tcl -tmpdir notWriteableDir} {unixOrPc nonRoot} {
+ slave msg a.tcl -tmpdir $notWriteableDir
+ string match {*not writeable*} $msg
} {1}
-# -testdir
-test tcltest-8.5 {tcltest a.tcl -testdir thisdirectorydoesnotexist} {
+test tcltest-8.5 {tcltest a.tcl -tmpdir normaldirectory} {unixOrPc} {
+ slave msg a.tcl -tmpdir $normaldirectory
+ # The join is necessary because the message can be split on multiple lines
+ list [file exists [file join $normaldirectory a.tmp]] \
+ [file delete [file join $normaldirectory a.tmp]]
+} {1 {}}
+cd [workingDirectory]
+
+test tcltest-8.6 {temporaryDirectory} {
+ -setup {
+ set old $::tcltest::temporaryDirectory
+ set ::tcltest::temporaryDirectory $normaldirectory
+ }
+ -body {
+ set f1 [temporaryDirectory]
+ set f2 [temporaryDirectory [workingDirectory]]
+ set f3 [temporaryDirectory]
+ list $f1 $f2 $f3
+ }
+ -result "[list $normaldirectory [workingDirectory] [workingDirectory]]"
+ -cleanup {
+ set ::tcltest::temporaryDirectory $old
+ }
+}
+
+test tcltest-8.6a {temporaryDirectory - test format 2} -setup {
+ set old $::tcltest::temporaryDirectory
+ set ::tcltest::temporaryDirectory $normaldirectory
+} -body {
+ set f1 [temporaryDirectory]
+ set f2 [temporaryDirectory [workingDirectory]]
+ set f3 [temporaryDirectory]
+ list $f1 $f2 $f3
+} -cleanup {
+ set ::tcltest::temporaryDirectory $old
+} -result [list $normaldirectory [workingDirectory] [workingDirectory]]
+
+cd [temporaryDirectory]
+# -testdir, [testsDirectory]
+test tcltest-8.10 {tcltest a.tcl -testdir thisdirectorydoesnotexist} {unixOrPc} {
file delete -force thisdirectorydoesnotexist
- catch {exec $::tcltest::tcltest a.tcl -testdir thisdirectorydoesnotexist} msg
- list [regexp "does not exist" [join $msg]]
+ slave msg a.tcl -testdir thisdirectorydoesnotexist
+ string match "*does not exist*" $msg
} {1}
-test tcltest-8.6 {tcltest a.tcl -testdir thisdirectoryisafile} {
- catch {exec $::tcltest::tcltest a.tcl -testdir thisdirectoryisafile} msg
- # The join is necessary because the message can be split on multiple lines
- list [regexp "not a directory" [join $msg]]
+test tcltest-8.11 {tcltest a.tcl -testdir thisdirectoryisafile} {unixOrPc} {
+ slave msg a.tcl -testdir thisdirectoryisafile
+ string match "*not a directory*" $msg
} {1}
-test tcltest-8.7 {tcltest a.tcl -testdir notReadableDir} {unixOnly} {
- catch {exec $::tcltest::tcltest a.tcl -testdir $notReadableDir} msg
- # The join is necessary because the message can be split on multiple lines
- list [regexp {not readable} [join $msg]]
+test tcltest-8.12 {tcltest a.tcl -testdir notReadableDir} {unixOnly nonRoot} {
+ slave msg a.tcl -testdir $notReadableDir
+ string match {*not readable*} $msg
} {1}
+test tcltest-8.13 {tcltest a.tcl -testdir normaldirectory} {unixOrPc} {
+ slave msg a.tcl -testdir $normaldirectory
+ # The join is necessary because the message can be split on multiple lines
+ list [string first "testdir: $normaldirectory" [join $msg]] \
+ [file exists [file join [temporaryDirectory] a.tmp]] \
+ [file delete [file join [temporaryDirectory] a.tmp]]
+} {0 1 {}}
+cd [workingDirectory]
+
+set current [pwd]
+test tcltest-8.14 {testsDirectory} {
+ -setup {
+ set old $::tcltest::testsDirectory
+ set ::tcltest::testsDirectory $normaldirectory
+ }
+ -body {
+ set f1 [testsDirectory]
+ set f2 [testsDirectory $current]
+ set f3 [testsDirectory]
+ list $f1 $f2 $f3
+ }
+ -result "[list $normaldirectory $current $current]"
+ -cleanup {
+ set ::tcltest::testsDirectory $old
+ }
+}
+
+# [workingDirectory]
+test tcltest-8.60 {::workingDirectory} {
+ -setup {
+ set old $::tcltest::workingDirectory
+ set current [pwd]
+ set ::tcltest::workingDirectory $normaldirectory
+ cd $normaldirectory
+ }
+ -body {
+ set f1 [workingDirectory]
+ set f2 [pwd]
+ set f3 [workingDirectory $current]
+ set f4 [pwd]
+ set f5 [workingDirectory]
+ list $f1 $f2 $f3 $f4 $f5
+ }
+ -result "[list $normaldirectory \
+ $normaldirectory \
+ $current \
+ $current \
+ $current]"
+ -cleanup {
+ set ::tcltest::workingDirectory $old
+ cd $current
+ }
+}
+
+# clean up from directory testing
+
switch $tcl_platform(platform) {
"unix" {
file attributes $notReadableDir -permissions 777
file attributes $notWriteableDir -permissions 777
}
default {
- file attributes $notWriteableDir -readonly 0
+ catch {file attributes $notWriteableDir -readonly 0}
}
}
file delete -force $notReadableDir $notWriteableDir
-# -file -notfile
+# -file, -notfile, [matchFiles], [skipFiles]
test tcltest-9.1 {-file a*.tcl} {unixOrPc} {
- catch {exec $::tcltest::tcltest \
- [file join $::tcltest::testsDirectory all.tcl] -file a*.test} msg
+ slave msg [file join [testsDirectory] all.tcl] -file a*.test
list [regexp assocd\.test $msg]
} {1}
test tcltest-9.2 {-file a*.tcl} {unixOrPc} {
- catch {exec $::tcltest::tcltest \
- [file join $::tcltest::testsDirectory all.tcl] \
- -file a*.test -notfile assocd*} msg
+ slave msg [file join [testsDirectory] all.tcl] \
+ -file a*.test -notfile assocd*
list [regexp assocd\.test $msg]
} {0}
+test tcltest-9.3 {matchFiles} {
+ -body {
+ set old [matchFiles]
+ matchFiles foo
+ set current [matchFiles]
+ matchFiles bar
+ set new [matchFiles]
+ matchFiles $old
+ list $current $new
+ }
+ -result {foo bar}
+}
+test tcltest-9.4 {skipFiles} {
+ -body {
+ set old [skipFiles]
+ skipFiles foo
+ set current [skipFiles]
+ skipFiles bar
+ set new [skipFiles]
+ skipFiles $old
+ list $current $new
+ }
+ -result {foo bar}
+}
+# -preservecore, [preserveCore]
makeFile {
package require tcltest
- namespace import -force ::tcltest::*
-
+ namespace import ::tcltest::test
test makecore {make a core file} {
set f [open core w]
close $f
@@ -324,84 +739,955 @@ makeFile {
return
} makecore.tcl
-# -preservecore
+cd [temporaryDirectory]
test tcltest-10.1 {-preservecore 0} {unixOrPc} {
- catch {exec $::tcltest::tcltest makecore.tcl -preservecore 0} msg
+ slave msg makecore.tcl -preservecore 0
file delete core
- regexp "produced core file" $msg
+ regexp "Core file produced" $msg
} {0}
test tcltest-10.2 {-preservecore 1} {unixOrPc} {
- catch {exec $::tcltest::tcltest makecore.tcl -preservecore 1} msg
+ slave msg makecore.tcl -preservecore 1
file delete core
- regexp "produced core file" $msg
+ regexp "Core file produced" $msg
} {1}
test tcltest-10.3 {-preservecore 2} {unixOrPc} {
- catch {exec $::tcltest::tcltest makecore.tcl -preservecore 2} msg
+ slave msg makecore.tcl -preservecore 2
file delete core
- list [regexp "==== makecore produced core file" $msg] [regexp "Moving file to" $msg] \
+ list [regexp "Core file produced" $msg] [regexp "Moving file to" $msg] \
[regexp "core-" $msg] [file delete core-makecore]
} {1 1 1 {}}
test tcltest-10.4 {-preservecore 3} {unixOrPc} {
- catch {exec $::tcltest::tcltest makecore.tcl -preservecore 3} msg
+ slave msg makecore.tcl -preservecore 3
file delete core
- list [regexp "produced core file" $msg] [regexp "Moving file to" $msg] \
+ list [regexp "Core file produced" $msg] [regexp "Moving file to" $msg] \
[regexp "core-" $msg] [file delete core-makecore]
} {1 1 1 {}}
-makeFile {
+# Removing this test. It makes no sense to test the ability of
+# [preserveCore] to accept an invalid value that will cause errors
+# in other parts of tcltest's operation.
+#test tcltest-10.5 {preserveCore} {
+# -body {
+# set old [preserveCore]
+# set result [preserveCore foo]
+# set result2 [preserveCore]
+# preserveCore $old
+# list $result $result2
+# }
+# -result {foo foo}
+#}
+
+# -load, -loadfile, [loadScript], [loadFile]
+set contents {
package require tcltest
- namespace import -force ::tcltest::*
- puts "=$::tcltest::parameters="
+ namespace import tcltest::*
+ puts [outputChannel] $::tcltest::loadScript
exit
-} args.tcl
+}
+set loadfile [makeFile $contents load.tcl]
+
+test tcltest-12.1 {-load xxx} {unixOrPc} {
+ slave msg load.tcl -load xxx
+ set msg
+} {xxx}
+
+# Using child process because of -debug usage.
+test tcltest-12.2 {-loadfile load.tcl} {unixOrPc} {
+ catch {exec [interpreter] load.tcl -debug 2 -loadfile load.tcl} msg
+ list \
+ [regexp {tcltest} [join [list $msg] [split $msg \n]]] \
+ [regexp {loadScript} [join [list $msg] [split $msg \n]]]
+} {1 1}
+
+test tcltest-12.3 {loadScript} {
+ -setup {
+ set old $::tcltest::loadScript
+ }
+ -body {
+ set f1 [loadScript]
+ set f2 [loadScript xxx]
+ set f3 [loadScript]
+ list $f1 $f2 $f3
+ }
+ -result {{} xxx xxx}
+ -cleanup {
+ set ::tcltest::loadScript $old
+ }
+}
-# -args
-test tcltest-11.1 {-args foo} {unixOrPc} {
- catch {exec $::tcltest::tcltest args.tcl -args foo} msg
- list $msg
-} {=foo=}
+test tcltest-12.4 {loadFile} {
+ -setup {
+ set olds $::tcltest::loadScript
+ set oldf $::tcltest::loadFile
+ set ::tcltest::loadFile {}
+ }
+ -body {
+ set f1 [loadScript]
+ set f2 [loadFile]
+ set f3 [loadFile load.tcl]
+ set f4 [loadScript]
+ set f5 [loadFile]
+ list $f1 $f2 $f3 $f4 $f5
+ }
+ -result "[list {} {} $loadfile $contents $loadfile]\n"
+ -cleanup {
+ set ::tcltest::loadScript $olds
+ set ::tcltest::loadFile $oldf
+ }
+}
-test tcltest-11.2 {-args {}} {unixOrPc} {
- catch {exec $::tcltest::tcltest args.tcl -args {}} msg
- list $msg
-} {==}
+# [interpreter]
+test tcltest-13.1 {interpreter} {
+ -setup {
+ set old $::tcltest::tcltest
+ set ::tcltest::tcltest tcltest
+ }
+ -body {
+ set f1 [interpreter]
+ set f2 [interpreter tclsh]
+ set f3 [interpreter]
+ list $f1 $f2 $f3
+ }
+ -result {tcltest tclsh tclsh}
+ -cleanup {
+ set ::tcltest::tcltest $old
+ }
+}
-test tcltest-11.3 {-args {-foo bar -baz}} {unixOrPc} {
- catch {exec $::tcltest::tcltest args.tcl -args {-foo bar -baz}} msg
- list $msg
-} {{=-foo bar -baz=}}
+# -singleproc, [singleProcess]
+makeDirectory singleprocdir
+makeFile {
+ set foo 1
+} [file join singleprocdir single1.test]
-# -load -loadfile
makeFile {
+ unset foo
+} [file join singleprocdir single2.test]
+
+set allfile [makeFile {
package require tcltest
- namespace import -force ::tcltest::*
- puts $::tcltest::loadScript
- exit
-} load.tcl
+ namespace import tcltest::*
+ testsDirectory [file join [temporaryDirectory] singleprocdir]
+ runAllTests
+} [file join singleprocdir all-single.tcl]]
+cd [workingDirectory]
-test tcltest-12.1 {-load xxx} {
- catch {exec $::tcltest::tcltest load.tcl -load xxx} msg
- set msg
-} {xxx}
+test tcltest-14.1 {-singleproc - single process} {
+ -constraints {unixOrPc}
+ -body {
+ slave msg $allfile -singleproc 0 -tmpdir [temporaryDirectory]
+ set msg
+ }
+ -result {Test file error: can't unset .foo.: no such variable}
+ -match regexp
+}
-test tcltest-12.1 {-loadfile load.tcl} {
- catch {exec $::tcltest::tcltest load.tcl -d 2 -loadfile load.tcl} msg
- list \
- [regexp {tcltest} [join $msg [split $msg \n]]] \
- [regexp {loadScript} [join $msg [split $msg \n]]]
-} {1 1}
+test tcltest-14.2 {-singleproc - multiple process} {
+ -constraints {unixOrPc}
+ -body {
+ slave msg $allfile -singleproc 1 -tmpdir [temporaryDirectory]
+ set msg
+ }
+ -result {single1.test.*single2.test.*all\-single.tcl:.*Total.*0.*Passed.*0.*Skipped.*0.*Failed.*0}
+ -match regexp
+}
+
+test tcltest-14.3 {singleProcess} {
+ -setup {
+ set old $::tcltest::singleProcess
+ set ::tcltest::singleProcess 0
+ }
+ -body {
+ set f1 [singleProcess]
+ set f2 [singleProcess 1]
+ set f3 [singleProcess]
+ list $f1 $f2 $f3
+ }
+ -result {0 1 1}
+ -cleanup {
+ set ::tcltest::singleProcess $old
+ }
+}
+
+# -asidefromdir, -relateddir, [matchDirectories], [skipDirectories]
+
+# Before running these tests, need to set up test subdirectories with their own
+# all.tcl files.
+
+makeDirectory dirtestdir
+makeDirectory [file join dirtestdir dirtestdir2.1]
+makeDirectory [file join dirtestdir dirtestdir2.2]
+makeDirectory [file join dirtestdir dirtestdir2.3]
+makeFile {
+ package require tcltest
+ namespace import -force tcltest::*
+ testsDirectory [file join [temporaryDirectory] dirtestdir]
+ runAllTests
+} [file join dirtestdir all.tcl]
+makeFile {
+ package require tcltest
+ namespace import -force tcltest::*
+ testsDirectory [file join [temporaryDirectory] dirtestdir dirtestdir2.1]
+ runAllTests
+} [file join dirtestdir dirtestdir2.1 all.tcl]
+makeFile {
+ package require tcltest
+ namespace import -force tcltest::*
+ testsDirectory [file join [temporaryDirectory] dirtestdir dirtestdir2.2]
+ runAllTests
+} [file join dirtestdir dirtestdir2.2 all.tcl]
+makeFile {
+ package require tcltest
+ namespace import -force tcltest::*
+ testsDirectory [file join [temporaryDirectory] dirtestdir dirtestdir2.3]
+ runAllTests
+} [file join dirtestdir dirtestdir2.3 all.tcl]
+
+test tcltest-15.1 {basic directory walking} {
+ -constraints {unixOrPc}
+ -body {
+ if {[slave msg \
+ [file join [temporaryDirectory] dirtestdir all.tcl] \
+ -tmpdir [temporaryDirectory]] == 1} {
+ error $msg
+ }
+ }
+ -match regexp
+ -returnCodes 1
+ -result {Tests located in:.*dirtestdir.*Tests located in:.*dirtestdir2.1.*Tests located in:.*dirtestdir2.2.*Tests located in:.*dirtestdir2.3}
+}
+
+test tcltest-15.2 {-asidefromdir} {
+ -constraints {unixOrPc}
+ -body {
+ if {[slave msg \
+ [file join [temporaryDirectory] dirtestdir all.tcl] \
+ -asidefromdir dirtestdir2.3 \
+ -tmpdir [temporaryDirectory]] == 1} {
+ error $msg
+ }
+ }
+ -match regexp
+ -returnCodes 1
+ -result {Tests located in:.*dirtestdir.*Tests located in:.*dirtestdir2.1.*Tests located in:.*dirtestdir2.2.*dirtestdir2.2 test ended at .*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Error: No test files remain after applying your match and skip patterns!
+Error: No test files remain after applying your match and skip patterns!
+Error: No test files remain after applying your match and skip patterns!$}
+}
+
+test tcltest-15.3 {-relateddir, non-existent dir} {
+ -constraints {unixOrPc}
+ -body {
+ if {[slave msg \
+ [file join [temporaryDirectory] dirtestdir all.tcl] \
+ -relateddir [file join [temporaryDirectory] dirtestdir0] \
+ -tmpdir [temporaryDirectory]] == 1} {
+ error $msg
+ }
+ }
+ -returnCodes 1
+ -match regexp
+ -result {[^~]|dirtestdir[^2]}
+}
+
+test tcltest-15.4 {-relateddir, subdir} {
+ -constraints {unixOrPc}
+ -body {
+ if {[slave msg \
+ [file join [temporaryDirectory] dirtestdir all.tcl] \
+ -relateddir dirtestdir2.1 -tmpdir [temporaryDirectory]] == 1} {
+ error $msg
+ }
+ }
+ -returnCodes 1
+ -match regexp
+ -result {Tests located in:.*dirtestdir2.[^23]}
+}
+test tcltest-15.5 {-relateddir, -asidefromdir} {
+ -constraints {unixOrPc}
+ -body {
+ if {[slave msg \
+ [file join [temporaryDirectory] dirtestdir all.tcl] \
+ -relateddir "dirtestdir2.1 dirtestdir2.2" \
+ -asidefromdir dirtestdir2.2 \
+ -tmpdir [temporaryDirectory]] == 1} {
+ error $msg
+ }
+ }
+ -match regexp
+ -returnCodes 1
+ -result {Tests located in:.*dirtestdir2.[^23]}
+}
+
+test tcltest-15.6 {matchDirectories} {
+ -setup {
+ set old [matchDirectories]
+ set ::tcltest::matchDirectories {}
+ }
+ -body {
+ set r1 [matchDirectories]
+ set r2 [matchDirectories foo]
+ set r3 [matchDirectories]
+ list $r1 $r2 $r3
+ }
+ -cleanup {
+ set ::tcltest::matchDirectories $old
+ }
+ -result {{} foo foo}
+}
+
+test tcltest-15.7 {skipDirectories} {
+ -setup {
+ set old [skipDirectories]
+ set ::tcltest::skipDirectories {}
+ }
+ -body {
+ set r1 [skipDirectories]
+ set r2 [skipDirectories foo]
+ set r3 [skipDirectories]
+ list $r1 $r2 $r3
+ }
+ -cleanup {
+ set ::tcltest::skipDirectories $old
+ }
+ -result {{} foo foo}
+}
+
+# TCLTEST_OPTIONS
+test tcltest-19.1 {TCLTEST_OPTIONS default} {
+ -constraints {unixOrPc singleTestInterp}
+ -setup {
+ if {[info exists ::env(TCLTEST_OPTIONS)]} {
+ set oldoptions $::env(TCLTEST_OPTIONS)
+ unset ::env(TCLTEST_OPTIONS)
+ } else {
+ set oldoptions none
+ }
+ # set this to { } instead of just {} to get around quirk in
+ # Windows env handling that removes empty elements from env array.
+ set ::env(TCLTEST_OPTIONS) { }
+ set olddebug [debug]
+ debug 2
+ }
+ -cleanup {
+ if {$oldoptions == "none"} {
+ unset ::env(TCLTEST_OPTIONS)
+ } else {
+ set ::env(TCLTEST_OPTIONS) $oldoptions
+ }
+ debug $olddebug
+ }
+ -body {
+ ::tcltest::ProcessCmdLineArgs
+ set ::env(TCLTEST_OPTIONS) "-debug 3"
+ ::tcltest::ProcessCmdLineArgs
+ }
+ -result {^$}
+ -match regexp
+ -output {tcltest::debug\s+= 2.*tcltest::debug\s+= 3}
+}
# Begin testing of tcltest procs ...
+cd [temporaryDirectory]
# PrintError
test tcltest-20.1 {PrintError} {unixOrPc} {
- set result [catch {exec $::tcltest::tcltest printerror.tcl} msg]
+ set result [slave msg printerror.tcl]
list $result [regexp "Error: a really short string" $msg] \
[regexp " \"quotes\"" $msg] [regexp " \"Path" $msg] \
[regexp " \"Really" $msg] [regexp Problem $msg]
} {1 1 1 1 1 1}
+cd [workingDirectory]
-# cleanup
-::tcltest::cleanupTests
-return
+# test::test
+test tcltest-21.0 {name and desc but no args specified} -setup {
+ set v [verbose]
+} -cleanup {
+ verbose $v
+} -body {
+ verbose {}
+ test tcltest-21.0.0 bar
+} -result {}
+
+test tcltest-21.1 {expect with glob} {
+ -body {
+ list a b c d e
+ }
+ -match glob
+ -result {[ab] b c d e}
+}
+test tcltest-21.2 {force a test command failure} {
+ -body {
+ test tcltest-21.2.0 {
+ return 2
+ } {1}
+ }
+ -returnCodes 1
+ -result {bad option "1": must be -body, -cleanup, -constraints, -errorOutput, -match, -output, -result, -returnCodes, or -setup}
+}
+
+test tcltest-21.3 {test command with setup} {
+ -setup {
+ set foo 1
+ }
+ -body {
+ set foo
+ }
+ -cleanup {unset foo}
+ -result {1}
+}
+
+test tcltest-21.4 {test command with cleanup failure} {
+ -setup {
+ if {[info exists foo]} {
+ unset foo
+ }
+ set fail $::tcltest::currentFailure
+ set v [verbose]
+ }
+ -body {
+ verbose {}
+ test tcltest-21.4.0 {foo-1} {
+ -cleanup {unset foo}
+ }
+ }
+ -result {^$}
+ -match regexp
+ -cleanup {verbose $v; set ::tcltest::currentFailure $fail}
+ -output "Test cleanup failed:.*can't unset \"foo\": no such variable"
+}
+
+test tcltest-21.5 {test command with setup failure} {
+ -setup {
+ if {[info exists foo]} {
+ unset foo
+ }
+ set fail $::tcltest::currentFailure
+ }
+ -body {
+ test tcltest-21.5.0 {foo-2} {
+ -setup {unset foo}
+ }
+ }
+ -result {^$}
+ -match regexp
+ -cleanup {set ::tcltest::currentFailure $fail}
+ -output "Test setup failed:.*can't unset \"foo\": no such variable"
+}
+
+test tcltest-21.6 {test command - setup occurs before cleanup & before script} {
+ -setup {set v [verbose]; set fail $::tcltest::currentFailure}
+ -body {
+ verbose {}
+ test tcltest-21.6.0 {foo-3} {
+ -setup {
+ if {[info exists foo]} {
+ unset foo
+ }
+ set foo 1
+ set expected 2
+ }
+ -body {
+ incr foo
+ set foo
+ }
+ -cleanup {
+ if {$foo != 2} {
+ puts [outputChannel] "foo is wrong"
+ } else {
+ puts [outputChannel] "foo is 2"
+ }
+ }
+ -result {$expected}
+ }
+ }
+ -cleanup {verbose $v; set ::tcltest::currentFailure $fail}
+ -result {^$}
+ -match regexp
+ -output "foo is 2"
+}
+
+test tcltest-21.7 {test command - bad flag} {
+ -setup {set fail $::tcltest::currentFailure}
+ -cleanup {set ::tcltest::currentFailure $fail}
+ -body {
+ test tcltest-21.7.0 {foo-4} {
+ -foobar {}
+ }
+ }
+ -returnCodes 1
+ -result {bad option "-foobar": must be -body, -cleanup, -constraints, -errorOutput, -match, -output, -result, -returnCodes, or -setup}
+}
+
+# alternate test command format (these are the same as 21.1-21.6, with the
+# exception of being in the all-inline format)
+
+test tcltest-21.7a {expect with glob} \
+ -body {list a b c d e} \
+ -result {[ab] b c d e} \
+ -match glob
+
+test tcltest-21.8 {force a test command failure} \
+ -setup {set fail $::tcltest::currentFailure} \
+ -body {
+ test tcltest-21.8.0 {
+ return 2
+ } {1}
+ } \
+ -returnCodes 1 \
+ -cleanup {set ::tcltest::currentFailure $fail} \
+ -result {bad option "1": must be -body, -cleanup, -constraints, -errorOutput, -match, -output, -result, -returnCodes, or -setup}
+
+test tcltest-21.9 {test command with setup} \
+ -setup {set foo 1} \
+ -body {set foo} \
+ -cleanup {unset foo} \
+ -result {1}
+
+test tcltest-21.10 {test command with cleanup failure} -setup {
+ if {[info exists foo]} {
+ unset foo
+ }
+ set fail $::tcltest::currentFailure
+ set v [verbose]
+} -cleanup {
+ verbose $v
+ set ::tcltest::currentFailure $fail
+} -body {
+ verbose {}
+ test tcltest-21.10.0 {foo-1} -cleanup {unset foo}
+} -result {^$} -match regexp \
+ -output {Test cleanup failed:.*can't unset \"foo\": no such variable}
+
+test tcltest-21.11 {test command with setup failure} -setup {
+ if {[info exists foo]} {
+ unset foo
+ }
+ set fail $::tcltest::currentFailure
+} -cleanup {set ::tcltest::currentFailure $fail} -body {
+ test tcltest-21.11.0 {foo-2} -setup {unset foo}
+} -result {^$} -output {Test setup failed:.*can't unset \"foo\": no such variable} -match regexp
+
+test tcltest-21.12 {
+ test command - setup occurs before cleanup & before script
+} -setup {
+ set fail $::tcltest::currentFailure
+ set v [verbose]
+} -cleanup {
+ verbose $v
+ set ::tcltest::currentFailure $fail
+} -body {
+ verbose {}
+ test tcltest-21.12.0 {foo-3} -setup {
+ if {[info exists foo]} {
+ unset foo
+ }
+ set foo 1
+ set expected 2
+ } -body {
+ incr foo
+ set foo
+ } -cleanup {
+ if {$foo != 2} {
+ puts [outputChannel] "foo is wrong"
+ } else {
+ puts [outputChannel] "foo is 2"
+ }
+ } -result {$expected}
+} -result {^$} -output {foo is 2} -match regexp
+
+# test all.tcl usage (runAllTests); simulate .test file failure, as well as
+# crashes to determine whether or not these errors are logged.
+
+makeDirectory alltestdir
+makeFile {
+ package require tcltest
+ namespace import -force tcltest::*
+ testsDirectory [file join [temporaryDirectory] alltestdir]
+ runAllTests
+} [file join alltestdir all.tcl]
+makeFile {
+ exit 1
+} [file join alltestdir exit.test]
+makeFile {
+ error "throw an error"
+} [file join alltestdir error.test]
+makeFile {
+ package require tcltest
+ namespace import -force tcltest::*
+ test foo-1.1 {foo} {
+ -body { return 1 }
+ -result {1}
+ }
+ cleanupTests
+} [file join alltestdir test.test]
+
+# Must use a child process because stdout/stderr parsing can't be
+# duplicated in slave interp.
+test tcltest-22.1 {runAllTests} {
+ -constraints {unixOrPc}
+ -body {
+ exec [interpreter] \
+ [file join [temporaryDirectory] alltestdir all.tcl] \
+ -verbose t -tmpdir [temporaryDirectory]
+ }
+ -match regexp
+ -result "Test files exiting with errors:.*error.test.*exit.test"
+}
+
+# makeFile, removeFile, makeDirectory, removeDirectory, viewFile
+test tcltest-23.1 {makeFile} {
+ -setup {
+ set mfdir [file join [temporaryDirectory] mfdir]
+ file mkdir $mfdir
+ }
+ -body {
+ makeFile {} t1.tmp
+ makeFile {} et1.tmp $mfdir
+ list [file exists [file join [temporaryDirectory] t1.tmp]] \
+ [file exists [file join $mfdir et1.tmp]]
+ }
+ -cleanup {
+ file delete -force $mfdir \
+ [file join [temporaryDirectory] t1.tmp]
+ }
+ -result {1 1}
+}
+test tcltest-23.2 {removeFile} {
+ -setup {
+ set mfdir [file join [temporaryDirectory] mfdir]
+ file mkdir $mfdir
+ makeFile {} t1.tmp
+ makeFile {} et1.tmp $mfdir
+ if {![file exists [file join [temporaryDirectory] t1.tmp]] || \
+ ![file exists [file join $mfdir et1.tmp]]} {
+ error "file creation didn't work"
+ }
+ }
+ -body {
+ removeFile t1.tmp
+ removeFile et1.tmp $mfdir
+ list [file exists [file join [temporaryDirectory] t1.tmp]] \
+ [file exists [file join $mfdir et1.tmp]]
+ }
+ -cleanup {
+ file delete -force $mfdir \
+ [file join [temporaryDirectory] t1.tmp]
+ }
+ -result {0 0}
+}
+test tcltest-23.3 {makeDirectory} {
+ -body {
+ set mfdir [file join [temporaryDirectory] mfdir]
+ file mkdir $mfdir
+ makeDirectory d1
+ makeDirectory d2 $mfdir
+ list [file exists [file join [temporaryDirectory] d1]] \
+ [file exists [file join $mfdir d2]]
+ }
+ -cleanup {
+ file delete -force [file join [temporaryDirectory] d1] $mfdir
+ }
+ -result {1 1}
+}
+test tcltest-23.4 {removeDirectory} {
+ -body {
+ set mfdir [file join [temporaryDirectory] mfdir]
+ file mkdir $mfdir
+ file mkdir [file join [temporaryDirectory] t1]
+ file mkdir [file join [temporaryDirectory] $mfdir t2]
+ if {![file exists $mfdir] || \
+ ![file exists [file join [temporaryDirectory] $mfdir t2]]} {
+ return "setup failed - directory not created"
+ }
+ removeDirectory t1
+ removeDirectory t2 $mfdir
+ list [file exists [file join [temporaryDirectory] t1]] \
+ [file exists [file join $mfdir t2]]
+ }
+ -result {0 0}
+}
+test tcltest-23.5 {viewFile} {
+ -body {
+ set mfdir [file join [temporaryDirectory] mfdir]
+ file mkdir $mfdir
+ makeFile {foobar} t1.tmp
+ makeFile {foobarbaz} t2.tmp $mfdir
+ list [viewFile t1.tmp] [viewFile t2.tmp $mfdir]
+ }
+ -result {foobar foobarbaz}
+ -cleanup {
+ file delete -force $mfdir
+ }
+}
+
+# customMatch
+proc matchNegative { expected actual } {
+ set match 0
+ foreach a $actual e $expected {
+ if { $a != $e } {
+ set match 1
+ break
+ }
+ }
+ return $match
+}
+
+test tcltest-24.0 {
+ customMatch: syntax
+} -body {
+ list [catch {customMatch} result] $result
+} -result [list 1 "wrong # args: should be \"customMatch mode script\""]
+
+test tcltest-24.1 {
+ customMatch: syntax
+} -body {
+ list [catch {customMatch foo} result] $result
+} -result [list 1 "wrong # args: should be \"customMatch mode script\""]
+
+test tcltest-24.2 {
+ customMatch: syntax
+} -body {
+ list [catch {customMatch foo bar baz} result] $result
+} -result [list 1 "wrong # args: should be \"customMatch mode script\""]
+
+test tcltest-24.3 {
+ customMatch: argument checking
+} -body {
+ list [catch {customMatch bad "a \{ b"} result] $result
+} -result [list 1 "invalid customMatch script; can't evaluate after completion"]
+
+test tcltest-24.4 {
+ test: valid -match values
+} -body {
+ list [catch {
+ test tcltest-24.4.0 {} \
+ -match [namespace current]::noSuchMode
+ } result] $result
+} -match glob -result {1 *bad -match value*}
+
+test tcltest-24.5 {
+ test: valid -match values
+} -setup {
+ customMatch [namespace current]::alwaysMatch "format 1 ;#"
+} -body {
+ list [catch {
+ test tcltest-24.5.0 {} \
+ -match [namespace current]::noSuchMode
+ } result] $result
+} -match glob -result {1 *bad -match value*: must be *alwaysMatch,*}
+
+test tcltest-24.6 {
+ customMatch: -match script that always matches
+} -setup {
+ customMatch [namespace current]::alwaysMatch "format 1 ;#"
+ set v [verbose]
+} -body {
+ verbose {}
+ test tcltest-24.6.0 {} -match [namespace current]::alwaysMatch \
+ -body {format 1} -result 0
+} -cleanup {
+ verbose $v
+} -result {} -output {} -errorOutput {}
+
+test tcltest-24.7 {
+ customMatch: replace default -exact matching
+} -setup {
+ set saveExactMatchScript $::tcltest::CustomMatch(exact)
+ customMatch exact "format 1 ;#"
+ set v [verbose]
+} -body {
+ verbose {}
+ test tcltest-24.7.0 {} -body {format 1} -result 0
+} -cleanup {
+ verbose $v
+ customMatch exact $saveExactMatchScript
+ unset saveExactMatchScript
+} -result {} -output {}
+
+test tcltest-24.9 {
+ customMatch: error during match
+} -setup {
+ proc errorDuringMatch args {return -code error "match returned error"}
+ customMatch [namespace current]::errorDuringMatch \
+ [namespace code errorDuringMatch]
+ set v [verbose]
+ set fail $::tcltest::currentFailure
+} -body {
+ verbose {}
+ test tcltest-24.9.0 {} -match [namespace current]::errorDuringMatch
+} -cleanup {
+ verbose $v
+ set ::tcltest::currentFailure $fail
+} -match glob -result {} -output {*FAILED*match returned error*}
+
+test tcltest-24.10 {
+ customMatch: bad return from match command
+} -setup {
+ proc nonBooleanReturn args {return foo}
+ customMatch nonBooleanReturn [namespace code nonBooleanReturn]
+ set v [verbose]
+ set fail $::tcltest::currentFailure
+} -body {
+ verbose {}
+ test tcltest-24.10.0 {} -match nonBooleanReturn
+} -cleanup {
+ verbose $v
+ set ::tcltest::currentFailure $fail
+} -match glob -result {} -output {*FAILED*expected boolean value*}
+
+test tcltest-24.11 {
+ test: -match exact
+} -body {
+ set result {A B C}
+} -match exact -result {A B C}
+
+test tcltest-24.12 {
+ test: -match exact match command eval in ::, not caller namespace
+} -setup {
+ set saveExactMatchScript $::tcltest::CustomMatch(exact)
+ customMatch exact [list string equal]
+ set v [verbose]
+ proc string args {error {called [string] in caller namespace}}
+} -body {
+ verbose {}
+ test tcltest-24.12.0 {} -body {format 1} -result 1
+} -cleanup {
+ rename string {}
+ verbose $v
+ customMatch exact $saveExactMatchScript
+ unset saveExactMatchScript
+} -match exact -result {} -output {}
+
+test tcltest-24.13 {
+ test: -match exact failure
+} -setup {
+ set saveExactMatchScript $::tcltest::CustomMatch(exact)
+ customMatch exact [list string equal]
+ set v [verbose]
+ set fail $::tcltest::currentFailure
+} -body {
+ verbose {}
+ test tcltest-24.13.0 {} -body {format 1} -result 0
+} -cleanup {
+ set ::tcltest::currentFailure $fail
+ verbose $v
+ customMatch exact $saveExactMatchScript
+ unset saveExactMatchScript
+} -match glob -result {} -output {*FAILED*Result was:
+1*(exact matching):
+0*}
+
+test tcltest-24.14 {
+ test: -match glob
+} -body {
+ set result {A B C}
+} -match glob -result {A B*}
+
+test tcltest-24.15 {
+ test: -match glob failure
+} -setup {
+ set v [verbose]
+ set fail $::tcltest::currentFailure
+} -body {
+ verbose {}
+ test tcltest-24.15.0 {} -match glob -body {format {A B C}} \
+ -result {A B* }
+} -cleanup {
+ set ::tcltest::currentFailure $fail
+ verbose $v
+} -match glob -result {} -output {*FAILED*Result was:
+*(glob matching):
+*}
+
+test tcltest-24.16 {
+ test: -match regexp
+} -body {
+ set result {A B C}
+} -match regexp -result {A B.*}
+
+test tcltest-24.17 {
+ test: -match regexp failure
+} -setup {
+ set fail $::tcltest::currentFailure
+ set v [verbose]
+} -body {
+ verbose {}
+ test tcltest-24.17.0 {} -match regexp -body {format {A B C}} \
+ -result {A B.* X}
+} -cleanup {
+ set ::tcltest::currentFailure $fail
+ verbose $v
+} -match glob -result {} -output {*FAILED*Result was:
+*(regexp matching):
+*}
+
+test tcltest-24.18 {
+ test: -match custom forget namespace qualification
+} -setup {
+ set fail $::tcltest::currentFailure
+ set v [verbose]
+ customMatch negative matchNegative
+} -body {
+ verbose {}
+ test tcltest-24.18.0 {} -match negative -body {format {A B C}} \
+ -result {A B X}
+} -cleanup {
+ set ::tcltest::currentFailure $fail
+ verbose $v
+} -match glob -result {} -output {*FAILED*Error testing result:*}
+
+test tcltest-24.19 {
+ test: -match custom
+} -setup {
+ set v [verbose]
+ customMatch negative [namespace code matchNegative]
+} -body {
+ verbose {}
+ test tcltest-24.19.0 {} -match negative -body {format {A B C}} \
+ -result {A B X}
+} -cleanup {
+ verbose $v
+} -match exact -result {} -output {}
+
+test tcltest-24.20 {
+ test: -match custom failure
+} -setup {
+ set fail $::tcltest::currentFailure
+ set v [verbose]
+ customMatch negative [namespace code matchNegative]
+} -body {
+ verbose {}
+ test tcltest-24.20.0 {} -match negative -body {format {A B C}} \
+ -result {A B C}
+} -cleanup {
+ set ::tcltest::currentFailure $fail
+ verbose $v
+} -match glob -result {} -output {*FAILED*Result was:
+*(negative matching):
+*}
+
+test tcltest-25.1 {
+ constraint of setup/cleanup (Bug 589859)
+} -setup {
+ set foo 0
+} -body {
+ # Buggy tcltest will generate result of 2
+ test tcltest-25.1.0 {} -constraints knownBug -setup {
+ incr foo
+ } -body {
+ incr foo
+ } -cleanup {
+ incr foo
+ } -match glob -result *
+ set foo
+} -cleanup {
+ unset foo
+} -result 0
+
+cleanupTests
+}
+
+namespace delete ::tcltest::test
+return
diff --git a/tcl/tests/thread.test b/tcl/tests/thread.test
index 70c616a6d24..35c9d2b201d 100644
--- a/tcl/tests/thread.test
+++ b/tcl/tests/thread.test
@@ -43,7 +43,7 @@ test thread-1.1 {Tcl_ThreadObjCmd: no args} {testthread} {
test thread-1.2 {Tcl_ThreadObjCmd: bad option} {testthread} {
list [catch {testthread foo} msg] $msg
-} {1 {bad option "foo": must be create, exit, id, names, send, wait, or errorproc}}
+} {1 {bad option "foo": must be create, exit, id, join, names, send, wait, or errorproc}}
test thread-1.3 {Tcl_ThreadObjCmd: initial thread list} {testthread} {
list [threadReap] [llength [testthread names]]
@@ -62,7 +62,7 @@ test thread-1.5 {Tcl_ThreadObjCmd: thread create one shot} {testthread} {
threadReap
testthread create {set x 5}
foreach try {0 1 2 4 5 6} {
- # Try various ways to yeild
+ # Try various ways to yield
update
after 10
set l [llength [testthread names]]
@@ -230,7 +230,35 @@ test thread-4.5 {TclThreadSend preserve errorCode} {testthread} {
list $x $msg $errorCode
} {1 ERR CODE}
+
+test thread-5.0 {Joining threads} {testthread} {
+ threadReap
+ set serverthread [testthread create -joinable]
+ testthread send -async $serverthread {after 1000 ; testthread exit}
+ set res [testthread join $serverthread]
+ threadReap
+ set res
+} {0}
+
+test thread-5.1 {Joining threads after the fact} {testthread} {
+ threadReap
+ set serverthread [testthread create -joinable]
+ testthread send -async $serverthread {testthread exit}
+ after 2000
+ set res [testthread join $serverthread]
+ threadReap
+ set res
+} {0}
+
+test thread-5.2 {Try to join a detached thread} {testthread} {
+ threadReap
+ set serverthread [testthread create]
+ testthread send -async $serverthread {after 1000 ; testthread exit}
+ catch {set res [testthread join $serverthread]} msg
+ threadReap
+ lrange $msg 0 2
+} {cannot join thread}
+
# cleanup
::tcltest::cleanupTests
return
-
diff --git a/tcl/tests/timer.test b/tcl/tests/timer.test
index 23dca314cdf..ac7429f1ce8 100644
--- a/tcl/tests/timer.test
+++ b/tcl/tests/timer.test
@@ -553,4 +553,3 @@ return
-
diff --git a/tcl/tests/trace.test b/tcl/tests/trace.test
index c2915fe260d..b17a9d0a1ed 100644
--- a/tcl/tests/trace.test
+++ b/tcl/tests/trace.test
@@ -52,57 +52,72 @@ proc traceCheck {cmd args} {
proc traceCrtElement {value name1 name2 op} {
uplevel set ${name1}($name2) $value
}
+proc traceCommand {oldName newName op} {
+ global info
+ set info [list $oldName $newName $op]
+}
+
+test trace-0.0 {memory corruption in trace (Tcl Bug 484339)} {
+ # You may need Purify or Electric Fence to reliably
+ # see this one fail.
+ catch {unset z}
+ trace add variable z array {set z(foo) 1 ;#}
+ set res "names: [array names z]"
+ catch {unset ::z}
+ trace variable ::z w {unset ::z; error "memory corruption";#}
+ list [catch {set ::z 1} msg] $msg
+} {1 {can't set "::z": memory corruption}}
# Read-tracing on variables
test trace-1.1 {trace variable reads} {
catch {unset x}
set info {}
- trace var x r traceScalar
+ trace add variable x read traceScalar
list [catch {set x} msg] $msg $info
-} {1 {can't read "x": no such variable} {x {} r 1 {can't read "x": no such variable}}}
+} {1 {can't read "x": no such variable} {x {} read 1 {can't read "x": no such variable}}}
test trace-1.2 {trace variable reads} {
catch {unset x}
set x 123
set info {}
- trace var x r traceScalar
+ trace add variable x read traceScalar
list [catch {set x} msg] $msg $info
-} {0 123 {x {} r 0 123}}
+} {0 123 {x {} read 0 123}}
test trace-1.3 {trace variable reads} {
catch {unset x}
set info {}
- trace var x r traceScalar
+ trace add variable x read traceScalar
set x 123
set info
} {}
test trace-1.4 {trace array element reads} {
catch {unset x}
set info {}
- trace var x(2) r traceArray
+ trace add variable x(2) read traceArray
list [catch {set x(2)} msg] $msg $info
-} {1 {can't read "x(2)": no such element in array} {x 2 r 1 {can't read "x(2)": no such element in array}}}
+} {1 {can't read "x(2)": no such element in array} {x 2 read 1 {can't read "x(2)": no such element in array}}}
test trace-1.5 {trace array element reads} {
catch {unset x}
set x(2) zzz
set info {}
- trace var x(2) r traceArray
+ trace add variable x(2) read traceArray
list [catch {set x(2)} msg] $msg $info
-} {0 zzz {x 2 r 0 zzz}}
+} {0 zzz {x 2 read 0 zzz}}
test trace-1.6 {trace array element reads} {
catch {unset x}
set info {}
- trace variable x r traceArray2
+ trace add variable x read traceArray2
proc p {} {
global x
set x(2) willi
return $x(2)
}
list [catch {p} msg] $msg $info
-} {0 willi {x 2 r}}
+} {0 willi {x 2 read}}
test trace-1.7 {trace array element reads, create element undefined if nonexistant} {
catch {unset x}
set info {}
- trace variable x r q
+ trace add variable x read q
proc q {name1 name2 op} {
global info
set info [list $name1 $name2 $op]
@@ -115,57 +130,85 @@ test trace-1.7 {trace array element reads, create element undefined if nonexista
return $x(Y)
}
list [catch {p} msg] $msg $info
-} {0 wolf {x Y r}}
+} {0 wolf {x Y read}}
test trace-1.8 {trace reads on whole arrays} {
catch {unset x}
set info {}
- trace var x r traceArray
+ trace add variable x read traceArray
list [catch {set x(2)} msg] $msg $info
} {1 {can't read "x(2)": no such variable} {}}
test trace-1.9 {trace reads on whole arrays} {
catch {unset x}
set x(2) zzz
set info {}
- trace var x r traceArray
+ trace add variable x read traceArray
list [catch {set x(2)} msg] $msg $info
-} {0 zzz {x 2 r 0 zzz}}
+} {0 zzz {x 2 read 0 zzz}}
test trace-1.10 {trace variable reads} {
catch {unset x}
set x 444
set info {}
- trace var x r traceScalar
+ trace add variable x read traceScalar
unset x
set info
} {}
+test trace-1.11 {read traces that modify the array structure} {
+ catch {unset x}
+ set x(bar) 0
+ trace variable x r {set x(foo) 1 ;#}
+ trace variable x r {unset -nocomplain x(bar) ;#}
+ array get x
+} {}
+test trace-1.12 {read traces that modify the array structure} {
+ catch {unset x}
+ set x(bar) 0
+ trace variable x r {unset -nocomplain x(bar) ;#}
+ trace variable x r {set x(foo) 1 ;#}
+ array get x
+} {}
+test trace-1.13 {read traces that modify the array structure} {
+ catch {unset x}
+ set x(bar) 0
+ trace variable x r {set x(foo) 1 ;#}
+ trace variable x r {unset -nocomplain x;#}
+ list [catch {array get x} res] $res
+} {1 {can't read "x(bar)": no such variable}}
+test trace-1.14 {read traces that modify the array structure} {
+ catch {unset x}
+ set x(bar) 0
+ trace variable x r {unset -nocomplain x;#}
+ trace variable x r {set x(foo) 1 ;#}
+ list [catch {array get x} res] $res
+} {1 {can't read "x(bar)": no such variable}}
# Basic write-tracing on variables
test trace-2.1 {trace variable writes} {
catch {unset x}
set info {}
- trace var x w traceScalar
+ trace add variable x write traceScalar
set x 123
set info
-} {x {} w 0 123}
+} {x {} write 0 123}
test trace-2.2 {trace writes to array elements} {
catch {unset x}
set info {}
- trace var x(33) w traceArray
+ trace add variable x(33) write traceArray
set x(33) 444
set info
-} {x 33 w 0 444}
+} {x 33 write 0 444}
test trace-2.3 {trace writes on whole arrays} {
catch {unset x}
set info {}
- trace var x w traceArray
+ trace add variable x write traceArray
set x(abc) qq
set info
-} {x abc w 0 qq}
+} {x abc write 0 qq}
test trace-2.4 {trace variable writes} {
catch {unset x}
set x 1234
set info {}
- trace var x w traceScalar
+ trace add variable x write traceScalar
set x
set info
} {}
@@ -173,7 +216,7 @@ test trace-2.5 {trace variable writes} {
catch {unset x}
set x 1234
set info {}
- trace var x w traceScalar
+ trace add variable x write traceScalar
unset x
set info
} {}
@@ -186,42 +229,42 @@ test trace-2.5 {trace variable writes} {
test trace-3.1 {trace variable read-modify-writes} {
catch {unset x}
set info {}
- trace var x r traceScalarAppend
+ trace add variable x read traceScalarAppend
append x 123
append x 456
lappend x 789
set info
-} {x {} r 0 123456}
+} {x {} read 0 123456}
test trace-3.2 {trace variable read-modify-writes} {
catch {unset x}
set info {}
- trace var x rw traceScalarAppend
+ trace add variable x {read write} traceScalarAppend
append x 123
lappend x 456
set info
-} {x {} w 0 123 x {} r 0 123 x {} w 0 {123 456}}
+} {x {} write 0 123 x {} read 0 123 x {} write 0 {123 456}}
# Basic unset-tracing on variables
test trace-4.1 {trace variable unsets} {
catch {unset x}
set info {}
- trace var x u traceScalar
+ trace add variable x unset traceScalar
catch {unset x}
set info
-} {x {} u 1 {can't read "x": no such variable}}
+} {x {} unset 1 {can't read "x": no such variable}}
test trace-4.2 {variable mustn't exist during unset trace} {
catch {unset x}
set x 1234
set info {}
- trace var x u traceScalar
+ trace add variable x unset traceScalar
unset x
set info
-} {x {} u 1 {can't read "x": no such variable}}
+} {x {} unset 1 {can't read "x": no such variable}}
test trace-4.3 {unset traces mustn't be called during reads and writes} {
catch {unset x}
set info {}
- trace var x u traceScalar
+ trace add variable x unset traceScalar
set x 44
set x
set info
@@ -230,31 +273,31 @@ test trace-4.4 {trace unsets on array elements} {
catch {unset x}
set x(0) 18
set info {}
- trace var x(1) u traceArray
+ trace add variable x(1) unset traceArray
catch {unset x(1)}
set info
-} {x 1 u 1 {can't read "x(1)": no such element in array}}
+} {x 1 unset 1 {can't read "x(1)": no such element in array}}
test trace-4.5 {trace unsets on array elements} {
catch {unset x}
set x(1) 18
set info {}
- trace var x(1) u traceArray
+ trace add variable x(1) unset traceArray
unset x(1)
set info
-} {x 1 u 1 {can't read "x(1)": no such element in array}}
+} {x 1 unset 1 {can't read "x(1)": no such element in array}}
test trace-4.6 {trace unsets on array elements} {
catch {unset x}
set x(1) 18
set info {}
- trace var x(1) u traceArray
+ trace add variable x(1) unset traceArray
unset x
set info
-} {x 1 u 1 {can't read "x(1)": no such variable}}
+} {x 1 unset 1 {can't read "x(1)": no such variable}}
test trace-4.7 {trace unsets on whole arrays} {
catch {unset x}
set x(1) 18
set info {}
- trace var x u traceProc
+ trace add variable x unset traceProc
catch {unset x(0)}
set info
} {}
@@ -264,38 +307,98 @@ test trace-4.8 {trace unsets on whole arrays} {
set x(2) 144
set x(3) 14
set info {}
- trace var x u traceProc
+ trace add variable x unset traceProc
unset x(1)
set info
-} {x 1 u}
+} {x 1 unset}
test trace-4.9 {trace unsets on whole arrays} {
catch {unset x}
set x(1) 18
set x(2) 144
set x(3) 14
set info {}
- trace var x u traceProc
+ trace add variable x unset traceProc
unset x
set info
-} {x {} u}
+} {x {} unset}
+# Array tracing on variables
+test trace-5.1 {array traces fire on accesses via [array]} {
+ catch {unset x}
+ set x(b) 2
+ trace add variable x array traceArray2
+ set ::info {}
+ array set x {a 1}
+ set ::info
+} {x {} array}
+test trace-5.2 {array traces do not fire on normal accesses} {
+ catch {unset x}
+ set x(b) 2
+ trace add variable x array traceArray2
+ set ::info {}
+ set x(a) 1
+ set x(b) $x(a)
+ set ::info
+} {}
+test trace-5.3 {array traces do not outlive variable} {
+ catch {unset x}
+ trace add variable x array traceArray2
+ set ::info {}
+ set x(a) 1
+ unset x
+ array set x {a 1}
+ set ::info
+} {}
+test trace-5.4 {array traces properly listed in trace information} {
+ catch {unset x}
+ trace add variable x array traceArray2
+ set result [trace info variable x]
+ set result
+} [list [list array traceArray2]]
+test trace-5.5 {array traces properly listed in trace information} {
+ catch {unset x}
+ trace variable x a traceArray2
+ set result [trace vinfo x]
+ set result
+} [list [list a traceArray2]]
+test trace-5.6 {array traces don't fire on scalar variables} {
+ catch {unset x}
+ set x foo
+ trace add variable x array traceArray2
+ set ::info {}
+ catch {array set x {a 1}}
+ set ::info
+} {}
+test trace-5.7 {array traces fire for undefined variables} {
+ catch {unset x}
+ trace add variable x array traceArray2
+ set ::info {}
+ array set x {a 1}
+ set ::info
+} {x {} array}
+test trace-5.8 {array traces fire for undefined variables} {
+ catch {unset x}
+ trace add variable x array {set x(foo) 1 ;#}
+ set res "names: [array names x]"
+} {names: foo}
+
# Trace multiple trace types at once.
-test trace-5.1 {multiple ops traced at once} {
+test trace-6.1 {multiple ops traced at once} {
catch {unset x}
set info {}
- trace var x rwu traceProc
+ trace add variable x {read write unset} traceProc
catch {set x}
set x 22
set x
set x 33
unset x
set info
-} {x {} r x {} w x {} r x {} w x {} u}
-test trace-5.2 {multiple ops traced on array element} {
+} {x {} read x {} write x {} read x {} write x {} unset}
+test trace-6.2 {multiple ops traced on array element} {
catch {unset x}
set info {}
- trace var x(0) rwu traceProc
+ trace add variable x(0) {read write unset} traceProc
catch {set x(0)}
set x(0) 22
set x(0)
@@ -303,11 +406,11 @@ test trace-5.2 {multiple ops traced on array element} {
unset x(0)
unset x
set info
-} {x 0 r x 0 w x 0 r x 0 w x 0 u}
-test trace-5.3 {multiple ops traced on whole array} {
+} {x 0 read x 0 write x 0 read x 0 write x 0 unset}
+test trace-6.3 {multiple ops traced on whole array} {
catch {unset x}
set info {}
- trace var x rwu traceProc
+ trace add variable x {read write unset} traceProc
catch {set x(0)}
set x(0) 22
set x(0)
@@ -315,404 +418,487 @@ test trace-5.3 {multiple ops traced on whole array} {
unset x(0)
unset x
set info
-} {x 0 w x 0 r x 0 w x 0 u x {} u}
+} {x 0 write x 0 read x 0 write x 0 unset x {} unset}
# Check order of invocation of traces
-test trace-6.1 {order of invocation of traces} {
+test trace-7.1 {order of invocation of traces} {
catch {unset x}
set info {}
- trace var x r "traceTag 1"
- trace var x r "traceTag 2"
- trace var x r "traceTag 3"
+ trace add variable x read "traceTag 1"
+ trace add variable x read "traceTag 2"
+ trace add variable x read "traceTag 3"
catch {set x}
set x 22
set x
set info
} {3 2 1 3 2 1}
-test trace-6.2 {order of invocation of traces} {
+test trace-7.2 {order of invocation of traces} {
catch {unset x}
set x(0) 44
set info {}
- trace var x(0) r "traceTag 1"
- trace var x(0) r "traceTag 2"
- trace var x(0) r "traceTag 3"
+ trace add variable x(0) read "traceTag 1"
+ trace add variable x(0) read "traceTag 2"
+ trace add variable x(0) read "traceTag 3"
set x(0)
set info
} {3 2 1}
-test trace-6.3 {order of invocation of traces} {
+test trace-7.3 {order of invocation of traces} {
catch {unset x}
set x(0) 44
set info {}
- trace var x(0) r "traceTag 1"
- trace var x r "traceTag A1"
- trace var x(0) r "traceTag 2"
- trace var x r "traceTag A2"
- trace var x(0) r "traceTag 3"
- trace var x r "traceTag A3"
+ trace add variable x(0) read "traceTag 1"
+ trace add variable x read "traceTag A1"
+ trace add variable x(0) read "traceTag 2"
+ trace add variable x read "traceTag A2"
+ trace add variable x(0) read "traceTag 3"
+ trace add variable x read "traceTag A3"
set x(0)
set info
} {A3 A2 A1 3 2 1}
# Check effects of errors in trace procedures
-test trace-7.1 {error returns from traces} {
+test trace-8.1 {error returns from traces} {
catch {unset x}
set x 123
set info {}
- trace var x r "traceTag 1"
- trace var x r traceError
+ trace add variable x read "traceTag 1"
+ trace add variable x read traceError
list [catch {set x} msg] $msg $info
} {1 {can't read "x": trace returned error} {}}
-test trace-7.2 {error returns from traces} {
+test trace-8.2 {error returns from traces} {
catch {unset x}
set x 123
set info {}
- trace var x w "traceTag 1"
- trace var x w traceError
+ trace add variable x write "traceTag 1"
+ trace add variable x write traceError
list [catch {set x 44} msg] $msg $info
} {1 {can't set "x": trace returned error} {}}
-test trace-7.3 {error returns from traces} {
+test trace-8.3 {error returns from traces} {
catch {unset x}
set x 123
set info {}
- trace var x w traceError
+ trace add variable x write traceError
list [catch {append x 44} msg] $msg $info
} {1 {can't set "x": trace returned error} {}}
-test trace-7.4 {error returns from traces} {
+test trace-8.4 {error returns from traces} {
catch {unset x}
set x 123
set info {}
- trace var x u "traceTag 1"
- trace var x u traceError
+ trace add variable x unset "traceTag 1"
+ trace add variable x unset traceError
list [catch {unset x} msg] $msg $info
} {0 {} 1}
-test trace-7.5 {error returns from traces} {
+test trace-8.5 {error returns from traces} {
catch {unset x}
set x(0) 123
set info {}
- trace var x(0) r "traceTag 1"
- trace var x r "traceTag 2"
- trace var x r traceError
- trace var x r "traceTag 3"
+ trace add variable x(0) read "traceTag 1"
+ trace add variable x read "traceTag 2"
+ trace add variable x read traceError
+ trace add variable x read "traceTag 3"
list [catch {set x(0)} msg] $msg $info
} {1 {can't read "x(0)": trace returned error} 3}
-test trace-7.6 {error returns from traces} {
+test trace-8.6 {error returns from traces} {
catch {unset x}
set x 123
- trace var x u traceError
+ trace add variable x unset traceError
list [catch {unset x} msg] $msg
} {0 {}}
-test trace-7.7 {error returns from traces} {
+test trace-8.7 {error returns from traces} {
# This test just makes sure that the memory for the error message
# gets deallocated correctly when the trace is invoked again or
# when the trace is deleted.
catch {unset x}
set x 123
- trace var x r traceError
+ trace add variable x read traceError
catch {set x}
catch {set x}
- trace vdelete x r traceError
+ trace remove variable x read traceError
+} {}
+test trace-8.8 {error returns from traces} {
+ # Yet more elaborate memory corruption testing that checks nothing
+ # bad happens when the trace deletes itself and installs something
+ # new. Alas, there is no neat way to guarantee that this test will
+ # fail if there is a problem, but that's life and with the new code
+ # it should *never* fail.
+ #
+ # Adapted from Bug #219393 reported by Don Porter.
+ catch {rename ::foo {}}
+ proc foo {old args} {
+ trace remove variable ::x write [list foo $old]
+ trace add variable ::x write [list foo $::x]
+ error "foo"
+ }
+ catch {unset ::x ::y}
+ set x junk
+ trace add variable ::x write [list foo $x]
+ for {set y 0} {$y<100} {incr y} {
+ catch {set x junk}
+ }
+ unset x
} {}
# Check to see that variables are expunged before trace
# procedures are invoked, so trace procedure can even manipulate
# a new copy of the variables.
-test trace-8.1 {be sure variable is unset before trace is called} {
+test trace-9.1 {be sure variable is unset before trace is called} {
catch {unset x}
set x 33
set info {}
- trace var x u {traceCheck {uplevel set x}}
+ trace add variable x unset {traceCheck {uplevel set x}}
unset x
set info
} {1 {can't read "x": no such variable}}
-test trace-8.2 {be sure variable is unset before trace is called} {
+test trace-9.2 {be sure variable is unset before trace is called} {
catch {unset x}
set x 33
set info {}
- trace var x u {traceCheck {uplevel set x 22}}
+ trace add variable x unset {traceCheck {uplevel set x 22}}
unset x
concat $info [list [catch {set x} msg] $msg]
} {0 22 0 22}
-test trace-8.3 {be sure traces are cleared before unset trace called} {
+test trace-9.3 {be sure traces are cleared before unset trace called} {
catch {unset x}
set x 33
set info {}
- trace var x u {traceCheck {uplevel trace vinfo x}}
+ trace add variable x unset {traceCheck {uplevel trace info variable x}}
unset x
set info
} {0 {}}
-test trace-8.4 {set new trace during unset trace} {
+test trace-9.4 {set new trace during unset trace} {
catch {unset x}
set x 33
set info {}
- trace var x u {traceCheck {global x; trace var x u traceProc}}
+ trace add variable x unset {traceCheck {global x; trace add variable x unset traceProc}}
unset x
- concat $info [trace vinfo x]
-} {0 {} {u traceProc}}
+ concat $info [trace info variable x]
+} {0 {} {unset traceProc}}
-test trace-9.1 {make sure array elements are unset before traces are called} {
+test trace-10.1 {make sure array elements are unset before traces are called} {
catch {unset x}
set x(0) 33
set info {}
- trace var x(0) u {traceCheck {uplevel set x(0)}}
+ trace add variable x(0) unset {traceCheck {uplevel set x(0)}}
unset x(0)
set info
} {1 {can't read "x(0)": no such element in array}}
-test trace-9.2 {make sure array elements are unset before traces are called} {
+test trace-10.2 {make sure array elements are unset before traces are called} {
catch {unset x}
set x(0) 33
set info {}
- trace var x(0) u {traceCheck {uplevel set x(0) zzz}}
+ trace add variable x(0) unset {traceCheck {uplevel set x(0) zzz}}
unset x(0)
concat $info [list [catch {set x(0)} msg] $msg]
} {0 zzz 0 zzz}
-test trace-9.3 {array elements are unset before traces are called} {
+test trace-10.3 {array elements are unset before traces are called} {
catch {unset x}
set x(0) 33
set info {}
- trace var x(0) u {traceCheck {global x; trace vinfo x(0)}}
+ trace add variable x(0) unset {traceCheck {global x; trace info variable x(0)}}
unset x(0)
set info
} {0 {}}
-test trace-9.4 {set new array element trace during unset trace} {
+test trace-10.4 {set new array element trace during unset trace} {
catch {unset x}
set x(0) 33
set info {}
- trace var x(0) u {traceCheck {uplevel {trace variable x(0) r {}}}}
+ trace add variable x(0) unset {traceCheck {uplevel {trace add variable x(0) read {}}}}
catch {unset x(0)}
- concat $info [trace vinfo x(0)]
-} {0 {} {r {}}}
+ concat $info [trace info variable x(0)]
+} {0 {} {read {}}}
-test trace-10.1 {make sure arrays are unset before traces are called} {
+test trace-11.1 {make sure arrays are unset before traces are called} {
catch {unset x}
set x(0) 33
set info {}
- trace var x u {traceCheck {uplevel set x(0)}}
+ trace add variable x unset {traceCheck {uplevel set x(0)}}
unset x
set info
} {1 {can't read "x(0)": no such variable}}
-test trace-10.2 {make sure arrays are unset before traces are called} {
+test trace-11.2 {make sure arrays are unset before traces are called} {
catch {unset x}
set x(y) 33
set info {}
- trace var x u {traceCheck {uplevel set x(y) 22}}
+ trace add variable x unset {traceCheck {uplevel set x(y) 22}}
unset x
concat $info [list [catch {set x(y)} msg] $msg]
} {0 22 0 22}
-test trace-10.3 {make sure arrays are unset before traces are called} {
+test trace-11.3 {make sure arrays are unset before traces are called} {
catch {unset x}
set x(y) 33
set info {}
- trace var x u {traceCheck {uplevel array exists x}}
+ trace add variable x unset {traceCheck {uplevel array exists x}}
unset x
set info
} {0 0}
-test trace-10.4 {make sure arrays are unset before traces are called} {
+test trace-11.4 {make sure arrays are unset before traces are called} {
catch {unset x}
set x(y) 33
set info {}
- set cmd {traceCheck {uplevel {trace vinfo x}}}
- trace var x u $cmd
+ set cmd {traceCheck {uplevel {trace info variable x}}}
+ trace add variable x unset $cmd
unset x
set info
} {0 {}}
-test trace-10.5 {set new array trace during unset trace} {
+test trace-11.5 {set new array trace during unset trace} {
catch {unset x}
set x(y) 33
set info {}
- trace var x u {traceCheck {global x; trace var x r {}}}
+ trace add variable x unset {traceCheck {global x; trace add variable x read {}}}
unset x
- concat $info [trace vinfo x]
-} {0 {} {r {}}}
-test trace-10.6 {create scalar during array unset trace} {
+ concat $info [trace info variable x]
+} {0 {} {read {}}}
+test trace-11.6 {create scalar during array unset trace} {
catch {unset x}
set x(y) 33
set info {}
- trace var x u {traceCheck {global x; set x 44}}
+ trace add variable x unset {traceCheck {global x; set x 44}}
unset x
concat $info [list [catch {set x} msg] $msg]
} {0 44 0 44}
# Check special conditions (e.g. errors) in Tcl_TraceVar2.
-test trace-11.1 {creating array when setting variable traces} {
+test trace-12.1 {creating array when setting variable traces} {
catch {unset x}
set info {}
- trace var x(0) w traceProc
+ trace add variable x(0) write traceProc
list [catch {set x 22} msg] $msg
} {1 {can't set "x": variable is array}}
-test trace-11.2 {creating array when setting variable traces} {
+test trace-12.2 {creating array when setting variable traces} {
catch {unset x}
set info {}
- trace var x(0) w traceProc
+ trace add variable x(0) write traceProc
list [catch {set x(0)} msg] $msg
} {1 {can't read "x(0)": no such element in array}}
-test trace-11.3 {creating array when setting variable traces} {
+test trace-12.3 {creating array when setting variable traces} {
catch {unset x}
set info {}
- trace var x(0) w traceProc
+ trace add variable x(0) write traceProc
set x(0) 22
set info
-} {x 0 w}
-test trace-11.4 {creating variable when setting variable traces} {
+} {x 0 write}
+test trace-12.4 {creating variable when setting variable traces} {
catch {unset x}
set info {}
- trace var x w traceProc
+ trace add variable x write traceProc
list [catch {set x} msg] $msg
} {1 {can't read "x": no such variable}}
-test trace-11.5 {creating variable when setting variable traces} {
+test trace-12.5 {creating variable when setting variable traces} {
catch {unset x}
set info {}
- trace var x w traceProc
+ trace add variable x write traceProc
set x 22
set info
-} {x {} w}
-test trace-11.6 {creating variable when setting variable traces} {
+} {x {} write}
+test trace-12.6 {creating variable when setting variable traces} {
catch {unset x}
set info {}
- trace var x w traceProc
+ trace add variable x write traceProc
set x(0) 22
set info
-} {x 0 w}
-test trace-11.7 {create array element during read trace} {
+} {x 0 write}
+test trace-12.7 {create array element during read trace} {
catch {unset x}
set x(2) zzz
- trace var x r {traceCrtElement xyzzy}
+ trace add variable x read {traceCrtElement xyzzy}
list [catch {set x(3)} msg] $msg
} {0 xyzzy}
-test trace-11.8 {errors when setting variable traces} {
+test trace-12.8 {errors when setting variable traces} {
catch {unset x}
set x 44
- list [catch {trace var x(0) w traceProc} msg] $msg
+ list [catch {trace add variable x(0) write traceProc} msg] $msg
} {1 {can't trace "x(0)": variable isn't array}}
# Check deleting one trace from another.
-test trace-12.1 {delete one trace from another} {
+test trace-13.1 {delete one trace from another} {
proc delTraces {args} {
global x
- trace vdel x r {traceTag 2}
- trace vdel x r {traceTag 3}
- trace vdel x r {traceTag 4}
+ trace remove variable x read {traceTag 2}
+ trace remove variable x read {traceTag 3}
+ trace remove variable x read {traceTag 4}
}
catch {unset x}
set x 44
set info {}
- trace var x r {traceTag 1}
- trace var x r {traceTag 2}
- trace var x r {traceTag 3}
- trace var x r {traceTag 4}
- trace var x r delTraces
- trace var x r {traceTag 5}
+ trace add variable x read {traceTag 1}
+ trace add variable x read {traceTag 2}
+ trace add variable x read {traceTag 3}
+ trace add variable x read {traceTag 4}
+ trace add variable x read delTraces
+ trace add variable x read {traceTag 5}
set x
set info
} {5 1}
# Check operation and syntax of "trace" command.
-test trace-13.1 {trace command (overall)} {
+# Syntax for adding/removing variable and command traces is basically the
+# same:
+# trace add variable name opList command
+# trace remove variable name opList command
+#
+# The following loops just get all the common "wrong # args" tests done.
+
+set i 0
+set start "wrong # args:"
+foreach type {variable command} {
+ foreach op {add remove} {
+ test trace-14.0.[incr i] "trace command, wrong # args errors" {
+ list [catch {trace $op $type} msg] $msg
+ } [list 1 "$start should be \"trace $op $type name opList command\""]
+ test trace-14.0.[incr i] "trace command wrong # args errors" {
+ list [catch {trace $op $type foo} msg] $msg
+ } [list 1 "$start should be \"trace $op $type name opList command\""]
+ test trace-14.0.[incr i] "trace command, wrong # args errors" {
+ list [catch {trace $op $type foo bar} msg] $msg
+ } [list 1 "$start should be \"trace $op $type name opList command\""]
+ test trace-14.0.[incr i] "trace command, wrong # args errors" {
+ list [catch {trace $op $type foo bar baz boo} msg] $msg
+ } [list 1 "$start should be \"trace $op $type name opList command\""]
+ }
+ test trace-14.0.[incr i] "trace command, wrong # args errors" {
+ list [catch {trace info $type foo bar} msg] $msg
+ } [list 1 "$start should be \"trace info $type name\""]
+ test trace-14.0.[incr i] "trace command, wrong # args errors" {
+ list [catch {trace info $type} msg] $msg
+ } [list 1 "$start should be \"trace info $type name\""]
+}
+
+test trace-14.1 "trace command, wrong # args errors" {
list [catch {trace} msg] $msg
-} {1 {wrong # args: should be "trace option [arg arg ...]"}}
-test trace-13.2 {trace command (overall)} {
+} [list 1 "wrong # args: should be \"trace option ?arg arg ...?\""]
+test trace-14.2 "trace command, wrong # args errors" {
+ list [catch {trace add} msg] $msg
+} [list 1 "wrong # args: should be \"trace add type ?arg arg ...?\""]
+test trace-14.3 "trace command, wrong # args errors" {
+ list [catch {trace remove} msg] $msg
+} [list 1 "wrong # args: should be \"trace remove type ?arg arg ...?\""]
+test trace-14.4 "trace command, wrong # args errors" {
+ list [catch {trace info} msg] $msg
+} [list 1 "wrong # args: should be \"trace info type ?arg arg ...?\""]
+
+test trace-14.5 {trace command, invalid option} {
list [catch {trace gorp} msg] $msg
-} {1 {bad option "gorp": must be variable, vdelete, or vinfo}}
-test trace-13.3 {trace command ("variable" option)} {
+} [list 1 "bad option \"gorp\": must be add, info, remove, variable, vdelete, or vinfo"]
+
+# Again, [trace ... command] and [trace ... variable] share syntax and
+# error message styles for their opList options; these loops test those
+# error messages.
+
+set i 0
+set errs [list "array, read, unset, or write" "delete or rename" "enter, leave, enterstep, or leavestep"]
+set abbvs [list {a r u w} {d r} {}]
+proc x {} {}
+foreach type {variable command execution} err $errs abbvlist $abbvs {
+ foreach op {add remove} {
+ test trace-14.6.[incr i] "trace $op $type errors" {
+ list [catch {trace $op $type x {y z w} a} msg] $msg
+ } [list 1 "bad operation \"y\": must be $err"]
+ foreach abbv $abbvlist {
+ test trace-14.6.[incr i] "trace $op $type rejects abbreviations" {
+ list [catch {trace $op $type x $abbv a} msg] $msg
+ } [list 1 "bad operation \"$abbv\": must be $err"]
+ }
+ test trace-14.6.[incr i] "trace $op $type rejects null opList" {
+ list [catch {trace $op $type x {} a} msg] $msg
+ } [list 1 "bad operation list \"\": must be one or more of $err"]
+ }
+}
+rename x {}
+
+test trace-14.7 {trace command, "trace variable" errors} {
+ list [catch {trace variable} msg] $msg
+} [list 1 "wrong # args: should be \"trace variable name ops command\""]
+test trace-14.8 {trace command, "trace variable" errors} {
+ list [catch {trace variable x} msg] $msg
+} [list 1 "wrong # args: should be \"trace variable name ops command\""]
+test trace-14.9 {trace command, "trace variable" errors} {
list [catch {trace variable x y} msg] $msg
-} {1 {wrong # args: should be "trace variable name ops command"}}
-test trace-13.4 {trace command ("variable" option)} {
- list [catch {trace var x y z z2} msg] $msg
-} {1 {wrong # args: should be "trace variable name ops command"}}
-test trace-13.5 {trace command ("variable" option)} {
- list [catch {trace var x y z} msg] $msg
-} {1 {bad operations "y": should be one or more of rwu}}
-test trace-13.6 {trace command ("vdelete" option)} {
- list [catch {trace vdelete x y} msg] $msg
-} {1 {wrong # args: should be "trace vdelete name ops command"}}
-test trace-13.7 {trace command ("vdelete" option)} {
- list [catch {trace vdelete x y z foo} msg] $msg
-} {1 {wrong # args: should be "trace vdelete name ops command"}}
-test trace-13.8 {trace command ("vdelete" option)} {
- list [catch {trace vdelete x y z} msg] $msg
-} {1 {bad operations "y": should be one or more of rwu}}
-test trace-13.9 {trace command ("vdelete" option)} {
- catch {unset x}
- set info {}
- trace var x w traceProc
- trace vdelete x w traceProc
+} [list 1 "wrong # args: should be \"trace variable name ops command\""]
+test trace-14.10 {trace command, "trace variable" errors} {
+ list [catch {trace variable x y z w} msg] $msg
+} [list 1 "wrong # args: should be \"trace variable name ops command\""]
+test trace-14.11 {trace command, "trace variable" errors} {
+ list [catch {trace variable x y z} msg] $msg
+} [list 1 "bad operations \"y\": should be one or more of rwua"]
+
+
+test trace-14.9 {trace command ("remove variable" option)} {
+ catch {unset x}
+ set info {}
+ trace add variable x write traceProc
+ trace remove variable x write traceProc
} {}
-test trace-13.10 {trace command ("vdelete" option)} {
+test trace-14.10 {trace command ("remove variable" option)} {
catch {unset x}
set info {}
- trace var x w traceProc
- trace vdelete x w traceProc
+ trace add variable x write traceProc
+ trace remove variable x write traceProc
set x 12345
set info
} {}
-test trace-13.11 {trace command ("vdelete" option)} {
+test trace-14.11 {trace command ("remove variable" option)} {
catch {unset x}
set info {}
- trace var x w {traceTag 1}
- trace var x w traceProc
- trace var x w {traceTag 2}
+ trace add variable x write {traceTag 1}
+ trace add variable x write traceProc
+ trace add variable x write {traceTag 2}
set x yy
- trace vdelete x w traceProc
+ trace remove variable x write traceProc
set x 12345
- trace vdelete x w {traceTag 1}
+ trace remove variable x write {traceTag 1}
set x foo
- trace vdelete x w {traceTag 2}
+ trace remove variable x write {traceTag 2}
set x gorp
set info
-} {2 x {} w 1 2 1 2}
-test trace-13.12 {trace command ("vdelete" option)} {
+} {2 x {} write 1 2 1 2}
+test trace-14.12 {trace command ("remove variable" option)} {
catch {unset x}
set info {}
- trace var x w {traceTag 1}
- trace vdelete x w non_existent
+ trace add variable x write {traceTag 1}
+ trace remove variable x write non_existent
set x 12345
set info
} {1}
-test trace-13.13 {trace command ("vinfo" option)} {
- list [catch {trace vinfo} msg] $msg]
-} {1 {wrong # args: should be "trace vinfo name"]}}
-test trace-13.14 {trace command ("vinfo" option)} {
- list [catch {trace vinfo x y} msg] $msg]
-} {1 {wrong # args: should be "trace vinfo name"]}}
-test trace-13.15 {trace command ("vinfo" option)} {
- catch {unset x}
- trace var x w {traceTag 1}
- trace var x w traceProc
- trace var x w {traceTag 2}
- trace vinfo x
-} {{w {traceTag 2}} {w traceProc} {w {traceTag 1}}}
-test trace-13.16 {trace command ("vinfo" option)} {
- catch {unset x}
- trace vinfo x
+test trace-14.15 {trace command ("list variable" option)} {
+ catch {unset x}
+ trace add variable x write {traceTag 1}
+ trace add variable x write traceProc
+ trace add variable x write {traceTag 2}
+ trace info variable x
+} {{write {traceTag 2}} {write traceProc} {write {traceTag 1}}}
+test trace-14.16 {trace command ("list variable" option)} {
+ catch {unset x}
+ trace info variable x
} {}
-test trace-13.17 {trace command ("vinfo" option)} {
+test trace-14.17 {trace command ("list variable" option)} {
catch {unset x}
- trace vinfo x(0)
+ trace info variable x(0)
} {}
-test trace-13.18 {trace command ("vinfo" option)} {
+test trace-14.18 {trace command ("list variable" option)} {
catch {unset x}
set x 44
- trace vinfo x(0)
+ trace info variable x(0)
} {}
-test trace-13.19 {trace command ("vinfo" option)} {
+test trace-14.19 {trace command ("list variable" option)} {
catch {unset x}
set x 44
- trace var x w {traceTag 1}
- proc check {} {global x; trace vinfo x}
+ trace add variable x write {traceTag 1}
+ proc check {} {global x; trace info variable x}
check
-} {{w {traceTag 1}}}
+} {{write {traceTag 1}}}
# Check fancy trace commands (long ones, weird arguments, etc.)
-test trace-14.1 {long trace command} {
+test trace-15.1 {long trace command} {
catch {unset x}
set info {}
- trace var x w {traceTag {This is a very very long argument. It's \
+ trace add variable x write {traceTag {This is a very very long argument. It's \
designed to test out the facilities of TraceVarProc for dealing \
with such long arguments by malloc-ing space. One possibility \
is that space doesn't get freed properly. If this happens, then \
@@ -724,24 +910,24 @@ test trace-14.1 {long trace command} {
with such long arguments by malloc-ing space. One possibility \
is that space doesn't get freed properly. If this happens, then \
invoking this test over and over again will eventually leak memory.}
-test trace-14.2 {long trace command result to ignore} {
+test trace-15.2 {long trace command result to ignore} {
proc longResult {args} {return "quite a bit of text, designed to
generate a core leak if this command file is invoked over and over again
and memory isn't being recycled correctly"}
catch {unset x}
- trace var x w longResult
+ trace add variable x write longResult
set x 44
set x 5
set x abcde
} abcde
-test trace-14.3 {special list-handling in trace commands} {
+test trace-15.3 {special list-handling in trace commands} {
catch {unset "x y z"}
set "x y z(a\n\{)" 44
set info {}
- trace var "x y z(a\n\{)" w traceProc
+ trace add variable "x y z(a\n\{)" write traceProc
set "x y z(a\n\{)" 33
set info
-} "{x y z} a\\n\\{ w"
+} "{x y z} a\\n\\\{ write"
# Check for proper handling of unsets during traces.
@@ -765,202 +951,213 @@ proc traceAppend {string name1 name2 op} {
lappend info $string
}
-test trace-15.1 {unsets during read traces} {
+test trace-16.1 {unsets during read traces} {
catch {unset y}
set y 1234
set info {}
- trace var y r {traceUnset y}
- trace var y u {traceAppend unset}
+ trace add variable y read {traceUnset y}
+ trace add variable y unset {traceAppend unset}
lappend info [catch {set y} msg] $msg
} {unset 0 {} 1 {can't read "x": no such variable} 1 {can't read "y": no such variable}}
-test trace-15.2 {unsets during read traces} {
+test trace-16.2 {unsets during read traces} {
catch {unset y}
set y(0) 1234
set info {}
- trace var y(0) r {traceUnset y(0)}
+ trace add variable y(0) read {traceUnset y(0)}
lappend info [catch {set y(0)} msg] $msg
} {0 {} 1 {can't read "x": no such variable} 1 {can't read "y(0)": no such element in array}}
-test trace-15.3 {unsets during read traces} {
+test trace-16.3 {unsets during read traces} {
catch {unset y}
set y(0) 1234
set info {}
- trace var y(0) r {traceUnset y}
+ trace add variable y(0) read {traceUnset y}
lappend info [catch {set y(0)} msg] $msg
} {0 {} 1 {can't read "x": no such variable} 1 {can't read "y(0)": no such variable}}
-test trace-15.4 {unsets during read traces} {
+test trace-16.4 {unsets during read traces} {
catch {unset y}
set y 1234
set info {}
- trace var y r {traceReset y y}
+ trace add variable y read {traceReset y y}
lappend info [catch {set y} msg] $msg
} {0 {} 0 xyzzy 0 xyzzy}
-test trace-15.5 {unsets during read traces} {
+test trace-16.5 {unsets during read traces} {
catch {unset y}
set y(0) 1234
set info {}
- trace var y(0) r {traceReset y(0) y(0)}
+ trace add variable y(0) read {traceReset y(0) y(0)}
lappend info [catch {set y(0)} msg] $msg
} {0 {} 0 xyzzy 0 xyzzy}
-test trace-15.6 {unsets during read traces} {
+test trace-16.6 {unsets during read traces} {
catch {unset y}
set y(0) 1234
set info {}
- trace var y(0) r {traceReset y y(0)}
+ trace add variable y(0) read {traceReset y y(0)}
lappend info [catch {set y(0)} msg] $msg [catch {set y(0)} msg] $msg
} {0 {} 1 {can't set "y": upvar refers to element in deleted array} 1 {can't read "y(0)": no such variable} 1 {can't read "y(0)": no such variable}}
-test trace-15.7 {unsets during read traces} {
+test trace-16.7 {unsets during read traces} {
catch {unset y}
set y(0) 1234
set info {}
- trace var y(0) r {traceReset2 y y(0)}
+ trace add variable y(0) read {traceReset2 y y(0)}
lappend info [catch {set y(0)} msg] $msg [catch {set y(0)} msg] $msg
} {0 {} 0 xyzzy 1 {can't read "y(0)": no such element in array} 0 xyzzy}
-test trace-15.8 {unsets during write traces} {
+test trace-16.8 {unsets during write traces} {
catch {unset y}
set y 1234
set info {}
- trace var y w {traceUnset y}
- trace var y u {traceAppend unset}
+ trace add variable y write {traceUnset y}
+ trace add variable y unset {traceAppend unset}
lappend info [catch {set y xxx} msg] $msg
} {unset 0 {} 1 {can't read "x": no such variable} 0 {}}
-test trace-15.9 {unsets during write traces} {
+test trace-16.9 {unsets during write traces} {
catch {unset y}
set y(0) 1234
set info {}
- trace var y(0) w {traceUnset y(0)}
+ trace add variable y(0) write {traceUnset y(0)}
lappend info [catch {set y(0) xxx} msg] $msg
} {0 {} 1 {can't read "x": no such variable} 0 {}}
-test trace-15.10 {unsets during write traces} {
+test trace-16.10 {unsets during write traces} {
catch {unset y}
set y(0) 1234
set info {}
- trace var y(0) w {traceUnset y}
+ trace add variable y(0) write {traceUnset y}
lappend info [catch {set y(0) xxx} msg] $msg
} {0 {} 1 {can't read "x": no such variable} 0 {}}
-test trace-15.11 {unsets during write traces} {
+test trace-16.11 {unsets during write traces} {
catch {unset y}
set y 1234
set info {}
- trace var y w {traceReset y y}
+ trace add variable y write {traceReset y y}
lappend info [catch {set y xxx} msg] $msg
} {0 {} 0 xyzzy 0 xyzzy}
-test trace-15.12 {unsets during write traces} {
+test trace-16.12 {unsets during write traces} {
catch {unset y}
set y(0) 1234
set info {}
- trace var y(0) w {traceReset y(0) y(0)}
+ trace add variable y(0) write {traceReset y(0) y(0)}
lappend info [catch {set y(0) xxx} msg] $msg
} {0 {} 0 xyzzy 0 xyzzy}
-test trace-15.13 {unsets during write traces} {
+test trace-16.13 {unsets during write traces} {
catch {unset y}
set y(0) 1234
set info {}
- trace var y(0) w {traceReset y y(0)}
+ trace add variable y(0) write {traceReset y y(0)}
lappend info [catch {set y(0) xxx} msg] $msg [catch {set y(0)} msg] $msg
} {0 {} 1 {can't set "y": upvar refers to element in deleted array} 0 {} 1 {can't read "y(0)": no such variable}}
-test trace-15.14 {unsets during write traces} {
+test trace-16.14 {unsets during write traces} {
catch {unset y}
set y(0) 1234
set info {}
- trace var y(0) w {traceReset2 y y(0)}
+ trace add variable y(0) write {traceReset2 y y(0)}
lappend info [catch {set y(0) xxx} msg] $msg [catch {set y(0)} msg] $msg
} {0 {} 0 xyzzy 0 {} 0 xyzzy}
-test trace-15.15 {unsets during unset traces} {
+test trace-16.15 {unsets during unset traces} {
catch {unset y}
set y 1234
set info {}
- trace var y u {traceUnset y}
+ trace add variable y unset {traceUnset y}
lappend info [catch {unset y} msg] $msg [catch {set y} msg] $msg
} {1 {can't unset "x": no such variable} 1 {can't read "x": no such variable} 0 {} 1 {can't read "y": no such variable}}
-test trace-15.16 {unsets during unset traces} {
+test trace-16.16 {unsets during unset traces} {
catch {unset y}
set y(0) 1234
set info {}
- trace var y(0) u {traceUnset y(0)}
+ trace add variable y(0) unset {traceUnset y(0)}
lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
} {1 {can't unset "x": no such variable} 1 {can't read "x": no such variable} 0 {} 1 {can't read "y(0)": no such element in array}}
-test trace-15.17 {unsets during unset traces} {
+test trace-16.17 {unsets during unset traces} {
catch {unset y}
set y(0) 1234
set info {}
- trace var y(0) u {traceUnset y}
+ trace add variable y(0) unset {traceUnset y}
lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
} {0 {} 1 {can't read "x": no such variable} 0 {} 1 {can't read "y(0)": no such variable}}
-test trace-15.18 {unsets during unset traces} {
+test trace-16.18 {unsets during unset traces} {
catch {unset y}
set y 1234
set info {}
- trace var y u {traceReset2 y y}
+ trace add variable y unset {traceReset2 y y}
lappend info [catch {unset y} msg] $msg [catch {set y} msg] $msg
} {1 {can't unset "y": no such variable} 0 xyzzy 0 {} 0 xyzzy}
-test trace-15.19 {unsets during unset traces} {
+test trace-16.19 {unsets during unset traces} {
catch {unset y}
set y(0) 1234
set info {}
- trace var y(0) u {traceReset2 y(0) y(0)}
+ trace add variable y(0) unset {traceReset2 y(0) y(0)}
lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
} {1 {can't unset "y(0)": no such element in array} 0 xyzzy 0 {} 0 xyzzy}
-test trace-15.20 {unsets during unset traces} {
+test trace-16.20 {unsets during unset traces} {
catch {unset y}
set y(0) 1234
set info {}
- trace var y(0) u {traceReset2 y y(0)}
+ trace add variable y(0) unset {traceReset2 y y(0)}
lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
} {0 {} 0 xyzzy 0 {} 0 xyzzy}
-test trace-15.21 {unsets cancelling traces} {
+test trace-16.21 {unsets cancelling traces} {
catch {unset y}
set y 1234
set info {}
- trace var y r {traceAppend first}
- trace var y r {traceUnset y}
- trace var y r {traceAppend third}
- trace var y u {traceAppend unset}
+ trace add variable y read {traceAppend first}
+ trace add variable y read {traceUnset y}
+ trace add variable y read {traceAppend third}
+ trace add variable y unset {traceAppend unset}
lappend info [catch {set y} msg] $msg
} {third unset 0 {} 1 {can't read "x": no such variable} 1 {can't read "y": no such variable}}
-test trace-15.22 {unsets cancelling traces} {
+test trace-16.22 {unsets cancelling traces} {
catch {unset y}
set y(0) 1234
set info {}
- trace var y(0) r {traceAppend first}
- trace var y(0) r {traceUnset y}
- trace var y(0) r {traceAppend third}
- trace var y(0) u {traceAppend unset}
+ trace add variable y(0) read {traceAppend first}
+ trace add variable y(0) read {traceUnset y}
+ trace add variable y(0) read {traceAppend third}
+ trace add variable y(0) unset {traceAppend unset}
lappend info [catch {set y(0)} msg] $msg
} {third unset 0 {} 1 {can't read "x": no such variable} 1 {can't read "y(0)": no such variable}}
# Check various non-interference between traces and other things.
-test trace-16.1 {trace doesn't prevent unset errors} {
+test trace-17.1 {trace doesn't prevent unset errors} {
catch {unset x}
set info {}
- trace var x u {traceProc}
+ trace add variable x unset {traceProc}
list [catch {unset x} msg] $msg $info
-} {1 {can't unset "x": no such variable} {x {} u}}
-test trace-16.2 {traced variables must survive procedure exits} {
+} {1 {can't unset "x": no such variable} {x {} unset}}
+test trace-17.2 {traced variables must survive procedure exits} {
catch {unset x}
- proc p1 {} {global x; trace var x w traceProc}
+ proc p1 {} {global x; trace add variable x write traceProc}
p1
- trace vinfo x
-} {{w traceProc}}
-test trace-16.3 {traced variables must survive procedure exits} {
+ trace info variable x
+} {{write traceProc}}
+test trace-17.3 {traced variables must survive procedure exits} {
catch {unset x}
set info {}
- proc p1 {} {global x; trace var x w traceProc}
+ proc p1 {} {global x; trace add variable x write traceProc}
p1
set x 44
set info
-} {x {} w}
+} {x {} write}
# Be sure that procedure frames are released before unset traces
# are invoked.
-test trace-17.1 {unset traces on procedure returns} {
+test trace-18.1 {unset traces on procedure returns} {
proc p1 {x y} {set a 44; p2 14}
- proc p2 {z} {trace var z u {traceCheck {lsort [uplevel {info vars}]}}}
+ proc p2 {z} {trace add variable z unset {traceCheck {lsort [uplevel {info vars}]}}}
set info {}
p1 foo bar
set info
} {0 {a x y}}
+test trace-18.2 {namespace delete / trace vdelete combo} {
+ namespace eval ::foo {
+ variable x 123
+ }
+ proc p1 args {
+ trace vdelete ::foo::x u p1
+ }
+ trace variable ::foo::x u p1
+ namespace delete ::foo
+ info exists ::foo::x
+} 0
# Delete arrays when done, so they can be re-used as scalars
# elsewhere.
@@ -968,19 +1165,686 @@ test trace-17.1 {unset traces on procedure returns} {
catch {unset x}
catch {unset y}
-# cleanup
-::tcltest::cleanupTests
-return
+test trace-18.2 {trace add command (command existence)} {
+ # Just in case!
+ catch {rename nosuchname ""}
+ list [catch {trace add command nosuchname rename traceCommand} msg] $msg
+} {1 {unknown command "nosuchname"}}
+test trace-18.3 {trace add command (command existence in ns)} {
+ list [catch {trace add command nosuchns::nosuchname rename traceCommand} msg] $msg
+} {1 {unknown command "nosuchns::nosuchname"}}
+
+
+test trace-19.1 {trace add command (rename option)} {
+ proc foo {} {}
+ catch {rename bar {}}
+ trace add command foo rename traceCommand
+ rename foo bar
+ set info
+} {foo bar rename}
+test trace-19.2 {traces stick with renamed commands} {
+ proc foo {} {}
+ catch {rename bar {}}
+ trace add command foo rename traceCommand
+ rename foo bar
+ rename bar foo
+ set info
+} {bar foo rename}
+test trace-19.2.1 {trace add command rename trace exists} {
+ proc foo {} {}
+ trace add command foo rename traceCommand
+ trace info command foo
+} {{rename traceCommand}}
+test trace-19.3 {command rename traces don't fire on command deletion} {
+ proc foo {} {}
+ set info {}
+ trace add command foo rename traceCommand
+ rename foo {}
+ set info
+} {}
+test trace-19.4 {trace add command rename doesn't trace recreated commands} {
+ proc foo {} {}
+ catch {rename bar {}}
+ trace add command foo rename traceCommand
+ proc foo {} {}
+ rename foo bar
+ set info
+} {}
+test trace-19.5 {trace add command deleted removes traces} {
+ proc foo {} {}
+ trace add command foo rename traceCommand
+ proc foo {} {}
+ trace info command foo
+} {}
+
+namespace eval tc {}
+proc tc::tcfoo {} {}
+test trace-19.6 {trace add command rename in namespace} {
+ trace add command tc::tcfoo rename traceCommand
+ rename tc::tcfoo tc::tcbar
+ set info
+} {tc::tcfoo tc::tcbar rename}
+test trace-19.7 {trace add command rename in namespace back again} {
+ rename tc::tcbar tc::tcfoo
+ set info
+} {tc::tcbar tc::tcfoo rename}
+test trace-19.8 {trace add command rename in namespace to out of namespace} {
+ rename tc::tcfoo tcbar
+ set info
+} {tc::tcfoo tcbar rename}
+test trace-19.9 {trace add command rename back into namespace} {
+ rename tcbar tc::tcfoo
+ set info
+} {tcbar tc::tcfoo rename}
+test trace-19.10 {trace add command failed rename doesn't trigger trace} {
+ set info {}
+ proc foo {} {}
+ proc bar {} {}
+ trace add command foo {rename delete} traceCommand
+ catch {rename foo bar}
+ set info
+} {}
+catch {rename foo {}}
+catch {rename bar {}}
+
+# Make sure it exists again
+proc foo {} {}
+
+test trace-20.1 {trace add command (delete option)} {
+ trace add command foo delete traceCommand
+ rename foo ""
+ set info
+} {::foo {} delete}
+test trace-20.2 {trace add command delete doesn't trace recreated commands} {
+ set info {}
+ proc foo {} {}
+ rename foo ""
+ set info
+} {}
+test trace-20.2.1 {trace add command delete trace info} {
+ proc foo {} {}
+ trace add command foo delete traceCommand
+ trace info command foo
+} {{delete traceCommand}}
+test trace-20.3 {trace add command implicit delete} {
+ proc foo {} {}
+ trace add command foo delete traceCommand
+ proc foo {} {}
+ set info
+} {::foo {} delete}
+test trace-20.3.1 {trace add command delete trace info} {
+ proc foo {} {}
+ trace info command foo
+} {}
+test trace-20.4 {trace add command rename followed by delete} {
+ set infotemp {}
+ proc foo {} {}
+ trace add command foo {rename delete} traceCommand
+ rename foo bar
+ lappend infotemp $info
+ rename bar {}
+ lappend infotemp $info
+ set info $infotemp
+ unset infotemp
+ set info
+} {{foo bar rename} {::bar {} delete}}
+catch {rename foo {}}
+catch {rename bar {}}
+
+test trace-20.5 {trace add command rename and delete} {
+ set infotemp {}
+ set info {}
+ proc foo {} {}
+ trace add command foo {rename delete} traceCommand
+ rename foo bar
+ lappend infotemp $info
+ rename bar {}
+ lappend infotemp $info
+ set info $infotemp
+ unset infotemp
+ set info
+} {{foo bar rename} {::bar {} delete}}
+
+test trace-20.6 {trace add command rename and delete in subinterp} {
+ set tc [interp create]
+ foreach p {traceCommand} {
+ $tc eval [list proc $p [info args $p] [info body $p]]
+ }
+ $tc eval [list set infotemp {}]
+ $tc eval [list set info {}]
+ $tc eval [list proc foo {} {}]
+ $tc eval [list trace add command foo {rename delete} traceCommand]
+ $tc eval [list rename foo bar]
+ $tc eval {lappend infotemp $info}
+ $tc eval [list rename bar {}]
+ $tc eval {lappend infotemp $info}
+ $tc eval {set info $infotemp}
+ $tc eval [list unset infotemp]
+ set info [$tc eval [list set info]]
+ interp delete $tc
+ set info
+} {{foo bar rename} {::bar {} delete}}
+
+# I'd like it if this test could give 'foo {} d' as a result,
+# but interp deletion means there is no interp to evaluate
+# the trace in.
+test trace-20.7 {trace add command delete in subinterp while being deleted} {
+ set info {}
+ set tc [interp create]
+ interp alias $tc traceCommand {} traceCommand
+ $tc eval [list proc foo {} {}]
+ $tc eval [list trace add command foo {rename delete} traceCommand]
+ interp delete $tc
+ set info
+} {}
+
+proc traceDelete {cmd old new op} {
+ eval trace remove command $cmd [lindex [trace info command $cmd] 0]
+ global info
+ set info [list $old $new $op]
+}
+proc traceCmdrename {cmd old new op} {
+ rename $old someothername
+}
+proc traceCmddelete {cmd old new op} {
+ rename $old ""
+}
+test trace-20.8 {trace delete while trace is active} {
+ set info {}
+ proc foo {} {}
+ catch {rename bar {}}
+ trace add command foo {rename delete} [list traceDelete foo]
+ rename foo bar
+ list [set info] [trace info command bar]
+} {{foo bar rename} {}}
+
+test trace-20.9 {rename trace deletes command} {
+ set info {}
+ proc foo {} {}
+ catch {rename bar {}}
+ catch {rename someothername {}}
+ trace add command foo rename [list traceCmddelete foo]
+ rename foo bar
+ list [info commands foo] [info commands bar] [info commands someothername]
+} {{} {} {}}
+
+test trace-20.10 {rename trace renames command} {
+ set info {}
+ proc foo {} {}
+ catch {rename bar {}}
+ catch {rename someothername {}}
+ trace add command foo rename [list traceCmdrename foo]
+ rename foo bar
+ set info [list [info commands foo] [info commands bar] [info commands someothername]]
+ rename someothername {}
+ set info
+} {{} {} someothername}
+
+test trace-20.11 {delete trace deletes command} {
+ set info {}
+ proc foo {} {}
+ catch {rename bar {}}
+ catch {rename someothername {}}
+ trace add command foo delete [list traceCmddelete foo]
+ rename foo {}
+ list [info commands foo] [info commands bar] [info commands someothername]
+} {{} {} {}}
+
+test trace-20.12 {delete trace renames command} {
+ set info {}
+ proc foo {} {}
+ catch {rename bar {}}
+ catch {rename someothername {}}
+ trace add command foo delete [list traceCmdrename foo]
+ rename foo bar
+ rename bar {}
+ # None of these should exist.
+ list [info commands foo] [info commands bar] [info commands someothername]
+} {{} {} {}}
+
+proc foo {b} { set a $b }
+
+
+# Delete arrays when done, so they can be re-used as scalars
+# elsewhere.
+
+catch {unset x}
+catch {unset y}
+
+# Delete procedures when done, so we don't clash with other tests
+# (e.g. foobar will clash with 'unknown' tests).
+catch {rename foobar {}}
+catch {rename foo {}}
+catch {rename bar {}}
+
+proc foo {a} {
+ set b $a
+}
+
+proc traceExecute {args} {
+ global info
+ lappend info $args
+}
+
+test trace-21.1 {trace execution: enter} {
+ set info {}
+ trace add execution foo enter [list traceExecute foo]
+ foo 1
+ trace remove execution foo enter [list traceExecute foo]
+ set info
+} {{foo {foo 1} enter}}
+test trace-21.2 {trace exeuction: leave} {
+ set info {}
+ trace add execution foo leave [list traceExecute foo]
+ foo 2
+ trace remove execution foo leave [list traceExecute foo]
+ set info
+} {{foo {foo 2} 0 2 leave}}
+
+test trace-21.3 {trace exeuction: enter, leave} {
+ set info {}
+ trace add execution foo {enter leave} [list traceExecute foo]
+ foo 3
+ trace remove execution foo {enter leave} [list traceExecute foo]
+ set info
+} {{foo {foo 3} enter} {foo {foo 3} 0 3 leave}}
+
+test trace-21.4 {trace execution: enter, leave, enterstep} {
+ set info {}
+ trace add execution foo {enter leave enterstep} [list traceExecute foo]
+ foo 3
+ trace remove execution foo {enter leave enterstep} [list traceExecute foo]
+ set info
+} {{foo {foo 3} enter} {foo {set b 3} enterstep} {foo {foo 3} 0 3 leave}}
+
+test trace-21.5 {trace execution: enter, leave, enterstep, leavestep} {
+ set info {}
+ trace add execution foo {enter leave enterstep leavestep} [list traceExecute foo]
+ foo 3
+ trace remove execution foo {enter leave enterstep leavestep} [list traceExecute foo]
+ set info
+} {{foo {foo 3} enter} {foo {set b 3} enterstep} {foo {set b 3} 0 3 leavestep} {foo {foo 3} 0 3 leave}}
+test trace-21.6 {trace execution: enterstep, leavestep} {
+ set info {}
+ trace add execution foo {enterstep leavestep} [list traceExecute foo]
+ foo 3
+ trace remove execution foo {enterstep leavestep} [list traceExecute foo]
+ set info
+} {{foo {set b 3} enterstep} {foo {set b 3} 0 3 leavestep}}
+test trace-21.7 {trace execution: enterstep} {
+ set info {}
+ trace add execution foo {enterstep} [list traceExecute foo]
+ foo 3
+ trace remove execution foo {enterstep} [list traceExecute foo]
+ set info
+} {{foo {set b 3} enterstep}}
+test trace-21.8 {trace execution: leavestep} {
+ set info {}
+ trace add execution foo {leavestep} [list traceExecute foo]
+ foo 3
+ trace remove execution foo {leavestep} [list traceExecute foo]
+ set info
+} {{foo {set b 3} 0 3 leavestep}}
+proc factorial {n} {
+ if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }
+ return 1
+}
+test trace-22.1 {recursive(1) trace execution: enter} {
+ set info {}
+ trace add execution factorial {enter} [list traceExecute factorial]
+ factorial 1
+ trace remove execution factorial {enter} [list traceExecute factorial]
+ set info
+} {{factorial {factorial 1} enter}}
+test trace-22.2 {recursive(2) trace execution: enter} {
+ set info {}
+ trace add execution factorial {enter} [list traceExecute factorial]
+ factorial 2
+ trace remove execution factorial {enter} [list traceExecute factorial]
+ set info
+} {{factorial {factorial 2} enter} {factorial {factorial 1} enter}}
+test trace-22.3 {recursive(3) trace execution: enter} {
+ set info {}
+ trace add execution factorial {enter} [list traceExecute factorial]
+ factorial 3
+ trace remove execution factorial {enter} [list traceExecute factorial]
+ set info
+} {{factorial {factorial 3} enter} {factorial {factorial 2} enter} {factorial {factorial 1} enter}}
+test trace-23.1 {recursive(1) trace execution: enter, leave, enterstep, leavestep} {
+ set info {}
+ trace add execution factorial {enter leave enterstep leavestep} [list traceExecute]
+ factorial 1
+ trace remove execution factorial {enter leave enterstep leavestep} [list traceExecute]
+ join $info "\n"
+} {{factorial 1} enter
+{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} enterstep
+{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} 0 {} leavestep
+{return 1} enterstep
+{return 1} 2 1 leavestep
+{factorial 1} 0 1 leave}
+test trace-23.2 {recursive(2) trace execution: enter, leave, enterstep, leavestep} {
+ set info {}
+ trace add execution factorial {enter leave enterstep leavestep} [list traceExecute]
+ factorial 2
+ trace remove execution factorial {enter leave enterstep leavestep} [list traceExecute]
+ join $info "\n"
+} {{factorial 2} enter
+{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} enterstep
+{expr {$n * [factorial [expr {$n -1 }]]}} enterstep
+{expr {$n -1 }} enterstep
+{expr {$n -1 }} 0 1 leavestep
+{factorial 1} enterstep
+{factorial 1} enter
+{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} enterstep
+{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} 0 {} leavestep
+{return 1} enterstep
+{return 1} 2 1 leavestep
+{factorial 1} 0 1 leave
+{factorial 1} 0 1 leavestep
+{expr {$n * [factorial [expr {$n -1 }]]}} 0 2 leavestep
+{return 2} enterstep
+{return 2} 2 2 leavestep
+{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} 2 2 leavestep
+{factorial 2} 0 2 leave}
+test trace-23.3 {recursive(3) trace execution: enter, leave, enterstep, leavestep} {
+ set info {}
+ trace add execution factorial {enter leave enterstep leavestep} [list traceExecute]
+ factorial 3
+ trace remove execution factorial {enter leave enterstep leavestep} [list traceExecute]
+ join $info "\n"
+} {{factorial 3} enter
+{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} enterstep
+{expr {$n * [factorial [expr {$n -1 }]]}} enterstep
+{expr {$n -1 }} enterstep
+{expr {$n -1 }} 0 2 leavestep
+{factorial 2} enterstep
+{factorial 2} enter
+{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} enterstep
+{expr {$n * [factorial [expr {$n -1 }]]}} enterstep
+{expr {$n -1 }} enterstep
+{expr {$n -1 }} 0 1 leavestep
+{factorial 1} enterstep
+{factorial 1} enter
+{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} enterstep
+{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} 0 {} leavestep
+{return 1} enterstep
+{return 1} 2 1 leavestep
+{factorial 1} 0 1 leave
+{factorial 1} 0 1 leavestep
+{expr {$n * [factorial [expr {$n -1 }]]}} 0 2 leavestep
+{return 2} enterstep
+{return 2} 2 2 leavestep
+{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} 2 2 leavestep
+{factorial 2} 0 2 leave
+{factorial 2} 0 2 leavestep
+{expr {$n * [factorial [expr {$n -1 }]]}} 0 6 leavestep
+{return 6} enterstep
+{return 6} 2 6 leavestep
+{if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }} 2 6 leavestep
+{factorial 3} 0 6 leave}
+proc traceDelete {cmd args} {
+ eval trace remove execution $cmd [lindex [trace info execution $cmd] 0]
+ global info
+ set info $args
+}
+
+test trace-24.1 {delete trace during enter trace} {
+ set info {}
+ trace add execution foo enter [list traceDelete foo]
+ foo 1
+ list $info [trace info execution foo]
+} {{{foo 1} enter} {}}
+
+test trace-24.2 {delete trace during leave trace} {
+ set info {}
+ trace add execution foo leave [list traceDelete foo]
+ foo 1
+ list $info [trace info execution foo]
+} {{{foo 1} 0 1 leave} {}}
+
+test trace-24.3 {delete trace during enter-leave trace} {
+ set info {}
+ trace add execution foo {enter leave} [list traceDelete foo]
+ foo 1
+ list $info [trace info execution foo]
+} {{{foo 1} enter} {}}
+
+test trace-24.4 {delete trace during all exec traces} {
+ set info {}
+ trace add execution foo {enter leave enterstep leavestep} [list traceDelete foo]
+ foo 1
+ list $info [trace info execution foo]
+} {{{foo 1} enter} {}}
+
+test trace-24.5 {delete trace during all exec traces except enter} {
+ set info {}
+ trace add execution foo {leave enterstep leavestep} [list traceDelete foo]
+ foo 1
+ list $info [trace info execution foo]
+} {{{set b 1} enterstep} {}}
+
+proc traceDelete {cmd args} {
+ rename $cmd {}
+ global info
+ set info $args
+}
+
+proc foo {a} {
+ set b $a
+}
+
+test trace-25.1 {delete command during enter trace} {
+ set info {}
+ trace add execution foo enter [list traceDelete foo]
+ catch {foo 1} err
+ list $err $info [trace info execution foo]
+} {{invalid command name "foo"} {{foo 1} enter} {unknown command "foo"}}
+
+proc foo {a} {
+ set b $a
+}
+
+test trace-25.2 {delete command during leave trace} {
+ set info {}
+ trace add execution foo leave [list traceDelete foo]
+ foo 1
+ list $info [trace info execution foo]
+} {{{foo 1} 0 1 leave} {unknown command "foo"}}
+
+proc foo {a} {
+ set b $a
+}
+
+test trace-25.3 {delete command during enter then leave trace} {
+ set info {}
+ trace add execution foo enter [list traceDelete foo]
+ trace add execution foo leave [list traceDelete foo]
+ catch {foo 1} err
+ list $err $info [trace info execution foo]
+} {{invalid command name "foo"} {{foo 1} enter} {unknown command "foo"}}
+
+proc foo {a} {
+ set b $a
+}
+proc traceExecute2 {args} {
+ global info
+ lappend info $args
+}
+
+# This shows the peculiar consequences of having two traces
+# at the same time: as well as tracing the procedure you want
+test trace-25.4 {order dependencies of two enter traces} {
+ set info {}
+ trace add execution foo enter [list traceExecute traceExecute]
+ trace add execution foo enter [list traceExecute2 traceExecute2]
+ catch {foo 1} err
+ trace remove execution foo enter [list traceExecute traceExecute]
+ trace remove execution foo enter [list traceExecute2 traceExecute2]
+ join [list $err [join $info \n] [trace info execution foo]] "\n"
+} {1
+traceExecute2 {foo 1} enter
+traceExecute {foo 1} enter
+}
+
+test trace-25.5 {order dependencies of two step traces} {
+ set info {}
+ trace add execution foo enterstep [list traceExecute traceExecute]
+ trace add execution foo enterstep [list traceExecute2 traceExecute2]
+ catch {foo 1} err
+ trace remove execution foo enterstep [list traceExecute traceExecute]
+ trace remove execution foo enterstep [list traceExecute2 traceExecute2]
+ join [list $err [join $info \n] [trace info execution foo]] "\n"
+} {1
+traceExecute2 {set b 1} enterstep
+traceExecute {set b 1} enterstep
+}
+
+# We don't want the result string (5th argument), or the results
+# will get unmanageable.
+proc tracePostExecute {args} {
+ global info
+ lappend info [concat [lrange $args 0 2] [lindex $args 4]]
+}
+proc tracePostExecute2 {args} {
+ global info
+ lappend info [concat [lrange $args 0 2] [lindex $args 4]]
+}
+
+test trace-25.6 {order dependencies of two leave traces} {
+ set info {}
+ trace add execution foo leave [list tracePostExecute tracePostExecute]
+ trace add execution foo leave [list tracePostExecute2 tracePostExecute2]
+ catch {foo 1} err
+ trace remove execution foo leave [list tracePostExecute tracePostExecute]
+ trace remove execution foo leave [list tracePostExecute2 tracePostExecute2]
+ join [list $err [join $info \n] [trace info execution foo]] "\n"
+} {1
+tracePostExecute {foo 1} 0 leave
+tracePostExecute2 {foo 1} 0 leave
+}
+
+test trace-25.7 {order dependencies of two leavestep traces} {
+ set info {}
+ trace add execution foo leavestep [list tracePostExecute tracePostExecute]
+ trace add execution foo leavestep [list tracePostExecute2 tracePostExecute2]
+ catch {foo 1} err
+ trace remove execution foo leavestep [list tracePostExecute tracePostExecute]
+ trace remove execution foo leavestep [list tracePostExecute2 tracePostExecute2]
+ join [list $err [join $info \n] [trace info execution foo]] "\n"
+} {1
+tracePostExecute {set b 1} 0 leavestep
+tracePostExecute2 {set b 1} 0 leavestep
+}
+
+proc foo {a} {
+ set b $a
+}
+
+proc traceDelete {cmd args} {
+ rename $cmd {}
+ global info
+ set info $args
+}
+
+test trace-25.8 {delete command during enter leave and enter/leave-step traces} {
+ set info {}
+ trace add execution foo enter [list traceDelete foo]
+ trace add execution foo leave [list traceDelete foo]
+ trace add execution foo enterstep [list traceDelete foo]
+ trace add execution foo leavestep [list traceDelete foo]
+ catch {foo 1} err
+ list $err $info [trace info execution foo]
+} {{invalid command name "foo"} {{foo 1} enter} {unknown command "foo"}}
+
+proc foo {a} {
+ set b $a
+}
+
+test trace-25.9 {delete command during enter leave and leavestep traces} {
+ set info {}
+ trace add execution foo enter [list traceDelete foo]
+ trace add execution foo leave [list traceDelete foo]
+ trace add execution foo leavestep [list traceDelete foo]
+ catch {foo 1} err
+ list $err $info [trace info execution foo]
+} {{invalid command name "foo"} {{foo 1} enter} {unknown command "foo"}}
+
+proc foo {a} {
+ set b $a
+}
+
+test trace-25.10 {delete command during leave and leavestep traces} {
+ set info {}
+ trace add execution foo leave [list traceDelete foo]
+ trace add execution foo leavestep [list traceDelete foo]
+ catch {foo 1} err
+ list $err $info [trace info execution foo]
+} {1 {{set b 1} 0 1 leavestep} {unknown command "foo"}}
+
+proc foo {a} {
+ set b $a
+}
+
+test trace-25.11 {delete command during enter and enterstep traces} {
+ set info {}
+ trace add execution foo enter [list traceDelete foo]
+ trace add execution foo enterstep [list traceDelete foo]
+ catch {foo 1} err
+ list $err $info [trace info execution foo]
+} {{invalid command name "foo"} {{foo 1} enter} {unknown command "foo"}}
+
+test trace-26.1 {trace targetCmd when invoked through an alias} {
+ proc foo {args} {
+ set b $args
+ }
+ set info {}
+ trace add execution foo enter [list traceExecute foo]
+ interp alias {} bar {} foo 1
+ bar 2
+ trace remove execution foo enter [list traceExecute foo]
+ set info
+} {{foo {foo 1 2} enter}}
+test trace-26.2 {trace targetCmd when invoked through an alias} {
+ proc foo {args} {
+ set b $args
+ }
+ set info {}
+ trace add execution foo enter [list traceExecute foo]
+ interp create child
+ interp alias child bar {} foo 1
+ child eval bar 2
+ interp delete child
+ trace remove execution foo enter [list traceExecute foo]
+ set info
+} {{foo {foo 1 2} enter}}
+
+test trace-27.1 {memory leak in rename trace (604609)} {
+ catch {rename bar {}}
+ proc foo {} {error foo}
+ trace add command foo rename {rename foo "" ;#}
+ rename foo bar
+ info commands foo
+} {}
+
+# Delete procedures when done, so we don't clash with other tests
+# (e.g. foobar will clash with 'unknown' tests).
+catch {rename foobar {}}
+catch {rename foo {}}
+catch {rename bar {}}
+
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/tcl/tests/unixFCmd.test b/tcl/tests/unixFCmd.test
index adc0c7f26bc..af5c405d32d 100644
--- a/tcl/tests/unixFCmd.test
+++ b/tcl/tests/unixFCmd.test
@@ -16,6 +16,11 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
namespace import -force ::tcltest::*
}
+# These tests really need to be run from a writable directory, which
+# it is assumed [temporaryDirectory] is.
+set oldcwd [pwd]
+cd [temporaryDirectory]
+
# Several tests require need to match results against the unix username
set user {}
if {$tcl_platform(platform) == "unix"} {
@@ -32,7 +37,7 @@ proc openup {path} {
testchmod 777 $path
if {[file isdirectory $path]} {
catch {
- foreach p [glob [file join $path *]] {
+ foreach p [glob -directory $path *] {
openup $p
}
}
@@ -43,7 +48,7 @@ proc cleanup {args} {
foreach p ". $args" {
set x ""
catch {
- set x [glob [file join $p tf*] [file join $p td*]]
+ set x [glob -directory $p tf* td*]
}
foreach file $x {
if {[catch {file delete -force -- $file}]} {
@@ -57,9 +62,9 @@ proc cleanup {args} {
test unixFCmd-1.1 {TclpRenameFile: EACCES} {unixOnly notRoot} {
cleanup
file mkdir td1/td2/td3
- exec chmod 000 td1/td2
+ file attributes td1/td2 -permissions 0000
set msg [list [catch {file rename td1/td2/td3 td2} msg] $msg]
- exec chmod 755 td1/td2
+ file attributes td1/td2 -permissions 0755
set msg
} {1 {error renaming "td1/td2/td3": permission denied}}
test unixFCmd-1.2 {TclpRenameFile: EEXIST} {unixOnly notRoot} {
@@ -118,13 +123,23 @@ test unixFCmd-1.9 {Checking EINTR Bug} {unixOnly notRoot nonPortable} {
test unixFCmd-2.1 {TclpCopyFile: target exists: lstat(dst) == 0} \
{unixOnly notRoot} {
cleanup
- exec touch tf1
- exec touch tf2
+ close [open tf1 a]
+ close [open tf2 a]
file copy -force tf1 tf2
} {}
-test unixFCmd-2.2 {TclpCopyFile: src is symlink} {unixOnly notRoot} {
+test unixFCmd-2.2.1 {TclpCopyFile: src is symlink} {unixOnly notRoot dontCopyLinks} {
+ # copying links should end up with real files
cleanup
- exec ln -s tf1 tf2
+ close [open tf1 a]
+ file link -symbolic tf2 tf1
+ file copy tf2 tf3
+ file type tf3
+} {file}
+test unixFCmd-2.2.2 {TclpCopyFile: src is symlink} {unixOnly notRoot} {
+ # copying links should end up with the links copied
+ cleanup
+ close [open tf1 a]
+ file link -symbolic tf2 tf1
file copy tf2 tf3
file type tf3
} {link}
@@ -147,11 +162,11 @@ test unixFCmd-2.4 {TclpCopyFile: src is fifo} {unixOnly notRoot} {
} {1}
test unixFCmd-2.5 {TclpCopyFile: copy attributes} {unixOnly notRoot} {
cleanup
- exec touch tf1
- exec chmod 472 tf1
+ close [open tf1 a]
+ file attributes tf1 -permissions 0472
file copy tf1 tf2
- string range [exec ls -l tf2] 0 9
-} {-r--rwx-w-}
+ file attributes tf2 -permissions
+} 00472 ;# i.e. perms field of [exec ls -l tf2] is -r--rwx-w-
test unixFCmd-3.1 {CopyFile not done} {emptyTest unixOnly notRoot} {
} {}
@@ -277,22 +292,20 @@ test unixFCmd-17.3 {SetPermissionsAttribute} {unixOnly notRoot} {
close [open foo.test w]
set ::i 4
-proc permcheck {permstr expected} {
- test unixFCmd-17.[incr ::i] {SetPermissionsAttribute} {unixOnly notRoot} \
- [subst {
+proc permcheck {testnum permstr expected} {
+ test $testnum {SetPermissionsAttribute} {unixOnly notRoot} {
file attributes foo.test -permissions $permstr
file attributes foo.test -permissions
- }
- ] $expected
+ } $expected
}
-permcheck rwxrwxrwx 00777
-permcheck r--r---w- 00442
-permcheck 0 00000
-permcheck u+rwx,g+r 00740
-permcheck u-w 00540
-permcheck o+rwx 00547
-permcheck --x--x--x 00111
-permcheck a+rwx 00777
+permcheck unixFCmd-17.4 rwxrwxrwx 00777
+permcheck unixFCmd-17.5 r--r---w- 00442
+permcheck unixFCmd-17.6 0 00000
+permcheck unixFCmd-17.7 u+rwx,g+r 00740
+permcheck unixFCmd-17.8 u-w 00540
+permcheck unixFCmd-17.9 o+rwx 00547
+permcheck unixFCmd-17.10 --x--x--x 00111
+permcheck unixFCmd-17.11 a+rwx 00777
file delete -force -- foo.test
test unixFCmd-18.1 {Unix pwd} {nonPortable unixOnly notRoot} {
@@ -302,28 +315,16 @@ test unixFCmd-18.1 {Unix pwd} {nonPortable unixOnly notRoot} {
set nd $cd/tstdir
file mkdir $nd
cd $nd
- exec chmod 000 $nd
+ file attributes $nd -permissions 0000
set r [list [catch {pwd} res] [string range $res 0 36]];
cd $cd;
- exec chmod 755 $nd
+ file attributes $nd -permissions 0755
file delete $nd
set r
} {1 {error getting working directory name:}}
# cleanup
cleanup
+cd $oldcwd
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tcl/tests/unixFile.test b/tcl/tests/unixFile.test
index d9d273a70b7..14dd6a96137 100644
--- a/tcl/tests/unixFile.test
+++ b/tcl/tests/unixFile.test
@@ -23,12 +23,14 @@ if {[info commands testobj] == {}} {
return
}
+set oldpwd [pwd]
+cd [temporaryDirectory]
+
catch {
set oldPath $env(PATH)
- close [open junk w]
- file attributes junk -perm 0777
+ file attributes [makeFile "" junk] -perm 0777
}
-set absPath [file join [pwd] junk]
+set absPath [file join [temporaryDirectory] junk]
test unixFile-1.1 {Tcl_FindExecutable} {unixOnly} {
set env(PATH) ""
@@ -61,19 +63,7 @@ test unixFile-1.7 {Tcl_FindExecutable} {unixOnly} {
# cleanup
catch {set env(PATH) $oldPath}
-file delete junk
+removeFile junk
+cd $oldpwd
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tcl/tests/unixInit.test b/tcl/tests/unixInit.test
index 40068ac038f..1cb9d8d21e2 100644
--- a/tcl/tests/unixInit.test
+++ b/tcl/tests/unixInit.test
@@ -12,10 +12,8 @@
#
# RCS: @(#) $Id$
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
- namespace import -force ::tcltest::*
-}
+package require tcltest 2
+namespace import -force ::tcltest::*
if {[info exists env(TCL_LIBRARY)]} {
set oldlibrary $env(TCL_LIBRARY)
@@ -24,32 +22,20 @@ if {[info exists env(TCL_LIBRARY)]} {
catch {set oldlang $env(LANG)}
set env(LANG) C
-# Some tests will fail if they are run on a machine that doesn't have
-# this Tcl version installed (as opposed to built) on it.
-if {[catch {
- set f [open "|[list $::tcltest::tcltest exit]" w+]
- exec kill -PIPE [pid $f]
- close $f
-}]} {
- set ::tcltest::testConstraints(installedTcl) 0
-} else {
- set ::tcltest::testConstraints(installedTcl) 1
-}
-
-test unixInit-1.1 {TclpInitPlatform: ignore SIGPIPE} {unixOnly installedTcl} {
+test unixInit-1.1 {TclpInitPlatform: ignore SIGPIPE} {unixOnly stdio} {
set x {}
# Watch out for a race condition here. If tcltest is too slow to start
# then we'll kill it before it has a chance to set up its signal handler.
- set f [open "|[list $::tcltest::tcltest]" w+]
+ set f [open "|[list [interpreter]]" w+]
puts $f "puts hi"
flush $f
gets $f
exec kill -PIPE [pid $f]
lappend x [catch {close $f}]
- set f [open "|[list $::tcltest::tcltest]" w+]
+ set f [open "|[list [interpreter]]" w+]
puts $f "puts hi"
flush $f
gets $f
@@ -59,8 +45,59 @@ test unixInit-1.1 {TclpInitPlatform: ignore SIGPIPE} {unixOnly installedTcl} {
set x
} {0 1}
-proc getlibpath "{program [list $::tcltest::tcltest]}" {
- set f [open "|$program" w+]
+# This test is really a test of code in tclUnixChan.c, but the
+# channels are set up as part of initialisation of the interpreter so
+# the test seems to me to fit here as well as anywhere else.
+test unixInit-1.2 {initialisation: standard channel type deduction} {unixOnly stdio} {
+ # pipe1 is a connection to a server that reports what port it
+ # starts on, and delivers a constant string to the first client to
+ # connect to that port before exiting.
+ set pipe1 [open "|[list [interpreter]]" r+]
+ puts $pipe1 {
+ proc accept {channel host port} {
+ puts $channel {puts [fconfigure stdin -peername]; exit}
+ close $channel
+ exit
+ }
+ puts [fconfigure [socket -server accept 0] -sockname]
+ vwait forever \
+ }
+ # Note the backslash above; this is important to make sure that the
+ # whole string is read before an [exit] can happen...
+ flush $pipe1
+ set port [lindex [gets $pipe1] 2]
+ set sock [socket localhost $port]
+ # pipe2 is a connection to a Tcl interpreter that takes its orders
+ # from the socket we hand it (i.e. the server we create above.)
+ # These orders will tell it to print out the details about the
+ # socket it is taking instructions from, hopefully identifying it
+ # as a socket. Which is what this test is all about.
+ set pipe2 [open "|[list [interpreter] <@$sock]" r]
+ set result [gets $pipe2]
+
+ # Clear any pending data; stops certain kinds of (non-important) errors
+ fconfigure $pipe1 -blocking 0; gets $pipe1
+ fconfigure $pipe2 -blocking 0; gets $pipe2
+
+ # Close the pipes and the socket.
+ close $pipe2
+ close $pipe1
+ catch {close $sock}
+
+ # Can't use normal comparison, as hostname varies due to some
+ # installations having a messed up /etc/hosts file.
+ if {
+ [string equal 127.0.0.1 [lindex $result 0]] &&
+ [string equal $port [lindex $result 2]]
+ } then {
+ subst "OK"
+ } else {
+ subst "Expected: `[list 127.0.0.1 localhost $port]', Got `$result'"
+ }
+} {OK}
+
+proc getlibpath [list [list program [interpreter]]] {
+ set f [open "|[list $program]" w+]
fconfigure $f -buffering none
puts $f {puts $tcl_libPath; exit}
set path [gets $f]
@@ -70,8 +107,7 @@ proc getlibpath "{program [list $::tcltest::tcltest]}" {
# Some tests require the testgetdefenc command
-set ::tcltest::testConstraints(testgetdefenc) \
- [expr {[info commands testgetdefenc] != {}}]
+testConstraint testgetdefenc [llength [info commands testgetdefenc]]
test unixInit-2.0 {TclpInitLibraryPath: setting tclDefaultEncodingDir} \
{unixOnly testgetdefenc} {
@@ -82,23 +118,19 @@ test unixInit-2.0 {TclpInitLibraryPath: setting tclDefaultEncodingDir} \
set path
} {slappy}
test unixInit-2.1 {TclpInitLibraryPath: value of installLib, developLib} \
- {unixOnly installedTcl} {
+ {unixOnly stdio} {
set path [getlibpath]
set installLib lib/tcl[info tclversion]
- if {[string match {*[ab]*} [info patchlevel]]} {
- set developLib tcl[info patchlevel]/library
- } else {
- set developLib tcl[info tclversion]/library
- }
- set prefix [file dirname [file dirname $::tcltest::tcltest]]
+ set developLib tcl[info patchlevel]/library
+ set prefix [file dirname [file dirname [interpreter]]]
set x {}
lappend x [string compare [lindex $path 0] $prefix/$installLib]
lappend x [string compare [lindex $path 4] [file dirname $prefix]/$developLib]
set x
} {0 0}
-test unixInit-2.2 {TclpInitLibraryPath: TCL_LIBRARY} {unixOnly installedTcl} {
+test unixInit-2.2 {TclpInitLibraryPath: TCL_LIBRARY} {unixOnly stdio} {
# ((str != NULL) && (str[0] != '\0'))
set env(TCL_LIBRARY) sparkly
@@ -108,7 +140,7 @@ test unixInit-2.2 {TclpInitLibraryPath: TCL_LIBRARY} {unixOnly installedTcl} {
lindex $path 0
} "sparkly"
test unixInit-2.3 {TclpInitLibraryPath: TCL_LIBRARY wrong version} \
- {unixOnly installedTcl} {
+ {unixOnly stdio} {
# ((pathc > 0) && (strcasecmp(installLib + 4, pathv[pathc - 1]) != 0))
set env(TCL_LIBRARY) /a/b/tcl1.7
@@ -118,7 +150,7 @@ test unixInit-2.3 {TclpInitLibraryPath: TCL_LIBRARY wrong version} \
lrange $path 0 1
} [list /a/b/tcl1.7 /a/b/tcl[info tclversion]]
test unixInit-2.4 {TclpInitLibraryPath: TCL_LIBRARY: INTL} \
- {unixOnly installedTcl} {
+ {unixOnly stdio} {
# Child process translates env variable from native encoding.
set env(TCL_LIBRARY) "\xa7"
@@ -133,27 +165,113 @@ test unixInit-2.5 {TclpInitLibraryPath: compiled-in library path} \
# cannot test
} {}
test unixInit-2.6 {TclpInitLibraryPath: executable relative} \
- {unixOnly installedTcl} {
- file delete -force /tmp/sparkly
- file mkdir /tmp/sparkly/bin
- file copy $::tcltest::tcltest /tmp/sparkly/bin/tcltest
+ {unixOnly stdio} {
+ makeDirectory tmp
+ makeDirectory [file join tmp sparkly]
+ makeDirectory [file join tmp sparkly bin]
+ file copy [interpreter] [file join [temporaryDirectory] tmp sparkly \
+ bin tcltest]
+ makeDirectory [file join tmp sparkly lib]
+ makeDirectory [file join tmp sparkly lib tcl[info tclversion]]
+ makeFile {} [file join tmp sparkly lib tcl[info tclversion] init.tcl]
- file mkdir /tmp/sparkly/lib/tcl[info tclversion]
- close [open /tmp/sparkly/lib/tcl[info tclversion]/init.tcl w]
-
- set x [lrange [getlibpath /tmp/sparkly/bin/tcltest] 0 1]
- file delete -force /tmp/sparkly
+ set x [lrange [getlibpath [file join [temporaryDirectory] tmp sparkly \
+ bin tcltest]] 0 1]
+ removeFile [file join tmp sparkly lib tcl[info tclversion] init.tcl]
+ removeDirectory [file join tmp sparkly lib tcl[info tclversion]]
+ removeDirectory [file join tmp sparkly lib]
+ removeDirectory [file join tmp sparkly bin]
+ removeDirectory [file join tmp sparkly]
+ removeDirectory tmp
set x
-} [list /tmp/sparkly/lib/tcl[info tclversion] /tmp/lib/tcl[info tclversion]]
+} [list [temporaryDirectory]/tmp/sparkly/lib/tcl[info tclversion] [temporaryDirectory]/tmp/lib/tcl[info tclversion]]
test unixInit-2.7 {TclpInitLibraryPath: compiled-in library path} \
{emptyTest unixOnly} {
# would need test command to get defaultLibDir and compare it to
# [lindex $auto_path end]
} {}
-test unixInit-3.1 {TclpSetInitialEncodings} {unixOnly installedTcl} {
+#
+# The following two tests write to the directory /tmp/sparkly instead
+# of to [temporaryDirectory]. This is because the failures tested by
+# these tests need paths near the "root" of the file system to present
+# themselves.
+#
+testConstraint noSparkly [expr {![file exists [file join /tmp sparkly]]}]
+testConstraint noTmpInstall [expr {![file exists \
+ [file join /tmp lib tcl[info tclversion]]]}]
+test unixInit-2.8 {TclpInitLibraryPath: all absolute pathtype} {unix noSparkly noTmpInstall} {
+ # Checking for Bug 219416
+ # When a program that embeds the Tcl library, like tcltest, is
+ # installed near the "root" of the file system, there was a problem
+ # constructing directories relative to the executable. When a
+ # relative ".." went past the root, relative path names were created
+ # rather than absolute pathnames. In some cases, accessing past the
+ # root caused memory access violations too.
+ #
+ # The bug is now fixed, but here we check for it by making sure that
+ # the directories constructed relative to the executable are all
+ # absolute pathnames, even when the executable is installed near
+ # the root of the filesystem.
+ #
+ # The only directory near the root we are likely to have write access
+ # to is /tmp.
+ file delete -force /tmp/sparkly
+ file delete -force /tmp/lib/tcl[info tclversion]
+ file mkdir /tmp/sparkly
+ file copy [interpreter] /tmp/sparkly/tcltest
+
+ # Keep any existing /tmp/lib directory
+ set deletelib 1
+ if {[file exists /tmp/lib]} {
+ if {[file isdirectory /tmp/lib]} {
+ set deletelib 0
+ } else {
+ file delete -force /tmp/lib
+ }
+ }
+
+ # For a successful Tcl_Init, we need a [source]-able init.tcl in
+ # ../lib/tcl$version relative to the executable.
+ file mkdir /tmp/lib/tcl[info tclversion]
+ close [open /tmp/lib/tcl[info tclversion]/init.tcl w]
+
+ # Check that all directories in the library path are absolute pathnames
+ set allAbsolute 1
+ foreach dir [getlibpath /tmp/sparkly/tcltest] {
+ set allAbsolute [expr {$allAbsolute \
+ && [string equal absolute [file pathtype $dir]]}]
+ }
+
+ # Clean up temporary installation
+ file delete -force /tmp/sparkly
+ file delete -force /tmp/lib/tcl[info tclversion]
+ if {$deletelib} {file delete -force /tmp/lib}
+ set allAbsolute
+} 1
+testConstraint noTmpBuild [expr {![file exists [file join /tmp library]]}]
+test unixInit-2.9 {TclpInitLibraryPath: paths relative to executable} {unix noSparkly noTmpBuild} {
+ # Checking for Bug 438014
+ file delete -force /tmp/sparkly
+ file delete -force /tmp/library
+ file mkdir /tmp/sparkly
+ file copy [interpreter] /tmp/sparkly/tcltest
+
+ file mkdir /tmp/library/
+ close [open /tmp/library/init.tcl w]
+
+ set x [lrange [getlibpath /tmp/sparkly/tcltest] 0 4]
+
+ file delete -force /tmp/sparkly
+ file delete -force /tmp/library
+ set x
+} [list /tmp/lib/tcl[info tclversion] /lib/tcl[info tclversion] \
+ /tmp/library /library /tcl[info patchlevel]/library]
+test unixInit-3.1 {TclpSetInitialEncodings} -constraints {
+ unixOnly stdio
+} -body {
set env(LANG) C
- set f [open "|[list $::tcltest::tcltest]" w+]
+ set f [open "|[list [interpreter]]" w+]
fconfigure $f -buffering none
puts $f {puts [encoding system]; exit}
set enc [gets $f]
@@ -161,13 +279,13 @@ test unixInit-3.1 {TclpSetInitialEncodings} {unixOnly installedTcl} {
unset env(LANG)
set enc
-} {iso8859-1}
-test unixInit-3.2 {TclpSetInitialEncodings} {unixOnly installedTcl} {
+} -match regexp -result ^iso8859-15?$
+test unixInit-3.2 {TclpSetInitialEncodings} {unixOnly stdio} {
set env(LANG) japanese
catch {set oldlc_all $env(LC_ALL)}
set env(LC_ALL) japanese
- set f [open "|[list $::tcltest::tcltest]" w+]
+ set f [open "|[list [interpreter]]" w+]
fconfigure $f -buffering none
puts $f {puts [encoding system]; exit}
set enc [gets $f]
@@ -176,11 +294,14 @@ test unixInit-3.2 {TclpSetInitialEncodings} {unixOnly installedTcl} {
unset env(LC_ALL)
catch {set env(LC_ALL) $oldlc_all}
- switch $tcl_platform(os) {
- HP-UX {set expectedEncoding shiftjis}
- default {set expectedEncoding euc-jp}
+ set validEncodings [list euc-jp]
+ if {[string match HP-UX $tcl_platform(os)]} {
+ # Some older HP-UX systems need us to accept this as valid
+ # Bug 453883 reports that newer HP-UX systems report euc-jp
+ # like everybody else.
+ lappend validEncodings shiftjis
}
- string compare $enc $expectedEncoding
+ expr {[lsearch -exact $validEncodings $enc] < 0}
} 0
test unixInit-4.1 {TclpSetVariables} {unixOnly} {
@@ -197,13 +318,13 @@ test unixInit-5.1 {Tcl_Init} {emptyTest unixOnly} {
test unixInit-6.1 {Tcl_SourceRCFile} {emptyTest unixOnly} {
} {}
-
+
# cleanup
if {[info exists oldlibrary]} {
set env(TCL_LIBRARY) $oldlibrary
}
-catch {unset env(LANG); set env(LANG) $oldlang}
+catch {unset env(LANG)}
+catch {set env(LANG) $oldlang}
::tcltest::cleanupTests
return
-
diff --git a/tcl/tests/unixNotfy.test b/tcl/tests/unixNotfy.test
index e2fe25bd3c6..91a22cabc8f 100644
--- a/tcl/tests/unixNotfy.test
+++ b/tcl/tests/unixNotfy.test
@@ -36,7 +36,7 @@ set ::tcltest::testConstraints(testthread) \
test unixNotfy-1.1 {Tcl_DeleteFileHandler} {unixOnly && !testthread} {
catch {vwait x}
- set f [open foo w]
+ set f [open [makeFile "" foo] w]
fileevent $f writable {set x 1}
vwait x
close $f
@@ -44,8 +44,8 @@ test unixNotfy-1.1 {Tcl_DeleteFileHandler} {unixOnly && !testthread} {
} {1 {can't wait for variable "x": would wait forever}}
test unixNotfy-1.2 {Tcl_DeleteFileHandler} {unixOnly && !testthread} {
catch {vwait x}
- set f1 [open foo w]
- set f2 [open foo2 w]
+ set f1 [open [makeFile "" foo] w]
+ set f2 [open [makeFile "" foo2] w]
fileevent $f1 writable {set x 1}
fileevent $f2 writable {set y 1}
vwait x
@@ -58,7 +58,7 @@ test unixNotfy-1.2 {Tcl_DeleteFileHandler} {unixOnly && !testthread} {
test unixNotfy-2.1 {Tcl_DeleteFileHandler} {unixOnly testthread} {
update
- set f [open foo w]
+ set f [open [makeFile "" foo] w]
fileevent $f writable {set x 1}
vwait x
close $f
@@ -68,10 +68,10 @@ test unixNotfy-2.1 {Tcl_DeleteFileHandler} {unixOnly testthread} {
vwait x
set x
} {ok}
-test unixNotfy-1.2 {Tcl_DeleteFileHandler} {unixOnly testthread} {
+test unixNotfy-2.2 {Tcl_DeleteFileHandler} {unixOnly testthread} {
update
- set f1 [open foo w]
- set f2 [open foo2 w]
+ set f1 [open [makeFile "" foo] w]
+ set f2 [open [makeFile "" foo2] w]
fileevent $f1 writable {set x 1}
fileevent $f2 writable {set y 1}
vwait x
@@ -86,22 +86,6 @@ test unixNotfy-1.2 {Tcl_DeleteFileHandler} {unixOnly testthread} {
} {ok}
-
# cleanup
-file delete foo
-file delete foo2
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tcl/tests/unknown.test b/tcl/tests/unknown.test
index 5a2bc4c68aa..c0bafa79e47 100644
--- a/tcl/tests/unknown.test
+++ b/tcl/tests/unknown.test
@@ -77,4 +77,3 @@ return
-
diff --git a/tcl/tests/uplevel.test b/tcl/tests/uplevel.test
index 45af2f04200..bff4cd5df3a 100644
--- a/tcl/tests/uplevel.test
+++ b/tcl/tests/uplevel.test
@@ -112,6 +112,21 @@ a2
test uplevel-5.1 {info level} {set x} 1
test uplevel-5.2 {info level} {set y} a3
+namespace eval ns1 {
+ proc set args {return ::ns1}
+}
+proc a2 {} {
+ uplevel {set x ::}
+}
+test uplevel-6.1 {uplevel and shadowed cmds} {
+ set res [namespace eval ns1 a2]
+ lappend res [namespace eval ns2 a2]
+ lappend res [namespace eval ns1 a2]
+ namespace eval ns1 {rename set {}}
+ lappend res [namespace eval ns1 a2]
+} {::ns1 :: ::ns1 ::}
+
+
# cleanup
::tcltest::cleanupTests
return
@@ -127,4 +142,3 @@ return
-
diff --git a/tcl/tests/upvar.test b/tcl/tests/upvar.test
index 54d6af29f1e..8ad66388091 100644
--- a/tcl/tests/upvar.test
+++ b/tcl/tests/upvar.test
@@ -415,4 +415,3 @@ return
-
diff --git a/tcl/tests/utf.test b/tcl/tests/utf.test
index 4dcfdae4a34..1e4321ed4f2 100644
--- a/tcl/tests/utf.test
+++ b/tcl/tests/utf.test
@@ -257,7 +257,13 @@ test utf-20.1 {TclUniCharNcmp} {
} {}
test utf-21.1 {TclUniCharIsAlnum} {
-} {}
+ # this returns 1 with Unicode 3 compliance
+ string is alnum \u1040\u021f
+} {1}
+test utf-21.2 {unicode alnum char in regc_locale.c} {
+ # this returns 1 with Unicode 3 compliance
+ list [regexp {^[[:alnum:]]+$} \u1040\u021f] [regexp {^\w+$} \u1040\u021f]
+} {1 1}
test utf-22.1 {TclUniCharIsWordChar} {
string wordend "xyz123_bar fg" 0
@@ -265,15 +271,33 @@ test utf-22.1 {TclUniCharIsWordChar} {
test utf-22.2 {TclUniCharIsWordChar} {
string wordend "x\u5080z123_bar\u203c fg" 0
} 10
-
+
test utf-23.1 {TclUniCharIsAlpha} {
-} {}
+ # this returns 1 with Unicode 3 compliance
+ string is alpha \u021f
+} {1}
+test utf-23.2 {unicode alpha char in regc_locale.c} {
+ # this returns 1 with Unicode 3 compliance
+ regexp {^[[:alpha:]]+$} \u021f
+} {1}
test utf-24.1 {TclUniCharIsDigit} {
-} {}
-
-test utf-24.2 {TclUniCharIsSpace} {
-} {}
+ # this returns 1 with Unicode 3 compliance
+ string is digit \u1040
+} {1}
+test utf-24.2 {unicode digit char in regc_locale.c} {
+ # this returns 1 with Unicode 3 compliance
+ list [regexp {^[[:digit:]]+$} \u1040] [regexp {^\d+$} \u1040]
+} {1 1}
+
+test utf-24.1 {TclUniCharIsSpace} {
+ # this returns 1 with Unicode 3 compliance
+ string is space \u1680
+} {1}
+test utf-24.2 {unicode space char in regc_locale.c} {
+ # this returns 1 with Unicode 3 compliance
+ list [regexp {^[[:space:]]+$} \u1680] [regexp {^\s+$} \u1680]
+} {1 1}
# cleanup
::tcltest::cleanupTests
@@ -291,4 +315,3 @@ return
-
diff --git a/tcl/tests/util.test b/tcl/tests/util.test
index ff3c1c08769..23c1c145209 100644
--- a/tcl/tests/util.test
+++ b/tcl/tests/util.test
@@ -62,181 +62,189 @@ test util-4.4 {Tcl_ConcatObj - backslash-space at end of argument} {
test util-4.5 {Tcl_ConcatObj - backslash-space at end of argument} {
concat a { } c
} {a c}
-
+test util-4.6 {Tcl_ConcatObj - utf-8 sequence with "whitespace" char} {
+ # Check for Bug #227512. If this violates C isspace, then it returns \xc3.
+ concat \xe0
+} \xe0
+
+proc Wrapper_Tcl_StringMatch {pattern string} {
+ # Forces use of Tcl_StringMatch, not Tcl_UniCharCaseMatch
+ switch -glob -- $string $pattern {return 1} default {return 0}
+}
test util-5.1 {Tcl_StringMatch} {
- string match ab*c abc
+ Wrapper_Tcl_StringMatch ab*c abc
} 1
test util-5.2 {Tcl_StringMatch} {
- string match ab**c abc
+ Wrapper_Tcl_StringMatch ab**c abc
} 1
test util-5.3 {Tcl_StringMatch} {
- string match ab* abcdef
+ Wrapper_Tcl_StringMatch ab* abcdef
} 1
test util-5.4 {Tcl_StringMatch} {
- string match *c abc
+ Wrapper_Tcl_StringMatch *c abc
} 1
test util-5.5 {Tcl_StringMatch} {
- string match *3*6*9 0123456789
+ Wrapper_Tcl_StringMatch *3*6*9 0123456789
} 1
test util-5.6 {Tcl_StringMatch} {
- string match *3*6*9 01234567890
+ Wrapper_Tcl_StringMatch *3*6*9 01234567890
} 0
test util-5.7 {Tcl_StringMatch: UTF-8} {
- string match *u \u4e4fu
+ Wrapper_Tcl_StringMatch *u \u4e4fu
} 1
test util-5.8 {Tcl_StringMatch} {
- string match a?c abc
+ Wrapper_Tcl_StringMatch a?c abc
} 1
test util-5.9 {Tcl_StringMatch: UTF-8} {
# skip one character in string
- string match a?c a\u4e4fc
+ Wrapper_Tcl_StringMatch a?c a\u4e4fc
} 1
test util-5.10 {Tcl_StringMatch} {
- string match a??c abc
+ Wrapper_Tcl_StringMatch a??c abc
} 0
test util-5.11 {Tcl_StringMatch} {
- string match ?1??4???8? 0123456789
+ Wrapper_Tcl_StringMatch ?1??4???8? 0123456789
} 1
test util-5.12 {Tcl_StringMatch} {
- string match {[abc]bc} abc
+ Wrapper_Tcl_StringMatch {[abc]bc} abc
} 1
test util-5.13 {Tcl_StringMatch: UTF-8} {
# string += Tcl_UtfToUniChar(string, &ch);
- string match "\[\u4e4fxy\]bc" "\u4e4fbc"
+ Wrapper_Tcl_StringMatch "\[\u4e4fxy\]bc" "\u4e4fbc"
} 1
test util-5.14 {Tcl_StringMatch} {
# if ((*pattern == ']') || (*pattern == '\0'))
# badly formed pattern
- string match {[]} {[]}
+ Wrapper_Tcl_StringMatch {[]} {[]}
} 0
test util-5.15 {Tcl_StringMatch} {
# if ((*pattern == ']') || (*pattern == '\0'))
# badly formed pattern
- string match {[} {[}
+ Wrapper_Tcl_StringMatch {[} {[}
} 0
test util-5.16 {Tcl_StringMatch} {
- string match {a[abc]c} abc
+ Wrapper_Tcl_StringMatch {a[abc]c} abc
} 1
test util-5.17 {Tcl_StringMatch: UTF-8} {
# pattern += Tcl_UtfToUniChar(pattern, &endChar);
# get 1 UTF-8 character
- string match "a\[a\u4e4fc]c" "a\u4e4fc"
+ Wrapper_Tcl_StringMatch "a\[a\u4e4fc]c" "a\u4e4fc"
} 1
test util-5.18 {Tcl_StringMatch: UTF-8} {
# pattern += Tcl_UtfToUniChar(pattern, &endChar);
# proper advance: wrong answer would match on UTF trail byte of \u4e4f
- string match {a[a\u4e4fc]c} [bytestring a\u008fc]
+ Wrapper_Tcl_StringMatch {a[a\u4e4fc]c} [bytestring a\u008fc]
} 0
test util-5.19 {Tcl_StringMatch: UTF-8} {
# pattern += Tcl_UtfToUniChar(pattern, &endChar);
# proper advance.
- string match {a[a\u4e4fc]c} "acc"
+ Wrapper_Tcl_StringMatch {a[a\u4e4fc]c} "acc"
} 1
test util-5.20 {Tcl_StringMatch} {
- string match {a[xyz]c} abc
+ Wrapper_Tcl_StringMatch {a[xyz]c} abc
} 0
test util-5.21 {Tcl_StringMatch} {
- string match {12[2-7]45} 12345
+ Wrapper_Tcl_StringMatch {12[2-7]45} 12345
} 1
test util-5.22 {Tcl_StringMatch: UTF-8 range} {
- string match "\[\u4e00-\u4e4f]" "0"
+ Wrapper_Tcl_StringMatch "\[\u4e00-\u4e4f]" "0"
} 0
test util-5.23 {Tcl_StringMatch: UTF-8 range} {
- string match "\[\u4e00-\u4e4f]" "\u4e33"
+ Wrapper_Tcl_StringMatch "\[\u4e00-\u4e4f]" "\u4e33"
} 1
test util-5.24 {Tcl_StringMatch: UTF-8 range} {
- string match "\[\u4e00-\u4e4f]" "\uff08"
+ Wrapper_Tcl_StringMatch "\[\u4e00-\u4e4f]" "\uff08"
} 0
test util-5.25 {Tcl_StringMatch} {
- string match {12[ab2-4cd]45} 12345
+ Wrapper_Tcl_StringMatch {12[ab2-4cd]45} 12345
} 1
test util-5.26 {Tcl_StringMatch} {
- string match {12[ab2-4cd]45} 12b45
+ Wrapper_Tcl_StringMatch {12[ab2-4cd]45} 12b45
} 1
test util-5.27 {Tcl_StringMatch} {
- string match {12[ab2-4cd]45} 12d45
+ Wrapper_Tcl_StringMatch {12[ab2-4cd]45} 12d45
} 1
test util-5.28 {Tcl_StringMatch} {
- string match {12[ab2-4cd]45} 12145
+ Wrapper_Tcl_StringMatch {12[ab2-4cd]45} 12145
} 0
test util-5.29 {Tcl_StringMatch} {
- string match {12[ab2-4cd]45} 12545
+ Wrapper_Tcl_StringMatch {12[ab2-4cd]45} 12545
} 0
test util-5.30 {Tcl_StringMatch: forwards range} {
- string match {[k-w]} "z"
+ Wrapper_Tcl_StringMatch {[k-w]} "z"
} 0
test util-5.31 {Tcl_StringMatch: forwards range} {
- string match {[k-w]} "w"
+ Wrapper_Tcl_StringMatch {[k-w]} "w"
} 1
test util-5.32 {Tcl_StringMatch: forwards range} {
- string match {[k-w]} "r"
+ Wrapper_Tcl_StringMatch {[k-w]} "r"
} 1
test util-5.33 {Tcl_StringMatch: forwards range} {
- string match {[k-w]} "k"
+ Wrapper_Tcl_StringMatch {[k-w]} "k"
} 1
test util-5.34 {Tcl_StringMatch: forwards range} {
- string match {[k-w]} "a"
+ Wrapper_Tcl_StringMatch {[k-w]} "a"
} 0
test util-5.35 {Tcl_StringMatch: reverse range} {
- string match {[w-k]} "z"
+ Wrapper_Tcl_StringMatch {[w-k]} "z"
} 0
test util-5.36 {Tcl_StringMatch: reverse range} {
- string match {[w-k]} "w"
+ Wrapper_Tcl_StringMatch {[w-k]} "w"
} 1
test util-5.37 {Tcl_StringMatch: reverse range} {
- string match {[w-k]} "r"
+ Wrapper_Tcl_StringMatch {[w-k]} "r"
} 1
test util-5.38 {Tcl_StringMatch: reverse range} {
- string match {[w-k]} "k"
+ Wrapper_Tcl_StringMatch {[w-k]} "k"
} 1
test util-5.39 {Tcl_StringMatch: reverse range} {
- string match {[w-k]} "a"
+ Wrapper_Tcl_StringMatch {[w-k]} "a"
} 0
test util-5.40 {Tcl_StringMatch: skip correct number of ']'} {
- string match {[A-]x} Ax
+ Wrapper_Tcl_StringMatch {[A-]x} Ax
} 0
test util-5.41 {Tcl_StringMatch: skip correct number of ']'} {
- string match {[A-]]x} Ax
+ Wrapper_Tcl_StringMatch {[A-]]x} Ax
} 1
test util-5.42 {Tcl_StringMatch: skip correct number of ']'} {
- string match {[A-]]x} \ue1x
+ Wrapper_Tcl_StringMatch {[A-]]x} \ue1x
} 0
test util-5.43 {Tcl_StringMatch: skip correct number of ']'} {
- string match \[A-]\ue1]x \ue1x
+ Wrapper_Tcl_StringMatch \[A-]\ue1]x \ue1x
} 1
test util-5.44 {Tcl_StringMatch: skip correct number of ']'} {
- string match {[A-]h]x} hx
+ Wrapper_Tcl_StringMatch {[A-]h]x} hx
} 1
test util-5.45 {Tcl_StringMatch} {
# if (*pattern == '\0')
# badly formed pattern, still treats as a set
- string match {[a} a
+ Wrapper_Tcl_StringMatch {[a} a
} 1
test util-5.46 {Tcl_StringMatch} {
- string match {a\*b} a*b
+ Wrapper_Tcl_StringMatch {a\*b} a*b
} 1
test util-5.47 {Tcl_StringMatch} {
- string match {a\*b} ab
+ Wrapper_Tcl_StringMatch {a\*b} ab
} 0
test util-5.48 {Tcl_StringMatch} {
- string match {a\*\?\[\]\\\x} "a*?\[\]\\x"
+ Wrapper_Tcl_StringMatch {a\*\?\[\]\\\x} "a*?\[\]\\x"
} 1
test util-5.49 {Tcl_StringMatch} {
- string match ** ""
+ Wrapper_Tcl_StringMatch ** ""
} 1
test util-5.50 {Tcl_StringMatch} {
- string match *. ""
+ Wrapper_Tcl_StringMatch *. ""
} 0
test util-5.51 {Tcl_StringMatch} {
- string match "" ""
+ Wrapper_Tcl_StringMatch "" ""
} 1
test util-6.1 {Tcl_PrintDouble - using tcl_precision} {
@@ -290,19 +298,16 @@ test util-7.4 {TclPrecTraceProc - write traces, bogus values} {
set tcl_precision 12
+# This test always succeeded in the C locale anyway...
+test util-8.1 {TclNeedSpace - correct UTF8 handling} {
+ interp create \u5420
+ interp create [list \u5420 foo]
+ interp alias {} fooset [list \u5420 foo] set
+ set result [interp target {} fooset]
+ interp delete \u5420
+ set result
+} "\u5420 foo"
+
# cleanup
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tcl/tests/var.test b/tcl/tests/var.test
index 0529b09edce..b158f5db4c9 100644
--- a/tcl/tests/var.test
+++ b/tcl/tests/var.test
@@ -173,6 +173,9 @@ test var-1.18 {TclLookupVar, resurrect array element via upvar to deleted array:
set result
}
} {0 2 1 {can't set "foo": upvar refers to element in deleted array}}
+test var-1.19 {TclLookupVar, right error message when parsing variable name} {
+ list [catch {[format set] thisvar(doesntexist)} msg] $msg
+} {1 {can't read "thisvar(doesntexist)": no such variable}}
test var-2.1 {Tcl_LappendObjCmd, create var if new} {
catch {unset x}
@@ -258,7 +261,7 @@ test var-3.9 {MakeUpvar, my var has invalid ns name} {
catch {unset aaaaa}
set aaaaa 789789
list [catch {upvar #0 aaaaa test_ns_fred::lnk} msg] $msg
-} {1 {bad variable name "test_ns_fred::lnk": unknown namespace}}
+} {1 {can't create "test_ns_fred::lnk": parent namespace doesn't exist}}
if {[info commands testgetvarfullname] != {}} {
test var-4.1 {Tcl_GetVariableName, global variable} {
@@ -324,6 +327,16 @@ test var-6.3 {Tcl_GlobalObjCmd, variable named {} qualified by a namespace name}
}
p
} {24}
+test var-6.4 {Tcl_GlobalObjCmd, variable name matching :*} {
+ # Test for Tcl Bug 480176
+ set :v broken
+ proc p {} {
+ global :v
+ set :v fixed
+ }
+ p
+ set :v
+} {fixed}
test var-7.1 {Tcl_VariableObjCmd, create and initialize one new ns variable} {
catch {namespace delete test_ns_var}
@@ -473,6 +486,14 @@ test var-7.15 {Tcl_VariableObjCmd, array element parameter} {
} res
set res
} "can't define \"arrayvar(1)\": name refers to an element in an array"
+test var-7.16 {Tcl_VariableObjCmd, no args} {
+ list [catch {variable} msg] $msg
+} {1 {wrong # args: should be "variable ?name value...? name ?value?"}}
+test var-7.17 {Tcl_VariableObjCmd, no args} {
+ namespace eval test_ns_var {
+ list [catch {variable} msg] $msg
+ }
+} {1 {wrong # args: should be "variable ?name value...? name ?value?"}}
test var-8.1 {TclDeleteVars, "unset" traces are called with fully-qualified var names} {
catch {namespace delete test_ns_var}
@@ -663,4 +684,3 @@ catch {unset aaaaa}
# cleanup
::tcltest::cleanupTests
return
-
diff --git a/tcl/tests/while-old.test b/tcl/tests/while-old.test
index 0ee2e2be35f..0ebeb6ba615 100644
--- a/tcl/tests/while-old.test
+++ b/tcl/tests/while-old.test
@@ -131,4 +131,3 @@ return
-
diff --git a/tcl/tests/while.test b/tcl/tests/while.test
index d3ac4b167d6..68fdc97d66f 100644
--- a/tcl/tests/while.test
+++ b/tcl/tests/while.test
@@ -30,7 +30,7 @@ test while-1.2 {TclCompileWhileCmd: error in test expression} {
set i 0
catch {while {$i<} break} msg
set errorInfo
-} {syntax error in expression "$i<"
+} {syntax error in expression "$i<": premature end of expression
("while" test expression)
while compiling
"while {$i<} break"}
@@ -310,7 +310,7 @@ test while-4.3 {while (not compiled): error in test expression} {
set z while
catch {$z {$i<} {set x 1}} msg
set errorInfo
-} {syntax error in expression "$i<"
+} {syntax error in expression "$i<": premature end of expression
while executing
"$z {$i<} {set x 1}"}
test while-4.4 {while (not compiled): error in test expression} {
@@ -609,27 +609,21 @@ test while-6.5 {continue tests, long command body with computed command names} {
# Test for incorrect "double evaluation" semantics
-test while-7.1 {delayed substitution of body} {knownBug} {
+test while-7.1 {delayed substitution of body} {
set i 0
while {[incr i] < 10} "
set result $i
"
- set result
-} {0}
+ proc p {} {
+ set i 0
+ while {[incr i] < 10} "
+ set result $i
+ "
+ set result
+ }
+ append result [p]
+} {00}
# cleanup
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tcl/tests/winConsole.test b/tcl/tests/winConsole.test
index 47d3eefb016..ed2f5468b37 100644
--- a/tcl/tests/winConsole.test
+++ b/tcl/tests/winConsole.test
@@ -50,4 +50,3 @@ test winConsole-1.1 {Console file channel: non-blocking gets} \
::tcltest::cleanupTests
return
-
diff --git a/tcl/tests/winDde.test b/tcl/tests/winDde.test
index 823d10264ac..5d2faffd49a 100644
--- a/tcl/tests/winDde.test
+++ b/tcl/tests/winDde.test
@@ -18,11 +18,11 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
if {$tcl_platform(platform) == "windows"} {
if [catch {
- set lib [lindex [glob [file join [pwd] [file dirname \
- [info nameofexecutable]] tcldde*.dll]] 0]
+ set lib [lindex [glob -directory [file join [pwd] [file dirname \
+ [info nameofexecutable]]] tcldde*.dll] 0]
load $lib dde
}] {
- puts "Unable to find the dde package. Skipping registry tests."
+ puts "WARNING: Unable to find the dde package. Skipping dde tests."
::tcltest::cleanupTests
return
}
@@ -30,24 +30,27 @@ if {$tcl_platform(platform) == "windows"} {
set scriptName script1.tcl
-
proc createChildProcess { ddeServerName } {
-
file delete -force $::scriptName
-
+
set f [open $::scriptName w+]
puts $f {
+ if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+ }
if [catch {
- set lib [lindex [glob [file join [pwd] [file dirname \
- [info nameofexecutable]] tcldde*.dll]] 0]
+ set lib [lindex [glob -directory \
+ [file join [pwd] [file dirname [info nameofexecutable]]] \
+ tcldde*.dll] 0]
load $lib dde
}] {
- puts "Unable to find the dde package. Skipping registry tests."
+ puts "Unable to find the dde package. Skipping dde tests."
::tcltest::cleanupTests
return
}
}
- puts $f "dde servername $ddeServerName"
+ puts $f [list dde servername $ddeServerName]
puts $f {
puts ready
vwait done
@@ -56,7 +59,7 @@ proc createChildProcess { ddeServerName } {
}
close $f
- set f [open "|$tcltest::tcltest $::scriptName" r]
+ set f [open |[list [interpreter] $::scriptName] r]
gets $f
return $f
}
@@ -103,43 +106,44 @@ test winDde-3.4 {DDE eval locally} {pcOnly} {
dde eval self set a "foo"
} foo
-test winDde-4.1 {DDE execute remotely} {pcOnly} {
+test winDde-3.5 {DDE request locally} {pcOnly} {
+ set a ""
+ dde execute TclEval self {set a "foo"}
+ dde request -binary TclEval self a
+} "foo\x00"
+
+test winDde-4.1 {DDE execute remotely} {stdio pcOnly} {
set a ""
set child [createChildProcess child]
dde execute TclEval child {set a "foo"}
-
dde execute TclEval child {set done 1}
set a
} ""
-test winDde-4.2 {DDE execute remotely} {pcOnly} {
+test winDde-4.2 {DDE execute remotely} {stdio pcOnly} {
set a ""
set child [createChildProcess child]
dde execute -async TclEval child {set a "foo"}
-
dde execute TclEval child {set done 1}
set a
} ""
-test winDde-4.3 {DDE request locally} {pcOnly} {
+test winDde-4.3 {DDE request locally} {stdio pcOnly} {
set a ""
set child [createChildProcess child]
dde execute TclEval child {set a "foo"}
set a [dde request TclEval child a]
-
-
dde execute TclEval child {set done 1}
set a
} foo
-test winDde-4.4 {DDE eval locally} {pcOnly} {
+test winDde-4.4 {DDE eval locally} {stdio pcOnly} {
set a ""
set child [createChildProcess child]
set a [dde eval child set a "foo"]
-
dde execute TclEval child {set done 1}
set a
@@ -160,10 +164,7 @@ test winDde-5.3 {check for bad arguments} {pcOnly} {
set result
} {wrong # args: should be "dde execute ?-async? serviceName topicName value"}
-
#cleanup
file delete -force $::scriptName
::tcltest::cleanupTests
return
-
-
diff --git a/tcl/tests/winFCmd.test b/tcl/tests/winFCmd.test
index 6116f10f742..e088bf076e8 100644
--- a/tcl/tests/winFCmd.test
+++ b/tcl/tests/winFCmd.test
@@ -36,7 +36,7 @@ proc cleanup {args} {
foreach p ". $args" {
set x ""
catch {
- set x [glob [file join $p tf*] [file join $p td*]]
+ set x [glob -directory $p tf* td*]
}
if {$x != ""} {
catch {eval file delete -force -- $x}
@@ -44,6 +44,20 @@ proc cleanup {args} {
}
}
+if {[string equal $tcl_platform(platform) "windows"]} {
+ if {[string equal $tcl_platform(os) "Windows NT"] \
+ && [string equal [string index $tcl_platform(osVersion) 0] "5"]} {
+ tcltest::testConstraint win2000orXP 1
+ tcltest::testConstraint winOlderThan2000 0
+ } else {
+ tcltest::testConstraint win2000orXP 0
+ tcltest::testConstraint winOlderThan2000 1
+ }
+} else {
+ tcltest::testConstraint win2000orXP 0
+ tcltest::testConstraint winOlderThan2000 0
+}
+
set ::tcltest::testConstraints(cdrom) 0
set ::tcltest::testConstraints(exdev) 0
@@ -188,16 +202,20 @@ test winFCmd-1.12 {TclpRenameFile: errno: EACCES} {pcOnly} {
close $fd
set msg
} {1 EACCES}
-test winFCmd-1.13 {TclpRenameFile: errno: EACCES} {pcOnly} {
+test winFCmd-1.13 {TclpRenameFile: errno: EACCES} {pcOnly win2000orXP} {
+ cleanup
+ list [catch {testfile mv nul tf1} msg] $msg
+} {1 EINVAL}
+test winFCmd-1.13.1 {TclpRenameFile: errno: EACCES} {pcOnly winOlderThan2000} {
cleanup
list [catch {testfile mv nul tf1} msg] $msg
} {1 EACCES}
-test winFCmd-1.14 {TclpRenameFile: errno: EACCES} {95} {
+test winFCmd-1.14 {TclpRenameFile: errno: EACCES} {pcOnly 95} {
cleanup
createfile tf1
list [catch {testfile mv tf1 nul} msg] $msg
} {1 EACCES}
-test winFCmd-1.15 {TclpRenameFile: errno: EEXIST} {nt} {
+test winFCmd-1.15 {TclpRenameFile: errno: EEXIST} {pcOnly nt} {
cleanup
createfile tf1
list [catch {testfile mv tf1 nul} msg] $msg
@@ -216,11 +234,15 @@ test winFCmd-1.18 {TclpRenameFile: srcAttr == -1} {pcOnly} {
cleanup
list [catch {testfile mv tf1 tf2} msg] $msg
} {1 ENOENT}
-test winFCmd-1.19 {TclpRenameFile: errno == EACCES} {pcOnly} {
+test winFCmd-1.19 {TclpRenameFile: errno == EACCES} {pcOnly win2000orXP} {
+ cleanup
+ list [catch {testfile mv nul tf1} msg] $msg
+} {1 EINVAL}
+test winFCmd-1.19.1 {TclpRenameFile: errno == EACCES} {pcOnly winOlderThan2000} {
cleanup
list [catch {testfile mv nul tf1} msg] $msg
} {1 EACCES}
-test winFCmd-1.20 {TclpRenameFile: src is dir} {nt} {
+test winFCmd-1.20 {TclpRenameFile: src is dir} {pcOnly nt} {
# under 95, this would actually succeed and move the current dir out from
# under the current process!
cleanup
@@ -353,7 +375,7 @@ test winFCmd-2.6 {TclpCopyFile: errno: ENOENT} {pcOnly} {
createfile tf1
list [catch {testfile cp tf1 ""} msg] $msg
} {1 ENOENT}
-test winFCmd-2.7 {TclpCopyFile: errno: EACCES} {95} {
+test winFCmd-2.7 {TclpCopyFile: errno: EACCES} {pcOnly 95} {
cleanup
createfile tf1
set fd [open tf2 w]
@@ -361,11 +383,15 @@ test winFCmd-2.7 {TclpCopyFile: errno: EACCES} {95} {
close $fd
set msg
} {1 EACCES}
-test winFCmd-2.8 {TclpCopyFile: errno: EACCES} {nt} {
+test winFCmd-2.8 {TclpCopyFile: errno: EACCES} {pcOnly win2000orXP} {
+ cleanup
+ list [catch {testfile cp nul tf1} msg] $msg
+} {1 EINVAL}
+test winFCmd-2.8.1 {TclpCopyFile: errno: EACCES} {pcOnly nt winOlderThan2000} {
cleanup
list [catch {testfile cp nul tf1} msg] $msg
} {1 EACCES}
-test winFCmd-2.9 {TclpCopyFile: errno: ENOENT} {95} {
+test winFCmd-2.9 {TclpCopyFile: errno: ENOENT} {pcOnly 95} {
cleanup
list [catch {testfile cp nul tf1} msg] $msg
} {1 ENOENT}
@@ -419,7 +445,7 @@ test winFCmd-2.17 {TclpCopyFile: dst is readonly} {pcOnly} {
testfile cp tf1 tf2
list [file writable tf2] [contents tf2]
} {1 tf1}
-test winFCmd-2.18 {TclpCopyFile: still can't copy onto dst} {95} {
+test winFCmd-2.18 {TclpCopyFile: still can't copy onto dst} {pcOnly 95} {
cleanup
createfile tf1
createfile tf2
@@ -491,10 +517,10 @@ test winFCmd-3.11 {TclpDeleteFile: still can't remove path} {pcOnly} {
set msg
} {1 EACCES}
-test winFCmd-4.1 {TclpCreateDirectory: errno: EACCES} {nt cdrom} {
+test winFCmd-4.1 {TclpCreateDirectory: errno: EACCES} {pcOnly nt cdrom} {
list [catch {testfile mkdir $cdrom/dummy~~.dir} msg] $msg
} {1 EACCES}
-test winFCmd-4.2 {TclpCreateDirectory: errno: EACCES} {95 cdrom} {
+test winFCmd-4.2 {TclpCreateDirectory: errno: EACCES} {pcOnly 95 cdrom} {
list [catch {testfile mkdir $cdrom/dummy~~.dir} msg] $msg
} {1 ENOSPC}
test winFCmd-4.3 {TclpCreateDirectory: errno: EEXIST} {pcOnly} {
@@ -529,7 +555,7 @@ test winFCmd-6.1 {TclpRemoveDirectory: errno: EACCES} {pcOnly} {
test winFCmd-6.2 {TclpRemoveDirectory: errno: EEXIST} {pcOnly} {
cleanup
file mkdir td1/td2
- list [catch {testfile rmdir td1} msg] $msg
+ list [catch {testfile rmdir td1} msg] [file tail $msg]
} {1 {td1 EEXIST}}
test winFCmd-6.3 {TclpRemoveDirectory: errno: EACCES} {pcOnly} {
# can't test this w/o removing everything on your hard disk first!
@@ -537,7 +563,7 @@ test winFCmd-6.3 {TclpRemoveDirectory: errno: EACCES} {pcOnly} {
} {}
test winFCmd-6.4 {TclpRemoveDirectory: errno: ENOENT} {pcOnly} {
cleanup
- list [catch {testfile rmdir td1} msg] $msg
+ list [catch {testfile rmdir td1} msg] [file tail $msg]
} {1 {td1 ENOENT}}
test winFCmd-6.5 {TclpRemoveDirectory: errno: ENOENT} {pcOnly} {
cleanup
@@ -546,7 +572,7 @@ test winFCmd-6.5 {TclpRemoveDirectory: errno: ENOENT} {pcOnly} {
test winFCmd-6.6 {TclpRemoveDirectory: errno: ENOTDIR} {pcOnly} {
cleanup
createfile tf1
- list [catch {testfile rmdir tf1} msg] $msg
+ list [catch {testfile rmdir tf1} msg] [file tail $msg]
} {1 {tf1 ENOTDIR}}
test winFCmd-6.7 {TclpRemoveDirectory: RemoveDirectory succeeds} {pcOnly} {
cleanup
@@ -557,7 +583,7 @@ test winFCmd-6.7 {TclpRemoveDirectory: RemoveDirectory succeeds} {pcOnly} {
test winFCmd-6.8 {TclpRemoveDirectory: RemoveDirectory fails} {pcOnly} {
cleanup
createfile tf1
- list [catch {testfile rmdir tf1} msg] $msg
+ list [catch {testfile rmdir tf1} msg] [file tail $msg]
} {1 {tf1 ENOTDIR}}
test winFCmd-6.9 {TclpRemoveDirectory: errno == EACCES} {pcOnly} {
cleanup
@@ -566,15 +592,15 @@ test winFCmd-6.9 {TclpRemoveDirectory: errno == EACCES} {pcOnly} {
testfile rmdir td1
file exists td1
} {0}
-test winFCmd-6.10 {TclpRemoveDirectory: attr == -1} {95} {
+test winFCmd-6.10 {TclpRemoveDirectory: attr == -1} {pcOnly 95} {
cleanup
list [catch {testfile rmdir nul} msg] $msg
} {1 {nul EACCES}}
-test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} {nt} {
+test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} {pcOnly nt} {
cleanup
list [catch {testfile rmdir /} msg] $msg
-} {1 {\ EACCES}}
-test winFCmd-6.12 {TclpRemoveDirectory: errno == EACCES} {95} {
+} {1 {/ EACCES}}
+test winFCmd-6.12 {TclpRemoveDirectory: errno == EACCES} {pcOnly 95} {
cleanup
createfile tf1
list [catch {testfile rmdir tf1} msg] $msg
@@ -586,7 +612,7 @@ test winFCmd-6.13 {TclpRemoveDirectory: write-protected} {pcOnly} {
testfile rmdir td1
file exists td1
} {0}
-test winFCmd-6.14 {TclpRemoveDirectory: check if empty dir} {95} {
+test winFCmd-6.14 {TclpRemoveDirectory: check if empty dir} {pcOnly 95} {
cleanup
file mkdir td1/td2
list [catch {testfile rmdir td1} msg] $msg
@@ -594,7 +620,7 @@ test winFCmd-6.14 {TclpRemoveDirectory: check if empty dir} {95} {
test winFCmd-6.15 {TclpRemoveDirectory: !recursive} {pcOnly} {
cleanup
file mkdir td1/td2
- list [catch {testfile rmdir td1} msg] $msg
+ list [catch {testfile rmdir td1} msg] [file tail $msg]
} {1 {td1 EEXIST}}
test winFCmd-6.16 {TclpRemoveDirectory: recursive, but errno != EEXIST} {pcOnly} {
cleanup
@@ -652,12 +678,13 @@ test winFCmd-7.7 {TraverseWinTree: append \ to source if necessary} {pcOnly} {
testfile cpdir td1 td2
contents td2/tf1
} {tf1}
-test winFCmd-7.8 {TraverseWinTree: append \ to source if necessary} {95 cdrom} {
- list [catch {testfile rmdir $cdrom/} msg] $msg
-} "1 {$cdrom\\ EEXIST}"
-test winFCmd-7.9 {TraverseWinTree: append \ to source if necessary} {nt cdrom} {
- list [catch {testfile rmdir $cdrom/} msg] $msg
-} "1 {$cdrom\\ EACCES}"
+test winFCmd-7.8 {TraverseWinTree: append \ to source if necessary} {pcOnly 95 cdrom} {
+ # cdrom can return either d:\ or D:/, but we only care about the errcode
+ list [catch {testfile rmdir $cdrom/} msg] [lindex $msg 1]
+} {1 EEXIST}
+test winFCmd-7.9 {TraverseWinTree: append \ to source if necessary} {pcOnly nt cdrom} {
+ list [catch {testfile rmdir $cdrom/} msg] [lindex $msg 1]
+} {1 EACCES}
test winFCmd-7.10 {TraverseWinTree: can't read directory: handle == INVALID} \
{pcOnly} {
# can't make it happen
@@ -684,16 +711,16 @@ test winFCmd-7.13 {TraverseWinTree: append \ to target if necessary} {pcOnly} {
testfile cpdir td1 td2
contents td2/tf1
} {tf1}
-test winFCmd-7.14 {TraverseWinTree: append \ to target if necessary} {95} {
+test winFCmd-7.14 {TraverseWinTree: append \ to target if necessary} {pcOnly 95} {
cleanup
file mkdir td1
list [catch {testfile cpdir td1 /} msg] $msg
-} {1 {\ EEXIST}}
-test winFCmd-7.15 {TraverseWinTree: append \ to target if necessary} {nt} {
+} {1 {/ EEXIST}}
+test winFCmd-7.15 {TraverseWinTree: append \ to target if necessary} {pcOnly nt} {
cleanup
file mkdir td1
list [catch {testfile cpdir td1 /} msg] $msg
-} {1 {\ EACCES}}
+} {1 {/ EACCES}}
test winFCmd-7.16 {TraverseWinTree: recurse on files: no files} {pcOnly} {
cleanup
file mkdir td1
@@ -763,7 +790,7 @@ test winFCmd-9.1 {TraversalDelete: DOTREE_F} {pcOnly} {
createfile td1/tf1
testfile rmdir -force td1
} {}
-test winFCmd-9.2 {TraversalDelete: DOTREE_F} {95} {
+test winFCmd-9.2 {TraversalDelete: DOTREE_F} {pcOnly 95} {
cleanup
file mkdir td1
set fd [open td1/tf1 w]
@@ -813,7 +840,7 @@ test winFCmd-11.4 {GetWinFileAttributes} {pcOnly} {
close [open td1 w]
list [catch {file attributes td1 -system} msg] $msg [cleanup]
} {0 0 {}}
-test winfcmd-11.5 {GetWinFileAttributes} {pcOnly} {
+test winFCmd-11.5 {GetWinFileAttributes} {pcOnly} {
# attr of relative paths that resolve to root was failing
# don't care about answer, just that test runs.
@@ -824,6 +851,9 @@ test winfcmd-11.5 {GetWinFileAttributes} {pcOnly} {
file attr .
cd $old
} {}
+test winFCmd-11.6 {GetWinFileAttributes} {pcOnly} {
+ file attr c:/ -hidden
+} {0}
test winFCmd-12.1 {ConvertFileNameFormat} {pcOnly} {
cleanup
@@ -935,6 +965,9 @@ test winFCmd-15.10 {SetWinFileAttributes - failing} {pcOnly cdrom} {
cleanup
catch {file attributes $cdfile -archive 1}
} {1}
+test winFCmd-16.1 {Windows file normalization} {pcOnly} {
+ list [file normalize c:/] [file normalize C:/]
+} {C:/ C:/}
# This block of code used to occur after the "return" call, so I'm
# commenting it out and assuming that this code is still under construction.
@@ -967,16 +1000,3 @@ test winFCmd-15.10 {SetWinFileAttributes - failing} {pcOnly cdrom} {
cleanup
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tcl/tests/winFile.test b/tcl/tests/winFile.test
index 2c4116a83f7..17aee65b220 100644
--- a/tcl/tests/winFile.test
+++ b/tcl/tests/winFile.test
@@ -20,12 +20,12 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
test winFile-1.1 {TclpGetUserHome} {pcOnly} {
list [catch {glob ~nosuchuser} msg] $msg
} {1 {user "nosuchuser" doesn't exist}}
-test winFile-1.2 {TclpGetUserHome} {nt nonPortable} {
+test winFile-1.2 {TclpGetUserHome} {pcOnly nt nonPortable} {
# The administrator account should always exist.
catch {glob ~administrator}
} {0}
-test winFile-1.2 {TclpGetUserHome} {95} {
+test winFile-1.2 {TclpGetUserHome} {pcOnly 95} {
# Find some user in system.ini and then see if they have a home.
set f [open $::env(windir)/system.ini]
@@ -44,7 +44,7 @@ test winFile-1.2 {TclpGetUserHome} {95} {
close $f
set x
} {0}
-test winFile-1.3 {TclpGetUserHome} {nt nonPortable} {
+test winFile-1.3 {TclpGetUserHome} {pcOnly nt nonPortable} {
catch {glob ~stanton@workgroup}
} {0}
@@ -62,6 +62,22 @@ test winFile-2.2 {TclpMatchFiles: case sensitivity} {pcOnly} {
set result
} {globlower globlower}
+test winFile-3.1 {file system} {pcOnly} {
+ set res "volume types ok"
+ foreach vol [file volumes] {
+ # Have to catch in case there is a removable drive (CDROM, floppy)
+ # with nothing in it.
+ catch {
+ if {![string equal [lindex [file system $vol] 1] [testvolumetype $vol]]} {
+ set res "For $vol, we found [file system $vol]\
+ and [testvolumetype $vol] are different"
+ break
+ }
+ }
+ }
+ set res
+} {volume types ok}
+
# cleanup
::tcltest::cleanupTests
return
@@ -77,4 +93,3 @@ return
-
diff --git a/tcl/tests/winNotify.test b/tcl/tests/winNotify.test
index 34efe7052af..c7b320d1947 100644
--- a/tcl/tests/winNotify.test
+++ b/tcl/tests/winNotify.test
@@ -172,4 +172,3 @@ return
-
diff --git a/tcl/tests/winPipe.test b/tcl/tests/winPipe.test
index 8e3e011d459..12c07dcfa5d 100644
--- a/tcl/tests/winPipe.test
+++ b/tcl/tests/winPipe.test
@@ -14,17 +14,15 @@
#
# RCS: @(#) $Id$
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
- namespace import -force ::tcltest::*
-}
+package require tcltest
+namespace import -force ::tcltest::*
+
+testConstraint exec [llength [info commands exec]]
set bindir [file join [pwd] [file dirname [info nameofexecutable]]]
-set cat16 [file join $bindir cat16.exe]
set cat32 [file join $bindir cat32.exe]
set ::tcltest::testConstraints(cat32) [file exists $cat32]
-set ::tcltest::testConstraints(cat16) [file exists $cat16]
if {[catch {puts console1 ""}]} {
set ::tcltest::testConstraints(AllocConsole) 1
@@ -40,11 +38,13 @@ append big $big
append big $big
append big $big
-set f [open "little" w]
+set path(little) [makeFile {} little]
+set f [open $path(little) w]
puts -nonewline $f "little"
close $f
-set f [open "big" w]
+set path(big) [makeFile {} big]
+set f [open $path(big) w]
puts -nonewline $f $big
close $f
@@ -55,115 +55,116 @@ proc contents {file} {
set r
}
-set f [open more w]
-puts $f {
+set path(more) [makeFile {
while {[eof stdin] == 0} {
puts -nonewline [read stdin]
}
-}
-close $f
+} more]
+
+set path(stdout) [makeFile {} stdout]
+set path(stderr) [makeFile {} stderr]
-test winpipe-1.1 {32 bit comprehensive tests: from little file} {pcOnly stdio cat32} {
- exec $cat32 < little > stdout 2> stderr
- list [contents stdout] [contents stderr]
+test winpipe-1.1 {32 bit comprehensive tests: from little file} {pcOnly exec cat32} {
+ exec $cat32 < $path(little) > $path(stdout) 2> $path(stderr)
+ list [contents $path(stdout)] [contents $path(stderr)]
} {little stderr32}
-test winpipe-1.2 {32 bit comprehensive tests: from big file} {pcOnly stdio cat32} {
- exec $cat32 < big > stdout 2> stderr
- list [contents stdout] [contents stderr]
+test winpipe-1.2 {32 bit comprehensive tests: from big file} {pcOnly exec cat32} {
+ exec $cat32 < $path(big) > $path(stdout) 2> $path(stderr)
+ list [contents $path(stdout)] [contents $path(stderr)]
} "{$big} stderr32"
-test winpipe-1.3 {32 bit comprehensive tests: a little from pipe} {nt stdio cat32} {
- exec $::tcltest::tcltest more < little | $cat32 > stdout 2> stderr
- list [contents stdout] [contents stderr]
+test winpipe-1.3 {32 bit comprehensive tests: a little from pipe} {pcOnly nt exec cat32} {
+ exec [interpreter] more < little | $cat32 > $path(stdout) 2> $path(stderr)
+ list [contents $path(stdout)] [contents $path(stderr)]
} {little stderr32}
-test winpipe-1.4 {32 bit comprehensive tests: a lot from pipe} {nt stdio cat32} {
- exec $::tcltest::tcltest more < big | $cat32 > stdout 2> stderr
- list [contents stdout] [contents stderr]
+test winpipe-1.4 {32 bit comprehensive tests: a lot from pipe} {pcOnly nt exec cat32} {
+ exec [interpreter] more < big | $cat32 > $path(stdout) 2> $path(stderr)
+ list [contents $path(stdout)] [contents $path(stderr)]
} "{$big} stderr32"
-test winpipe-1.5 {32 bit comprehensive tests: a lot from pipe} {95 stdio cat32} {
- exec command /c type big |& $cat32 > stdout 2> stderr
- list [contents stdout] [contents stderr]
+test winpipe-1.5 {32 bit comprehensive tests: a lot from pipe} {pcOnly 95 exec cat32} {
+ exec command /c type big |& $cat32 > $path(stdout) 2> $path(stderr)
+ list [contents $path(stdout)] [contents $path(stderr)]
} "{$big} stderr32"
test winpipe-1.6 {32 bit comprehensive tests: from console} \
- {pcOnly stdio cat32 AllocConsole} {
+ {pcOnly cat32 AllocConsole} {
# would block waiting for human input
} {}
-test winpipe-1.7 {32 bit comprehensive tests: from NUL} {pcOnly stdio cat32} {
- exec $cat32 < nul > stdout 2> stderr
- list [contents stdout] [contents stderr]
+test winpipe-1.7 {32 bit comprehensive tests: from NUL} {pcOnly exec cat32} {
+ exec $cat32 < nul > $path(stdout) 2> $path(stderr)
+ list [contents $path(stdout)] [contents $path(stderr)]
} {{} stderr32}
-test winpipe-1.8 {32 bit comprehensive tests: from socket} {pcOnly stdio cat32} {
+test winpipe-1.8 {32 bit comprehensive tests: from socket} {pcOnly cat32} {
# doesn't work
} {}
test winpipe-1.9 {32 bit comprehensive tests: from nowhere} \
- {pcOnly stdio cat32 .console} {
- exec $cat32 > stdout 2> stderr
- list [contents stdout] [contents stderr]
+ {pcOnly exec cat32 .console} {
+ exec $cat32 > $path(stdout) 2> $path(stderr)
+ list [contents $path(stdout)] [contents $path(stderr)]
} {{} stderr32}
test winpipe-1.10 {32 bit comprehensive tests: from file handle} \
- {pcOnly stdio cat32} {
- set f [open "little" r]
- exec $cat32 <@$f > stdout 2> stderr
+ {pcOnly exec cat32} {
+ set f [open $path(little) r]
+ exec $cat32 <@$f > $path(stdout) 2> $path(stderr)
close $f
- list [contents stdout] [contents stderr]
+ list [contents $path(stdout)] [contents $path(stderr)]
} {little stderr32}
test winpipe-1.11 {32 bit comprehensive tests: read from application} \
- {pcOnly stdio cat32} {
- set f [open "|$cat32 < little" r]
+ {pcOnly exec cat32} {
+ set f [open "|[list $cat32] < $path(little)" r]
gets $f line
catch {close $f} msg
list $line $msg
} {little stderr32}
test winpipe-1.12 {32 bit comprehensive tests: a little to file} \
- {pcOnly stdio cat32} {
- exec $cat32 < little > stdout 2> stderr
- list [contents stdout] [contents stderr]
+ {pcOnly exec cat32} {
+ exec $cat32 < $path(little) > $path(stdout) 2> $path(stderr)
+ list [contents $path(stdout)] [contents $path(stderr)]
} {little stderr32}
test winpipe-1.13 {32 bit comprehensive tests: a lot to file} \
- {pcOnly stdio cat32} {
- exec $cat32 < big > stdout 2> stderr
- list [contents stdout] [contents stderr]
+ {pcOnly exec cat32} {
+ exec $cat32 < $path(big) > $path(stdout) 2> $path(stderr)
+ list [contents $path(stdout)] [contents $path(stderr)]
} "{$big} stderr32"
test winpipe-1.14 {32 bit comprehensive tests: a little to pipe} \
- {pcOnly stdio cat32} {
- exec $cat32 < little | $::tcltest::tcltest more > stdout 2> stderr
- list [contents stdout] [contents stderr]
+ {pcOnly exec stdio cat32} {
+ exec $cat32 < $path(little) | [interpreter] $path(more) > $path(stdout) 2> $path(stderr)
+ list [contents $path(stdout)] [contents $path(stderr)]
} {little stderr32}
test winpipe-1.15 {32 bit comprehensive tests: a lot to pipe} \
- {pcOnly stdio cat32} {
- exec $cat32 < big | $::tcltest::tcltest more > stdout 2> stderr
- list [contents stdout] [contents stderr]
+ {pcOnly exec stdio cat32} {
+ exec $cat32 < $path(big) | [interpreter] $path(more) > $path(stdout) 2> $path(stderr)
+ list [contents $path(stdout)] [contents $path(stderr)]
} "{$big} stderr32"
-test winpipe-1.16 {32 bit comprehensive tests: to console} {pcOnly stdio cat32} {
+test winpipe-1.16 {32 bit comprehensive tests: to console} {pcOnly exec cat32} {
catch {exec $cat32 << "You should see this\n" >@stdout} msg
set msg
} stderr32
-test winpipe-1.17 {32 bit comprehensive tests: to NUL} {pcOnly stdio cat32} {
+test winpipe-1.17 {32 bit comprehensive tests: to NUL} {pcOnly exec cat32} {
# some apps hang when sending a large amount to NUL. $cat32 isn't one.
- catch {exec $cat32 < big > nul} msg
+ catch {exec $cat32 < $path(big) > nul} msg
set msg
} stderr32
test winpipe-1.18 {32 bit comprehensive tests: to nowhere} \
- {pcOnly stdio cat32 .console} {
- exec $cat32 < big >&@stdout
+ {pcOnly exec cat32 .console} {
+ exec $cat32 < $path(big) >&@stdout
} {}
-test winpipe-1.19 {32 bit comprehensive tests: to file handle} {pcOnly stdio cat32} {
- set f1 [open "stdout" w]
- set f2 [open "stderr" w]
- exec $cat32 < little >@$f1 2>@$f2
+test winpipe-1.19 {32 bit comprehensive tests: to file handle} {pcOnly exec cat32} {
+ set f1 [open $path(stdout) w]
+ set f2 [open $path(stderr) w]
+ exec $cat32 < $path(little) >@$f1 2>@$f2
close $f1
close $f2
- list [contents stdout] [contents stderr]
+ list [contents $path(stdout)] [contents $path(stderr)]
} {little stderr32}
test winpipe-1.20 {32 bit comprehensive tests: write to application} \
- {pcOnly stdio cat32} {
- set f [open "|$cat32 > stdout" w]
+ {pcOnly exec cat32} {
+ set f [open |[list $cat32 >$path(stdout)] w]
puts -nonewline $f "foo"
catch {close $f} msg
- list [contents stdout] $msg
+ list [contents $path(stdout)] $msg
} {foo stderr32}
test winpipe-1.21 {32 bit comprehensive tests: read/write application} \
- {pcOnly stdio cat32} {
- set f [open "|$cat32" r+]
+ {pcOnly exec cat32} {
+ set f [open "|[list $cat32]" r+]
puts $f $big
puts $f \032
flush $f
@@ -171,113 +172,13 @@ test winpipe-1.21 {32 bit comprehensive tests: read/write application} \
catch {close $f}
set r
} "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
-test winpipe-1.22 {Checking command.com for Win95/98 hanging} \
- {pcOnly stdio} {
+test winpipe-1.22 {Checking command.com for Win95/98 hanging} {pcOnly 95 exec} {
exec command.com /c dir /b
set result 1
} 1
-
-test winpipe-2.1 {16 bit comprehensive tests: from little file} {pcOnly stdio cat16} {
- exec $cat16 < little > stdout 2> stderr
- list [contents stdout] [contents stderr]
-} "little stderr16"
-test winpipe-2.2 {16 bit comprehensive tests: from big file} {pcOnly stdio cat16} {
- exec $cat16 < big > stdout 2> stderr
- list [contents stdout] [contents stderr]
-} "{$big} stderr16"
-test winpipe-2.3 {16 bit comprehensive tests: a little from pipe} {pcOnly stdio cat16} {
- exec $::tcltest::tcltest more < little | $cat16 > stdout 2> stderr
- list [contents stdout] [contents stderr]
-} {little stderr16}
-test winpipe-2.4 {16 bit comprehensive tests: a lot from pipe} {nt stdio cat16} {
- exec $cat16 < big | $cat16 > stdout 2> stderr
- list [contents stdout] [contents stderr]
-} "{$big} stderr16stderr16"
-test winpipe-2.5 {16 bit comprehensive tests: a lot from pipe} {95 stdio cat16} {
- exec $::tcltest::tcltest more < big | $cat16 > stdout 2> stderr
- list [contents stdout] [contents stderr]
-} "{$big} stderr16"
-test winpipe-2.6 {16 bit comprehensive tests: from console} \
- {pcOnly stdio cat16 AllocConsole} {
- # would block waiting for human input
-} {}
-test winpipe-2.7 {16 bit comprehensive tests: from NUL} {nt stdio cat16} {
- exec $cat16 < nul > stdout 2> stderr
- list [contents stdout] [contents stderr]
-} "{} stderr16"
-test winpipe-2.8 {16 bit comprehensive tests: from socket} {pcOnly stdio cat16} {
- # doesn't work
-} {}
-test winpipe-2.9 {16 bit comprehensive tests: from nowhere} {pcOnly stdio cat16 .console} {
- exec $cat16 > stdout 2> stderr
- list [contents stdout] [contents stderr]
-} "{} stderr16"
-test winpipe-2.10 {16 bit comprehensive tests: from file handle} {pcOnly stdio cat16} {
- set f [open "little" r]
- exec $cat16 <@$f > stdout 2> stderr
- close $f
- list [contents stdout] [contents stderr]
-} "little stderr16"
-test winpipe-2.11 {16 bit comprehensive tests: read from application} {pcOnly stdio cat16} {
- set f [open "|$cat16 < little" r]
- gets $f line
- catch {close $f} msg
- list $line $msg
-} "little stderr16"
-test winpipe-2.12 {16 bit comprehensive tests: a little to file} {pcOnly stdio cat16} {
- exec $cat16 < little > stdout 2> stderr
- list [contents stdout] [contents stderr]
-} "little stderr16"
-test winpipe-2.13 {16 bit comprehensive tests: a lot to file} {pcOnly stdio cat16} {
- exec $cat16 < big > stdout 2> stderr
- list [contents stdout] [contents stderr]
-} "{$big} stderr16"
-test winpipe-2.14 {16 bit comprehensive tests: a little to pipe} {pcOnly stdio cat16} {
- exec $cat16 < little | $::tcltest::tcltest more > stdout 2> stderr
- list [contents stdout] [contents stderr]
-} {little stderr16}
-test winpipe-2.15 {16 bit comprehensive tests: a lot to pipe} {pcOnly stdio cat16} {
- exec $cat16 < big | $::tcltest::tcltest more > stdout 2> stderr
- list [contents stdout] [contents stderr]
-} "{$big} stderr16"
-test winpipe-2.16 {16 bit comprehensive tests: to console} {pcOnly stdio cat16} {
- catch {exec $cat16 << "You should see this\n" >@stdout} msg
- set msg
-} [lindex stderr16 0]
-test winpipe-2.17 {16 bit comprehensive tests: to NUL} {nt stdio cat16} {
- # some apps hang when sending a large amount to NUL. cat16 isn't one.
- catch {exec $cat16 < big > nul} msg
- set msg
-} stderr16
-test winpipe-2.18 {16 bit comprehensive tests: to nowhere} {pcOnly stdio cat16 .console} {
- exec $cat16 < big >&@stdout
-} {}
-test winpipe-2.19 {16 bit comprehensive tests: to file handle} {pcOnly stdio cat16} {
- set f1 [open "stdout" w]
- set f2 [open "stderr" w]
- exec $cat16 < little >@$f1 2>@$f2
- close $f1
- close $f2
- list [contents stdout] [contents stderr]
-} "little stderr16"
-test winpipe-2.20 {16 bit comprehensive tests: write to application} {pcOnly stdio cat16} {
- set f [open "|$cat16 > stdout" w]
- puts -nonewline $f "foo"
- catch {close $f} msg
- list [contents stdout] $msg
-} "foo stderr16"
-test winpipe-2.21 {16 bit comprehensive tests: read/write application} {nt stdio cat16} {
- set f [open "|$cat16" r+]
- puts $f $big
- puts $f \032
- flush $f
- set r [read $f 64]
- catch {close $f}
- set r
-} "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
file delete more
-test winpipe-4.1 {Tcl_WaitPid} {nt stdio} {
+test winpipe-4.1 {Tcl_WaitPid} {pcOnly nt exec cat32} {
proc readResults {f} {
global x result
if { [eof $f] } {
@@ -289,16 +190,17 @@ test winpipe-4.1 {Tcl_WaitPid} {nt stdio} {
}
}
- set f [open "|$cat32 < big 2> stderr" r]
+ set f [open "|[list $cat32] < big 2> $path(stderr)" r]
fconfigure $f -buffering none -blocking 0
fileevent $f readable "readResults $f"
set x 0
set result ""
vwait x
- list $result $x [contents stderr]
+ list $result $x [contents $path(stderr)]
} "{$big} 1 stderr32"
-close [open nothing w]
+set path(nothing) [makeFile {} nothing]
+close [open $path(nothing) w]
catch {set env_tmp $env(TMP)}
catch {set env_temp $env(TEMP)}
@@ -306,10 +208,10 @@ catch {set env_temp $env(TEMP)}
set env(TMP) c:/
set env(TEMP) c:/
-test winpipe-5.1 {TclpCreateTempFile: cleanup temp files} {pcOnly stdio} {
+test winpipe-5.1 {TclpCreateTempFile: cleanup temp files} {pcOnly exec} {
set x {}
set existing [glob -nocomplain c:/tcl*.tmp]
- exec $::tcltest::tcltest < nothing
+ exec [interpreter] < nothing
foreach p [glob -nocomplain c:/tcl*.tmp] {
if {[lsearch $existing $p] == -1} {
lappend x $p
@@ -317,39 +219,39 @@ test winpipe-5.1 {TclpCreateTempFile: cleanup temp files} {pcOnly stdio} {
}
set x
} {}
-test winpipe-5.2 {TclpCreateTempFile: TMP and TEMP not defined} {pcOnly stdio} {
+test winpipe-5.2 {TclpCreateTempFile: TMP and TEMP not defined} {pcOnly exec} {
set tmp $env(TMP)
set temp $env(TEMP)
unset env(TMP)
unset env(TEMP)
- exec $::tcltest::tcltest < nothing
+ exec [interpreter] < nothing
set env(TMP) $tmp
set env(TEMP) $temp
set x {}
} {}
test winpipe-5.3 {TclpCreateTempFile: TMP specifies non-existent directory} \
- {pcOnly stdio} {
+ {pcOnly exec } {
set tmp $env(TMP)
set env(TMP) snarky
- exec $::tcltest::tcltest < nothing
+ exec [interpreter] < nothing
set env(TMP) $tmp
set x {}
} {}
test winpipe-5.4 {TclpCreateTempFile: TEMP specifies non-existent directory} \
- {pcOnly stdio} {
+ {pcOnly exec} {
set tmp $env(TMP)
set temp $env(TEMP)
unset env(TMP)
set env(TEMP) snarky
- exec $::tcltest::tcltest < nothing
+ exec [interpreter] < nothing
set env(TMP) $tmp
set env(TEMP) $temp
set x {}
} {}
test winpipe-6.1 {PipeSetupProc & PipeCheckProc: read threads} \
- {pcOnly stdio cat32} {
- set f [open "|$cat32" r+]
+ {pcOnly exec cat32} {
+ set f [open "|[list $cat32]" r+]
fconfigure $f -blocking 0
fileevent $f writable { set x writable }
set x {}
@@ -368,8 +270,8 @@ test winpipe-6.1 {PipeSetupProc & PipeCheckProc: read threads} \
} {writable timeout readable {foobar
} timeout 1 stderr32}
test winpipe-6.2 {PipeSetupProc & PipeCheckProc: write threads} \
- {pcOnly stdio cat32} {
- set f [open "|$cat32" r+]
+ {pcOnly exec cat32} {
+ set f [open "|[list $cat32]" r+]
fconfigure $f -blocking 0
fileevent $f writable { set x writable }
set x {}
@@ -381,16 +283,16 @@ test winpipe-6.2 {PipeSetupProc & PipeCheckProc: write threads} \
lappend x [catch {close $f} msg] $msg
} {writable timeout 0 {}}
-makeFile {
+set path(echoArgs.tcl) [makeFile {
puts "[list $argv0 $argv]"
-} echoArgs.tcl
+} echoArgs.tcl]
-test winpipe-7.1 {BuildCommandLine: null arguments} {pcOnly stdio} {
- exec $::tcltest::tcltest echoArgs.tcl foo "" bar
-} {echoArgs.tcl {foo {} bar}}
-test winpipe-7.2 {BuildCommandLine: null arguments} {pcOnly stdio} {
- exec $::tcltest::tcltest echoArgs.tcl foo \" bar
-} {echoArgs.tcl {foo {"} bar}}
+test winpipe-7.1 {BuildCommandLine: null arguments} {pcOnly exec} {
+ exec [interpreter] $path(echoArgs.tcl) foo "" bar
+} [list $path(echoArgs.tcl) {foo {} bar}]
+test winpipe-7.2 {BuildCommandLine: null arguments} {pcOnly exec} {
+ exec [interpreter] $path(echoArgs.tcl) foo \" bar
+} [list $path(echoArgs.tcl) {foo {"} bar}]
# restore old values for env(TMP) and env(TEMP)
@@ -405,15 +307,3 @@ if {[catch {set env(TEMP) $env_temp}]} {
file delete big little stdout stderr nothing echoArgs.tcl
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tcl/tests/winTime.test b/tcl/tests/winTime.test
index aeb7734b28b..d376f6c667e 100644
--- a/tcl/tests/winTime.test
+++ b/tcl/tests/winTime.test
@@ -33,6 +33,32 @@ test winTime-1.2 {TclpGetDate} {pcOnly} {
set result
} {1969}
+# Next test tries to make sure that the Tcl clock stays in step
+# with the Windows clock. 3000 iterations really isn't enough,
+# but how many does a tester have patience for?
+
+test winTime-2.1 {Synchronization of Tcl and Windows clocks} {pcOnly} {
+ set failed 0
+ foreach { sys_sec sys_usec tcl_sec tcl_usec } [testwinclock] {}
+ set olddiff [expr { abs ( $tcl_sec - $sys_sec
+ + 1.0e-6 * ( $tcl_usec - $sys_usec ) ) }]
+ set ok 1
+ for { set i 0 } { $i < 3000 } { incr i } {
+ foreach { sys_sec sys_usec tcl_sec tcl_usec } [testwinclock] {}
+ set diff [expr { abs ( $tcl_sec - $sys_sec
+ + 1.0e-6 * ( $tcl_usec - $sys_usec ) ) }]
+ if { ( $diff > $olddiff + 1000 )
+ || ( $diff > 11000 ) } {
+ set failed 1
+ break
+ } else {
+ set olddiff $diff
+ after 1
+ }
+ }
+ set failed
+} {0}
+
# cleanup
::tcltest::cleanupTests
return
@@ -48,4 +74,3 @@ return
-
diff --git a/tcl/tools/checkLibraryDoc.tcl b/tcl/tools/checkLibraryDoc.tcl
index 3e7169b6ff5..51375f3870f 100644
--- a/tcl/tools/checkLibraryDoc.tcl
+++ b/tcl/tools/checkLibraryDoc.tcl
@@ -38,7 +38,6 @@ set StructList {
Tcl_Encoding \
Tcl_EncodingState \
Tcl_EncodingType \
- Tcl_EolTranslation \
Tcl_HashEntry \
Tcl_HashSearch \
Tcl_HashTable \
diff --git a/tcl/tools/configure b/tcl/tools/configure
index c63dbe2f201..1747525168a 100755
--- a/tcl/tools/configure
+++ b/tcl/tools/configure
@@ -1,7 +1,7 @@
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
-# Generated automatically using autoconf version 2.9
+# Generated automatically using autoconf version 2.13
# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
#
# This configure script is free software; the Free Software Foundation
@@ -12,7 +12,7 @@ ac_help=
ac_default_prefix=/usr/local
# Any additions from configure.in:
ac_help="$ac_help
- --with-tcl=DIR use Tcl 8.1 binaries from DIR"
+ --with-tcl=DIR use Tcl $DEF_VER binaries from DIR"
# Initialize some variables set by options.
# The variables have the same names as the options, with
@@ -51,6 +51,9 @@ mandir='${prefix}/man'
# Initialize some other variables.
subdirs=
MFLAGS= MAKEFLAGS=
+SHELL=${CONFIG_SHELL-/bin/sh}
+# Maximum number of lines to put in a shell here document.
+ac_max_here_lines=12
ac_prev=
for ac_option
@@ -332,7 +335,7 @@ EOF
verbose=yes ;;
-version | --version | --versio | --versi | --vers)
- echo "configure generated by autoconf version 2.9"
+ echo "configure generated by autoconf version 2.13"
exit 0 ;;
-with-* | --with-*)
@@ -434,11 +437,14 @@ do
done
# NLS nuisances.
-# Only set LANG and LC_ALL to C if already set.
-# These must not be set unconditionally because not all systems understand
-# e.g. LANG=C (notably SCO).
-if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi
+# Only set these to C if already set. These must not be set unconditionally
+# because not all systems understand e.g. LANG=C (notably SCO).
+# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'!
+# Non-C LC_CTYPE values break the ctype check.
if test "${LANG+set}" = set; then LANG=C; export LANG; fi
+if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi
+if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi
+if test "${LC_CTYPE+set}" = set; then LC_CTYPE=C; export LC_CTYPE; fi
# confdefs.h avoids OS command line length limits that DEFS can exceed.
rm -rf conftest* confdefs.h
@@ -499,8 +505,11 @@ ac_ext=c
# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
ac_cpp='$CPP $CPPFLAGS'
ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
-ac_link='${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+ac_exeext=
+ac_objext=o
if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
# Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu.
if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
@@ -523,12 +532,14 @@ fi
# not, assume that its top-level directory is a sibling of ours.
#--------------------------------------------------------------------
+DEF_VER=8.4
+
# Check whether --with-tcl or --without-tcl was given.
if test "${with_tcl+set}" = set; then
withval="$with_tcl"
TCL_BIN_DIR=$withval
else
- TCL_BIN_DIR=`cd ../../tcl8.1$TCL_PATCH_LEVEL/unix; pwd`
+ TCL_BIN_DIR=`cd ../../tcl$DEF_VER$TCL_PATCH_LEVEL/unix; pwd`
fi
if test ! -d $TCL_BIN_DIR; then
@@ -566,11 +577,25 @@ cat > confcache <<\EOF
# --recheck option to rerun configure.
#
EOF
+# The following way of writing the cache mishandles newlines in values,
+# but we know of no workaround that is simple, portable, and efficient.
+# So, don't put newlines in cache variables' values.
# Ultrix sh set writes to stderr and can't be redirected directly,
# and sets the high bit in the cache file unless we assign to the vars.
(set) 2>&1 |
- sed -n "s/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=\${\1='\2'}/p" \
- >> confcache
+ case `(ac_space=' '; set | grep ac_space) 2>&1` in
+ *ac_space=\ *)
+ # `set' does not quote correctly, so add quotes (double-quote substitution
+ # turns \\\\ into \\, and sed turns \\ into \).
+ sed -n \
+ -e "s/'/'\\\\''/g" \
+ -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p"
+ ;;
+ *)
+ # `set' quotes correctly as required by POSIX, so do not add quotes.
+ sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p'
+ ;;
+ esac >> confcache
if cmp -s $cache_file confcache; then
:
else
@@ -637,7 +662,7 @@ do
echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion"
exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;;
-version | --version | --versio | --versi | --vers | --ver | --ve | --v)
- echo "$CONFIG_STATUS generated by autoconf version 2.9"
+ echo "$CONFIG_STATUS generated by autoconf version 2.13"
exit 0 ;;
-help | --help | --hel | --he | --h)
echo "\$ac_cs_usage"; exit 0 ;;
@@ -656,9 +681,11 @@ sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g;
s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > conftest.subs <<\\CEOF
$ac_vpsub
$extrasub
+s%@SHELL@%$SHELL%g
s%@CFLAGS@%$CFLAGS%g
s%@CPPFLAGS@%$CPPFLAGS%g
s%@CXXFLAGS@%$CXXFLAGS%g
+s%@FFLAGS@%$FFLAGS%g
s%@DEFS@%$DEFS%g
s%@LDFLAGS@%$LDFLAGS%g
s%@LIBS@%$LIBS%g
@@ -686,20 +713,56 @@ s%@TCL_BIN_DIR@%$TCL_BIN_DIR%g
CEOF
EOF
+
+cat >> $CONFIG_STATUS <<\EOF
+
+# Split the substitutions into bite-sized pieces for seds with
+# small command number limits, like on Digital OSF/1 and HP-UX.
+ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script.
+ac_file=1 # Number of current file.
+ac_beg=1 # First line for current file.
+ac_end=$ac_max_sed_cmds # Line after last line for current file.
+ac_more_lines=:
+ac_sed_cmds=""
+while $ac_more_lines; do
+ if test $ac_beg -gt 1; then
+ sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file
+ else
+ sed "${ac_end}q" conftest.subs > conftest.s$ac_file
+ fi
+ if test ! -s conftest.s$ac_file; then
+ ac_more_lines=false
+ rm -f conftest.s$ac_file
+ else
+ if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds="sed -f conftest.s$ac_file"
+ else
+ ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file"
+ fi
+ ac_file=`expr $ac_file + 1`
+ ac_beg=$ac_end
+ ac_end=`expr $ac_end + $ac_max_sed_cmds`
+ fi
+done
+if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds=cat
+fi
+EOF
+
cat >> $CONFIG_STATUS <<EOF
CONFIG_FILES=\${CONFIG_FILES-"Makefile tcl.hpj"}
EOF
cat >> $CONFIG_STATUS <<\EOF
for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
- # Support "outfile[:infile]", defaulting infile="outfile.in".
+ # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
case "$ac_file" in
- *:*) ac_file_in=`echo "$ac_file"|sed 's%.*:%%'`
+ *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'`
ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
*) ac_file_in="${ac_file}.in" ;;
esac
- # Adjust relative srcdir, etc. for subdirectories.
+ # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories.
# Remove last slash and all that follows it. Not all systems have dirname.
ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
@@ -723,6 +786,7 @@ for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
top_srcdir="$ac_dots$ac_given_srcdir" ;;
esac
+
echo creating "$ac_file"
rm -f "$ac_file"
configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure."
@@ -731,15 +795,21 @@ for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
# $configure_input" ;;
*) ac_comsub= ;;
esac
+
+ ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"`
sed -e "$ac_comsub
s%@configure_input@%$configure_input%g
s%@srcdir@%$srcdir%g
s%@top_srcdir@%$top_srcdir%g
-" -f conftest.subs $ac_given_srcdir/$ac_file_in > $ac_file
+" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file
fi; done
-rm -f conftest.subs
+rm -f conftest.s*
+EOF
+cat >> $CONFIG_STATUS <<EOF
+EOF
+cat >> $CONFIG_STATUS <<\EOF
exit 0
EOF
diff --git a/tcl/tools/configure.in b/tcl/tools/configure.in
index 7b6d947087e..a224d299c4e 100644
--- a/tcl/tools/configure.in
+++ b/tcl/tools/configure.in
@@ -11,7 +11,9 @@ AC_INIT(man2tcl.c)
# not, assume that its top-level directory is a sibling of ours.
#--------------------------------------------------------------------
-AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.3 binaries from DIR], TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd ../../tcl8.3$TCL_PATCH_LEVEL/unix; pwd`)
+DEF_VER=8.4
+
+AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl $DEF_VER binaries from DIR], TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd ../../tcl$DEF_VER$TCL_PATCH_LEVEL/unix; pwd`)
if test ! -d $TCL_BIN_DIR; then
AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR doesn't exist)
fi
diff --git a/tcl/tools/eolFix.tcl b/tcl/tools/eolFix.tcl
new file mode 100644
index 00000000000..11c410d65f9
--- /dev/null
+++ b/tcl/tools/eolFix.tcl
@@ -0,0 +1,78 @@
+## Super aggressive EOL-fixer!
+##
+## Will even understand screwed up ones like CRCRLF.
+## (found in bad CVS repositories, caused by spacey developers
+## abusing CVS)
+##
+## davygrvy@pobox.com 3:41 PM 10/12/2001
+##
+
+package provide EOL-fix 1.1
+
+namespace eval ::EOL {
+ variable outMode crlf
+}
+
+proc EOL::fix {filename {newfilename ""}} {
+ variable outMode
+
+ if {![file exist $filename]} { return }
+ puts "EOL Fixing: $filename"
+
+ file rename ${filename} ${filename}.o
+ set fhnd [open ${filename}.o r]
+
+ if {$newfilename != ""} {
+ set newfhnd [open ${newfilename} w]
+ } else {
+ set newfhnd [open ${filename} w]
+ }
+
+ fconfigure $newfhnd -translation [list auto $outMode]
+ seek $fhnd 0 end
+ set theEnd [tell $fhnd]
+ seek $fhnd 0 start
+
+ fconfigure $fhnd -translation binary -buffersize $theEnd
+ set rawFile [read $fhnd $theEnd]
+ close $fhnd
+
+ regsub -all {(\r)|(\r){1,2}(\n)} $rawFile "\n" rawFile
+
+ set lineList [split $rawFile \n]
+
+ foreach line $lineList {
+ puts $newfhnd $line
+ }
+
+ close $newfhnd
+ file delete ${filename}.o
+}
+
+proc EOL::fixall {args} {
+ if {[llength $args] == 0} {
+ puts stderr "no files to fix"
+ exit 1
+ } else {
+ set cmd [lreplace $args -1 -1 glob -nocomplain]
+ }
+
+ foreach f [eval $cmd] {
+ if {[file isfile $f]} {fix $f}
+ }
+}
+
+if {$tcl_interactive == 0 && $argc > 0} {
+ if {[string index [lindex $argv 0] 0] == "-"} {
+ switch -- [lindex $argv 0] {
+ -cr { set ::EOL::outMode cr }
+ -crlf { set ::EOL::outMode crlf }
+ -lf { set ::EOL::outMode lf }
+ default { puts stderr "improper mode switch" ; exit 1 }
+ }
+ set argv [lrange $argv 1 end]
+ }
+ eval EOL::fixall $argv
+} else {
+ return
+}
diff --git a/tcl/tools/feather.bmp b/tcl/tools/feather.bmp
new file mode 100644
index 00000000000..23aa02e5caf
--- /dev/null
+++ b/tcl/tools/feather.bmp
Binary files differ
diff --git a/tcl/tools/genStubs.tcl b/tcl/tools/genStubs.tcl
index ee0bfd4d067..9193b3b426b 100644
--- a/tcl/tools/genStubs.tcl
+++ b/tcl/tools/genStubs.tcl
@@ -10,6 +10,8 @@
#
# RCS: @(#) $Id$
+package require Tcl 8
+
namespace eval genStubs {
# libraryName --
#
@@ -120,7 +122,7 @@ proc genStubs::hooks {names} {
# Arguments:
# index The index number of the interface.
# platform The platform the interface belongs to. Should be one
-# of generic, win, unix, or mac.
+# of generic, win, unix, or mac, or macosx or aqua or x11.
# decl The C function declaration, or {} for an undefined
# entry.
#
@@ -180,9 +182,6 @@ proc genStubs::rewriteFile {file text} {
set in [open ${file} r]
set out [open ${file}.new w]
- # Always write out the file with LF termination
- fconfigure $out -translation lf
-
while {![eof $in]} {
set line [gets $in]
if {[regexp {!BEGIN!} $line]} {
@@ -227,6 +226,15 @@ proc genStubs::addPlatformGuard {plat text} {
mac {
return "#ifdef MAC_TCL\n${text}#endif /* MAC_TCL */\n"
}
+ macosx {
+ return "#ifdef MAC_OSX_TCL\n${text}#endif /* MAC_OSX_TCL */\n"
+ }
+ aqua {
+ return "#ifdef MAC_OSX_TK\n${text}#endif /* MAC_OSX_TK */\n"
+ }
+ x11 {
+ return "#if !(defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK)) /* X11 */\n${text}#endif /* X11 */\n"
+ }
}
return "$text"
}
@@ -616,6 +624,30 @@ proc genStubs::forAllStubs {name slotProc onAll textVar \
set emit 1
}
}
+ #
+ # "aqua" and "macosx" and "x11" are special cases,
+ # since "macosx" always implies "unix" and "aqua",
+ # "macosx", so we need to be careful not to
+ # emit duplicate stubs entries for the two.
+ #
+ if {[info exists stubs($name,aqua,$i)]
+ && ![info exists stubs($name,macosx,$i)]} {
+ append text [addPlatformGuard aqua \
+ [$slotProc $name $stubs($name,aqua,$i) $i]]
+ set emit 1
+ }
+ if {[info exists stubs($name,macosx,$i)]
+ && ![info exists stubs($name,unix,$i)]} {
+ append text [addPlatformGuard macosx \
+ [$slotProc $name $stubs($name,macosx,$i) $i]]
+ set emit 1
+ }
+ if {[info exists stubs($name,x11,$i)]
+ && ![info exists stubs($name,unix,$i)]} {
+ append text [addPlatformGuard x11 \
+ [$slotProc $name $stubs($name,x11,$i) $i]]
+ set emit 1
+ }
}
if {$emit == 0} {
eval {append text} $skipString
@@ -638,8 +670,49 @@ proc genStubs::forAllStubs {name slotProc onAll textVar \
append text [addPlatformGuard $plat $temp]
}
}
+ # Again, make sure you don't duplicate entries for macosx & aqua.
+ if {[info exists stubs($name,aqua,lastNum)]
+ && ![info exists stubs($name,macosx,lastNum)]} {
+ set lastNum $stubs($name,aqua,lastNum)
+ set temp {}
+ for {set i 0} {$i <= $lastNum} {incr i} {
+ if {![info exists stubs($name,aqua,$i)]} {
+ eval {append temp} $skipString
+ } else {
+ append temp [$slotProc $name $stubs($name,aqua,$i) $i]
+ }
+ }
+ append text [addPlatformGuard aqua $temp]
+ }
+ # Again, make sure you don't duplicate entries for macosx & unix.
+ if {[info exists stubs($name,macosx,lastNum)]
+ && ![info exists stubs($name,unix,lastNum)]} {
+ set lastNum $stubs($name,macosx,lastNum)
+ set temp {}
+ for {set i 0} {$i <= $lastNum} {incr i} {
+ if {![info exists stubs($name,macosx,$i)]} {
+ eval {append temp} $skipString
+ } else {
+ append temp [$slotProc $name $stubs($name,macosx,$i) $i]
+ }
+ }
+ append text [addPlatformGuard macosx $temp]
+ }
+ # Again, make sure you don't duplicate entries for x11 & unix.
+ if {[info exists stubs($name,x11,lastNum)]
+ && ![info exists stubs($name,unix,lastNum)]} {
+ set lastNum $stubs($name,x11,lastNum)
+ set temp {}
+ for {set i 0} {$i <= $lastNum} {incr i} {
+ if {![info exists stubs($name,x11,$i)]} {
+ eval {append temp} $skipString
+ } else {
+ append temp [$slotProc $name $stubs($name,x11,$i) $i]
+ }
+ }
+ append text [addPlatformGuard x11 $temp]
+ }
}
-
}
# genStubs::emitDeclarations --
diff --git a/tcl/tools/genWinImage.tcl b/tcl/tools/genWinImage.tcl
index b49c52a45ab..a28ddcbdd94 100644
--- a/tcl/tools/genWinImage.tcl
+++ b/tcl/tools/genWinImage.tcl
@@ -155,4 +155,3 @@ proc genWinImage::generateInstallers {} {
}
genWinImage::init
-
diff --git a/tcl/tools/man2help.tcl b/tcl/tools/man2help.tcl
index 6a3ab6517b7..4269991c886 100644
--- a/tcl/tools/man2help.tcl
+++ b/tcl/tools/man2help.tcl
@@ -13,6 +13,8 @@
# PASS 1
#
+set man2tclprog [file join [file dirname [info script]] man2tcl.exe]
+
proc generateContents {basename version files} {
global curID topics
set curID 0
@@ -21,7 +23,7 @@ proc generateContents {basename version files} {
flush stdout
doFile $f
}
- set fd [open "$basename$version.cnt" w]
+ set fd [open [file join [file dirname [info script]] $basename$version.cnt] w]
fconfigure $fd -translation crlf
puts $fd ":Base $basename$version.hlp"
foreach package [getPackages] {
@@ -55,9 +57,9 @@ proc generateHelp {basename files} {
}
}
- set file [open "$basename.rtf" w]
+ set file [open [file join [file dirname [info script]] $basename.rtf] w]
fconfigure $file -translation crlf
- puts $file "\{\\rtf1\\ansi \\deff0\\deflang1033\{\\fonttbl\{\\f0\\froman\\fcharset0\\fprq2 Times New Roman\;\}\}"
+ puts $file "\{\\rtf1\\ansi \\deff0\\deflang1033\{\\fonttbl\{\\f0\\froman\\fcharset0\\fprq2 Times New Roman\;\}\{\\f1\\fmodern\\fcharset0\\fprq1 Courier New\;\}\}"
foreach f $files {
puts "Pass 2 -- $f"
flush stdout
@@ -78,8 +80,8 @@ proc generateHelp {basename files} {
# file - Name of file to translate.
proc doFile {file} {
- if {[catch {eval [exec man2tcl [glob $file]]} msg] &&
- [catch {eval [exec ./man2tcl [glob $file]]} msg]} {
+ global man2tclprog
+ if {[catch {eval [exec $man2tclprog [glob $file]]} msg]} {
global errorInfo
puts stderr $msg
puts "in"
@@ -98,33 +100,38 @@ proc doFile {file} {
proc doDir dir {
puts "Generating man pages for $dir..."
- foreach f [lsort [glob [file join $dir *.\[13n\]]]] {
- do $f
+ foreach f [lsort [glob -directory $dir "*.\[13n\]"]] {
+ doFile $f
}
}
# process command line arguments
if {$argc < 3} {
- puts stderr "usage: $argv0 projectName version manFiles..."
+ puts stderr "usage: $argv0 \[options\] projectName version manFiles..."
exit 1
}
-set baseName [lindex $argv 0]
-set version [lindex $argv 1]
+set arg 0
+
+if {![string compare [lindex $argv $arg] "-bitmap"]} {
+ set bitmap [lindex $argv [incr arg]]
+ incr arg
+}
+set baseName [lindex $argv $arg]
+set version [lindex $argv [incr arg]]
set files {}
-foreach i [lrange $argv 2 end] {
+foreach i [lrange $argv [incr arg] end] {
set i [file join $i]
if {[file isdir $i]} {
- foreach f [lsort [glob [file join $i *.\[13n\]]]] {
+ foreach f [lsort [glob -directory $i "*.\[13n\]"]] {
lappend files $f
}
} elseif {[file exists $i]} {
lappend files $i
}
}
-
-source [file join [file dir $argv0] index.tcl]
+source [file join [file dirname [info script]] index.tcl]
generateContents $baseName $version $files
-source [file join [file dir $argv0] man2help2.tcl]
+source [file join [file dirname [info script]] man2help2.tcl]
generateHelp $baseName $files
diff --git a/tcl/tools/man2help2.tcl b/tcl/tools/man2help2.tcl
index 4ea9d9dd8c4..5aa3ec80f62 100644
--- a/tcl/tools/man2help2.tcl
+++ b/tcl/tools/man2help2.tcl
@@ -271,22 +271,29 @@ proc macro {name args} {
}
tab
}
- AS {} ;# next page and previous page
+ AS {
+ # next page and previous page
+ }
br {
lineBreak
}
BS {}
BE {}
CE {
- decrNestingLevel
+ puts -nonewline $::file "\\f0\\fs20 "
set state(noFill) 0
set state(breakPending) 0
- newPara 0i
+ newPara ""
+ set state(leftIndent) [expr {$state(leftIndent) - $state(offset)}]
+ set state(sb) 80
}
- CS { ;# code section
- incrNestingLevel
+ CS {
+ # code section
set state(noFill) 1
- newPara 0i
+ newPara ""
+ set state(leftIndent) [expr {$state(leftIndent) + $state(offset)}]
+ set state(sb) 80
+ puts -nonewline $::file "\\f1\\fs18 "
}
DE {
set state(noFill) 0
@@ -510,7 +517,7 @@ proc formattedText {text} {
}
o {
text "\\'"
- regexp "'([^']*)'(.*)" $text all ch text
+ regexp {'([^']*)'(.*)} $text all ch text
text $chars($ch)
}
default {
@@ -705,7 +712,7 @@ proc SHmacro {argList} {
set args [join $argList " "]
if {[llength $argList] < 1} {
- puts stderr "Bad .SH macro: .$name $args"
+ puts stderr "Bad .SH macro: .SH $args"
}
# control what the text proc does with text
@@ -823,11 +830,11 @@ proc TPmacro {argList} {
# argList - List of arguments to the .TH macro.
proc THmacro {argList} {
- global file curPkg curSect curID id_keywords state curVer
+ global file curPkg curSect curID id_keywords state curVer bitmap
if {[llength $argList] != 5} {
set args [join $argList " "]
- puts stderr "Bad .TH macro: .$name $args"
+ puts stderr "Bad .TH macro: .TH $args"
}
incr curID
set name [lindex $argList 0] ;# Tcl_UpVar
@@ -861,6 +868,10 @@ proc THmacro {argList} {
tab
text $curSect
font R
+ if {[info exist bitmap]} {
+ # a right justified bitmap
+ puts $file "\\\{bmrt $bitmap\\\}"
+ }
puts $file "\\fs20"
set state(breakPending) -1
}
@@ -896,8 +907,11 @@ proc newPara {leftIndent {firstIndent 0i}} {
if $state(paragraph) {
puts -nonewline $file "\\line\n"
}
- set state(leftIndent) [expr {$state(leftMargin) \
- + ($state(offset) * $state(nestingLevel)) +[getTwips $leftIndent]}]
+ if {$leftIndent != ""} {
+ set state(leftIndent) [expr {$state(leftMargin) \
+ + ($state(offset) * $state(nestingLevel)) \
+ + [getTwips $leftIndent]}]
+ }
set state(firstIndent) [getTwips $firstIndent]
set state(paragraphPending) 1
}
@@ -967,4 +981,3 @@ proc decrNestingLevel {} {
}
}
-
diff --git a/tcl/tools/man2html.tcl b/tcl/tools/man2html.tcl
index cb60887ba65..6f44aaa4c07 100644
--- a/tcl/tools/man2html.tcl
+++ b/tcl/tools/man2html.tcl
@@ -75,7 +75,7 @@ proc footer {packages} {
# dir - Name of the directory.
proc doDir dir {
- foreach f [lsort [glob $dir/*.\[13n\]]] {
+ foreach f [lsort [glob -directory $dir "*.\[13n\]"]] {
do $f ;# defined in man2html1.tcl & man2html2.tcl
}
}
diff --git a/tcl/tools/man2tcl.c b/tcl/tools/man2tcl.c
index 3bb82496826..2396251ee67 100644
--- a/tcl/tools/man2tcl.c
+++ b/tcl/tools/man2tcl.c
@@ -88,7 +88,7 @@ main(argc, argv)
char **argv; /* Values of command-line arguments. */
{
FILE *f;
-#define MAX_LINE_SIZE 500
+#define MAX_LINE_SIZE 1000
char line[MAX_LINE_SIZE];
char *p;
@@ -136,6 +136,12 @@ main(argc, argv)
continue;
}
+ if (strlen(line) >= MAX_LINE_SIZE -1) {
+ fprintf(stderr, "Too long line. Max is %d chars.\n",
+ MAX_LINE_SIZE - 1);
+ exit(1);
+ }
+
if ((line[0] == '.') || (line[0] == '\'')) {
/*
* This line is a macro invocation.
diff --git a/tcl/tools/tcl.hpj.in b/tcl/tools/tcl.hpj.in
index 3400816b9ef..88f15e3b0d0 100644
--- a/tcl/tools/tcl.hpj.in
+++ b/tcl/tools/tcl.hpj.in
@@ -5,9 +5,9 @@ HCW=0
LCID=0x409 0x0 0x0 ;English (United States)
REPORT=Yes
TITLE=Tcl/Tk Reference Manual
-CNT=tcl83.cnt
-COPYRIGHT=Copyright © 1999 Scriptics Corporation
-HLP=tcl83.hlp
+CNT=tcl84.cnt
+COPYRIGHT=Copyright © 2000 Ajuba Solutions
+HLP=tcl84.hlp
[FILES]
tcl.rtf
@@ -17,3 +17,4 @@ main="Tcl/Tk Reference Manual",,0
[CONFIG]
BrowseButtons()
+
diff --git a/tcl/tools/tcl.wse.in b/tcl/tools/tcl.wse.in
index 9ca4b0f9fc6..19cccad5a0a 100644
--- a/tcl/tools/tcl.wse.in
+++ b/tcl/tools/tcl.wse.in
@@ -1,2356 +1,2377 @@
-Document Type: WSE
-item: Global
- Version=6.01
- Title=Tcl 8.3 for Windows Installation
- Flags=00010100
- Languages=65 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
- Japanese Font Name=MS Gothic
- Japanese Font Size=10
- Start Gradient=0 0 255
- End Gradient=0 0 0
- Windows Flags=00000000000000010010110000001000
- Log Pathname=%MAINDIR%\INSTALL.LOG
- Message Font=MS Sans Serif
- Font Size=8
- Disk Label=tcl8.3.2
- Disk Filename=setup
- Patch Flags=0000000000000001
- Patch Threshold=85
- Patch Memory=4000
- Variable Name1=_SYS_
- Variable Default1=C:\WINDOWS\SYSTEM
- Variable Flags1=00001000
- Variable Name2=_ODBC16_
- Variable Default2=C:\WINDOWS\SYSTEM
- Variable Flags2=00001000
- Variable Name3=_WISE_
- Variable Default3=${__WISE__}
- Variable Flags3=00001000
-end
-item: Open/Close INSTALL.LOG
- Flags=00000001
-end
-item: Check if File/Dir Exists
- Pathname=%SYS%
- Flags=10000100
-end
-item: Set Variable
- Variable=SYS
- Value=%WIN%
-end
-item: End Block
-end
-item: Set Variable
- Variable=VER
- Value=8.3
-end
-item: Set Variable
- Variable=PATCHLEVEL
- Value=${__TCL_PATCH_LEVEL__}
-end
-item: Set Variable
- Variable=APPTITLE
- Value=Tcl/Tk %PATCHLEVEL% for Windows
-end
-item: Set Variable
- Variable=URL
- Value=http://dev.scriptics.com/registration/%PATCHLEVEL%.html
-end
-item: Set Variable
- Variable=GROUP
- Value=Tcl
-end
-item: Set Variable
- Variable=DISABLED
- Value=!
-end
-item: Set Variable
- Variable=MAINDIR
- Value=Tcl
-end
-item: Check Configuration
- Flags=10111011
-end
-item: Get Registry Key Value
- Variable=PROGRAM_FILES
- Key=SOFTWARE\Microsoft\Windows\CurrentVersion
- Default=C:\Program Files
- Value Name=ProgramFilesDir
- Flags=00000100
-end
-item: Set Variable
- Variable=MAINDIR
- Value=%PROGRAM_FILES%\%MAINDIR%
-end
-item: Set Variable
- Variable=EXPLORER
- Value=1
-end
-item: Else Statement
-end
-item: Set Variable
- Variable=MAINDIR
- Value=C:\%MAINDIR%
-end
-item: End Block
-end
-item: Set Variable
- Variable=BACKUP
- Value=%MAINDIR%\BACKUP
-end
-item: Set Variable
- Variable=DOBACKUP
- Value=B
-end
-item: Set Variable
- Variable=BRANDING
- Value=0
-end
-remarked item: If/While Statement
- Variable=BRANDING
- Value=1
-end
-remarked item: Read INI Value
- Variable=NAME
- Pathname=%INST%\CUSTDATA.INI
- Section=Registration
- Item=Name
-end
-remarked item: Read INI Value
- Variable=COMPANY
- Pathname=%INST%\CUSTDATA.INI
- Section=Registration
- Item=Company
-end
-remarked item: If/While Statement
- Variable=NAME
-end
-remarked item: Set Variable
- Variable=DOBRAND
- Value=1
-end
-remarked item: End Block
-end
-remarked item: End Block
-end
-item: Set Variable
- Variable=TYPE
- Value=C
-end
-item: Set Variable
- Variable=COMPONENTS
- Value=ABC
-end
-item: Wizard Block
- Direction Variable=DIRECTION
- Display Variable=DISPLAY
- X Position=0
- Y Position=0
- Filler Color=8421440
- Flags=00000001
-end
-item: Custom Dialog Set
- Name=Splash
- Display Variable=DISPLAY
- item: Dialog
- Title=%APPTITLE% Installation
- Title French=Bienvenue
- Title German=Willkommen
- Title Portuguese=Bem-vindo
- Title Spanish=Bienvenido
- Title Italian=Benvenuto
- Title Danish=Velkommen
- Title Dutch=Welkom
- Title Norwegian=Velkommen
- Title Swedish=Välkommen
- Width=273
- Height=250
- Font Name=Helv
- Font Size=8
- item: Push Button
- Rectangle=166 214 208 228
- Variable=DIRECTION
- Value=N
- Create Flags=01010000000000010000000000000001
- Text=&Next >
- end
- item: Push Button
- Rectangle=212 214 254 228
- Action=3
- Create Flags=01010000000000010000000000000000
- Text=Cancel
- end
- item: Static
- Rectangle=0 0 268 233
- Action=2
- Enabled Color=00000000000000001111111111111111
- Create Flags=01010000000000000000000000001011
- Pathname=${__TCLBASEDIR__}\tools\white.bmp
- end
- item: Static
- Rectangle=5 5 268 215
- Destination Dialog=1
- Action=2
- Enabled Color=00000000000000001111111111111111
- Create Flags=01010000000000000000000000001011
- Pathname=${__TCLBASEDIR__}\tools\tclSplash.bmp
- end
- end
-end
-item: End Block
-end
-item: Wizard Block
- Direction Variable=DIRECTION
- Display Variable=DISPLAY
- Bitmap Pathname=%_WISE_%\DIALOGS\TEMPLATE\WIZARD.BMP
- X Position=9
- Y Position=10
- Filler Color=8421440
- Dialog=Welcome
- Dialog=Select Destination Directory
- Dialog=Select Installation Type
- Dialog=Select Components
- Dialog=Select Program Manager Group
- Variable=
- Variable=
- Variable=
- Variable=TYPE
- Variable=EXPLORER
- Value=
- Value=
- Value=
- Value=C
- Value=1
- Compare=0
- Compare=0
- Compare=0
- Compare=1
- Compare=0
- Flags=00000011
-end
-item: Custom Dialog Set
- Name=Welcome
- Display Variable=DISPLAY
- item: Dialog
- Title=%APPTITLE% Installation
- Title French=Installation de %APPTITLE%
- Title German=Installation von %APPTITLE%
- Title Spanish=Instalación de %APPTITLE%
- Title Italian=Installazione di %APPTITLE%
- Width=271
- Height=224
- Font Name=Helv
- Font Size=8
- item: Static
- Rectangle=86 8 258 42
- Create Flags=01010000000000000000000000000000
- Flags=0000000000000001
- Name=Times New Roman
- Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18
- Text=Welcome!
- Text French=Bienvenue !
- Text German=Willkommen!
- Text Spanish=¡Bienvenido!
- Text Italian=Benvenuti!
- end
- item: Push Button
- Rectangle=150 187 195 202
- Variable=DIRECTION
- Value=N
- Create Flags=01010000000000010000000000000001
- Text=&Next >
- Text French=&Suite >
- Text German=&Weiter >
- Text Spanish=&Siguiente >
- Text Italian=&Avanti >
- end
- item: Push Button
- Rectangle=105 187 150 202
- Variable=DISABLED
- Value=!
- Create Flags=01010000000000010000000000000000
- Text=< &Back
- Text French=< &Retour
- Text German=< &Zurück
- Text Spanish=< &Atrás
- Text Italian=< &Indietro
- end
- item: Push Button
- Rectangle=211 187 256 202
- Action=3
- Create Flags=01010000000000010000000000000000
- Text=&Cancel
- Text French=&Annuler
- Text German=&Abbrechen
- Text Spanish=&Cancelar
- Text Italian=&Annulla
- end
- item: Static
- Rectangle=85 41 255 130
- Create Flags=01010000000000000000000000000000
- Text=This installation program will install %APPTITLE%.
- Text=
- Text=Press the Next button to start the installation. You can press the Exit Setup button now if you do not want to install %APPTITLE% at this time.
- Text=
- Text=It is strongly recommended that you exit all Windows programs before running this installation program.
- Text French=Ce programme d'installation va installer %APPTITLE%.
- Text French=
- Text French=Cliquez sur le bouton Suite pour démarrer l'installation. Vous pouvez cliquer sur le bouton Quitter l'installation si vous ne voulez pas installer %APPTITLE% tout de suite.
- Text German=Mit diesem Installationsprogramm wird %APPTITLE% installiert.
- Text German=
- Text German=Klicken Sie auf "Weiter", um mit der Installation zu beginnen. Klicken Sie auf "Abbrechen", um die Installation von %APPTITLE% abzubrechen.
- Text Spanish=Este programa de instalación instalará %APPTITLE%.
- Text Spanish=
- Text Spanish=Presione el botón Siguiente para iniciar la instalación. Puede presionar el botón Salir de instalación si no desea instalar %APPTITLE% en este momento.
- Text Italian=Questo programma installerà %APPTITLE%.
- Text Italian=
- Text Italian=Per avvviare l'installazione premere il pulsante Avanti. Se non si desidera installare %APPTITLE% ora, premere il pulsante Esci dall'installazione.
- end
- item: Static
- Rectangle=8 180 256 181
- Action=3
- Create Flags=01010000000000000000000000000111
- end
- end
-end
-item: Custom Dialog Set
- Name=Select Destination Directory
- Display Variable=DISPLAY
- item: Dialog
- Title=%APPTITLE% Installation
- Title French=Installation de %APPTITLE%
- Title German=Installation von %APPTITLE%
- Title Spanish=Instalación de %APPTITLE%
- Title Italian=Installazione di %APPTITLE%
- Width=271
- Height=224
- Font Name=Helv
- Font Size=8
- item: Push Button
- Rectangle=150 187 195 202
- Variable=DIRECTION
- Value=N
- Create Flags=01010000000000010000000000000001
- Text=&Next >
- Text French=&Suite >
- Text German=&Weiter >
- Text Spanish=&Siguiente >
- Text Italian=&Avanti >
- end
- item: Push Button
- Rectangle=105 187 150 202
- Variable=DIRECTION
- Value=B
- Create Flags=01010000000000010000000000000000
- Flags=0000000000000001
- Text=< &Back
- Text French=< &Retour
- Text German=< &Zurück
- Text Spanish=< &Atrás
- Text Italian=< &Indietro
- end
- item: Push Button
- Rectangle=211 187 256 202
- Action=3
- Create Flags=01010000000000010000000000000000
- Text=&Cancel
- Text French=&Annuler
- Text German=&Abbrechen
- Text Spanish=&Cancelar
- Text Italian=&Annulla
- end
- item: Static
- Rectangle=8 180 256 181
- Action=3
- Create Flags=01010000000000000000000000000111
- end
- item: Static
- Rectangle=86 8 258 42
- Create Flags=01010000000000000000000000000000
- Flags=0000000000000001
- Name=Times New Roman
- Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18
- Text=Select Destination Directory
- Text French=Sélectionner le répertoire de destination
- Text German=Zielverzeichnis wählen
- Text Spanish=Seleccione el directorio de destino
- Text Italian=Selezionare Directory di destinazione
- end
- item: Static
- Rectangle=86 39 256 114
- Create Flags=01010000000000000000000000000000
- Text=Please select the directory where the %APPTITLE% files are to be installed.
- Text=
- Text=To install in the default directory below, click Next.
- Text=
- Text=To install in a different directory, click Browse and select another directory.
- Text French=Veuillez sélectionner le répertoire dans lequel les fichiers %APPTITLE% doivent être installés.
- Text German=Geben Sie an, in welchem Verzeichnis die %APPTITLE%-Dateien installiert werden sollen.
- Text Spanish=Por favor seleccione el directorio donde desee instalar los archivos de %APPTITLE%.
- Text Italian=Selezionare la directory dove verranno installati i file %APPTITLE%.
- end
- item: Static
- Rectangle=86 130 256 157
- Action=1
- Create Flags=01010000000000000000000000000111
- end
- item: Push Button
- Rectangle=205 138 250 153
- Variable=MAINDIR_SAVE
- Value=%MAINDIR%
- Destination Dialog=1
- Action=2
- Create Flags=01010000000000010000000000000000
- Text=Browse
- Text French=Parcourir
- Text German=Durchsuchen
- Text Spanish=Buscar
- Text Italian=Sfoglie
- end
- item: Static
- Rectangle=91 140 198 151
- Create Flags=01010000000000000000000000000000
- Text=%MAINDIR%
- Text French=%MAINDIR%
- Text German=%MAINDIR%
- Text Spanish=%MAINDIR%
- Text Italian=%MAINDIR%
- end
- end
- item: Dialog
- Title=Select Destination Directory
- Title French=Sélectionner le répertoire de destination
- Title German=Zielverzeichnis wählen
- Title Spanish=Seleccione el directorio de destino
- Title Italian=Selezionare Directory di destinazione
- Width=221
- Height=173
- Font Name=Helv
- Font Size=8
- item: Listbox
- Rectangle=5 5 163 149
- Variable=MAINDIR
- Create Flags=01010000100000010000000101000000
- Flags=0000110000100010
- Text=%MAINDIR%
- Text French=%MAINDIR%
- Text German=%MAINDIR%
- Text Spanish=%MAINDIR%
- Text Italian=%MAINDIR%
- end
- item: Push Button
- Rectangle=167 6 212 21
- Create Flags=01010000000000010000000000000001
- Text=OK
- Text French=OK
- Text German=OK
- Text Spanish=Aceptar
- Text Italian=OK
- end
- item: Push Button
- Rectangle=167 25 212 40
- Variable=MAINDIR
- Value=%MAINDIR_SAVE%
- Create Flags=01010000000000010000000000000000
- Flags=0000000000000001
- Text=Cancel
- Text French=Annuler
- Text German=Abbrechen
- Text Spanish=Cancelar
- Text Italian=Annulla
- end
- end
-end
-remarked item: Custom Dialog Set
- Name=Select Installation Type
- Display Variable=DISPLAY
- item: Dialog
- Title=%APPTITLE% Installation
- Title French=Installation de %APPTITLE%
- Title German=Installation von %APPTITLE%
- Title Spanish=Instalación de %APPTITLE%
- Title Italian=Installazione di %APPTITLE%
- Width=271
- Height=224
- Font Name=Helv
- Font Size=8
- item: Push Button
- Rectangle=150 187 195 202
- Variable=DIRECTION
- Value=N
- Create Flags=01010000000000010000000000000001
- Text=&Next >
- Text French=&Suite >
- Text German=&Weiter >
- Text Spanish=&Siguiente >
- Text Italian=&Avanti >
- end
- item: Push Button
- Rectangle=105 187 150 202
- Variable=DIRECTION
- Value=B
- Create Flags=01010000000000010000000000000000
- Text=< &Back
- Text French=< &Retour
- Text German=< &Zurück
- Text Spanish=< &Atrás
- Text Italian=< &Indietro
- end
- item: Push Button
- Rectangle=211 187 256 202
- Action=3
- Create Flags=01010000000000010000000000000000
- Text=&Cancel
- Text French=&Annuler
- Text German=&Abbrechen
- Text Spanish=&Cancelar
- Text Italian=&Annulla
- end
- item: Static
- Rectangle=8 180 256 181
- Action=3
- Create Flags=01010000000000000000000000000111
- end
- item: Static
- Rectangle=86 8 258 42
- Create Flags=01010000000000000000000000000000
- Flags=0000000000000001
- Name=Times New Roman
- Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18
- Text=Select Installation Type
- Text French=Sélectionner les composants
- Text German=Komponenten auswählen
- Text Spanish=Seleccione componentes
- Text Italian=Selezionare i componenti
- end
- item: Static
- Rectangle=194 162 242 172
- Variable=COMPONENTS
- Value=MAINDIR
- Create Flags=01010000000000000000000000000010
- end
- item: Static
- Rectangle=194 153 242 162
- Variable=COMPONENTS
- Create Flags=01010000000000000000000000000010
- end
- item: Static
- Rectangle=107 153 196 164
- Create Flags=01010000000000000000000000000000
- Text=Disk Space Required:
- Text French=Espace disque requis :
- Text German=Notwendiger Speicherplatz:
- Text Spanish=Espacio requerido en el disco:
- Text Italian=Spazio su disco necessario:
- end
- item: Static
- Rectangle=107 162 196 172
- Create Flags=01010000000000000000000000000000
- Text=Disk Space Remaining:
- Text French=Espace disque disponible :
- Text German=Verbleibender Speicherplatz:
- Text Spanish=Espacio en disco disponible:
- Text Italian=Spazio su disco disponibile:
- end
- item: Static
- Rectangle=86 145 256 175
- Action=1
- Create Flags=01010000000000000000000000000111
- end
- item: Static
- Rectangle=86 42 256 61
- Create Flags=01010000000000000000000000000000
- Text=Choose which type of installation to perform by selecting one of the buttons below.
- Text French=Choisissez les composants que vous voulez installer en cochant les cases ci-dessous.
- Text German=Wählen Sie die zu installierenden Komponenten, indem Sie in die entsprechenden Kästchen klicken.
- Text Spanish=Elija los componentes que desee instalar marcando los cuadros de abajo.
- Text Italian=Scegliere quali componenti installare selezionando le caselle sottostanti.
- end
- item: Radio Button
- Rectangle=86 74 256 128
- Variable=TYPE
- Create Flags=01010000000000010000000000001001
- Text=&Full Installation (Recommended)
- Text=&Minimal Installation
- Text=C&ustom Installation
- Text=
- end
- end
-end
-item: Custom Dialog Set
- Name=Select Components
- Display Variable=DISPLAY
- item: Dialog
- Title=%APPTITLE% Installation
- Title French=Installation de %APPTITLE%
- Title German=Installation von %APPTITLE%
- Title Spanish=Instalación de %APPTITLE%
- Title Italian=Installazione di %APPTITLE%
- Width=271
- Height=224
- Font Name=Helv
- Font Size=8
- item: Push Button
- Rectangle=150 187 195 202
- Variable=DIRECTION
- Value=N
- Create Flags=01010000000000010000000000000001
- Text=&Next >
- Text French=&Suite >
- Text German=&Weiter >
- Text Spanish=&Siguiente >
- Text Italian=&Avanti >
- end
- item: Push Button
- Rectangle=105 187 150 202
- Variable=DIRECTION
- Value=B
- Create Flags=01010000000000010000000000000000
- Text=< &Back
- Text French=< &Retour
- Text German=< &Zurück
- Text Spanish=< &Atrás
- Text Italian=< &Indietro
- end
- item: Push Button
- Rectangle=211 187 256 202
- Action=3
- Create Flags=01010000000000010000000000000000
- Text=&Cancel
- Text French=&Annuler
- Text German=&Abbrechen
- Text Spanish=&Cancelar
- Text Italian=&Annulla
- end
- item: Static
- Rectangle=8 180 256 181
- Action=3
- Create Flags=01010000000000000000000000000111
- end
- item: Static
- Rectangle=86 8 258 42
- Create Flags=01010000000000000000000000000000
- Flags=0000000000000001
- Name=Times New Roman
- Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18
- Text=Select Components
- Text French=Sélectionner les composants
- Text German=Komponenten auswählen
- Text Spanish=Seleccione componentes
- Text Italian=Selezionare i componenti
- end
- item: Checkbox
- Rectangle=86 75 256 129
- Variable=COMPONENTS
- Create Flags=01010000000000010000000000000011
- Flags=0000000000000110
- Text=Tcl Run-Time Files
- Text=Example Scripts
- Text=Help Files
- Text=Header and Library Files
- Text=
- Text French=Tcl Run-Time Files
- Text French=Example Scripts
- Text French=Help Files
- Text French=Header and Library Files
- Text French=
- Text German=Tcl Run-Time Files
- Text German=Example Scripts
- Text German=Help Files
- Text German=Header and Library Files
- Text German=
- Text Spanish=Tcl Run-Time Files
- Text Spanish=Example Scripts
- Text Spanish=Help Files
- Text Spanish=Header and Library Files
- Text Spanish=
- Text Italian=Tcl Run-Time Files
- Text Italian=Example Scripts
- Text Italian=Help Files
- Text Italian=Header and Library Files
- Text Italian=
- end
- item: Static
- Rectangle=194 162 242 172
- Variable=COMPONENTS
- Value=MAINDIR
- Create Flags=01010000000000000000000000000010
- end
- item: Static
- Rectangle=194 153 242 162
- Variable=COMPONENTS
- Create Flags=01010000000000000000000000000010
- end
- item: Static
- Rectangle=107 153 196 164
- Create Flags=01010000000000000000000000000000
- Text=Disk Space Required:
- Text French=Espace disque requis :
- Text German=Notwendiger Speicherplatz:
- Text Spanish=Espacio requerido en el disco:
- Text Italian=Spazio su disco necessario:
- end
- item: Static
- Rectangle=107 162 196 172
- Create Flags=01010000000000000000000000000000
- Text=Disk Space Remaining:
- Text French=Espace disque disponible :
- Text German=Verbleibender Speicherplatz:
- Text Spanish=Espacio en disco disponible:
- Text Italian=Spazio su disco disponibile:
- end
- item: Static
- Rectangle=86 145 256 175
- Action=1
- Create Flags=01010000000000000000000000000111
- end
- item: Static
- Rectangle=86 42 256 61
- Create Flags=01010000000000000000000000000000
- Text=Choose which components to install by checking the boxes below.
- Text French=Choisissez les composants que vous voulez installer en cochant les cases ci-dessous.
- Text German=Wählen Sie die zu installierenden Komponenten, indem Sie in die entsprechenden Kästchen klicken.
- Text Spanish=Elija los componentes que desee instalar marcando los cuadros de abajo.
- Text Italian=Scegliere quali componenti installare selezionando le caselle sottostanti.
- end
- end
-end
-item: Custom Dialog Set
- Name=Select Program Manager Group
- Display Variable=DISPLAY
- item: Dialog
- Title=%APPTITLE% Installation
- Title French=Installation de %APPTITLE%
- Title German=Installation von %APPTITLE%
- Title Spanish=Instalación de %APPTITLE%
- Title Italian=Installazione di %APPTITLE%
- Width=271
- Height=224
- Font Name=Helv
- Font Size=8
- item: Push Button
- Rectangle=150 187 195 202
- Variable=DIRECTION
- Value=N
- Create Flags=01010000000000010000000000000001
- Text=&Next >
- Text French=&Suite >
- Text German=&Weiter >
- Text Spanish=&Siguiente >
- Text Italian=&Avanti >
- end
- item: Push Button
- Rectangle=105 187 150 202
- Variable=DIRECTION
- Value=B
- Create Flags=01010000000000010000000000000000
- Flags=0000000000000001
- Text=< &Back
- Text French=< &Retour
- Text German=< &Zurück
- Text Spanish=< &Atrás
- Text Italian=< &Indietro
- end
- item: Push Button
- Rectangle=211 187 256 202
- Action=3
- Create Flags=01010000000000010000000000000000
- Text=&Cancel
- Text French=&Annuler
- Text German=&Abbrechen
- Text Spanish=&Cancelar
- Text Italian=&Annulla
- end
- item: Static
- Rectangle=8 180 256 181
- Action=3
- Create Flags=01010000000000000000000000000111
- end
- item: Static
- Rectangle=86 8 258 42
- Create Flags=01010000000000000000000000000000
- Flags=0000000000000001
- Name=Times New Roman
- Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18
- Text=Select ProgMan Group
- Text French=Sélectionner le groupe du Gestionnaire de programme
- Text German=Bestimmung der Programm-Managergruppe
- Text Spanish=Seleccione grupo del Administrador de programas
- Text Italian=Selezionare il gruppo ProgMan
- end
- item: Static
- Rectangle=86 44 256 68
- Create Flags=01010000000000000000000000000000
- Text=Enter the name of the Program Manager group to add the %APPTITLE% icons to:
- Text French=Entrez le nom du groupe du Gestionnaire de programme dans lequel vous souhaitez ajouter les icônes de %APPTITLE% :
- Text German=Geben Sie den Namen der Programmgruppe ein, der das Symbol %APPTITLE% hinzugefügt werden soll:
- Text Spanish=Escriba el nombre del grupo del Administrador de programas en el que desea agregar los iconos de %APPTITLE%:
- Text Italian=Inserire il nome del gruppo Program Manager per aggiungere le icone %APPTITLE% a:
- end
- item: Combobox
- Rectangle=86 69 256 175
- Variable=GROUP
- Create Flags=01010000000000010000001000000001
- Flags=0000000000000001
- Text=%GROUP%
- Text French=%GROUP%
- Text German=%GROUP%
- Text Spanish=%GROUP%
- Text Italian=%GROUP%
- end
- end
-end
-item: Custom Dialog Set
- Name=Start Installation
- Display Variable=DISPLAY
- item: Dialog
- Title=%APPTITLE% Installation
- Title French=Installation de %APPTITLE%
- Title German=Installation von %APPTITLE%
- Title Spanish=Instalación de %APPTITLE%
- Title Italian=Installazione di %APPTITLE%
- Width=271
- Height=224
- Font Name=Helv
- Font Size=8
- item: Push Button
- Rectangle=150 187 195 202
- Variable=DIRECTION
- Value=N
- Create Flags=01010000000000010000000000000001
- Text=&Next >
- Text French=&Suite >
- Text German=&Weiter >
- Text Spanish=&Siguiente >
- Text Italian=&Avanti >
- end
- item: Push Button
- Rectangle=105 187 150 202
- Variable=DIRECTION
- Value=B
- Create Flags=01010000000000010000000000000000
- Text=< &Back
- Text French=< &Retour
- Text German=< &Zurück
- Text Spanish=< &Atrás
- Text Italian=< &Indietro
- end
- item: Push Button
- Rectangle=211 187 256 202
- Action=3
- Create Flags=01010000000000010000000000000000
- Text=&Cancel
- Text French=&Annuler
- Text German=&Abbrechen
- Text Spanish=&Cancelar
- Text Italian=&Annulla
- end
- item: Static
- Rectangle=8 180 256 181
- Action=3
- Create Flags=01010000000000000000000000000111
- end
- item: Static
- Rectangle=86 8 258 42
- Create Flags=01010000000000000000000000000000
- Flags=0000000000000001
- Name=Times New Roman
- Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18
- Text=Ready to Install!
- Text French=Prêt à installer !
- Text German=Installationsbereit!
- Text Spanish=¡Preparado para la instalación!
- Text Italian=Pronto per l'installazione!
- end
- item: Static
- Rectangle=86 42 256 102
- Create Flags=01010000000000000000000000000000
- Text=You are now ready to install %APPTITLE%.
- Text=
- Text=Press the Next button to begin the installation or the Back button to reenter the installation information.
- Text French=Vous êtes maintenant prêt à installer les fichiers %APPTITLE%.
- Text French=
- Text French=Cliquez sur le bouton Suite pour commencer l'installation ou sur le bouton Retour pour entrer les informations d'installation à nouveau.
- Text German=Sie können %APPTITLE% nun installieren.
- Text German=
- Text German=Klicken Sie auf "Weiter", um mit der Installation zu beginnen. Klicken Sie auf "Zurück", um die Installationsinformationen neu einzugeben.
- Text Spanish=Ya está listo para instalar %APPTITLE%.
- Text Spanish=
- Text Spanish=Presione el botón Siguiente para comenzar la instalación o presione Atrás para volver a ingresar la información para la instalación.
- Text Italian=Ora è possibile installare %APPTITLE%.
- Text Italian=
- Text Italian=Premere il pulsante Avanti per avviare l'installazione o il pulsante Indietro per reinserire le informazioni di installazione.
- end
- end
-end
-item: If/While Statement
- Variable=DISPLAY
- Value=Select Destination Directory
-end
-item: Set Variable
- Variable=BACKUP
- Value=%MAINDIR%\BACKUP
-end
-item: End Block
-end
-item: End Block
-end
-item: If/While Statement
- Variable=TYPE
- Value=B
-end
-item: Set Variable
- Variable=COMPONENTS
- Value=A
-end
-item: End Block
-end
-item: If/While Statement
- Variable=DOBACKUP
- Value=A
-end
-item: Set Variable
- Variable=BACKUPDIR
- Value=%BACKUP%
-end
-item: End Block
-end
-remarked item: If/While Statement
- Variable=BRANDING
- Value=1
-end
-remarked item: If/While Statement
- Variable=DOBRAND
- Value=1
-end
-remarked item: Edit INI File
- Pathname=%INST%\CUSTDATA.INI
- Settings=[Registration]
- Settings=NAME=%NAME%
- Settings=COMPANY=%COMPANY%
- Settings=
-end
-remarked item: End Block
-end
-remarked item: End Block
-end
-item: Set Variable
- Variable=MAINDIRSHORT
- Value=%MAINDIR%
- Flags=00010100
-end
-item: Open/Close INSTALL.LOG
-end
-item: Check Disk Space
- Component=COMPONENTS
-end
-item: Install File
- Source=${__TCLBASEDIR__}\license.txt
- Destination=%MAINDIR%\license.txt
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\win\Readme.txt
- Destination=%MAINDIR%\Readme.txt
- Flags=0000000000000010
-end
-item: If/While Statement
- Variable=COMPONENTS
- Value=D
- Flags=00001010
-end
-item: Install File
- Source=${__TKBASEDIR__}\win\release\tk83.lib
- Destination=%MAINDIR%\lib\tk83.lib
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\win\release\tkstub83.lib
- Destination=%MAINDIR%\lib\tkstub83.lib
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\win\release\tcl83.lib
- Destination=%MAINDIR%\lib\tcl83.lib
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\win\release\tclstub83.lib
- Destination=%MAINDIR%\lib\tclstub83.lib
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\xlib\X11\Xutil.h
- Destination=%MAINDIR%\include\X11\Xutil.h
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\xlib\X11\Xlib.h
- Destination=%MAINDIR%\include\X11\Xlib.h
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\xlib\X11\Xfuncproto.h
- Destination=%MAINDIR%\include\X11\Xfuncproto.h
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\xlib\X11\Xatom.h
- Destination=%MAINDIR%\include\X11\Xatom.h
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\xlib\X11\X.h
- Destination=%MAINDIR%\include\X11\X.h
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\xlib\X11\keysymdef.h
- Destination=%MAINDIR%\include\X11\keysymdef.h
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\xlib\X11\keysym.h
- Destination=%MAINDIR%\include\X11\keysym.h
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\xlib\X11\cursorfont.h
- Destination=%MAINDIR%\include\X11\cursorfont.h
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\generic\tk.h
- Destination=%MAINDIR%\include\tk.h
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\generic\tkDecls.h
- Destination=%MAINDIR%\include\tkDecls.h
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\generic\tkIntXlibDecls.h
- Destination=%MAINDIR%\include\tkIntXlibDecls.h
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\generic\tcl.h
- Destination=%MAINDIR%\include\tcl.h
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\generic\tclDecls.h
- Destination=%MAINDIR%\include\tclDecls.h
- Flags=0000000000000010
-end
-item: End Block
-end
-item: If/While Statement
- Variable=COMPONENTS
- Value=A
- Flags=00001010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\msgcat1.0\pkgIndex.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\msgcat1.0\pkgIndex.tcl
- Flags=0000000010000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\msgcat1.0\msgcat.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\msgcat1.0\msgcat.tcl
- Flags=0000000010000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\tcltest1.0\pkgIndex.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\tcltest1.0\pkgIndex.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\tcltest1.0\tcltest.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\tcltest1.0\tcltest.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\symbol.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\symbol.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\shiftjis.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\shiftjis.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\macUkraine.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\macUkraine.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\macTurkish.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\macTurkish.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\macThai.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\macThai.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\macRomania.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\macRomania.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\macRoman.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\macRoman.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\macJapan.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\macJapan.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\macIceland.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\macIceland.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\macGreek.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\macGreek.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\macDingbats.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\macDingbats.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\macCyrillic.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\macCyrillic.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\macCroatian.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\macCroatian.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\macCentEuro.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\macCentEuro.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\ksc5601.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\ksc5601.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\koi8-r.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\koi8-r.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\jis0212.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\jis0212.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\jis0208.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\jis0208.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\jis0201.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\jis0201.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\iso8859-9.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-9.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\iso8859-8.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-8.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\iso8859-7.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-7.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\iso8859-6.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-6.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\iso8859-5.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-5.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\iso8859-4.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-4.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\iso8859-3.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-3.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\iso8859-2.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-2.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\iso8859-1.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-1.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\iso2022.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso2022.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\iso2022-kr.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso2022-kr.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\iso2022-jp.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso2022-jp.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\gb2312.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\gb2312.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\gb1988.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\gb1988.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\gb12345.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\gb12345.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\euc-cn.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\euc-cn.enc
- Flags=0000000010000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\euc-jp.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\euc-jp.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\euc-kr.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\euc-kr.enc
- Flags=0000000010000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\dingbats.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\dingbats.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp950.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp950.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp949.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp949.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp936.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp936.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp932.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp932.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp874.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp874.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp869.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp869.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp866.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp866.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp865.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp865.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp864.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp864.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp863.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp863.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp862.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp862.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp861.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp861.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp860.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp860.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp857.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp857.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp855.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp855.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp852.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp852.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp850.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp850.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp775.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp775.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp737.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp737.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp437.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp437.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp1258.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1258.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp1257.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1257.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp1256.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1256.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp1255.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1255.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp1254.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1254.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp1253.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1253.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp1252.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1252.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp1251.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1251.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\cp1250.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1250.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\ascii.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\ascii.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\encoding\big5.enc
- Destination=%MAINDIR%\lib\tcl%VER%\encoding\big5.enc
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\opt0.4\pkgIndex.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\opt0.4\pkgIndex.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\opt0.4\optparse.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\opt0.4\optparse.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\http2.3\pkgIndex.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\http2.3\pkgIndex.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\http2.3\http.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\http2.3\http.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\msgbox.tcl
- Destination=%MAINDIR%\lib\tk%VER%\msgbox.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\optMenu.tcl
- Destination=%MAINDIR%\lib\tk%VER%\optMenu.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\clrpick.tcl
- Destination=%MAINDIR%\lib\tk%VER%\clrpick.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\entry.tcl
- Destination=%MAINDIR%\lib\tk%VER%\entry.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\comdlg.tcl
- Destination=%MAINDIR%\lib\tk%VER%\comdlg.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\bgerror.tcl
- Destination=%MAINDIR%\lib\tk%VER%\bgerror.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\obsolete.tcl
- Destination=%MAINDIR%\lib\tk%VER%\obsolete.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\button.tcl
- Destination=%MAINDIR%\lib\tk%VER%\button.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\xmfbox.tcl
- Destination=%MAINDIR%\lib\tk%VER%\xmfbox.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\console.tcl
- Destination=%MAINDIR%\lib\tk%VER%\console.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\listbox.tcl
- Destination=%MAINDIR%\lib\tk%VER%\listbox.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\menu.tcl
- Destination=%MAINDIR%\lib\tk%VER%\menu.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\dialog.tcl
- Destination=%MAINDIR%\lib\tk%VER%\dialog.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\focus.tcl
- Destination=%MAINDIR%\lib\tk%VER%\focus.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\palette.tcl
- Destination=%MAINDIR%\lib\tk%VER%\palette.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\tkfbox.tcl
- Destination=%MAINDIR%\lib\tk%VER%\tkfbox.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\tk.tcl
- Destination=%MAINDIR%\lib\tk%VER%\tk.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\text.tcl
- Destination=%MAINDIR%\lib\tk%VER%\text.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\tearoff.tcl
- Destination=%MAINDIR%\lib\tk%VER%\tearoff.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\tclIndex
- Destination=%MAINDIR%\lib\tk%VER%\tclIndex
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\scrlbar.tcl
- Destination=%MAINDIR%\lib\tk%VER%\scrlbar.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\scale.tcl
- Destination=%MAINDIR%\lib\tk%VER%\scale.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\safetk.tcl
- Destination=%MAINDIR%\lib\tk%VER%\safetk.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\http1.0\pkgIndex.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\http1.0\pkgIndex.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\http1.0\http.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\http1.0\http.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\reg1.0\pkgIndex.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\reg1.0\pkgIndex.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\win\release\tclreg83.dll
- Destination=%MAINDIR%\lib\tcl%VER%\reg1.0\tclreg83.dll
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\dde1.1\pkgIndex.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\dde1.1\pkgIndex.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\win\release\tcldde83.dll
- Destination=%MAINDIR%\lib\tcl%VER%\dde1.1\tcldde83.dll
- Flags=0000000000000010
-end
-item: Install File
- Source=C:\WINNT\SYSTEM32\Msvcrt.dll
- Destination=%MAINDIR%\bin\msvcrt.dll
- Flags=0010001000000011
-end
-item: Install File
- Source=${__TKBASEDIR__}\win\release\wish83.exe
- Destination=%MAINDIR%\bin\wish83.exe
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\win\release\tclsh83.exe
- Destination=%MAINDIR%\bin\tclsh83.exe
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\win\release\tclpip83.dll
- Destination=%MAINDIR%\bin\tclpip83.dll
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\win\release\tcl83.dll
- Destination=%MAINDIR%\bin\tcl83.dll
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\win\release\tk83.dll
- Destination=%MAINDIR%\bin\tk83.dll
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\auto.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\auto.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\history.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\history.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\init.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\init.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\package.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\package.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\parray.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\parray.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\safe.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\safe.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\tclIndex
- Destination=%MAINDIR%\lib\tcl%VER%\tclIndex
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\library\word.tcl
- Destination=%MAINDIR%\lib\tcl%VER%\word.tcl
- Flags=0000000000000010
-end
-item: End Block
-end
-item: If/While Statement
- Variable=COMPONENTS
- Value=B
- Flags=00001010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\images\tai-ku.gif
- Destination=%MAINDIR%\lib\tk%VER%\images\tai-ku.gif
- Flags=0000000010000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\images\teapot.ppm
- Destination=%MAINDIR%\lib\tk%VER%\demos\images\teapot.ppm
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\images\tcllogo.gif
- Destination=%MAINDIR%\lib\tk%VER%\demos\images\tcllogo.gif
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\images\pattern.bmp
- Destination=%MAINDIR%\lib\tk%VER%\demos\images\pattern.bmp
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\images\noletter.bmp
- Destination=%MAINDIR%\lib\tk%VER%\demos\images\noletter.bmp
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\images\letters.bmp
- Destination=%MAINDIR%\lib\tk%VER%\demos\images\letters.bmp
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\images\gray25.bmp
- Destination=%MAINDIR%\lib\tk%VER%\demos\images\gray25.bmp
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\images\flagup.bmp
- Destination=%MAINDIR%\lib\tk%VER%\demos\images\flagup.bmp
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\images\flagdown.bmp
- Destination=%MAINDIR%\lib\tk%VER%\demos\images\flagdown.bmp
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\images\face.bmp
- Destination=%MAINDIR%\lib\tk%VER%\demos\images\face.bmp
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\images\earthris.gif
- Destination=%MAINDIR%\lib\tk%VER%\demos\images\earthris.gif
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\images\earth.gif
- Destination=%MAINDIR%\lib\tk%VER%\demos\images\earth.gif
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\vscale.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\vscale.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\twind.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\twind.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\text.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\text.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\style.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\style.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\states.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\states.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\search.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\search.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\sayings.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\sayings.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\ruler.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\ruler.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\radio.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\radio.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\puzzle.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\puzzle.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\plot.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\plot.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\msgbox.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\msgbox.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\menubu.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\menubu.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\menu.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\menu.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\label.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\label.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\items.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\items.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\image2.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\image2.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\image1.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\image1.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\icon.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\icon.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\hscale.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\hscale.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\form.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\form.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\ixset
- Destination=%MAINDIR%\lib\tk%VER%\demos\ixset.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\rolodex
- Destination=%MAINDIR%\lib\tk%VER%\demos\rolodex.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\square
- Destination=%MAINDIR%\lib\tk%VER%\demos\square.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\Readme
- Destination=%MAINDIR%\lib\tk%VER%\demos\Readme
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\hello
- Destination=%MAINDIR%\lib\tk%VER%\demos\hello.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\tclIndex
- Destination=%MAINDIR%\lib\tk%VER%\demos\tclIndex
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\browse
- Destination=%MAINDIR%\lib\tk%VER%\demos\browse.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\timer
- Destination=%MAINDIR%\lib\tk%VER%\demos\timer.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\widget
- Destination=%MAINDIR%\lib\tk%VER%\demos\widget.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\tcolor
- Destination=%MAINDIR%\lib\tk%VER%\demos\tcolor.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\rmt
- Destination=%MAINDIR%\lib\tk%VER%\demos\rmt.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\floor.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\floor.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\filebox.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\filebox.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\images\pwrdLogo75.gif
- Destination=%MAINDIR%\lib\tk%VER%\images\pwrdLogo75.gif
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\images\pwrdLogo200.gif
- Destination=%MAINDIR%\lib\tk%VER%\images\pwrdLogo200.gif
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\images\pwrdLogo175.gif
- Destination=%MAINDIR%\lib\tk%VER%\images\pwrdLogo175.gif
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\images\pwrdLogo150.gif
- Destination=%MAINDIR%\lib\tk%VER%\images\pwrdLogo150.gif
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\images\pwrdLogo100.gif
- Destination=%MAINDIR%\lib\tk%VER%\images\pwrdLogo100.gif
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\images\logoMed.gif
- Destination=%MAINDIR%\lib\tk%VER%\images\logoMed.gif
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\images\logoLarge.gif
- Destination=%MAINDIR%\lib\tk%VER%\images\logoLarge.gif
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\images\logo64.gif
- Destination=%MAINDIR%\lib\tk%VER%\images\logo64.gif
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\images\logo100.gif
- Destination=%MAINDIR%\lib\tk%VER%\images\logo100.gif
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\images\Readme
- Destination=%MAINDIR%\lib\tk%VER%\images\Readme
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\arrow.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\arrow.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\bind.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\bind.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\bitmap.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\bitmap.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\button.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\button.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\check.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\check.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\clrpick.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\clrpick.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\colors.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\colors.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\cscroll.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\cscroll.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\ctext.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\ctext.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\dialog1.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\dialog1.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\dialog2.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\dialog2.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\entry1.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\entry1.tcl
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TKBASEDIR__}\library\demos\entry2.tcl
- Destination=%MAINDIR%\lib\tk%VER%\demos\entry2.tcl
- Flags=0000000000000010
-end
-item: End Block
-end
-item: If/While Statement
- Variable=COMPONENTS
- Value=C
- Flags=00001010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\tools\tcl83.cnt
- Destination=%MAINDIR%\doc\tcl83.cnt
- Flags=0000000000000010
-end
-item: Install File
- Source=${__TCLBASEDIR__}\tools\tcl83.hlp
- Destination=%MAINDIR%\doc\tcl83.hlp
- Flags=0000000000000010
-end
-item: End Block
-end
-item: Set Variable
- Variable=MAINDIR
- Value=%MAINDIR%
- Flags=00010100
-end
-item: Include Script
- Pathname=\\pop\tools\1.2\win32-ix86\wise\INCLUDE\uninstal.wse
-end
-item: Check Configuration
- Flags=10111011
-end
-item: Get Registry Key Value
- Variable=GROUPDIR
- Key=Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders
- Default=%WIN%\Start Menu\Programs
- Value Name=Programs
- Flags=00000010
-end
-item: Set Variable
- Variable=GROUP
- Value=%GROUPDIR%\%GROUP%
-end
-item: If/While Statement
- Variable=COMPONENTS
- Value=A
- Flags=00001010
-end
-item: Create Shortcut
- Source=%MAINDIR%\bin\wish83.exe
- Destination=%GROUP%\Wish.lnk
- Working Directory=%MAINDIR%
-end
-item: End Block
-end
-item: If/While Statement
- Variable=COMPONENTS
- Value=A
- Flags=00001010
-end
-item: Create Shortcut
- Source=%MAINDIR%\bin\tclsh83.exe
- Destination=%GROUP%\Tclsh.lnk
- Working Directory=%MAINDIR%
- Key Type=1536
- Flags=00000001
-end
-item: End Block
-end
-item: If/While Statement
- Variable=COMPONENTS
- Value=C
- Flags=00001010
-end
-item: Create Shortcut
- Source=%MAINDIR%\doc\tcl83.hlp
- Destination=%GROUP%\Tcl Help.lnk
- Working Directory=%MAINDIR%
-end
-item: End Block
-end
-item: Create Shortcut
- Source=%MAINDIR%\Readme.txt
- Destination=%GROUP%\Readme.lnk
- Working Directory=%MAINDIR%
-end
-item: If/While Statement
- Variable=COMPONENTS
- Value=B
- Flags=00001010
-end
-item: Create Shortcut
- Source=%MAINDIR%\lib\tk%VER%\demos\widget.tcl
- Destination=%GROUP%\Widget Tour.lnk
- Working Directory=%MAINDIR%
- Key Type=1536
- Flags=00000001
-end
-item: End Block
-end
-item: Else Statement
-end
-item: If/While Statement
- Variable=COMPONENTS
- Value=B
- Flags=00001010
-end
-item: Add ProgMan Icon
- Group=%GROUP%
- Icon Name=Widget Tour
- Command Line=%MAINDIR%\lib\tk%VER%\demos\widget.tcl
- Icon Pathname=%MAINDIR%\bin\wish83.exe
- Default Directory=%MAINDIR%
-end
-item: End Block
-end
-item: If/While Statement
- Variable=COMPONENTS
- Value=C
- Flags=00001010
-end
-item: Add ProgMan Icon
- Group=%GROUP%
- Icon Name=Tcl Help
- Command Line=%MAINDIR%\doc\tcl83.hlp
- Default Directory=%MAINDIR%
-end
-item: End Block
-end
-item: Add ProgMan Icon
- Group=%GROUP%
- Icon Name=Readme
- Command Line=%MAINDIR%\Readme.txt
- Default Directory=%MAINDIR%
-end
-item: If/While Statement
- Variable=COMPONENTS
- Value=A
- Flags=00001010
-end
-item: Add ProgMan Icon
- Group=%GROUP%
- Icon Name=Wish
- Command Line=%MAINDIR%\bin\wish83.exe
- Default Directory=%MAINDIR%
-end
-item: End Block
-end
-item: If/While Statement
- Variable=COMPONENTS
- Value=A
- Flags=00001010
-end
-item: Add ProgMan Icon
- Group=%GROUP%
- Icon Name=Tclsh
- Command Line=%MAINDIR%\bin\tclsh83.exe
- Default Directory=%MAINDIR%
-end
-item: End Block
-end
-item: End Block
-end
-item: Self-Register OCXs/DLLs
- Description=Updating System Configuration, Please Wait...
-end
-item: Edit Registry
- Total Keys=1
- Key=SOFTWARE\Scriptics\Tcl\%VER%
- New Value=%MAINDIR%
- Value Name=Root
- Root=2
-end
-item: Edit Registry
- Total Keys=1
- Key=TclScript\DefaultIcon
- New Value=%MAINDIR%\bin\tk83.dll
-end
-item: Edit Registry
- Total Keys=1
- Key=.tcl
- New Value=TclScript
-end
-item: Edit Registry
- Total Keys=1
- Key=TclScript
- New Value=TclScript
-end
-item: Edit Registry
- Total Keys=1
- Key=TclScript\shell\open\command
- New Value=%MAINDIRSHORT%\bin\wish83.exe "%%1" %%*
-end
-item: Edit Registry
- Total Keys=1
- Key=TclScript\shell\edit
- New Value=&Edit
-end
-item: Edit Registry
- Total Keys=1
- Key=TclScript\shell\edit\command
- New Value=notepad "%%1"
-end
-item: Add Directory to Path
- Directory=%MAINDIR%\bin
-end
-item: Check Configuration
- Flags=10111011
-end
-item: Set Variable
- Variable=TO_SCRIPTICS
- Value=A
-end
-item: Else Statement
-end
-item: Set Variable
- Variable=TO_SCRIPTICS
-end
-item: End Block
-end
-item: Wizard Block
- Direction Variable=DIRECTION
- Display Variable=DISPLAY
- Bitmap Pathname=%_WISE_%\DIALOGS\TEMPLATE\WIZARD.BMP
- X Position=9
- Y Position=10
- Filler Color=8421440
- Flags=00000011
-end
-item: Custom Dialog Set
- Name=Finished
- Display Variable=DISPLAY
- item: Dialog
- Title=%APPTITLE% Installation
- Title French=Installation de %APPTITLE%
- Title German=Installation von %APPTITLE%
- Title Spanish=Instalación de %APPTITLE%
- Title Italian=Installazione di %APPTITLE%
- Width=271
- Height=224
- Font Name=Helv
- Font Size=8
- item: Push Button
- Rectangle=150 187 195 202
- Variable=DIRECTION
- Value=N
- Create Flags=01010000000000010000000000000001
- Text=&Finish
- Text French=&Fin
- Text German=&Weiter
- Text Spanish=&Terminar
- Text Italian=&Fine
- end
- item: Push Button
- Rectangle=105 187 150 202
- Variable=DISABLED
- Value=!
- Create Flags=01010000000000010000000000000000
- Text=< &Back
- Text French=< &Retour
- Text German=< &Zurück
- Text Spanish=< &Atrás
- Text Italian=< &Indietro
- end
- item: Push Button
- Rectangle=211 187 256 202
- Variable=DISABLED
- Value=!
- Action=3
- Create Flags=01010000000000010000000000000000
- Text=&Cancel
- Text French=&Annuler
- Text German=&Abbrechen
- Text Spanish=&Cancelar
- Text Italian=&Annulla
- end
- item: Static
- Rectangle=8 180 256 181
- Action=3
- Create Flags=01010000000000000000000000000111
- end
- item: Static
- Rectangle=86 8 258 42
- Create Flags=01010000000000000000000000000000
- Flags=0000000000000001
- Name=Times New Roman
- Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18
- Text=Installation Completed!
- Text French=Installation terminée !
- Text German=Die Installation ist abgeschlossen!
- Text Spanish=¡Instalación terminada!
- Text Italian=Installazione completata!
- end
- item: Static
- Rectangle=86 42 256 153
- Create Flags=01010000000000000000000000000000
- Text=%APPTITLE% has been successfully installed.
- Text=
- Text=Click the Finish button to exit this installation.
- Text=
- Text=You can learn more about Tcl/Tk %VER%, including release notes, updates, tutorials, and more at %URL%. Check the box below to start your web browser and go there now.
- Text=
- Text=The installer may ask you to reboot your computer, this is to update your PATH and is not necessary to do immediately.
- Text French=%APPTITLE% est maintenant installé.
- Text French=
- Text French=Cliquez sur le bouton Fin pour quitter l'installation.
- Text German=%APPTITLE% wurde erfolgreich installiert.
- Text German=
- Text German=Klicken Sie auf "Weiter", um die Installation zu beenden.
- Text Spanish=%APPTITLE% se ha instalado con éxito.
- Text Spanish=
- Text Spanish=Presione el botón Terminar para salir de esta instalación.
- Text Italian=L'installazione %APPTITLE% è stata portata a termine con successo.
- Text Italian=
- Text Italian=Premere il pulsante Fine per uscire dall'installazione.
- end
- item: Checkbox
- Rectangle=88 143 245 157
- Variable=TO_SCRIPTICS
- Enabled Color=00000000000000001111111111111111
- Create Flags=01010000000000010000000000000011
- Text=Show me important information about
- Text=
- end
- item: Static
- Rectangle=99 156 245 170
- Enabled Color=00000000000000001111111111111111
- Create Flags=01010000000000000000000000000000
- Text=Tcl/Tk %VER% and TclPro
- end
- end
-end
-item: End Block
-end
-item: Check Configuration
- Flags=10111011
-end
-item: If/While Statement
- Variable=TO_SCRIPTICS
- Value=A
- Flags=00000010
-end
-item: Execute Program
- Command Line=%URL%
-end
-item: End Block
-end
-item: Execute Program
- Pathname=explorer
- Command Line=%GROUP%
-end
-item: End Block
-end
+Document Type: WSE
+item: Global
+ Version=6.01
+ Title=Tcl 8.4 for Windows Installation
+ Flags=00010100
+ Languages=65 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+ Japanese Font Name=MS Gothic
+ Japanese Font Size=10
+ Start Gradient=0 0 255
+ End Gradient=0 0 0
+ Windows Flags=00000000000000010010110000001000
+ Log Pathname=%MAINDIR%\INSTALL.LOG
+ Message Font=MS Sans Serif
+ Font Size=8
+ Disk Label=tcl8.4.0
+ Disk Filename=setup
+ Patch Flags=0000000000000001
+ Patch Threshold=85
+ Patch Memory=4000
+ Variable Name1=_SYS_
+ Variable Default1=C:\WINDOWS\SYSTEM
+ Variable Flags1=00001000
+ Variable Name2=_ODBC16_
+ Variable Default2=C:\WINDOWS\SYSTEM
+ Variable Flags2=00001000
+ Variable Name3=_WISE_
+ Variable Default3=${__WISE__}
+ Variable Flags3=00001000
+end
+item: Open/Close INSTALL.LOG
+ Flags=00000001
+end
+item: Check if File/Dir Exists
+ Pathname=%SYS%
+ Flags=10000100
+end
+item: Set Variable
+ Variable=SYS
+ Value=%WIN%
+end
+item: End Block
+end
+item: Set Variable
+ Variable=VER
+ Value=8.4
+end
+item: Set Variable
+ Variable=PATCHLEVEL
+ Value=${__TCL_PATCH_LEVEL__}
+end
+item: Set Variable
+ Variable=APPTITLE
+ Value=Tcl/Tk %PATCHLEVEL% for Windows
+end
+item: Set Variable
+ Variable=URL
+ Value=http://www.tcl.tk/
+end
+item: Set Variable
+ Variable=GROUP
+ Value=Tcl
+end
+item: Set Variable
+ Variable=DISABLED
+ Value=!
+end
+item: Set Variable
+ Variable=MAINDIR
+ Value=Tcl
+end
+item: Check Configuration
+ Flags=10111011
+end
+item: Get Registry Key Value
+ Variable=PROGRAM_FILES
+ Key=SOFTWARE\Microsoft\Windows\CurrentVersion
+ Default=C:\Program Files
+ Value Name=ProgramFilesDir
+ Flags=00000100
+end
+item: Set Variable
+ Variable=MAINDIR
+ Value=%PROGRAM_FILES%\%MAINDIR%
+end
+item: Set Variable
+ Variable=EXPLORER
+ Value=1
+end
+item: Else Statement
+end
+item: Set Variable
+ Variable=MAINDIR
+ Value=C:\%MAINDIR%
+end
+item: End Block
+end
+item: Set Variable
+ Variable=BACKUP
+ Value=%MAINDIR%\BACKUP
+end
+item: Set Variable
+ Variable=DOBACKUP
+ Value=B
+end
+item: Set Variable
+ Variable=BRANDING
+ Value=0
+end
+remarked item: If/While Statement
+ Variable=BRANDING
+ Value=1
+end
+remarked item: Read INI Value
+ Variable=NAME
+ Pathname=%INST%\CUSTDATA.INI
+ Section=Registration
+ Item=Name
+end
+remarked item: Read INI Value
+ Variable=COMPANY
+ Pathname=%INST%\CUSTDATA.INI
+ Section=Registration
+ Item=Company
+end
+remarked item: If/While Statement
+ Variable=NAME
+end
+remarked item: Set Variable
+ Variable=DOBRAND
+ Value=1
+end
+remarked item: End Block
+end
+remarked item: End Block
+end
+item: Set Variable
+ Variable=TYPE
+ Value=C
+end
+item: Set Variable
+ Variable=COMPONENTS
+ Value=ABC
+end
+item: Wizard Block
+ Direction Variable=DIRECTION
+ Display Variable=DISPLAY
+ X Position=0
+ Y Position=0
+ Filler Color=8421440
+ Flags=00000001
+end
+item: Custom Dialog Set
+ Name=Splash
+ Display Variable=DISPLAY
+ item: Dialog
+ Title=%APPTITLE% Installation
+ Title French=Bienvenue
+ Title German=Willkommen
+ Title Portuguese=Bem-vindo
+ Title Spanish=Bienvenido
+ Title Italian=Benvenuto
+ Title Danish=Velkommen
+ Title Dutch=Welkom
+ Title Norwegian=Velkommen
+ Title Swedish=Välkommen
+ Width=273
+ Height=250
+ Font Name=Helv
+ Font Size=8
+ item: Push Button
+ Rectangle=166 214 208 228
+ Variable=DIRECTION
+ Value=N
+ Create Flags=01010000000000010000000000000001
+ Text=&Next >
+ end
+ item: Push Button
+ Rectangle=212 214 254 228
+ Action=3
+ Create Flags=01010000000000010000000000000000
+ Text=Cancel
+ end
+ item: Static
+ Rectangle=0 0 268 233
+ Action=2
+ Enabled Color=00000000000000001111111111111111
+ Create Flags=01010000000000000000000000001011
+ Pathname=${__TCLBASEDIR__}\tools\white.bmp
+ end
+ item: Static
+ Rectangle=5 5 268 215
+ Destination Dialog=1
+ Action=2
+ Enabled Color=00000000000000001111111111111111
+ Create Flags=01010000000000000000000000001011
+ Pathname=${__TCLBASEDIR__}\tools\tclSplash.bmp
+ end
+ end
+end
+item: End Block
+end
+item: Wizard Block
+ Direction Variable=DIRECTION
+ Display Variable=DISPLAY
+ Bitmap Pathname=%_WISE_%\DIALOGS\TEMPLATE\WIZARD.BMP
+ X Position=9
+ Y Position=10
+ Filler Color=8421440
+ Dialog=Welcome
+ Dialog=Select Destination Directory
+ Dialog=Select Installation Type
+ Dialog=Select Components
+ Dialog=Select Program Manager Group
+ Variable=
+ Variable=
+ Variable=
+ Variable=TYPE
+ Variable=EXPLORER
+ Value=
+ Value=
+ Value=
+ Value=C
+ Value=1
+ Compare=0
+ Compare=0
+ Compare=0
+ Compare=1
+ Compare=0
+ Flags=00000011
+end
+item: Custom Dialog Set
+ Name=Welcome
+ Display Variable=DISPLAY
+ item: Dialog
+ Title=%APPTITLE% Installation
+ Title French=Installation de %APPTITLE%
+ Title German=Installation von %APPTITLE%
+ Title Spanish=Instalación de %APPTITLE%
+ Title Italian=Installazione di %APPTITLE%
+ Width=271
+ Height=224
+ Font Name=Helv
+ Font Size=8
+ item: Static
+ Rectangle=86 8 258 42
+ Create Flags=01010000000000000000000000000000
+ Flags=0000000000000001
+ Name=Times New Roman
+ Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18
+ Text=Welcome!
+ Text French=Bienvenue !
+ Text German=Willkommen!
+ Text Spanish=¡Bienvenido!
+ Text Italian=Benvenuti!
+ end
+ item: Push Button
+ Rectangle=150 187 195 202
+ Variable=DIRECTION
+ Value=N
+ Create Flags=01010000000000010000000000000001
+ Text=&Next >
+ Text French=&Suite >
+ Text German=&Weiter >
+ Text Spanish=&Siguiente >
+ Text Italian=&Avanti >
+ end
+ item: Push Button
+ Rectangle=105 187 150 202
+ Variable=DISABLED
+ Value=!
+ Create Flags=01010000000000010000000000000000
+ Text=< &Back
+ Text French=< &Retour
+ Text German=< &Zurück
+ Text Spanish=< &Atrás
+ Text Italian=< &Indietro
+ end
+ item: Push Button
+ Rectangle=211 187 256 202
+ Action=3
+ Create Flags=01010000000000010000000000000000
+ Text=&Cancel
+ Text French=&Annuler
+ Text German=&Abbrechen
+ Text Spanish=&Cancelar
+ Text Italian=&Annulla
+ end
+ item: Static
+ Rectangle=85 41 255 130
+ Create Flags=01010000000000000000000000000000
+ Text=This installation program will install %APPTITLE%.
+ Text=
+ Text=Press the Next button to start the installation. You can press the Exit Setup button now if you do not want to install %APPTITLE% at this time.
+ Text=
+ Text=It is strongly recommended that you exit all Windows programs before running this installation program.
+ Text French=Ce programme d'installation va installer %APPTITLE%.
+ Text French=
+ Text French=Cliquez sur le bouton Suite pour démarrer l'installation. Vous pouvez cliquer sur le bouton Quitter l'installation si vous ne voulez pas installer %APPTITLE% tout de suite.
+ Text German=Mit diesem Installationsprogramm wird %APPTITLE% installiert.
+ Text German=
+ Text German=Klicken Sie auf "Weiter", um mit der Installation zu beginnen. Klicken Sie auf "Abbrechen", um die Installation von %APPTITLE% abzubrechen.
+ Text Spanish=Este programa de instalación instalará %APPTITLE%.
+ Text Spanish=
+ Text Spanish=Presione el botón Siguiente para iniciar la instalación. Puede presionar el botón Salir de instalación si no desea instalar %APPTITLE% en este momento.
+ Text Italian=Questo programma installerà %APPTITLE%.
+ Text Italian=
+ Text Italian=Per avvviare l'installazione premere il pulsante Avanti. Se non si desidera installare %APPTITLE% ora, premere il pulsante Esci dall'installazione.
+ end
+ item: Static
+ Rectangle=8 180 256 181
+ Action=3
+ Create Flags=01010000000000000000000000000111
+ end
+ end
+end
+item: Custom Dialog Set
+ Name=Select Destination Directory
+ Display Variable=DISPLAY
+ item: Dialog
+ Title=%APPTITLE% Installation
+ Title French=Installation de %APPTITLE%
+ Title German=Installation von %APPTITLE%
+ Title Spanish=Instalación de %APPTITLE%
+ Title Italian=Installazione di %APPTITLE%
+ Width=271
+ Height=224
+ Font Name=Helv
+ Font Size=8
+ item: Push Button
+ Rectangle=150 187 195 202
+ Variable=DIRECTION
+ Value=N
+ Create Flags=01010000000000010000000000000001
+ Text=&Next >
+ Text French=&Suite >
+ Text German=&Weiter >
+ Text Spanish=&Siguiente >
+ Text Italian=&Avanti >
+ end
+ item: Push Button
+ Rectangle=105 187 150 202
+ Variable=DIRECTION
+ Value=B
+ Create Flags=01010000000000010000000000000000
+ Flags=0000000000000001
+ Text=< &Back
+ Text French=< &Retour
+ Text German=< &Zurück
+ Text Spanish=< &Atrás
+ Text Italian=< &Indietro
+ end
+ item: Push Button
+ Rectangle=211 187 256 202
+ Action=3
+ Create Flags=01010000000000010000000000000000
+ Text=&Cancel
+ Text French=&Annuler
+ Text German=&Abbrechen
+ Text Spanish=&Cancelar
+ Text Italian=&Annulla
+ end
+ item: Static
+ Rectangle=8 180 256 181
+ Action=3
+ Create Flags=01010000000000000000000000000111
+ end
+ item: Static
+ Rectangle=86 8 258 42
+ Create Flags=01010000000000000000000000000000
+ Flags=0000000000000001
+ Name=Times New Roman
+ Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18
+ Text=Select Destination Directory
+ Text French=Sélectionner le répertoire de destination
+ Text German=Zielverzeichnis wählen
+ Text Spanish=Seleccione el directorio de destino
+ Text Italian=Selezionare Directory di destinazione
+ end
+ item: Static
+ Rectangle=86 39 256 114
+ Create Flags=01010000000000000000000000000000
+ Text=Please select the directory where the %APPTITLE% files are to be installed.
+ Text=
+ Text=To install in the default directory below, click Next.
+ Text=
+ Text=To install in a different directory, click Browse and select another directory.
+ Text French=Veuillez sélectionner le répertoire dans lequel les fichiers %APPTITLE% doivent être installés.
+ Text German=Geben Sie an, in welchem Verzeichnis die %APPTITLE%-Dateien installiert werden sollen.
+ Text Spanish=Por favor seleccione el directorio donde desee instalar los archivos de %APPTITLE%.
+ Text Italian=Selezionare la directory dove verranno installati i file %APPTITLE%.
+ end
+ item: Static
+ Rectangle=86 130 256 157
+ Action=1
+ Create Flags=01010000000000000000000000000111
+ end
+ item: Push Button
+ Rectangle=205 138 250 153
+ Variable=MAINDIR_SAVE
+ Value=%MAINDIR%
+ Destination Dialog=1
+ Action=2
+ Create Flags=01010000000000010000000000000000
+ Text=Browse
+ Text French=Parcourir
+ Text German=Durchsuchen
+ Text Spanish=Buscar
+ Text Italian=Sfoglie
+ end
+ item: Static
+ Rectangle=91 140 198 151
+ Create Flags=01010000000000000000000000000000
+ Text=%MAINDIR%
+ Text French=%MAINDIR%
+ Text German=%MAINDIR%
+ Text Spanish=%MAINDIR%
+ Text Italian=%MAINDIR%
+ end
+ end
+ item: Dialog
+ Title=Select Destination Directory
+ Title French=Sélectionner le répertoire de destination
+ Title German=Zielverzeichnis wählen
+ Title Spanish=Seleccione el directorio de destino
+ Title Italian=Selezionare Directory di destinazione
+ Width=221
+ Height=173
+ Font Name=Helv
+ Font Size=8
+ item: Listbox
+ Rectangle=5 5 163 149
+ Variable=MAINDIR
+ Create Flags=01010000100000010000000101000000
+ Flags=0000110000100010
+ Text=%MAINDIR%
+ Text French=%MAINDIR%
+ Text German=%MAINDIR%
+ Text Spanish=%MAINDIR%
+ Text Italian=%MAINDIR%
+ end
+ item: Push Button
+ Rectangle=167 6 212 21
+ Create Flags=01010000000000010000000000000001
+ Text=OK
+ Text French=OK
+ Text German=OK
+ Text Spanish=Aceptar
+ Text Italian=OK
+ end
+ item: Push Button
+ Rectangle=167 25 212 40
+ Variable=MAINDIR
+ Value=%MAINDIR_SAVE%
+ Create Flags=01010000000000010000000000000000
+ Flags=0000000000000001
+ Text=Cancel
+ Text French=Annuler
+ Text German=Abbrechen
+ Text Spanish=Cancelar
+ Text Italian=Annulla
+ end
+ end
+end
+remarked item: Custom Dialog Set
+ Name=Select Installation Type
+ Display Variable=DISPLAY
+ item: Dialog
+ Title=%APPTITLE% Installation
+ Title French=Installation de %APPTITLE%
+ Title German=Installation von %APPTITLE%
+ Title Spanish=Instalación de %APPTITLE%
+ Title Italian=Installazione di %APPTITLE%
+ Width=271
+ Height=224
+ Font Name=Helv
+ Font Size=8
+ item: Push Button
+ Rectangle=150 187 195 202
+ Variable=DIRECTION
+ Value=N
+ Create Flags=01010000000000010000000000000001
+ Text=&Next >
+ Text French=&Suite >
+ Text German=&Weiter >
+ Text Spanish=&Siguiente >
+ Text Italian=&Avanti >
+ end
+ item: Push Button
+ Rectangle=105 187 150 202
+ Variable=DIRECTION
+ Value=B
+ Create Flags=01010000000000010000000000000000
+ Text=< &Back
+ Text French=< &Retour
+ Text German=< &Zurück
+ Text Spanish=< &Atrás
+ Text Italian=< &Indietro
+ end
+ item: Push Button
+ Rectangle=211 187 256 202
+ Action=3
+ Create Flags=01010000000000010000000000000000
+ Text=&Cancel
+ Text French=&Annuler
+ Text German=&Abbrechen
+ Text Spanish=&Cancelar
+ Text Italian=&Annulla
+ end
+ item: Static
+ Rectangle=8 180 256 181
+ Action=3
+ Create Flags=01010000000000000000000000000111
+ end
+ item: Static
+ Rectangle=86 8 258 42
+ Create Flags=01010000000000000000000000000000
+ Flags=0000000000000001
+ Name=Times New Roman
+ Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18
+ Text=Select Installation Type
+ Text French=Sélectionner les composants
+ Text German=Komponenten auswählen
+ Text Spanish=Seleccione componentes
+ Text Italian=Selezionare i componenti
+ end
+ item: Static
+ Rectangle=194 162 242 172
+ Variable=COMPONENTS
+ Value=MAINDIR
+ Create Flags=01010000000000000000000000000010
+ end
+ item: Static
+ Rectangle=194 153 242 162
+ Variable=COMPONENTS
+ Create Flags=01010000000000000000000000000010
+ end
+ item: Static
+ Rectangle=107 153 196 164
+ Create Flags=01010000000000000000000000000000
+ Text=Disk Space Required:
+ Text French=Espace disque requis :
+ Text German=Notwendiger Speicherplatz:
+ Text Spanish=Espacio requerido en el disco:
+ Text Italian=Spazio su disco necessario:
+ end
+ item: Static
+ Rectangle=107 162 196 172
+ Create Flags=01010000000000000000000000000000
+ Text=Disk Space Remaining:
+ Text French=Espace disque disponible :
+ Text German=Verbleibender Speicherplatz:
+ Text Spanish=Espacio en disco disponible:
+ Text Italian=Spazio su disco disponibile:
+ end
+ item: Static
+ Rectangle=86 145 256 175
+ Action=1
+ Create Flags=01010000000000000000000000000111
+ end
+ item: Static
+ Rectangle=86 42 256 61
+ Create Flags=01010000000000000000000000000000
+ Text=Choose which type of installation to perform by selecting one of the buttons below.
+ Text French=Choisissez les composants que vous voulez installer en cochant les cases ci-dessous.
+ Text German=Wählen Sie die zu installierenden Komponenten, indem Sie in die entsprechenden Kästchen klicken.
+ Text Spanish=Elija los componentes que desee instalar marcando los cuadros de abajo.
+ Text Italian=Scegliere quali componenti installare selezionando le caselle sottostanti.
+ end
+ item: Radio Button
+ Rectangle=86 74 256 128
+ Variable=TYPE
+ Create Flags=01010000000000010000000000001001
+ Text=&Full Installation (Recommended)
+ Text=&Minimal Installation
+ Text=C&ustom Installation
+ Text=
+ end
+ end
+end
+item: Custom Dialog Set
+ Name=Select Components
+ Display Variable=DISPLAY
+ item: Dialog
+ Title=%APPTITLE% Installation
+ Title French=Installation de %APPTITLE%
+ Title German=Installation von %APPTITLE%
+ Title Spanish=Instalación de %APPTITLE%
+ Title Italian=Installazione di %APPTITLE%
+ Width=271
+ Height=224
+ Font Name=Helv
+ Font Size=8
+ item: Push Button
+ Rectangle=150 187 195 202
+ Variable=DIRECTION
+ Value=N
+ Create Flags=01010000000000010000000000000001
+ Text=&Next >
+ Text French=&Suite >
+ Text German=&Weiter >
+ Text Spanish=&Siguiente >
+ Text Italian=&Avanti >
+ end
+ item: Push Button
+ Rectangle=105 187 150 202
+ Variable=DIRECTION
+ Value=B
+ Create Flags=01010000000000010000000000000000
+ Text=< &Back
+ Text French=< &Retour
+ Text German=< &Zurück
+ Text Spanish=< &Atrás
+ Text Italian=< &Indietro
+ end
+ item: Push Button
+ Rectangle=211 187 256 202
+ Action=3
+ Create Flags=01010000000000010000000000000000
+ Text=&Cancel
+ Text French=&Annuler
+ Text German=&Abbrechen
+ Text Spanish=&Cancelar
+ Text Italian=&Annulla
+ end
+ item: Static
+ Rectangle=8 180 256 181
+ Action=3
+ Create Flags=01010000000000000000000000000111
+ end
+ item: Static
+ Rectangle=86 8 258 42
+ Create Flags=01010000000000000000000000000000
+ Flags=0000000000000001
+ Name=Times New Roman
+ Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18
+ Text=Select Components
+ Text French=Sélectionner les composants
+ Text German=Komponenten auswählen
+ Text Spanish=Seleccione componentes
+ Text Italian=Selezionare i componenti
+ end
+ item: Checkbox
+ Rectangle=86 75 256 129
+ Variable=COMPONENTS
+ Create Flags=01010000000000010000000000000011
+ Flags=0000000000000110
+ Text=Tcl Run-Time Files
+ Text=Example Scripts
+ Text=Help Files
+ Text=Header and Library Files
+ Text=
+ Text French=Tcl Run-Time Files
+ Text French=Example Scripts
+ Text French=Help Files
+ Text French=Header and Library Files
+ Text French=
+ Text German=Tcl Run-Time Files
+ Text German=Example Scripts
+ Text German=Help Files
+ Text German=Header and Library Files
+ Text German=
+ Text Spanish=Tcl Run-Time Files
+ Text Spanish=Example Scripts
+ Text Spanish=Help Files
+ Text Spanish=Header and Library Files
+ Text Spanish=
+ Text Italian=Tcl Run-Time Files
+ Text Italian=Example Scripts
+ Text Italian=Help Files
+ Text Italian=Header and Library Files
+ Text Italian=
+ end
+ item: Static
+ Rectangle=194 162 242 172
+ Variable=COMPONENTS
+ Value=MAINDIR
+ Create Flags=01010000000000000000000000000010
+ end
+ item: Static
+ Rectangle=194 153 242 162
+ Variable=COMPONENTS
+ Create Flags=01010000000000000000000000000010
+ end
+ item: Static
+ Rectangle=107 153 196 164
+ Create Flags=01010000000000000000000000000000
+ Text=Disk Space Required:
+ Text French=Espace disque requis :
+ Text German=Notwendiger Speicherplatz:
+ Text Spanish=Espacio requerido en el disco:
+ Text Italian=Spazio su disco necessario:
+ end
+ item: Static
+ Rectangle=107 162 196 172
+ Create Flags=01010000000000000000000000000000
+ Text=Disk Space Remaining:
+ Text French=Espace disque disponible :
+ Text German=Verbleibender Speicherplatz:
+ Text Spanish=Espacio en disco disponible:
+ Text Italian=Spazio su disco disponibile:
+ end
+ item: Static
+ Rectangle=86 145 256 175
+ Action=1
+ Create Flags=01010000000000000000000000000111
+ end
+ item: Static
+ Rectangle=86 42 256 61
+ Create Flags=01010000000000000000000000000000
+ Text=Choose which components to install by checking the boxes below.
+ Text French=Choisissez les composants que vous voulez installer en cochant les cases ci-dessous.
+ Text German=Wählen Sie die zu installierenden Komponenten, indem Sie in die entsprechenden Kästchen klicken.
+ Text Spanish=Elija los componentes que desee instalar marcando los cuadros de abajo.
+ Text Italian=Scegliere quali componenti installare selezionando le caselle sottostanti.
+ end
+ end
+end
+item: Custom Dialog Set
+ Name=Select Program Manager Group
+ Display Variable=DISPLAY
+ item: Dialog
+ Title=%APPTITLE% Installation
+ Title French=Installation de %APPTITLE%
+ Title German=Installation von %APPTITLE%
+ Title Spanish=Instalación de %APPTITLE%
+ Title Italian=Installazione di %APPTITLE%
+ Width=271
+ Height=224
+ Font Name=Helv
+ Font Size=8
+ item: Push Button
+ Rectangle=150 187 195 202
+ Variable=DIRECTION
+ Value=N
+ Create Flags=01010000000000010000000000000001
+ Text=&Next >
+ Text French=&Suite >
+ Text German=&Weiter >
+ Text Spanish=&Siguiente >
+ Text Italian=&Avanti >
+ end
+ item: Push Button
+ Rectangle=105 187 150 202
+ Variable=DIRECTION
+ Value=B
+ Create Flags=01010000000000010000000000000000
+ Flags=0000000000000001
+ Text=< &Back
+ Text French=< &Retour
+ Text German=< &Zurück
+ Text Spanish=< &Atrás
+ Text Italian=< &Indietro
+ end
+ item: Push Button
+ Rectangle=211 187 256 202
+ Action=3
+ Create Flags=01010000000000010000000000000000
+ Text=&Cancel
+ Text French=&Annuler
+ Text German=&Abbrechen
+ Text Spanish=&Cancelar
+ Text Italian=&Annulla
+ end
+ item: Static
+ Rectangle=8 180 256 181
+ Action=3
+ Create Flags=01010000000000000000000000000111
+ end
+ item: Static
+ Rectangle=86 8 258 42
+ Create Flags=01010000000000000000000000000000
+ Flags=0000000000000001
+ Name=Times New Roman
+ Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18
+ Text=Select ProgMan Group
+ Text French=Sélectionner le groupe du Gestionnaire de programme
+ Text German=Bestimmung der Programm-Managergruppe
+ Text Spanish=Seleccione grupo del Administrador de programas
+ Text Italian=Selezionare il gruppo ProgMan
+ end
+ item: Static
+ Rectangle=86 44 256 68
+ Create Flags=01010000000000000000000000000000
+ Text=Enter the name of the Program Manager group to add the %APPTITLE% icons to:
+ Text French=Entrez le nom du groupe du Gestionnaire de programme dans lequel vous souhaitez ajouter les icônes de %APPTITLE% :
+ Text German=Geben Sie den Namen der Programmgruppe ein, der das Symbol %APPTITLE% hinzugefügt werden soll:
+ Text Spanish=Escriba el nombre del grupo del Administrador de programas en el que desea agregar los iconos de %APPTITLE%:
+ Text Italian=Inserire il nome del gruppo Program Manager per aggiungere le icone %APPTITLE% a:
+ end
+ item: Combobox
+ Rectangle=86 69 256 175
+ Variable=GROUP
+ Create Flags=01010000000000010000001000000001
+ Flags=0000000000000001
+ Text=%GROUP%
+ Text French=%GROUP%
+ Text German=%GROUP%
+ Text Spanish=%GROUP%
+ Text Italian=%GROUP%
+ end
+ end
+end
+item: Custom Dialog Set
+ Name=Start Installation
+ Display Variable=DISPLAY
+ item: Dialog
+ Title=%APPTITLE% Installation
+ Title French=Installation de %APPTITLE%
+ Title German=Installation von %APPTITLE%
+ Title Spanish=Instalación de %APPTITLE%
+ Title Italian=Installazione di %APPTITLE%
+ Width=271
+ Height=224
+ Font Name=Helv
+ Font Size=8
+ item: Push Button
+ Rectangle=150 187 195 202
+ Variable=DIRECTION
+ Value=N
+ Create Flags=01010000000000010000000000000001
+ Text=&Next >
+ Text French=&Suite >
+ Text German=&Weiter >
+ Text Spanish=&Siguiente >
+ Text Italian=&Avanti >
+ end
+ item: Push Button
+ Rectangle=105 187 150 202
+ Variable=DIRECTION
+ Value=B
+ Create Flags=01010000000000010000000000000000
+ Text=< &Back
+ Text French=< &Retour
+ Text German=< &Zurück
+ Text Spanish=< &Atrás
+ Text Italian=< &Indietro
+ end
+ item: Push Button
+ Rectangle=211 187 256 202
+ Action=3
+ Create Flags=01010000000000010000000000000000
+ Text=&Cancel
+ Text French=&Annuler
+ Text German=&Abbrechen
+ Text Spanish=&Cancelar
+ Text Italian=&Annulla
+ end
+ item: Static
+ Rectangle=8 180 256 181
+ Action=3
+ Create Flags=01010000000000000000000000000111
+ end
+ item: Static
+ Rectangle=86 8 258 42
+ Create Flags=01010000000000000000000000000000
+ Flags=0000000000000001
+ Name=Times New Roman
+ Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18
+ Text=Ready to Install!
+ Text French=Prêt à installer !
+ Text German=Installationsbereit!
+ Text Spanish=¡Preparado para la instalación!
+ Text Italian=Pronto per l'installazione!
+ end
+ item: Static
+ Rectangle=86 42 256 102
+ Create Flags=01010000000000000000000000000000
+ Text=You are now ready to install %APPTITLE%.
+ Text=
+ Text=Press the Next button to begin the installation or the Back button to reenter the installation information.
+ Text French=Vous êtes maintenant prêt à installer les fichiers %APPTITLE%.
+ Text French=
+ Text French=Cliquez sur le bouton Suite pour commencer l'installation ou sur le bouton Retour pour entrer les informations d'installation à nouveau.
+ Text German=Sie können %APPTITLE% nun installieren.
+ Text German=
+ Text German=Klicken Sie auf "Weiter", um mit der Installation zu beginnen. Klicken Sie auf "Zurück", um die Installationsinformationen neu einzugeben.
+ Text Spanish=Ya está listo para instalar %APPTITLE%.
+ Text Spanish=
+ Text Spanish=Presione el botón Siguiente para comenzar la instalación o presione Atrás para volver a ingresar la información para la instalación.
+ Text Italian=Ora è possibile installare %APPTITLE%.
+ Text Italian=
+ Text Italian=Premere il pulsante Avanti per avviare l'installazione o il pulsante Indietro per reinserire le informazioni di installazione.
+ end
+ end
+end
+item: If/While Statement
+ Variable=DISPLAY
+ Value=Select Destination Directory
+end
+item: Set Variable
+ Variable=BACKUP
+ Value=%MAINDIR%\BACKUP
+end
+item: End Block
+end
+item: End Block
+end
+item: If/While Statement
+ Variable=TYPE
+ Value=B
+end
+item: Set Variable
+ Variable=COMPONENTS
+ Value=A
+end
+item: End Block
+end
+item: If/While Statement
+ Variable=DOBACKUP
+ Value=A
+end
+item: Set Variable
+ Variable=BACKUPDIR
+ Value=%BACKUP%
+end
+item: End Block
+end
+remarked item: If/While Statement
+ Variable=BRANDING
+ Value=1
+end
+remarked item: If/While Statement
+ Variable=DOBRAND
+ Value=1
+end
+remarked item: Edit INI File
+ Pathname=%INST%\CUSTDATA.INI
+ Settings=[Registration]
+ Settings=NAME=%NAME%
+ Settings=COMPANY=%COMPANY%
+ Settings=
+end
+remarked item: End Block
+end
+remarked item: End Block
+end
+item: Set Variable
+ Variable=MAINDIRSHORT
+ Value=%MAINDIR%
+ Flags=00010100
+end
+item: Open/Close INSTALL.LOG
+end
+item: Check Disk Space
+ Component=COMPONENTS
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\license.txt
+ Destination=%MAINDIR%\license.txt
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\win\Readme.txt
+ Destination=%MAINDIR%\Readme.txt
+ Flags=0000000000000010
+end
+item: If/While Statement
+ Variable=COMPONENTS
+ Value=D
+ Flags=00001010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\win\release\tk84.lib
+ Destination=%MAINDIR%\lib\tk84.lib
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\win\release\tkstub84.lib
+ Destination=%MAINDIR%\lib\tkstub84.lib
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\win\release\tcl84.lib
+ Destination=%MAINDIR%\lib\tcl84.lib
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\win\release\tclstub84.lib
+ Destination=%MAINDIR%\lib\tclstub84.lib
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\xlib\X11\Xutil.h
+ Destination=%MAINDIR%\include\X11\Xutil.h
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\xlib\X11\Xlib.h
+ Destination=%MAINDIR%\include\X11\Xlib.h
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\xlib\X11\Xfuncproto.h
+ Destination=%MAINDIR%\include\X11\Xfuncproto.h
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\xlib\X11\Xatom.h
+ Destination=%MAINDIR%\include\X11\Xatom.h
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\xlib\X11\X.h
+ Destination=%MAINDIR%\include\X11\X.h
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\xlib\X11\keysymdef.h
+ Destination=%MAINDIR%\include\X11\keysymdef.h
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\xlib\X11\keysym.h
+ Destination=%MAINDIR%\include\X11\keysym.h
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\xlib\X11\cursorfont.h
+ Destination=%MAINDIR%\include\X11\cursorfont.h
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\generic\tk.h
+ Destination=%MAINDIR%\include\tk.h
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\generic\tkDecls.h
+ Destination=%MAINDIR%\include\tkDecls.h
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\generic\tkPlatDecls.h
+ Destination=%MAINDIR%\include\tkPlatDecls.h
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\generic\tkIntXlibDecls.h
+ Destination=%MAINDIR%\include\tkIntXlibDecls.h
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\generic\tcl.h
+ Destination=%MAINDIR%\include\tcl.h
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\generic\tclDecls.h
+ Destination=%MAINDIR%\include\tclDecls.h
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\generic\tclPlatDecls.h
+ Destination=%MAINDIR%\include\tclPlatDecls.h
+ Flags=0000000000000010
+end
+item: End Block
+end
+item: If/While Statement
+ Variable=COMPONENTS
+ Value=A
+ Flags=00001010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\msgcat\pkgIndex.tcl
+ Destination=%MAINDIR%\lib\tcl%VER%\msgcat1.2\pkgIndex.tcl
+ Flags=0000000010000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\msgcat\msgcat.tcl
+ Destination=%MAINDIR%\lib\tcl%VER%\msgcat1.2\msgcat.tcl
+ Flags=0000000010000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\tcltest\pkgIndex.tcl
+ Destination=%MAINDIR%\lib\tcl%VER%\tcltest2.0\pkgIndex.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\tcltest\tcltest.tcl
+ Destination=%MAINDIR%\lib\tcl%VER%\tcltest2.0\tcltest.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\symbol.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\symbol.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\shiftjis.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\shiftjis.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\macUkraine.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\macUkraine.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\macTurkish.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\macTurkish.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\macThai.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\macThai.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\macRomania.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\macRomania.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\macRoman.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\macRoman.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\macJapan.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\macJapan.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\macIceland.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\macIceland.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\macGreek.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\macGreek.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\macDingbats.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\macDingbats.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\macCyrillic.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\macCyrillic.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\macCroatian.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\macCroatian.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\macCentEuro.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\macCentEuro.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\ksc5601.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\ksc5601.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\koi8-r.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\koi8-r.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\jis0212.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\jis0212.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\jis0208.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\jis0208.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\jis0201.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\jis0201.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\iso8859-15.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-15.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\iso8859-9.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-9.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\iso8859-8.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-8.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\iso8859-7.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-7.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\iso8859-6.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-6.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\iso8859-5.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-5.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\iso8859-4.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-4.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\iso8859-3.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-3.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\iso8859-2.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-2.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\iso8859-1.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-1.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\iso2022.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso2022.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\iso2022-kr.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso2022-kr.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\iso2022-jp.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso2022-jp.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\gb2312.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\gb2312.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\gb1988.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\gb1988.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\gb12345.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\gb12345.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\euc-cn.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\euc-cn.enc
+ Flags=0000000010000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\euc-jp.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\euc-jp.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\euc-kr.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\euc-kr.enc
+ Flags=0000000010000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\dingbats.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\dingbats.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp950.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp950.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp949.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp949.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp936.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp936.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp932.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp932.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp874.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp874.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp869.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp869.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp866.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp866.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp865.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp865.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp864.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp864.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp863.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp863.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp862.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp862.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp861.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp861.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp860.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp860.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp857.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp857.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp855.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp855.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp852.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp852.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp850.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp850.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp775.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp775.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp737.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp737.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp437.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp437.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp1258.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1258.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp1257.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1257.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp1256.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1256.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp1255.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1255.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp1254.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1254.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp1253.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1253.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp1252.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1252.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp1251.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1251.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\cp1250.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1250.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\ascii.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\ascii.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\encoding\big5.enc
+ Destination=%MAINDIR%\lib\tcl%VER%\encoding\big5.enc
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\opt\pkgIndex.tcl
+ Destination=%MAINDIR%\lib\tcl%VER%\opt0.4\pkgIndex.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\opt\optparse.tcl
+ Destination=%MAINDIR%\lib\tcl%VER%\opt0.4\optparse.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\http\pkgIndex.tcl
+ Destination=%MAINDIR%\lib\tcl%VER%\http2.4\pkgIndex.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\http\http.tcl
+ Destination=%MAINDIR%\lib\tcl%VER%\http2.4\http.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\msgbox.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\msgbox.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\optMenu.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\optMenu.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\clrpick.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\clrpick.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\entry.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\entry.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\spinbox.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\spinbox.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\comdlg.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\comdlg.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\bgerror.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\bgerror.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\obsolete.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\obsolete.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\button.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\button.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\xmfbox.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\xmfbox.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\console.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\console.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\listbox.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\listbox.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\menu.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\menu.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\dialog.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\dialog.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\focus.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\focus.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\palette.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\palette.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\tkfbox.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\tkfbox.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\tk.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\tk.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\text.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\text.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\tearoff.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\tearoff.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\tclIndex
+ Destination=%MAINDIR%\lib\tk%VER%\tclIndex
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\scrlbar.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\scrlbar.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\scale.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\scale.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\safetk.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\safetk.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\http1.0\pkgIndex.tcl
+ Destination=%MAINDIR%\lib\tcl%VER%\http1.0\pkgIndex.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\http1.0\http.tcl
+ Destination=%MAINDIR%\lib\tcl%VER%\http1.0\http.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\reg\pkgIndex.tcl
+ Destination=%MAINDIR%\lib\tcl%VER%\reg1.0\pkgIndex.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\win\release\tclreg10.dll
+ Destination=%MAINDIR%\lib\tcl%VER%\reg1.0\tclreg10.dll
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\dde\pkgIndex.tcl
+ Destination=%MAINDIR%\lib\tcl%VER%\dde1.2\pkgIndex.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\win\release\tcldde12.dll
+ Destination=%MAINDIR%\lib\tcl%VER%\dde1.2\tcldde12.dll
+ Flags=0000000000000010
+end
+item: Install File
+ Source=C:\WINNT\SYSTEM32\Msvcrt.dll
+ Destination=%MAINDIR%\bin\msvcrt.dll
+ Flags=0010001000000011
+end
+item: Install File
+ Source=${__TKBASEDIR__}\win\release\wish84.exe
+ Destination=%MAINDIR%\bin\wish84.exe
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\win\release\tclsh84.exe
+ Destination=%MAINDIR%\bin\tclsh84.exe
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\win\release\tclpip84.dll
+ Destination=%MAINDIR%\bin\tclpip84.dll
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\win\release\tcl84.dll
+ Destination=%MAINDIR%\bin\tcl84.dll
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\win\release\tk84.dll
+ Destination=%MAINDIR%\bin\tk84.dll
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\auto.tcl
+ Destination=%MAINDIR%\lib\tcl%VER%\auto.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\history.tcl
+ Destination=%MAINDIR%\lib\tcl%VER%\history.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\init.tcl
+ Destination=%MAINDIR%\lib\tcl%VER%\init.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\package.tcl
+ Destination=%MAINDIR%\lib\tcl%VER%\package.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\parray.tcl
+ Destination=%MAINDIR%\lib\tcl%VER%\parray.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\safe.tcl
+ Destination=%MAINDIR%\lib\tcl%VER%\safe.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\tclIndex
+ Destination=%MAINDIR%\lib\tcl%VER%\tclIndex
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\library\word.tcl
+ Destination=%MAINDIR%\lib\tcl%VER%\word.tcl
+ Flags=0000000000000010
+end
+item: End Block
+end
+item: If/While Statement
+ Variable=COMPONENTS
+ Value=B
+ Flags=00001010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\images\tai-ku.gif
+ Destination=%MAINDIR%\lib\tk%VER%\images\tai-ku.gif
+ Flags=0000000010000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\images\teapot.ppm
+ Destination=%MAINDIR%\lib\tk%VER%\demos\images\teapot.ppm
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\images\tcllogo.gif
+ Destination=%MAINDIR%\lib\tk%VER%\demos\images\tcllogo.gif
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\images\pattern.bmp
+ Destination=%MAINDIR%\lib\tk%VER%\demos\images\pattern.bmp
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\images\noletter.bmp
+ Destination=%MAINDIR%\lib\tk%VER%\demos\images\noletter.bmp
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\images\letters.bmp
+ Destination=%MAINDIR%\lib\tk%VER%\demos\images\letters.bmp
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\images\gray25.bmp
+ Destination=%MAINDIR%\lib\tk%VER%\demos\images\gray25.bmp
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\images\flagup.bmp
+ Destination=%MAINDIR%\lib\tk%VER%\demos\images\flagup.bmp
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\images\flagdown.bmp
+ Destination=%MAINDIR%\lib\tk%VER%\demos\images\flagdown.bmp
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\images\face.bmp
+ Destination=%MAINDIR%\lib\tk%VER%\demos\images\face.bmp
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\images\earthris.gif
+ Destination=%MAINDIR%\lib\tk%VER%\demos\images\earthris.gif
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\images\earth.gif
+ Destination=%MAINDIR%\lib\tk%VER%\demos\images\earth.gif
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\vscale.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\vscale.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\twind.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\twind.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\text.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\text.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\style.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\style.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\states.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\states.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\search.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\search.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\sayings.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\sayings.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\ruler.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\ruler.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\radio.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\radio.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\puzzle.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\puzzle.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\plot.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\plot.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\msgbox.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\msgbox.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\menubu.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\menubu.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\menu.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\menu.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\label.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\label.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\items.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\items.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\image2.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\image2.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\image1.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\image1.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\icon.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\icon.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\hscale.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\hscale.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\form.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\form.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\ixset
+ Destination=%MAINDIR%\lib\tk%VER%\demos\ixset.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\rolodex
+ Destination=%MAINDIR%\lib\tk%VER%\demos\rolodex.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\square
+ Destination=%MAINDIR%\lib\tk%VER%\demos\square.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\Readme
+ Destination=%MAINDIR%\lib\tk%VER%\demos\Readme
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\hello
+ Destination=%MAINDIR%\lib\tk%VER%\demos\hello.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\tclIndex
+ Destination=%MAINDIR%\lib\tk%VER%\demos\tclIndex
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\browse
+ Destination=%MAINDIR%\lib\tk%VER%\demos\browse.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\timer
+ Destination=%MAINDIR%\lib\tk%VER%\demos\timer.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\widget
+ Destination=%MAINDIR%\lib\tk%VER%\demos\widget.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\tcolor
+ Destination=%MAINDIR%\lib\tk%VER%\demos\tcolor.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\rmt
+ Destination=%MAINDIR%\lib\tk%VER%\demos\rmt.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\floor.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\floor.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\filebox.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\filebox.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\images\pwrdLogo75.gif
+ Destination=%MAINDIR%\lib\tk%VER%\images\pwrdLogo75.gif
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\images\pwrdLogo200.gif
+ Destination=%MAINDIR%\lib\tk%VER%\images\pwrdLogo200.gif
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\images\pwrdLogo175.gif
+ Destination=%MAINDIR%\lib\tk%VER%\images\pwrdLogo175.gif
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\images\pwrdLogo150.gif
+ Destination=%MAINDIR%\lib\tk%VER%\images\pwrdLogo150.gif
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\images\pwrdLogo100.gif
+ Destination=%MAINDIR%\lib\tk%VER%\images\pwrdLogo100.gif
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\images\logoMed.gif
+ Destination=%MAINDIR%\lib\tk%VER%\images\logoMed.gif
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\images\logoLarge.gif
+ Destination=%MAINDIR%\lib\tk%VER%\images\logoLarge.gif
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\images\logo64.gif
+ Destination=%MAINDIR%\lib\tk%VER%\images\logo64.gif
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\images\logo100.gif
+ Destination=%MAINDIR%\lib\tk%VER%\images\logo100.gif
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\images\Readme
+ Destination=%MAINDIR%\lib\tk%VER%\images\Readme
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\arrow.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\arrow.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\bind.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\bind.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\bitmap.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\bitmap.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\button.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\button.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\check.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\check.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\clrpick.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\clrpick.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\colors.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\colors.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\cscroll.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\cscroll.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\ctext.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\ctext.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\dialog1.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\dialog1.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\dialog2.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\dialog2.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\entry1.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\entry1.tcl
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TKBASEDIR__}\library\demos\entry2.tcl
+ Destination=%MAINDIR%\lib\tk%VER%\demos\entry2.tcl
+ Flags=0000000000000010
+end
+item: End Block
+end
+item: If/While Statement
+ Variable=COMPONENTS
+ Value=C
+ Flags=00001010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\tools\tcl84.cnt
+ Destination=%MAINDIR%\doc\tcl84.cnt
+ Flags=0000000000000010
+end
+item: Install File
+ Source=${__TCLBASEDIR__}\tools\tcl84.hlp
+ Destination=%MAINDIR%\doc\tcl84.hlp
+ Flags=0000000000000010
+end
+item: End Block
+end
+item: Set Variable
+ Variable=MAINDIR
+ Value=%MAINDIR%
+ Flags=00010100
+end
+item: Include Script
+ Pathname=\\pop\tools\1.2\win32-ix86\wise\INCLUDE\uninstal.wse
+end
+item: Check Configuration
+ Flags=10111011
+end
+item: Get Registry Key Value
+ Variable=GROUPDIR
+ Key=Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders
+ Default=%WIN%\Start Menu\Programs
+ Value Name=Programs
+ Flags=00000010
+end
+item: Set Variable
+ Variable=GROUP
+ Value=%GROUPDIR%\%GROUP%
+end
+item: If/While Statement
+ Variable=COMPONENTS
+ Value=A
+ Flags=00001010
+end
+item: Create Shortcut
+ Source=%MAINDIR%\bin\wish84.exe
+ Destination=%GROUP%\Wish.lnk
+ Working Directory=%MAINDIR%
+end
+item: End Block
+end
+item: If/While Statement
+ Variable=COMPONENTS
+ Value=A
+ Flags=00001010
+end
+item: Create Shortcut
+ Source=%MAINDIR%\bin\tclsh84.exe
+ Destination=%GROUP%\Tclsh.lnk
+ Working Directory=%MAINDIR%
+ Key Type=1536
+ Flags=00000001
+end
+item: End Block
+end
+item: If/While Statement
+ Variable=COMPONENTS
+ Value=C
+ Flags=00001010
+end
+item: Create Shortcut
+ Source=%MAINDIR%\doc\tcl84.hlp
+ Destination=%GROUP%\Tcl Help.lnk
+ Working Directory=%MAINDIR%
+end
+item: End Block
+end
+item: Create Shortcut
+ Source=%MAINDIR%\Readme.txt
+ Destination=%GROUP%\Readme.lnk
+ Working Directory=%MAINDIR%
+end
+item: If/While Statement
+ Variable=COMPONENTS
+ Value=B
+ Flags=00001010
+end
+item: Create Shortcut
+ Source=%MAINDIR%\lib\tk%VER%\demos\widget.tcl
+ Destination=%GROUP%\Widget Tour.lnk
+ Working Directory=%MAINDIR%
+ Key Type=1536
+ Flags=00000001
+end
+item: End Block
+end
+item: Else Statement
+end
+item: If/While Statement
+ Variable=COMPONENTS
+ Value=B
+ Flags=00001010
+end
+item: Add ProgMan Icon
+ Group=%GROUP%
+ Icon Name=Widget Tour
+ Command Line=%MAINDIR%\lib\tk%VER%\demos\widget.tcl
+ Icon Pathname=%MAINDIR%\bin\wish84.exe
+ Default Directory=%MAINDIR%
+end
+item: End Block
+end
+item: If/While Statement
+ Variable=COMPONENTS
+ Value=C
+ Flags=00001010
+end
+item: Add ProgMan Icon
+ Group=%GROUP%
+ Icon Name=Tcl Help
+ Command Line=%MAINDIR%\doc\tcl84.hlp
+ Default Directory=%MAINDIR%
+end
+item: End Block
+end
+item: Add ProgMan Icon
+ Group=%GROUP%
+ Icon Name=Readme
+ Command Line=%MAINDIR%\Readme.txt
+ Default Directory=%MAINDIR%
+end
+item: If/While Statement
+ Variable=COMPONENTS
+ Value=A
+ Flags=00001010
+end
+item: Add ProgMan Icon
+ Group=%GROUP%
+ Icon Name=Wish
+ Command Line=%MAINDIR%\bin\wish84.exe
+ Default Directory=%MAINDIR%
+end
+item: End Block
+end
+item: If/While Statement
+ Variable=COMPONENTS
+ Value=A
+ Flags=00001010
+end
+item: Add ProgMan Icon
+ Group=%GROUP%
+ Icon Name=Tclsh
+ Command Line=%MAINDIR%\bin\tclsh84.exe
+ Default Directory=%MAINDIR%
+end
+item: End Block
+end
+item: End Block
+end
+item: Self-Register OCXs/DLLs
+ Description=Updating System Configuration, Please Wait...
+end
+item: Edit Registry
+ Total Keys=1
+ Key=SOFTWARE\Scriptics\Tcl\%VER%
+ New Value=%MAINDIR%
+ Value Name=Root
+ Root=2
+end
+item: Edit Registry
+ Total Keys=1
+ Key=TclScript\DefaultIcon
+ New Value=%MAINDIR%\bin\tk84.dll
+end
+item: Edit Registry
+ Total Keys=1
+ Key=.tcl
+ New Value=TclScript
+end
+item: Edit Registry
+ Total Keys=1
+ Key=TclScript
+ New Value=TclScript
+end
+item: Edit Registry
+ Total Keys=1
+ Key=TclScript\shell\open\command
+ New Value=%MAINDIRSHORT%\bin\wish84.exe "%%1" %%*
+end
+item: Edit Registry
+ Total Keys=1
+ Key=TclScript\shell\edit
+ New Value=&Edit
+end
+item: Edit Registry
+ Total Keys=1
+ Key=TclScript\shell\edit\command
+ New Value=notepad "%%1"
+end
+item: Add Directory to Path
+ Directory=%MAINDIR%\bin
+end
+item: Check Configuration
+ Flags=10111011
+end
+item: Set Variable
+ Variable=TO_SCRIPTICS
+ Value=A
+end
+item: Else Statement
+end
+item: Set Variable
+ Variable=TO_SCRIPTICS
+end
+item: End Block
+end
+item: Wizard Block
+ Direction Variable=DIRECTION
+ Display Variable=DISPLAY
+ Bitmap Pathname=%_WISE_%\DIALOGS\TEMPLATE\WIZARD.BMP
+ X Position=9
+ Y Position=10
+ Filler Color=8421440
+ Flags=00000011
+end
+item: Custom Dialog Set
+ Name=Finished
+ Display Variable=DISPLAY
+ item: Dialog
+ Title=%APPTITLE% Installation
+ Title French=Installation de %APPTITLE%
+ Title German=Installation von %APPTITLE%
+ Title Spanish=Instalación de %APPTITLE%
+ Title Italian=Installazione di %APPTITLE%
+ Width=271
+ Height=224
+ Font Name=Helv
+ Font Size=8
+ item: Push Button
+ Rectangle=150 187 195 202
+ Variable=DIRECTION
+ Value=N
+ Create Flags=01010000000000010000000000000001
+ Text=&Finish
+ Text French=&Fin
+ Text German=&Weiter
+ Text Spanish=&Terminar
+ Text Italian=&Fine
+ end
+ item: Push Button
+ Rectangle=105 187 150 202
+ Variable=DISABLED
+ Value=!
+ Create Flags=01010000000000010000000000000000
+ Text=< &Back
+ Text French=< &Retour
+ Text German=< &Zurück
+ Text Spanish=< &Atrás
+ Text Italian=< &Indietro
+ end
+ item: Push Button
+ Rectangle=211 187 256 202
+ Variable=DISABLED
+ Value=!
+ Action=3
+ Create Flags=01010000000000010000000000000000
+ Text=&Cancel
+ Text French=&Annuler
+ Text German=&Abbrechen
+ Text Spanish=&Cancelar
+ Text Italian=&Annulla
+ end
+ item: Static
+ Rectangle=8 180 256 181
+ Action=3
+ Create Flags=01010000000000000000000000000111
+ end
+ item: Static
+ Rectangle=86 8 258 42
+ Create Flags=01010000000000000000000000000000
+ Flags=0000000000000001
+ Name=Times New Roman
+ Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18
+ Text=Installation Completed!
+ Text French=Installation terminée !
+ Text German=Die Installation ist abgeschlossen!
+ Text Spanish=¡Instalación terminada!
+ Text Italian=Installazione completata!
+ end
+ item: Static
+ Rectangle=86 42 256 153
+ Create Flags=01010000000000000000000000000000
+ Text=%APPTITLE% has been successfully installed.
+ Text=
+ Text=Click the Finish button to exit this installation.
+ Text=
+ Text=You can learn more about Tcl/Tk %VER%, including release notes, updates, tutorials, and more at %URL%. Check the box below to start your web browser and go there now.
+ Text=
+ Text=The installer may ask you to reboot your computer, this is to update your PATH and is not necessary to do immediately.
+ Text French=%APPTITLE% est maintenant installé.
+ Text French=
+ Text French=Cliquez sur le bouton Fin pour quitter l'installation.
+ Text German=%APPTITLE% wurde erfolgreich installiert.
+ Text German=
+ Text German=Klicken Sie auf "Weiter", um die Installation zu beenden.
+ Text Spanish=%APPTITLE% se ha instalado con éxito.
+ Text Spanish=
+ Text Spanish=Presione el botón Terminar para salir de esta instalación.
+ Text Italian=L'installazione %APPTITLE% è stata portata a termine con successo.
+ Text Italian=
+ Text Italian=Premere il pulsante Fine per uscire dall'installazione.
+ end
+ item: Checkbox
+ Rectangle=88 143 245 157
+ Variable=TO_SCRIPTICS
+ Enabled Color=00000000000000001111111111111111
+ Create Flags=01010000000000010000000000000011
+ Text=Show me important information about
+ Text=
+ end
+ item: Static
+ Rectangle=99 156 245 170
+ Enabled Color=00000000000000001111111111111111
+ Create Flags=01010000000000000000000000000000
+ Text=Tcl/Tk %VER% and TclPro
+ end
+ end
+end
+item: End Block
+end
+item: Check Configuration
+ Flags=10111011
+end
+item: If/While Statement
+ Variable=TO_SCRIPTICS
+ Value=A
+ Flags=00000010
+end
+item: Execute Program
+ Command Line=%URL%
+end
+item: End Block
+end
+item: Execute Program
+ Pathname=explorer
+ Command Line=%GROUP%
+end
+item: End Block
+end
+
diff --git a/tcl/tools/tclSplash.bmp b/tcl/tools/tclSplash.bmp
index 19e3c4a7c04..e3e83ad6ebc 100644
--- a/tcl/tools/tclSplash.bmp
+++ b/tcl/tools/tclSplash.bmp
Binary files differ
diff --git a/tcl/tools/tcltk-man2html.tcl b/tcl/tools/tcltk-man2html.tcl
index 3893e55bf75..c5bd2a669a8 100755
--- a/tcl/tools/tcltk-man2html.tcl
+++ b/tcl/tools/tcltk-man2html.tcl
@@ -65,7 +65,7 @@ package require Tcl 8.2
# Oct 24, 1997 - moved from 8.0b1 to 8.0 release
#
-set Version "0.20"
+set Version "0.30"
proc parse_command_line {} {
global argv Version
@@ -81,8 +81,8 @@ proc parse_command_line {} {
set webdir ../html
# Directory names for Tcl and Tk, in priority order.
- set tclDirList {tcl8.3 tcl8.2 tcl8.1 tcl8.0 tcl}
- set tkDirList {tk8.3 tk8.2 tk8.1 tk8.0 tk}
+ set tclDirList {tcl8.4 tcl8.3 tcl8.2 tcl8.1 tcl8.0 tcl}
+ set tkDirList {tk8.4 tk8.3 tk8.2 tk8.1 tk8.0 tk}
# Handle arguments a la GNU:
# --version
@@ -223,27 +223,35 @@ proc process-text {text} {
regsub -all {\\-\\\|\\-} $text -- text; # two hyphens
regsub -all -- {\\-\\\^\\-} $text -- text; # two hyphens
regsub -all {\\-} $text - text; # a hyphen
- regsub -all "\\\\\n" $text "\\&\#92;\n" text; # backslashed newline
- while {[regexp {\\} $text]} {
+ regsub -all "\\\\\n" $text "\\&#92;\n" text; # backslashed newline
+ while {[string first "\\" $text] >= 0} {
# C R
- if {[regsub {^([^\\]*)\\fC([^\\]*)\\fR(.*)$} $text {\1<TT>\2</TT>\3} text]} continue
+ if {[regsub {^([^\\]*)\\fC([^\\]*)\\fR(.*)$} $text \
+ {\1<TT>\2</TT>\3} text]} continue
# B R
- if {[regsub {^([^\\]*)\\fB([^\\]*)\\fR(.*)$} $text {\1<B>\2</B>\3} text]} continue
+ if {[regsub {^([^\\]*)\\fB([^\\]*)\\fR(.*)$} $text \
+ {\1<B>\2</B>\3} text]} continue
# B I
- if {[regsub {^([^\\]*)\\fB([^\\]*)\\fI(.*)$} $text {\1<B>\2</B>\\fI\3} text]} continue
+ if {[regsub {^([^\\]*)\\fB([^\\]*)\\fI(.*)$} $text \
+ {\1<B>\2</B>\\fI\3} text]} continue
# I R
- if {[regsub {^([^\\]*)\\fI([^\\]*)\\fR(.*)$} $text {\1<I>\2</I>\3} text]} continue
+ if {[regsub {^([^\\]*)\\fI([^\\]*)\\fR(.*)$} $text \
+ {\1<I>\2</I>\3} text]} continue
# I B
- if {[regsub {^([^\\]*)\\fI([^\\]*)\\fB(.*)$} $text {\1<I>\2</I>\\fB\3} text]} continue
+ if {[regsub {^([^\\]*)\\fI([^\\]*)\\fB(.*)$} $text \
+ {\1<I>\2</I>\\fB\3} text]} continue
# B B, I I, R R
- if {[regsub {^([^\\]*)\\fB([^\\]*)\\fB(.*)$} $text {\1\\fB\2\3} ntext]
- || [regsub {^([^\\]*)\\fI([^\\]*)\\fI(.*)$} $text {\1\\fI\2\3} ntext]
- || [regsub {^([^\\]*)\\fR([^\\]*)\\fR(.*)$} $text {\1\\fR\2\3} ntext]} {
+ if {[regsub {^([^\\]*)\\fB([^\\]*)\\fB(.*)$} $text \
+ {\1\\fB\2\3} ntext]
+ || [regsub {^([^\\]*)\\fI([^\\]*)\\fI(.*)$} $text \
+ {\1\\fI\2\3} ntext]
+ || [regsub {^([^\\]*)\\fR([^\\]*)\\fR(.*)$} $text \
+ {\1\\fR\2\3} ntext]} {
manerror "process-text: impotent font change: $text"
set text $ntext
continue
}
- # unrecognized
+ # unrecognized
manerror "process-text: uncaught backslash: $text"
set text [string map [list "\\" "#92;"] $text]
}
@@ -272,7 +280,7 @@ proc next-text {} {
error "fatal"
}
proc is-a-directive {line} {
- return [expr {[string first . $line] == 0}]
+ return [string match .* $line]
}
proc split-directive {line opname restname} {
upvar $opname op $restname rest
@@ -317,14 +325,14 @@ proc match-text args {
incr manual(text-pointer)
continue
}
- if {[regexp {^@([_a-zA-Z0-9]+)$} $arg all name]} {
+ if {[regexp {^@(\w+)$} $arg all name]} {
upvar $name var
set var $targ
incr nback
incr manual(text-pointer)
continue
}
- if {[regexp {^(\.[a-zA-Z][a-zA-Z])@([_a-zA-Z0-9]+)$} $arg all op name]\
+ if {[regexp -nocase {^(\.[A-Z][A-Z])@(\w+)$} $arg all op name]\
&& [string equal $op [lindex $targ 0]]} {
upvar $name var
set var [lrange $targ 1 end]
@@ -357,7 +365,8 @@ proc long-toc {text} {
global manual
set here M[incr manual(section-toc-n)]
set there L[incr manual(long-toc-n)]
- lappend manual(section-toc) "<DD><A HREF=\"$manual(name).htm#$here\" NAME=\"$there\">$text</A>"
+ lappend manual(section-toc) \
+ "<DD><A HREF=\"$manual(name).htm#$here\" NAME=\"$there\">$text</A>"
return "<A NAME=\"$here\">$text</A>"
}
proc option-toc {name class switch} {
@@ -406,11 +415,7 @@ proc output-widget-options {rest} {
set para {}
while {[next-op-is .OP rest]} {
switch -exact [llength $rest] {
- 3 {
- set switch [lindex $rest 0]
- set name [lindex $rest 1]
- set class [lindex $rest 2]
- }
+ 3 { foreach {switch name class} $rest { break } }
5 {
set switch [lrange $rest 0 2]
set name [lindex $rest 3]
@@ -420,17 +425,17 @@ proc output-widget-options {rest} {
fatal "bad .OP $rest"
}
}
- if {![regexp {^(<.>)([-a-zA-Z0-9 ]+)(</.>)$} $switch all oswitch switch cswitch]} {
- if {![regexp {^(<.>)([-a-zA-Z0-9 ]+) or ([-a-zA-Z0-9 ]+)(</.>)$} $switch all oswitch switch1 switch2 cswitch]} {
+ if {![regexp {^(<.>)([-\w ]+)(</.>)$} $switch all oswitch switch cswitch]} {
+ if {![regexp {^(<.>)([-\w ]+) or ([-\w ]+)(</.>)$} $switch all oswitch switch1 switch2 cswitch]} {
error "not Switch: $switch"
} else {
set switch "$switch1$cswitch or $oswitch$switch2"
}
}
- if {![regexp {^(<.>)([a-zA-Z0-9]*)(</.>)$} $name all oname name cname]} {
+ if {![regexp {^(<.>)([\w]*)(</.>)$} $name all oname name cname]} {
error "not Name: $name"
}
- if {![regexp {^(<.>)([a-zA-Z0-9]*)(</.>)$} $class all oclass class cclass]} {
+ if {![regexp {^(<.>)([\w]*)(</.>)$} $class all oclass class cclass]} {
error "not Class: $class"
}
man-puts "$para<DT>Command-Line Name: $oswitch[option-toc $name $class $switch]$cswitch"
@@ -493,7 +498,7 @@ proc output-RS-list {} {
##
proc output-IP-list {context code rest} {
global manual
- if {[string equal $rest {}]} {
+ if {![string length $rest]} {
# blank label, plain indent, no contents entry
man-puts <DL><P><DD>
while {[more-text]} {
@@ -535,7 +540,7 @@ proc output-IP-list {context code rest} {
continue
}
if {[string equal $manual(section) "ARGUMENTS"] || \
- [regexp {^\[[0-9]+\]$} $rest]} {
+ [regexp {^\[\d+\]$} $rest]} {
man-puts "<P><DT>$rest<DD>"
} else {
man-puts "<P><DT>[long-toc $rest]<DD>"
@@ -578,7 +583,7 @@ proc output-IP-list {context code rest} {
incr accept_RE 1
} elseif {[match-text @rest .RE]} {
# gad, this is getting ridiculous
- if { ! $accept_RE} {
+ if {!$accept_RE} {
man-puts "</DL><P>$rest<DL>"
backup-text 1
break
@@ -594,7 +599,7 @@ proc output-IP-list {context code rest} {
}
}
.RE {
- if { ! $accept_RE} {
+ if {!$accept_RE} {
backup-text 1
break
}
@@ -657,7 +662,7 @@ proc cross-reference {ref} {
##
## nothing to reference
##
- if { ! [info exists manual(name-$lref)]} {
+ if {![info exists manual(name-$lref)]} {
foreach name {array file history info interp string trace
after clipboard grab image option pack place selection tk tkwait update winfo wm} {
if {[regexp "^$name \[a-z0-9]*\$" $lref] && \
@@ -688,10 +693,12 @@ proc cross-reference {ref} {
set tcl_ref [lindex $manual(name-$lref) $tcl_i]
set tk_i [lsearch -glob $manual(name-$lref) *TkCmd*]
set tk_ref [lindex $manual(name-$lref) $tk_i]
- if {$tcl_i >= 0 && "$manual(wing-file)" == {TclCmd} || "$manual(wing-file)" == {TclLib}} {
+ if {$tcl_i >= 0 && "$manual(wing-file)" == {TclCmd} \
+ || "$manual(wing-file)" == {TclLib}} {
return "<A HREF=\"../$tcl_ref.htm\">$ref</A>"
}
- if {$tk_i >= 0 && "$manual(wing-file)" == {TkCmd} || "$manual(wing-file)" == {TkLib}} {
+ if {$tk_i >= 0 && "$manual(wing-file)" == {TkCmd} \
+ || "$manual(wing-file)" == {TkLib}} {
return "<A HREF=\"../$tk_ref.htm\">$ref</A>"
}
if {"$lref" == {exit} && "$manual(tail)" == {tclsh.1} && $tcl_i >= 0} {
@@ -812,7 +819,7 @@ proc insert-cross-references {text} {
##
## if nothing, then we're done.
##
- if { ! [info exists offsets]} {
+ if {![info exists offsets]} {
return $text
}
##
@@ -824,68 +831,92 @@ proc insert-cross-references {text} {
##
switch -exact $invert([lindex $offsets 0]) {
anchor {
- if {$offset(end-anchor) < 0} { return [reference-error {Missing end anchor} $text]; }
+ if {$offset(end-anchor) < 0} {
+ return [reference-error {Missing end anchor} $text]
+ }
set head [string range $text 0 $offset(end-anchor)]
- set tail [string range $text [expr $offset(end-anchor)+1] end]
+ set tail [string range $text [expr {$offset(end-anchor)+1}] end]
return $head[insert-cross-references $tail]
}
quote {
- if {$offset(end-quote) < 0} { return [reference-error {Missing end quote} $text]; }
- if {"$invert([lindex $offsets 1])" == {tk}} { set offsets [lreplace $offsets 1 1]; }
- if {"$invert([lindex $offsets 1])" == {tcl}} { set offsets [lreplace $offsets 1 1]; }
+ if {$offset(end-quote) < 0} {
+ return [reference-error "Missing end quote" $text]
+ }
+ if {$invert([lindex $offsets 1]) == "tk"} {
+ set offsets [lreplace $offsets 1 1]
+ }
+ if {$invert([lindex $offsets 1]) == "tcl"} {
+ set offsets [lreplace $offsets 1 1]
+ }
switch -exact $invert([lindex $offsets 1]) {
end-quote {
- set head [string range $text 0 [expr $offset(quote)-1]]
- set body [string range $text [expr $offset(quote)+2] [expr $offset(end-quote)-1]]
- set tail [string range $text [expr $offset(end-quote)+2] end]
- return $head``[cross-reference $body]''[insert-cross-references $tail]
+ set head [string range $text 0 [expr {$offset(quote)-1}]]
+ set body [string range $text [expr {$offset(quote)+2}] \
+ [expr {$offset(end-quote)-1}]]
+ set tail [string range $text \
+ [expr {$offset(end-quote)+2}] end]
+ return "$head``[cross-reference $body]''[insert-cross-references $tail]"
}
bold -
anchor {
- set head [string range $text 0 [expr $offset(end-quote)+1]]
- set tail [string range $text [expr $offset(end-quote)+2] end]
- return $head[insert-cross-references $tail]
+ set head [string range $text \
+ 0 [expr {$offset(end-quote)+1}]]
+ set tail [string range $text \
+ [expr {$offset(end-quote)+2}] end]
+ return "$head[insert-cross-references $tail]"
}
}
- return [reference-error {Uncaught quote case} $text]
+ return [reference-error "Uncaught quote case" $text]
}
bold {
- if {$offset(end-bold) < 0} { return $text; }
- if {"$invert([lindex $offsets 1])" == {tk}} { set offsets [lreplace $offsets 1 1]; }
- if {"$invert([lindex $offsets 1])" == {tcl}} { set offsets [lreplace $offsets 1 1]; }
+ if {$offset(end-bold) < 0} { return $text }
+ if {$invert([lindex $offsets 1]) == "tk"} {
+ set offsets [lreplace $offsets 1 1]
+ }
+ if {$invert([lindex $offsets 1]) == "tcl"} {
+ set offsets [lreplace $offsets 1 1]
+ }
switch -exact $invert([lindex $offsets 1]) {
end-bold {
- set head [string range $text 0 [expr $offset(bold)-1]]
- set body [string range $text [expr $offset(bold)+3] [expr $offset(end-bold)-1]]
- set tail [string range $text [expr $offset(end-bold)+4] end]
- return $head<B>[cross-reference $body]</B>[insert-cross-references $tail]
+ set head [string range $text 0 [expr {$offset(bold)-1}]]
+ set body [string range $text [expr {$offset(bold)+3}] \
+ [expr {$offset(end-bold)-1}]]
+ set tail [string range $text \
+ [expr {$offset(end-bold)+4}] end]
+ return "$head<B>[cross-reference $body]</B>[insert-cross-references $tail]"
}
anchor {
- set head [string range $text 0 [expr $offset(end-bold)+3]]
- set tail [string range $text [expr $offset(end-bold)+4] end]
- return $head[insert-cross-references $tail]
+ set head [string range $text \
+ 0 [expr {$offset(end-bold)+3}]]
+ set tail [string range $text \
+ [expr {$offset(end-bold)+4}] end]
+ return "$head[insert-cross-references $tail]"
}
}
- return [reference-error {Uncaught bold case} $text]
+ return [reference-error "Uncaught bold case" $text]
}
tk {
- set head [string range $text 0 [expr $offset(tk)-1]]
+ set head [string range $text 0 [expr {$offset(tk)-1}]]
set tail [string range $text $offset(tk) end]
- if { ! [regexp {^(Tk_[a-zA-Z0-9_]+)(.*)$} $tail all body tail]} { return [reference-error {Tk regexp failed} $text]; }
+ if {![regexp {^(Tk_\w+)(.*)$} $tail all body tail]} {
+ return [reference-error "Tk regexp failed" $text]
+ }
return $head[cross-reference $body][insert-cross-references $tail]
}
tcl {
- set head [string range $text 0 [expr $offset(tcl)-1]]
+ set head [string range $text 0 [expr {$offset(tcl)-1}]]
set tail [string range $text $offset(tcl) end]
- if { ! [regexp {^(Tcl_[a-zA-Z0-9_]+)(.*)$} $tail all body tail]} { return [reference-error {Tcl regexp failed} $text]; }
+ if {![regexp {^(Tcl_\w+)(.*)$} $tail all body tail]} {
+ return [reference-error {Tcl regexp failed} $text]
+ }
return $head[cross-reference $body][insert-cross-references $tail]
}
Tcl1 -
Tcl2 {
set off [lindex $offsets 0]
- set head [string range $text 0 [expr $off-1]]
+ set head [string range $text 0 [expr {$off-1}]]
set body Tcl
- set tail [string range $text [expr $off+3] end]
+ set tail [string range $text [expr {$off+3}] end]
return $head[cross-reference $body][insert-cross-references $tail]
}
end-anchor -
@@ -988,7 +1019,7 @@ proc output-directive {line} {
set nmore {}
foreach cr [split $more ,] {
set cr [string trim $cr]
- if { ! [regexp {^<B>.*</B>$} $cr]} {
+ if {![regexp {^<B>.*</B>$} $cr]} {
set cr <B>$cr</B>
}
if {[regexp {^<B>(.*)\([13n]\)</B>$} $cr all name]} {
@@ -1204,17 +1235,17 @@ proc output-directive {line} {
##
proc merge-copyrights {l1 l2} {
foreach copyright [concat $l1 $l2] {
- if {[regexp {^Copyright +\(c\) +([0-9]+) +(by +)?([A-Za-z].*)$} $copyright all date by who]} {
+ if {[regexp {^Copyright +\(c\) +(\d+) +(by +)?(\w.*)$} $copyright all date by who]} {
lappend dates($who) $date
continue
}
- if {[regexp {^Copyright +\(c\) +([0-9]+)-([0-9]+) +(by +)?([A-Za-z].*)$} $copyright all from to by who]} {
+ if {[regexp {^Copyright +\(c\) +(\d+)-(\d+) +(by +)?(\w.*)$} $copyright all from to by who]} {
for {set date $from} {$date <= $to} {incr date} {
lappend dates($who) $date
}
continue
}
- if {[regexp {^Copyright +\(c\) +([0-9]+), *([0-9]+) +(by +)?([A-Za-z].*)$} $copyright all date1 date2 by who]} {
+ if {[regexp {^Copyright +\(c\) +(\d+), *(\d+) +(by +)?(\w.*)$} $copyright all date1 date2 by who]} {
lappend dates($who) $date1 $date2
continue
}
@@ -1230,18 +1261,14 @@ proc merge-copyrights {l1 l2} {
}
return [lsort $merge]
}
-
+
proc makedirhier {dir} {
- if { ! [file isdirectory $dir]} {
- makedirhier [file dirname $dir]
- if { ! [file isdirectory $dir]} {
- if {[catch {exec mkdir $dir} error]} {
- error "cannot create directory $dir: $error"
- }
- }
+ if {![file isdirectory $dir] && \
+ [catch {file mkdir $dir} error]} {
+ return -code error "cannot create directory $dir: $error"
}
}
-
+
##
## foreach of the man directories specified by args
## convert manpages into hypertext in the directory
@@ -1250,9 +1277,6 @@ proc makedirhier {dir} {
proc make-man-pages {html args} {
global env manual overall_title
makedirhier $html
- if { ! [file isdirectory $html]} {
- exec mkdir $html
- }
set manual(short-toc-n) 1
set manual(short-toc-fp) [open $html/contents.htm w]
puts $manual(short-toc-fp) "<HTML><HEAD><TITLE>$overall_title</TITLE></HEAD>"
@@ -1297,7 +1321,7 @@ proc make-man-pages {html args} {
manerror "discarding $manual(name)"
continue
}
- set manual(infp) [open "$manual(page)"]
+ set manual(infp) [open $manual(page)]
set manual(text) {}
set manual(partial-text) {}
foreach p {.RS .DS .CS .SO} {
@@ -1309,7 +1333,7 @@ proc make-man-pages {html args} {
set manual(section-toc-n) 1
set manual(copyrights) {}
lappend manual(all-pages) $manual(wing-file)/$manual(tail)
- manreport 100 "$manual(name)"
+ manreport 100 $manual(name)
while {[gets $manual(infp) line] >= 0} {
manreport 100 $line
if {[regexp {^[`'][/\\]} $line]} {
@@ -1325,13 +1349,7 @@ proc make-man-pages {html args} {
}
if {[parse-directive $line code rest]} {
switch -exact $code {
- .ad -
- .na -
- .so -
- .ne -
- .AS -
- .VE -
- .VS -
+ .ad - .na - .so - .ne - .AS - .VE - .VS -
. {
# ignore
continue
@@ -1351,16 +1369,11 @@ proc make-man-pages {html args} {
.TH {
lappend manual(text) "$code [unquote $rest]"
}
- .HS -
- .UL -
+ .HS - .UL -
.ta {
lappend manual(text) "$code [unquote $rest]"
}
- .BS -
- .BE -
- .br -
- .fi -
- .sp -
+ .BS - .BE - .br - .fi - .sp -
.nf {
if {"$rest" != {}} {
manerror "unexpected argument: $line"
@@ -1371,7 +1384,7 @@ proc make-man-pages {html args} {
lappend manual(text) [concat .IP [process-text "[lindex $rest 0] \\fB[lindex $rest 1]\\fR ([lindex $rest 2])"]]
}
.IP {
- regexp {^(.*) +[0-9]+$} $rest all rest
+ regexp {^(.*) +\d+$} $rest all rest
lappend manual(text) ".IP [process-text [unquote [string trim $rest]]]"
}
.TP {
@@ -1382,7 +1395,7 @@ proc make-man-pages {html args} {
}
.OP {
lappend manual(text) [concat .OP [process-text \
- "\\fB[lindex $rest 0]\\fR \\fB[lindex $rest 1]\\fR \\fB[lindex $rest 2]\\fR"]]
+ "\\fB[lindex $rest 0]\\fR \\fB[lindex $rest 1]\\fR \\fB[lindex $rest 2]\\fR"]]
}
.PP -
.LP {
@@ -1422,7 +1435,7 @@ proc make-man-pages {html args} {
}
.de {
while {[gets $manual(infp) line] >= 0} {
- if {[regexp {^\.\.} $line]} {
+ if {[string match "..*" $line]} {
break
}
}
@@ -1435,20 +1448,20 @@ proc make-man-pages {html args} {
}
}
} else {
- if {"$manual(partial-text)" == {}} {
+ if {$manual(partial-text) == ""} {
set manual(partial-text) $line
} else {
append manual(partial-text) \n$line
}
}
}
- if {"$manual(partial-text)" != {}} {
+ if {$manual(partial-text) != ""} {
lappend manual(text) [process-text $manual(partial-text)]
}
close $manual(infp)
# fixups
if {$manual(.RS) != 0} {
- if {"$manual(name)" != {selection}} {
+ if {$manual(name) != "selection"} {
puts "unbalanced .RS .RE"
}
}
@@ -1464,7 +1477,8 @@ proc make-man-pages {html args} {
# output conversion
open-text
if {[next-op-is .HS rest]} {
- set manual($manual(name)-title) "[lrange $rest 1 end] [lindex $rest 0] manual page"
+ set manual($manual(name)-title) \
+ "[lrange $rest 1 end] [lindex $rest 0] manual page"
while {[more-text]} {
set line [next-text]
if {[is-a-directive $line]} {
@@ -1513,18 +1527,19 @@ proc make-man-pages {html args} {
set width [string length $name]
}
}
- set perline [expr 120 / $width]
- set nrows [expr ([llength $manual(wing-toc)]+$perline)/$perline]
+ set perline [expr {120 / $width}]
+ set nrows [expr {([llength $manual(wing-toc)]+$perline)/$perline}]
set n 0
catch {unset rows}
foreach name [lsort $manual(wing-toc)] {
set tail $manual(name-$name)
if {[llength $tail] > 1} {
manerror "$name is defined in more than one file: $tail"
- set tail [lindex $tail [expr [llength $tail]-1]]
+ set tail [lindex $tail [expr {[llength $tail]-1}]]
}
set tail [file tail $tail]
- append rows([expr $n%$nrows]) "<td> <a href=\"$tail.htm\">$name</a>"
+ append rows([expr {$n%$nrows}]) \
+ "<td> <a href=\"$tail.htm\">$name</a>"
incr n
}
puts $manual(wing-toc-fp) <table>
@@ -1552,7 +1567,7 @@ proc make-man-pages {html args} {
proc strcasecmp {a b} { return [string compare -nocase $a $b] }
set keys [lsort -command strcasecmp [array names manual keyword-*]]
makedirhier $html/Keywords
- catch {eval exec rm -f [glob $html/Keywords/*]}
+ catch {eval file delete -- [glob $html/Keywords/*]}
puts $manual(short-toc-fp) {<DT><A HREF="Keywords/contents.htm">Keywords</A><DD>The keywords from the Tcl/Tk man pages.}
set keyfp [open $html/Keywords/contents.htm w]
puts $keyfp "<HTML><HEAD><TITLE>Tcl/Tk Keywords</TITLE></HEAD>"
@@ -1672,4 +1687,3 @@ if {1} {
puts $error\n$errorInfo
}
}
-
diff --git a/tcl/tools/uniClass.tcl b/tcl/tools/uniClass.tcl
index 2820ba44193..442fc2adfad 100644
--- a/tcl/tools/uniClass.tcl
+++ b/tcl/tools/uniClass.tcl
@@ -1,3 +1,17 @@
+#!/bin/sh
+# The next line is executed by /bin/sh, but not tcl \
+exec tclsh "$0" ${1+"$@"}
+
+#
+# uniClass.tcl --
+#
+# Generates the character ranges and singletons that are used in
+# generic/regc_locale.c for translation of character classes.
+# This file must be generated using a tclsh that contains the
+# correct corresponding tclUniData.c file (generated by uniParse.tcl)
+# in order for the class ranges to match.
+#
+
proc emitRange {first last} {
global ranges numranges chars numchars
@@ -33,7 +47,7 @@ proc genTable {type} {
set chars " "
set numchars 0
- for {set i 0} {$i < 0x10000} {incr i} {
+ for {set i 0} {$i <= 0xFFFF} {incr i} {
if {[string is $type [format %c $i]]} {
if {$i == ($last + 1)} {
set last $i
@@ -47,15 +61,43 @@ proc genTable {type} {
}
}
emitRange $first $last
-
- puts "static crange ${type}RangeTable\[\] = {\n$ranges\n};\n"
- puts "#define NUM_[string toupper $type]_RANGE (sizeof(${type}RangeTable)/sizeof(crange))\n"
- puts "static chr ${type}CharTable\[\] = {\n$chars\n};\n"
- puts "#define NUM_[string toupper $type]_CHAR (sizeof(${type}CharTable)/sizeof(chr))\n"
+
+ set ranges [string trimright $ranges "\t\n ,"]
+ set chars [string trimright $chars "\t\n ,"]
+ if {$ranges != ""} {
+ puts "static crange ${type}RangeTable\[\] = {\n$ranges\n};\n"
+ puts "#define NUM_[string toupper $type]_RANGE (sizeof(${type}RangeTable)/sizeof(crange))\n"
+ } else {
+ puts "/* no contiguous ranges of $type characters */\n"
+ }
+ if {$chars != ""} {
+ puts "static chr ${type}CharTable\[\] = {\n$chars\n};\n"
+ puts "#define NUM_[string toupper $type]_CHAR (sizeof(${type}CharTable)/sizeof(chr))\n"
+ } else {
+ puts "/* no singletons of $type characters */\n"
+ }
}
+puts "/*
+ * Declarations of Unicode character ranges. This code
+ * is automatically generated by the tools/uniClass.tcl script
+ * and used in generic/regc_locale.c. Do not modify by hand.
+ */
+"
-foreach type {alpha digit punct space lower upper graph } {
+foreach {type desc} {
+ alpha "alphabetic characters"
+ digit "decimal digit characters"
+ punct "punctuation characters"
+ space "white space characters"
+ lower "lowercase characters"
+ upper "uppercase characters"
+ graph "unicode print characters excluding space"
+} {
+ puts "/* Unicode: $desc */\n"
genTable $type
}
+puts "/*
+ * End of auto-generated Unicode character ranges declarations.
+ */"
diff --git a/tcl/tools/uniParse.tcl b/tcl/tools/uniParse.tcl
index 4692fd5e29c..1b6f90a222a 100644
--- a/tcl/tools/uniParse.tcl
+++ b/tcl/tools/uniParse.tcl
@@ -183,7 +183,7 @@ proc uni::main {} {
set f [open [file join [lindex $argv 1] tclUniData.c] w]
fconfigure $f -translation lf
puts $f "/*
- * tclUtfData.c --
+ * tclUniData.c --
*
* Declarations of Unicode character information tables. This file is
* automatically generated by the tools/uniParse.tcl script. Do not
@@ -368,7 +368,7 @@ enum {
#define GetCaseType(info) (((info) & 0xE0) >> 5)
#define GetCategory(info) ((info) & 0x1F)
-#define GetDelta(infO) (((info) > 0) ? ((info) >> 22) : (~(~((info)) >> 22)))
+#define GetDelta(info) (((info) > 0) ? ((info) >> 22) : (~(~((info)) >> 22)))
/*
* This macro extracts the information about a character from the
diff --git a/tcl/unix/Makefile.in b/tcl/unix/Makefile.in
index a7dbf51e6bf..e4dcb1b6f1c 100644
--- a/tcl/unix/Makefile.in
+++ b/tcl/unix/Makefile.in
@@ -8,6 +8,9 @@
# RCS: @(#) $Id$
VERSION = @TCL_VERSION@
+MAJOR_VERSION = @TCL_MAJOR_VERSION@
+MINOR_VERSION = @TCL_MINOR_VERSION@
+PATCH_LEVEL = @TCL_PATCH_LEVEL@
#----------------------------------------------------------------
# Things you can change to personalize the Makefile for your own
@@ -37,7 +40,8 @@ mandir = @mandir@
# when installing files.
INSTALL_ROOT =
-TCL_LIBRARY = @datadir@/tcl$(VERSION)
+# Path for the platform independent Tcl scripting libraries:
+TCL_LIBRARY = $(prefix)/lib/tcl$(VERSION)
# Path to use at runtime to refer to LIB_INSTALL_DIR:
LIB_RUNTIME_DIR = $(libdir)
@@ -46,19 +50,16 @@ LIB_RUNTIME_DIR = $(libdir)
BIN_INSTALL_DIR = $(INSTALL_ROOT)$(bindir)
# Directory in which to install libtcl.so or libtcl.a:
-LIB_INSTALL_DIR = $(INSTALL_ROOT)@libdir@
+LIB_INSTALL_DIR = $(INSTALL_ROOT)$(libdir)
# Path name to use when installing library scripts.
SCRIPT_INSTALL_DIR = $(INSTALL_ROOT)$(TCL_LIBRARY)
-# Directory in which to install the program tclsh:
-BIN_INSTALL_DIR = $(INSTALL_ROOT)@bindir@
-
# Directory in which to install the include file tcl.h:
-INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)@includedir@
+INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)$(includedir)
# Top-level directory in which to install manual entries:
-MAN_INSTALL_DIR = $(INSTALL_ROOT)@mandir@
+MAN_INSTALL_DIR = $(INSTALL_ROOT)$(mandir)
# Directory in which to install manual entry for tclsh:
MAN1_INSTALL_DIR = $(MAN_INSTALL_DIR)/man1
@@ -92,9 +93,9 @@ CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@
CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@
# Flags to pass to the linker
-LDFLAGS_DEBUG = @LDFLAGS_DEBUG@
-LDFLAGS_OPTIMIZE = @LDFLAGS_OPTIMIZE@
-LDFLAGS = @LDFLAGS@ @LDFLAGS_DEFAULT@
+LDFLAGS_DEBUG = @LDFLAGS_DEBUG@
+LDFLAGS_OPTIMIZE = @LDFLAGS_OPTIMIZE@
+LDFLAGS = @LDFLAGS@ @LDFLAGS_DEFAULT@
# To disable ANSI-C procedure prototypes reverse the comment characters
# on the following lines:
@@ -125,7 +126,7 @@ ENV_FLAGS =
# the current one does).
GENERIC_FLAGS =
#GENERIC_FLAGS = -DTCL_GENERIC_ONLY
-UNIX_OBJS = tclMtherr.o tclUnixChan.o tclUnixEvent.o tclUnixFCmd.o \
+UNIX_OBJS = tclUnixChan.o tclUnixEvent.o tclUnixFCmd.o \
tclUnixFile.o tclUnixPipe.o tclUnixSock.o \
tclUnixTime.o tclUnixInit.o tclUnixThrd.o
#UNIX_OBJS =
@@ -136,15 +137,15 @@ NOTIFY_OBJS = tclUnixNotfy.o
# lines. Warning: if you enable memory debugging, you must do it
# *everywhere*, including all the code that calls Tcl, and you must use
# ckalloc and ckfree everywhere instead of malloc and free.
-MEM_DEBUG_FLAGS =
+MEM_DEBUG_FLAGS = @MEM_DEBUG_FLAGS@
#MEM_DEBUG_FLAGS = -DTCL_MEM_DEBUG
-# To enable support for stubs in Tcl.
-STUB_LIB_FILE = @TCL_STUB_LIB_FILE@
-
TCL_STUB_LIB_FILE = @TCL_STUB_LIB_FILE@
#TCL_STUB_LIB_FILE = libtclstub.a
+# Generic stub lib name used in rules that apply to tcl and tk
+STUB_LIB_FILE = ${TCL_STUB_LIB_FILE}
+
TCL_STUB_LIB_FLAG = @TCL_STUB_LIB_FLAG@
#TCL_STUB_LIB_FLAG = -ltclstub
@@ -161,37 +162,26 @@ NO_DEPRECATED_FLAGS =
# Some versions of make, like SGI's, use the following variable to
# determine which shell to use for executing commands:
-SHELL = @SHELL@
+SHELL = /bin/sh
# Tcl used to let the configure script choose which program to use
# for installing, but there are just too many different versions of
# "install" around; better to use the install-sh script that comes
# with the distribution, which is slower but guaranteed to work.
-INSTALL = @srcdir@/install-sh -c
-INSTALL_PROGRAM = @INSTALL_PROGRAM@
-INSTALL_DATA = @INSTALL_DATA@
-
-# The following symbol defines additional compiler flags to enable
-# Tcl itself to be a shared library. If Tcl isn't going to be a
-# shared library then the symbol has an empty definition.
-
-TCL_SHLIB_CFLAGS = @TCL_SHLIB_CFLAGS@
-#TCL_SHLIB_CFLAGS =
-
-# The following symbol defines additional compiler flags to enable
-# writable strings, since Tcl_Eval2 writes into its arguments. Only
-# applicable for GCC
+INSTALL_STRIP_PROGRAM = -s
+INSTALL_STRIP_LIBRARY = -S -S
INSTALL = @srcdir@/install-sh -c
INSTALL_PROGRAM = ${INSTALL}
+INSTALL_LIBRARY = ${INSTALL}
INSTALL_DATA = ${INSTALL} -m 644
-# The following specifies which Tcl executable to use for make targets
-# below. This can generally be 'tclsh', meaning all targets will work
-# once we have created the initial executable, but in some cases you
-# may want to use a target without having made tclsh on these sources
-# (like for make genstubs)
+# TCL_EXE is the name of a tclsh executable that is available *BEFORE*
+# running make for the first time. Certain build targets (make genstubs)
+# need it to be available on the PATH. This executable should *NOT* be
+# required just to do a normal build although it can be required to run
+# make dist.
TCL_EXE = tclsh
# The symbols below provide support for dynamic loading and shared
@@ -200,19 +190,23 @@ TCL_EXE = tclsh
# configure script. You shouldn't normally need to modify any of
# these definitions by hand.
-STLIB_LD = @STLIB_LD@
-SHLIB_LD = @SHLIB_LD@
-SHLIB_CFLAGS = @SHLIB_CFLAGS@
+STLIB_LD = @STLIB_LD@
+SHLIB_LD = @SHLIB_LD@
+SHLIB_CFLAGS = @SHLIB_CFLAGS@
+SHLIB_LD_FLAGS = @SHLIB_LD_FLAGS@
+SHLIB_LD_LIBS = @SHLIB_LD_LIBS@
+TCL_SHLIB_LD_EXTRAS = @TCL_SHLIB_LD_EXTRAS@
-SHLIB_SUFFIX = @SHLIB_SUFFIX@
-#SHLIB_SUFFIX =
+SHLIB_SUFFIX = @SHLIB_SUFFIX@
+#SHLIB_SUFFIX =
-TCL_SHARED_LIB_SUFFIX = @TCL_SHARED_LIB_SUFFIX@
-TCL_UNSHARED_LIB_SUFFIX = @TCL_UNSHARED_LIB_SUFFIX@
-TCL_SHARED_LIB_FILE = @TCL_SHARED_LIB_FILE@
-TCL_UNSHARED_LIB_FILE = @TCL_UNSHARED_LIB_FILE@
+DLTEST_TARGETS = dltest.marker
-DLTEST_TARGETS = dltest/pkg5${SHLIB_SUFFIX} dltest/Makefile
+# Additional search flags needed to find the various shared libraries
+# at run-time. The first symbol is for use when creating a binary
+# with cc, and the second is for use when running ld directly.
+CC_SEARCH_FLAGS = @CC_SEARCH_FLAGS@
+LD_SEARCH_FLAGS = @LD_SEARCH_FLAGS@
# The following symbol is defined to "$(DLTEST_TARGETS)" if dynamic
# loading is available; this causes everything in the "dltest"
@@ -225,12 +219,18 @@ BUILD_DLTEST = @BUILD_DLTEST@
TCL_LIB_FILE = @TCL_LIB_FILE@
#TCL_LIB_FILE = libtcl.a
+# Generic lib name used in rules that apply to tcl and tk
+LIB_FILE = ${TCL_LIB_FILE}
+
TCL_LIB_FLAG = @TCL_LIB_FLAG@
#TCL_LIB_FLAG = -ltcl
TCL_EXP_FILE = @TCL_EXP_FILE@
TCL_BUILD_EXP_FILE = @TCL_BUILD_EXP_FILE@
+# support for embedded libraries on Darwin / Mac OS X
+DYLIB_INSTALL_DIR = ${LIB_RUNTIME_DIR}
+
#----------------------------------------------------------------
# The information below is modified by the configure script when
# Makefile is generated from Makefile.in. You shouldn't normally
@@ -248,13 +248,27 @@ GENERIC_DIR = $(TOP_DIR)/generic
COMPAT_DIR = $(TOP_DIR)/compat
TOOL_DIR = $(TOP_DIR)/tools
UNIX_DIR = $(TOP_DIR)/unix
+MAC_OSX_DIR = $(TOP_DIR)/macosx
# Must be absolute because of the cd dltest $(DLTEST_DIR)/configure below.
DLTEST_DIR = @TCL_SRC_DIR@/unix/dltest
# Must be absolute to so the corresponding tcltest's tcl_library is absolute.
TCL_BUILDTIME_LIBRARY = @TCL_SRC_DIR@/library
-#CC = purify -best-effort @CC@
CC = @CC@
+#CC = purify -best-effort @CC@ -DPURIFY
+
+# Flags to be passed to mkLinks to control whether the manpages
+# should be compressed and linked with softlinks
+MKLINKS_FLAGS = @MKLINKS_FLAGS@
+
+#----------------------------------------------------------------
+# The information below is usually usable as is. The configure
+# script won't modify it and it only exists to make working
+# around selected rare system configurations easier.
+#----------------------------------------------------------------
+
+GDB = gdb
+DDD = ddd
#----------------------------------------------------------------
# The information below should be usable as is. The configure
@@ -274,7 +288,7 @@ STUB_CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \
${AC_FLAGS} ${MATH_FLAGS} ${GENERIC_FLAGS} ${PROTO_FLAGS} ${MEM_DEBUG_FLAGS} \
${COMPILE_DEBUG_FLAGS} ${ENV_FLAGS} -DTCL_SHLIB_EXT=\"${SHLIB_SUFFIX}\"
-LIBS = @DL_LIBS@ @LIBS@ $(MATH_LIBS) -lc
+LIBS = @DL_LIBS@ @LIBS@ $(MATH_LIBS)
DEPEND_SWITCHES = ${CFLAGS} -I${GENERIC_DIR} -I${SRC_DIR} \
${AC_FLAGS} ${MATH_FLAGS} \
@@ -300,11 +314,13 @@ GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \
tclObj.o tclPanic.o tclParse.o tclParseExpr.o tclPipe.o \
tclPkg.o tclPosixStr.o tclPreserve.o tclProc.o tclRegexp.o \
tclResolve.o tclResult.o tclScan.o tclStringObj.o tclThread.o \
- tclStubInit.o tclStubLib.o tclTimer.o tclUtf.o tclUtil.o tclVar.o
+ tclThreadAlloc.o tclThreadJoin.o tclStubInit.o tclStubLib.o \
+ tclTimer.o tclUtf.o tclUtil.o tclVar.o
STUB_LIB_OBJS = tclStubLib.o ${COMPAT_OBJS}
-OBJS = ${GENERIC_OBJS} ${UNIX_OBJS} ${NOTIFY_OBJS} ${COMPAT_OBJS} @DL_OBJS@
+OBJS = ${GENERIC_OBJS} ${UNIX_OBJS} ${NOTIFY_OBJS} ${COMPAT_OBJS} \
+ @DL_OBJS@ @PLAT_OBJS@
TCL_DECLS = \
$(GENERIC_DIR)/tcl.decls \
@@ -381,6 +397,8 @@ GENERIC_SRCS = \
$(GENERIC_DIR)/tclTestObj.c \
$(GENERIC_DIR)/tclTestProcBodyObj.c \
$(GENERIC_DIR)/tclThread.c \
+ $(GENERIC_DIR)/tclThreadAlloc.c \
+ $(GENERIC_DIR)/tclThreadJoin.c \
$(GENERIC_DIR)/tclTimer.c \
$(GENERIC_DIR)/tclUtil.c \
$(GENERIC_DIR)/tclVar.c
@@ -393,7 +411,6 @@ UNIX_HDRS = \
UNIX_SRCS = \
$(UNIX_DIR)/tclAppInit.c \
- $(UNIX_DIR)/tclMtherr.c \
$(UNIX_DIR)/tclUnixChan.c \
$(UNIX_DIR)/tclUnixEvent.c \
$(UNIX_DIR)/tclUnixFCmd.c \
@@ -417,15 +434,18 @@ DL_SRCS = \
$(UNIX_DIR)/tclLoadOSF.c \
$(UNIX_DIR)/tclLoadShl.c
-# Note: don't include DL_SRCS in SRCS: most of those files won't
-# compile on the current machine, and they will cause problems for
-# things like "make depend".
+MAC_OSX_SRCS = \
+ $(MAC_OSX_DIR)/tclMacOSXBundle.c
+
+# Note: don't include DL_SRCS or MAC_OSX_SRCS in SRCS: most of those
+# files won't compile on the current machine, and they will cause
+# problems for things like "make depend".
SRCS = $(GENERIC_SRCS) $(UNIX_SRCS) $(STUB_SRCS)
all: binaries libraries doc
-binaries: ${TCL_LIB_FILE} $(TCL_STUB_LIB_FILE) $(TCL_BUILD_EXP_FILE) tclsh
+binaries: ${LIB_FILE} $(STUB_LIB_FILE) $(TCL_BUILD_EXP_FILE) tclsh
libraries:
@@ -433,15 +453,13 @@ doc:
# The following target is configured by autoconf to generate either
# a shared library or non-shared library for Tcl.
-${TCL_LIB_FILE}: ${OBJS} ${STUB_LIB_FILE}
- rm -f ${TCL_LIB_FILE}
+${LIB_FILE}: ${OBJS} ${STUB_LIB_FILE}
+ rm -f $@
@MAKE_LIB@
- $(RANLIB) ${TCL_LIB_FILE}
${STUB_LIB_FILE}: ${STUB_LIB_OBJS}
- rm -f ${STUB_LIB_FILE}
+ rm -f $@
@MAKE_STUB_LIB@
- $(RANLIB) ${STUB_LIB_FILE}
# Make target which outputs the list of the .o contained in the Tcl lib
# usefull to build a single big shared library containing Tcl and other
@@ -457,32 +475,66 @@ objs: ${OBJS}
tclsh: ${TCLSH_OBJS} ${TCL_LIB_FILE}
${CC} ${LDFLAGS} ${TCLSH_OBJS} @TCL_BUILD_LIB_SPEC@ ${LIBS} \
- @TCL_LD_SEARCH_FLAGS@ -o tclsh
+ ${CC_SEARCH_FLAGS} -o tclsh
+
+# Resetting the LIB_RUNTIME_DIR below is required so that
+# the generated tcltest executable gets the build directory
+# burned into its ld search path. This keeps tcltest from
+# picking up an already installed version of the Tcl library.
tcltest: ${TCLTEST_OBJS} ${TCL_LIB_FILE} ${BUILD_DLTEST}
- ${CC} ${LDFLAGS} ${TCLTEST_OBJS} @TCL_BUILD_LIB_SPEC@ ${LIBS} \
- @TCL_LD_SEARCH_FLAGS@ -o tcltest
+ $(MAKE) tcltest-real LIB_RUNTIME_DIR=`pwd`
+tcltest-real:
+ ${CC} ${LDFLAGS} ${TCLTEST_OBJS} @TCL_BUILD_LIB_SPEC@ ${LIBS} \
+ ${CC_SEARCH_FLAGS} -o tcltest
# Note, in the target below TCL_LIBRARY needs to be set or else
# "make test" won't work in the case where the compilation directory
# isn't the same as the source directory.
+# Specifying TESTFLAGS on the command line is the standard way to pass
+# args to tcltest, ie:
+# % make test TESTFLAGS="-verbose bps -file fileName.test"
test: tcltest
- LD_LIBRARY_PATH=`pwd`:${LD_LIBRARY_PATH}; export LD_LIBRARY_PATH; \
- LIBPATH=`pwd`:${LIBPATH}; export LIBPATH; \
- SHLIB_PATH=`pwd`:${SHLIB_PATH}; export SHLIB_PATH; \
+ @LD_LIBRARY_PATH_VAR@=`pwd`:${@LD_LIBRARY_PATH_VAR@}; export @LD_LIBRARY_PATH_VAR@; \
TCL_LIBRARY="${TCL_BUILDTIME_LIBRARY}"; export TCL_LIBRARY; \
- ./tcltest $(TOP_DIR)/tests/all.tcl $(TCLTESTARGS)
+ ./tcltest $(TOP_DIR)/tests/all.tcl $(TESTFLAGS) $(TCLTESTARGS)
# Useful target to launch a built tcltest with the proper path,...
runtest: tcltest
- LD_LIBRARY_PATH=`pwd`:${LD_LIBRARY_PATH}; export LD_LIBRARY_PATH; \
- LIBPATH=`pwd`:${LIBPATH}; export LIBPATH; \
- SHLIB_PATH=`pwd`:${SHLIB_PATH}; export SHLIB_PATH; \
+ @LD_LIBRARY_PATH_VAR@=`pwd`:${@LD_LIBRARY_PATH_VAR@}; export @LD_LIBRARY_PATH_VAR@; \
TCL_LIBRARY="${TCL_BUILDTIME_LIBRARY}"; export TCL_LIBRARY; \
./tcltest
+# Useful target for running the test suite with an unwritable current
+# directory...
+ro-test: tcltest
+ @LD_LIBRARY_PATH_VAR@=`pwd`:${@LD_LIBRARY_PATH_VAR@}; export @LD_LIBRARY_PATH_VAR@; \
+ TCL_LIBRARY="${TCL_BUILDTIME_LIBRARY}"; export TCL_LIBRARY; \
+ echo 'exec chmod -w .;package require tcltest;tcltest::temporaryDirectory /tmp;source ../tests/all.tcl;exec chmod +w .' | ./tcltest
+
+# This target can be used to run tclsh from the build directory
+# via `make shell SCRIPT=/tmp/foo.tcl`
+shell: tclsh
+ @@LD_LIBRARY_PATH_VAR@=`pwd`:${@LD_LIBRARY_PATH_VAR@}; export @LD_LIBRARY_PATH_VAR@; \
+ TCL_LIBRARY="${TCL_BUILDTIME_LIBRARY}"; export TCL_LIBRARY; \
+ ./tclsh $(SCRIPT)
+
+# This target can be used to run tclsh inside either gdb or insight
+gdb: tclsh
+ @echo "set env @LD_LIBRARY_PATH_VAR@=`pwd`:${@LD_LIBRARY_PATH_VAR@}" > gdb.run
+ @echo "set env TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" >> gdb.run
+ $(GDB) ./tclsh --command=gdb.run
+ rm gdb.run
+
+# This target can be used to run tclsh inside ddd
+ddd: tclsh
+ @echo "set env @LD_LIBRARY_PATH_VAR@=`pwd`:${@LD_LIBRARY_PATH_VAR@}" > gdb.run
+ @echo "set env TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" >> gdb.run
+ $(DDD) -command=gdb.run ./tclsh
+ rm gdb.run
+
# The following target outputs the name of the top-level source directory
# for Tcl (it is used by Tk's configure script, for example). The
# .NO_PARALLEL line is needed to avoid problems under Sun's "pmake".
@@ -502,36 +554,28 @@ topDirName:
gendate:
yacc -l $(GENERIC_DIR)/tclGetDate.y
sed -e 's/yy/TclDate/g' -e '/^#include <values.h>/d' \
- -e 's?SCCSID?RCS: @(#) $$Id$$?' \
+ -e 's?SCCSID?RCS: @(#) ?' \
-e '/#ifdef __STDC__/,/#endif/d' -e '/TclDateerrlab:/d' \
-e '/TclDatenewstate:/d' -e '/#pragma/d' \
-e '/#include <inttypes.h>/d' -e 's/const /CONST /g' \
<y.tab.c >$(GENERIC_DIR)/tclDate.c
rm y.tab.c
-# The following targets generate the shared libraries in dltest that
+# The following target generates the shared libraries in dltest/ that
# are used for testing; they are included as part of the "tcltest"
# target (via the BUILD_DLTEST variable) if dynamic loading is supported
-# on this platform. The ".." environment variable stuff is needed
-# because on some platforms tclsh scripts will be executed as part of
-# building the shared libraries, and they need to be able to use the
-# uninstalled tclsh that is present in this directory. The "make tclsh"
-# command is needed for the same reason (must make sure that it exists).
-
-dltest/pkg5${SHLIB_SUFFIX}: dltest/Makefile
- if test ! -f tclsh; then $(MAKE) tclsh; else true; fi
- libdir=`cd $(TOP_DIR)/library && pwd`; cd dltest; \
- PATH=..:${PATH} TCL_LIBRARY=$$libdir $(MAKE)
-
-dltest/Makefile: $(DLTEST_DIR)/configure $(DLTEST_DIR)/Makefile.in tclConfig.sh
- if test ! -d dltest; then mkdir dltest; else true; fi
- dldir=`cd $(DLTEST_DIR) && pwd`; cd dltest; \
- if test -f configure; then ./configure; else $$dldir/configure; fi
+# on this platform. The Makefile in the dltest subdirectory creates
+# the dltest.marker file in this directory after a successful build.
+
+dltest.marker:
+ cd dltest ; $(MAKE)
install: install-binaries install-libraries install-doc
install-strip:
- $(MAKE) install INSTALL_PROGRAM="$(INSTALL_PROGRAM) -s"
+ $(MAKE) install \
+ INSTALL_PROGRAM="$(INSTALL_PROGRAM) ${INSTALL_STRIP_PROGRAM}" \
+ INSTALL_LIBRARY="$(INSTALL_LIBRARY) ${INSTALL_STRIP_LIBRARY}"
# Note: before running ranlib below, must cd to target directory because
# some ranlibs write to current directory, and this might not always be
@@ -550,10 +594,9 @@ install-binaries: binaries
@if test ! -x $(SRC_DIR)/install-sh; then \
chmod +x $(SRC_DIR)/install-sh; \
fi
- @echo "Installing $(TCL_LIB_FILE) to $(LIB_INSTALL_DIR)/"
- @$(INSTALL_DATA) $(TCL_LIB_FILE) $(LIB_INSTALL_DIR)/$(TCL_LIB_FILE)
- @(cd $(LIB_INSTALL_DIR); $(RANLIB) $(TCL_LIB_FILE))
- @chmod 555 $(LIB_INSTALL_DIR)/$(TCL_LIB_FILE)
+ @echo "Installing $(LIB_FILE) to $(LIB_INSTALL_DIR)/"
+ @@INSTALL_LIB@
+ @chmod 555 $(LIB_INSTALL_DIR)/$(LIB_FILE)
@if test "$(TCL_BUILD_EXP_FILE)" != ""; then \
echo "Installing $(TCL_EXP_FILE) to $(LIB_INSTALL_DIR)/"; \
$(INSTALL_DATA) $(TCL_BUILD_EXP_FILE) \
@@ -563,15 +606,13 @@ install-binaries: binaries
@$(INSTALL_PROGRAM) tclsh $(BIN_INSTALL_DIR)/tclsh$(VERSION)
@echo "Installing tclConfig.sh to $(LIB_INSTALL_DIR)/"
@$(INSTALL_DATA) tclConfig.sh $(LIB_INSTALL_DIR)/tclConfig.sh
- @if test "$(TCL_STUB_LIB_FILE)" != "" ; then \
- echo "Installing $(TCL_STUB_LIB_FILE) to $(LIB_INSTALL_DIR)/"; \
- $(INSTALL_DATA) $(STUB_LIB_FILE) \
- $(LIB_INSTALL_DIR)/$(TCL_STUB_LIB_FILE); \
- fi
+ @if test "$(STUB_LIB_FILE)" != "" ; then \
+ echo "Installing $(STUB_LIB_FILE) to $(LIB_INSTALL_DIR)/"; \
+ @INSTALL_STUB_LIB@ ; \
+ fi
-install-libraries:
- @for i in $(INSTALL_ROOT)@datadir@ $(INCLUDE_INSTALL_DIR) \
- $(SCRIPT_INSTALL_DIR) ; \
+install-libraries: libraries
+ @for i in $(INCLUDE_INSTALL_DIR) $(SCRIPT_INSTALL_DIR); \
do \
if [ ! -d $$i ] ; then \
echo "Making directory $$i"; \
@@ -580,7 +621,7 @@ install-libraries:
else true; \
fi; \
done;
- @for i in http2.3 http1.0 opt0.4 encoding msgcat1.0 tcltest1.0; \
+ @for i in http2.4 http1.0 opt0.4 encoding msgcat1.3 tcltest2.2; \
do \
if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \
echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
@@ -593,7 +634,8 @@ install-libraries:
chmod +x $(SRC_DIR)/install-sh; \
fi
@echo "Installing header files";
- @for i in $(GENERIC_DIR)/tcl.h $(GENERIC_DIR)/tclDecls.h ; \
+ @for i in $(GENERIC_DIR)/tcl.h $(GENERIC_DIR)/tclDecls.h \
+ $(GENERIC_DIR)/tclPlatDecls.h ; \
do \
$(INSTALL_DATA) $$i $(INCLUDE_INSTALL_DIR); \
done;
@@ -602,13 +644,30 @@ install-libraries:
do \
$(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR); \
done;
- @for i in http2.3 http1.0 opt0.4 msgcat1.0 tcltest1.0; \
+ @echo "Installing library http1.0 directory";
+ @for j in $(TOP_DIR)/library/http1.0/*.tcl ; \
do \
- echo "Installing library $$i directory"; \
- for j in $(TOP_DIR)/library/$$i/*.tcl ; \
- do \
- $(INSTALL_DATA) $$j $(SCRIPT_INSTALL_DIR)/$$i; \
- done; \
+ $(INSTALL_DATA) $$j $(SCRIPT_INSTALL_DIR)/http1.0; \
+ done;
+ @echo "Installing library http2.4 directory";
+ @for j in $(TOP_DIR)/library/http/*.tcl ; \
+ do \
+ $(INSTALL_DATA) $$j $(SCRIPT_INSTALL_DIR)/http2.4; \
+ done;
+ @echo "Installing library opt0.4 directory";
+ @for j in $(TOP_DIR)/library/opt/*.tcl ; \
+ do \
+ $(INSTALL_DATA) $$j $(SCRIPT_INSTALL_DIR)/opt0.4; \
+ done;
+ @echo "Installing library msgcat1.3 directory";
+ @for j in $(TOP_DIR)/library/msgcat/*.tcl ; \
+ do \
+ $(INSTALL_DATA) $$j $(SCRIPT_INSTALL_DIR)/msgcat1.3; \
+ done;
+ @echo "Installing library tcltest2.2 directory";
+ @for j in $(TOP_DIR)/library/tcltest/*.tcl ; \
+ do \
+ $(INSTALL_DATA) $$j $(SCRIPT_INSTALL_DIR)/tcltest2.2; \
done;
@echo "Installing library encoding directory";
@for i in $(TOP_DIR)/library/encoding/*.enc ; do \
@@ -634,54 +693,47 @@ install-doc: doc
rm -f $(MAN1_INSTALL_DIR)/$$i; \
sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \
$$i > $(MAN1_INSTALL_DIR)/$$i; \
- chmod 644 $(MAN1_INSTALL_DIR)/$$i; \
+ chmod 444 $(MAN1_INSTALL_DIR)/$$i; \
done;
@echo "Cross-linking top-level (.1) docs";
- @$(UNIX_DIR)/mkLinks $(MAN1_INSTALL_DIR)
+ @$(UNIX_DIR)/mkLinks $(MKLINKS_FLAGS) $(MAN1_INSTALL_DIR)
@echo "Installing C API (.3) docs";
@cd $(TOP_DIR)/doc; for i in *.3; \
do \
rm -f $(MAN3_INSTALL_DIR)/$$i; \
sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \
$$i > $(MAN3_INSTALL_DIR)/$$i; \
- chmod 644 $(MAN3_INSTALL_DIR)/$$i; \
+ chmod 444 $(MAN3_INSTALL_DIR)/$$i; \
done;
@echo "Cross-linking C API (.3) docs";
- @$(UNIX_DIR)/mkLinks $(MAN3_INSTALL_DIR)
+ @$(UNIX_DIR)/mkLinks $(MKLINKS_FLAGS) $(MAN3_INSTALL_DIR)
@echo "Installing command (.n) docs";
@cd $(TOP_DIR)/doc; for i in *.n; \
do \
rm -f $(MANN_INSTALL_DIR)/$$i; \
sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \
- $$i > $(MAN3_INSTALL_DIR)/$$i; \
- chmod 644 $(MAN3_INSTALL_DIR)/$$i; \
+ $$i > $(MANN_INSTALL_DIR)/$$i; \
+ chmod 444 $(MANN_INSTALL_DIR)/$$i; \
done;
@echo "Cross-linking command (.n) docs";
- @$(UNIX_DIR)/mkLinks $(MANN_INSTALL_DIR)
+ @$(UNIX_DIR)/mkLinks $(MKLINKS_FLAGS) $(MANN_INSTALL_DIR)
-Makefile: $(UNIX_DIR)/Makefile.in config.status
+Makefile: $(UNIX_DIR)/Makefile.in $(DLTEST_DIR)/Makefile.in
$(SHELL) config.status
-config.status: $(UNIX_DIR)/configure
- ./config.status --recheck
-
-mostlyclean: clean
clean:
rm -f *.a *.o libtcl* core errs *~ \#* TAGS *.E a.out \
errors tclsh tcltest lib.exp
- if test -f dltest/Makefile; then cd dltest; $(MAKE) clean; fi
+ cd dltest ; $(MAKE) clean
distclean: clean
rm -rf Makefile config.status config.cache config.log tclConfig.sh \
$(PACKAGE).* prototype
- if test -f dltest/Makefile; then cd dltest; $(MAKE) distclean; fi
+ cd dltest ; $(MAKE) distclean
depend:
makedepend -- $(DEPEND_SWITCHES) -- $(SRCS)
-bp: $(UNIX_DIR)/bp.c
- $(CC) $(CC_SWITCHES) $(UNIX_DIR)/bp.c -o bp
-
# Test binaries. The rules for tclTestInit.o and xtTestInit.o are
# complicated because they are compiled from tclAppInit.c. Can't use
# the "-o" option because this doesn't work on some strange compilers
@@ -871,9 +923,6 @@ tclLoadShl.o: $(UNIX_DIR)/tclLoadShl.c
tclMain.o: $(GENERIC_DIR)/tclMain.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclMain.c
-tclMtherr.o: $(UNIX_DIR)/tclMtherr.c
- $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclMtherr.c
-
tclNamesp.o: $(GENERIC_DIR)/tclNamesp.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclNamesp.c
@@ -925,7 +974,7 @@ tclStubInit.o: $(GENERIC_DIR)/tclStubInit.c
tclUtil.o: $(GENERIC_DIR)/tclUtil.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclUtil.c
-tclUtf.o: $(GENERIC_DIR)/tclUtf.c
+tclUtf.o: $(GENERIC_DIR)/tclUtf.c $(GENERIC_DIR)/tclUniData.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclUtf.c
tclVar.o: $(GENERIC_DIR)/tclVar.c
@@ -946,6 +995,12 @@ tclTimer.o: $(GENERIC_DIR)/tclTimer.c
tclThread.o: $(GENERIC_DIR)/tclThread.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclThread.c
+tclThreadAlloc.o: $(GENERIC_DIR)/tclThreadAlloc.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclThreadAlloc.c
+
+tclThreadJoin.o: $(GENERIC_DIR)/tclThreadJoin.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclThreadJoin.c
+
tclThreadTest.o: $(GENERIC_DIR)/tclThreadTest.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclThreadTest.c
@@ -979,24 +1034,15 @@ tclUnixThrd.o: $(UNIX_DIR)/tclUnixThrd.c
tclUnixTime.o: $(UNIX_DIR)/tclUnixTime.c
$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixTime.c
-# CYGNUS LOCAL
-
-# Don't burn a TCL_LIBRARY path into tclUnixInit.o.
-# We need Tcl to be location independent and a compiled
-# in path just masks problems with the search algo.
-
-# FIXME: The TCL_PACKAGE_PATH is still compiled in,
-# the only effect seems to be that the compiled in
-# dir name appears on the auto_path after the tree
-# has been moved.
-
-# END CYGNUS LOCAL
-
tclUnixInit.o: $(UNIX_DIR)/tclUnixInit.c $(GENERIC_DIR)/tclInitScript.h tclConfig.sh
- $(CC) -c $(CC_SWITCHES) -DTCL_LIBRARY=\"\" \
+ $(CC) -c $(CC_SWITCHES) -DTCL_LIBRARY=\"${TCL_LIBRARY}\" \
-DTCL_PACKAGE_PATH="\"${TCL_PACKAGE_PATH}\"" \
$(UNIX_DIR)/tclUnixInit.c
+# This is the CFBundle interface. It is only used on Mac OS X.
+tclMacOSXBundle.o: $(MAC_OSX_DIR)/tclMacOSXBundle.c
+ $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tclMacOSXBundle.c
+
# The following targets are not completely general. They are provide
# purely for documentation purposes so people who are interested in
# the Xt based notifier can modify them to suit their own installation.
@@ -1005,7 +1051,7 @@ xttest: ${XTTEST_OBJS} ${GENERIC_OBJS} ${UNIX_OBJS} ${COMPAT_OBJS} \
@DL_OBJS@ ${BUILD_DLTEST}
${CC} ${XTTEST_OBJS} ${GENERIC_OBJS} ${UNIX_OBJS} ${COMPAT_OBJS} \
@DL_OBJS@ @TCL_BUILD_LIB_SPEC@ ${LIBS} \
- @TCL_LD_SEARCH_FLAGS@ -L/usr/openwin/lib -lXt -o xttest
+ ${CC_SEARCH_FLAGS} -L/usr/openwin/lib -lXt -o xttest
tclXtNotify.o: $(UNIX_DIR)/tclXtNotify.c
$(CC) -c $(CC_SWITCHES) -I/usr/openwin/include \
@@ -1023,9 +1069,6 @@ tclXtTest.o: $(UNIX_DIR)/tclXtTest.c
fixstrtod.o: $(COMPAT_DIR)/fixstrtod.c
$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/fixstrtod.c
-getcwd.o: $(COMPAT_DIR)/getcwd.c
- $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/getcwd.c
-
opendir.o: $(COMPAT_DIR)/opendir.c
$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/opendir.c
@@ -1044,9 +1087,15 @@ strtod.o: $(COMPAT_DIR)/strtod.c
strtol.o: $(COMPAT_DIR)/strtol.c
$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strtol.c
+strtoll.o: $(COMPAT_DIR)/strtoll.c
+ $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strtoll.c
+
strtoul.o: $(COMPAT_DIR)/strtoul.c
$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strtoul.c
+strtoull.o: $(COMPAT_DIR)/strtoull.c
+ $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strtoull.c
+
tmpnam.o: $(COMPAT_DIR)/tmpnam.c
$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/tmpnam.c
@@ -1069,8 +1118,9 @@ tclStubLib.o: $(GENERIC_DIR)/tclStubLib.c
$(GENERIC_DIR)/tclStubInit.c: $(GENERIC_DIR)/tcl.decls \
$(GENERIC_DIR)/tclInt.decls
- $(TCL_EXE) $(TOOL_DIR)/genStubs.tcl $(GENERIC_DIR) \
- $(GENERIC_DIR)/tcl.decls $(GENERIC_DIR)/tclInt.decls
+ @echo "Warning: tclStubInit.c may be out of date."
+ @echo "Developers may want to run \"make genstubs\" to regenerate."
+ @echo "This warning can be safely ignored, do not report as a bug!"
genstubs:
$(TCL_EXE) $(TOOL_DIR)/genStubs.tcl $(GENERIC_DIR) \
@@ -1094,6 +1144,24 @@ checkstubs:
done
#
+# Target to check that all public APIs which are not command
+# implementations have an entry in section three of the distributed
+# manpages.
+#
+
+checkdoc:
+ -@for i in `nm -p $(TCL_LIB_FILE) | awk '$$3 ~ /Tcl_/ { print $$3 }' \
+ | grep -v 'Cmd$$' | sort -n`; do \
+ match=0; \
+ for j in $(TOP_DIR)/doc/*.3; do \
+ if [ `grep '\-' $$j | grep -c $$i` -gt 0 ]; then \
+ match=1; \
+ fi; \
+ done; \
+ if [ $$match -eq 0 ]; then echo $$i; fi \
+ done
+
+#
# Target to check for proper usage of UCHAR macro.
#
@@ -1123,49 +1191,51 @@ rpm: all /bin/rpm
mv RPMS/i386/*.rpm .
rm -rf RPMS THIS.TCL.SPEC
+mklinks:
+ $(TCL_EXE) $(UNIX_DIR)/mkLinks.tcl \
+ $(UNIX_DIR)/../doc/*.[13n] > $(UNIX_DIR)/mkLinks
+ chmod +x $(UNIX_DIR)/mkLinks
+
#
# Target to create a proper Tcl distribution from information in the
# master source directory. DISTDIR must be defined to indicate where
# to put the distribution.
#
-DISTROOT = /tmp/dist
-DISTNAME = tcl@TCL_VERSION@@TCL_PATCH_LEVEL@
-ZIPNAME = tcl@TCL_MAJOR_VERSION@@TCL_MINOR_VERSION@@TCL_PATCH_LEVEL@.zip
-DISTDIR = $(DISTROOT)/$(DISTNAME)
+DISTROOT = /tmp/dist
+DISTNAME = tcl${VERSION}${PATCH_LEVEL}
+ZIPNAME = tcl${MAJOR_VERSION}${MINOR_VERSION}${PATCH_LEVEL}.zip
+DISTDIR = $(DISTROOT)/$(DISTNAME)
$(UNIX_DIR)/configure: $(UNIX_DIR)/configure.in
autoconf $(UNIX_DIR)/configure.in > $(UNIX_DIR)/configure
-dist: $(UNIX_DIR)/configure
+
+dist: $(UNIX_DIR)/configure mklinks
rm -rf $(DISTDIR)
- mkdir $(DISTDIR)
- mkdir $(DISTDIR)/unix
+ mkdir -p $(DISTDIR)/unix
cp -p $(UNIX_DIR)/*.c $(UNIX_DIR)/*.h $(DISTDIR)/unix
- rm -f $(DISTDIR)/unix/bp.c
cp $(UNIX_DIR)/Makefile.in $(DISTDIR)/unix
chmod 664 $(DISTDIR)/unix/Makefile.in
cp $(UNIX_DIR)/configure $(UNIX_DIR)/configure.in \
$(UNIX_DIR)/tcl.m4 $(UNIX_DIR)/aclocal.m4 \
$(UNIX_DIR)/tclConfig.sh.in $(UNIX_DIR)/install-sh \
$(UNIX_DIR)/README $(UNIX_DIR)/ldAix $(UNIX_DIR)/tcl.spec \
+ $(UNIX_DIR)/mkLinks \
$(DISTDIR)/unix
chmod 775 $(DISTDIR)/unix/configure $(DISTDIR)/unix/configure.in
chmod 775 $(DISTDIR)/unix/ldAix
chmod +x $(DISTDIR)/unix/install-sh
-
- $(TCL_EXE) $(UNIX_DIR)/mkLinks.tcl \
- $(UNIX_DIR)/../doc/*.[13n] > $(DISTDIR)/unix/mkLinks
- chmod +x $(DISTDIR)/unix/mkLinks
mkdir $(DISTDIR)/generic
cp -p $(GENERIC_DIR)/*.c $(GENERIC_DIR)/*.h $(DISTDIR)/generic
cp -p $(GENERIC_DIR)/*.decls $(DISTDIR)/generic
cp -p $(GENERIC_DIR)/README $(DISTDIR)/generic
cp -p $(GENERIC_DIR)/tclGetDate.y $(DISTDIR)/generic
cp -p $(TOP_DIR)/changes $(TOP_DIR)/ChangeLog $(TOP_DIR)/README* \
- $(TOP_DIR)/license.terms $(DISTDIR)
+ $(TOP_DIR)/ChangeLog.[12]??? $(TOP_DIR)/license.terms \
+ $(DISTDIR)
mkdir $(DISTDIR)/library
cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \
$(TOP_DIR)/library/tclIndex $(DISTDIR)/library
- for i in http2.3 http1.0 opt0.4 msgcat1.0 reg1.0 dde1.1 tcltest1.0; \
+ for i in http1.0 http opt msgcat reg dde tcltest; \
do \
mkdir $(DISTDIR)/library/$$i ;\
cp -p $(TOP_DIR)/library/$$i/*.tcl $(DISTDIR)/library/$$i; \
@@ -1184,46 +1254,56 @@ dist: $(UNIX_DIR)/configure
cp -p $(TOP_DIR)/tests/*.test $(TOP_DIR)/tests/README \
$(TOP_DIR)/tests/httpd $(TOP_DIR)/tests/*.tcl \
$(DISTDIR)/tests
- mkdir $(DISTDIR)/tests/pkg
- cp -p $(TOP_DIR)/license.terms $(DISTDIR)/tests/pkg
- cp -p $(TOP_DIR)/tests/pkg/*.tcl $(DISTDIR)/tests/pkg
mkdir $(DISTDIR)/win
cp $(TOP_DIR)/win/Makefile.in $(DISTDIR)/win
- cp $(TOP_DIR)/win/configure.in \
- $(TOP_DIR)/win/configure \
+ cp $(TOP_DIR)/win/configure.in $(TOP_DIR)/win/configure \
$(TOP_DIR)/win/tclConfig.sh.in \
$(TOP_DIR)/win/tcl.m4 $(TOP_DIR)/win/aclocal.m4 \
$(DISTDIR)/win
- cp -p $(TOP_DIR)/win/*.c $(TOP_DIR)/win/*.h $(TOP_DIR)/win/*.rc \
- $(TOP_DIR)/win/*.ico $(DISTDIR)/win
+ cp -p $(TOP_DIR)/win/*.c $(TOP_DIR)/win/*.h \
+ $(TOP_DIR)/win/*.ico $(TOP_DIR)/win/*.rc \
+ $(DISTDIR)/win
cp -p $(TOP_DIR)/win/*.bat $(DISTDIR)/win
+ $(TCL_EXE) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/*.bat
cp -p $(TOP_DIR)/win/makefile.* $(DISTDIR)/win
+ $(TCL_EXE) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/makefile.*
+ cp -p $(TOP_DIR)/win/rules.vc $(DISTDIR)/win
+ $(TCL_EXE) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/rules.vc
+ cp -p $(TOP_DIR)/win/coffbase.txt $(DISTDIR)/win
+ $(TCL_EXE) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/coffbase.txt
+ cp -p $(TOP_DIR)/win/tcl.hpj.in $(DISTDIR)/win
+ $(TCL_EXE) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/tcl.hpj.in
+ cp -p $(TOP_DIR)/win/tcl.ds* $(DISTDIR)/win
+ $(TCL_EXE) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/tcl.ds*
cp -p $(TOP_DIR)/win/README $(DISTDIR)/win
cp -p $(TOP_DIR)/license.terms $(DISTDIR)/win
mkdir $(DISTDIR)/mac
- cp -p $(TOP_DIR)/mac/tclMacProjects.sea.hqx $(DISTDIR)/mac
- cp -p $(TOP_DIR)/mac/*.c $(TOP_DIR)/mac/*.h $(TOP_DIR)/mac/*.r \
+ cp -p $(TOP_DIR)/mac/tclMacProjects.sea.hqx \
+ $(TOP_DIR)/mac/*.c $(TOP_DIR)/mac/*.h $(TOP_DIR)/mac/*.r \
$(DISTDIR)/mac
cp -p $(TOP_DIR)/mac/porting.notes $(TOP_DIR)/mac/README $(DISTDIR)/mac
- cp -p $(TOP_DIR)/mac/*.exp $(TOP_DIR)/mac/*.pch $(DISTDIR)/mac
- cp -p $(TOP_DIR)/mac/*.doc $(DISTDIR)/mac
- cp -p $(TOP_DIR)/mac/*.html $(DISTDIR)/mac
+ cp -p $(TOP_DIR)/mac/*.pch $(DISTDIR)/mac
+ cp -p $(TOP_DIR)/mac/*.doc $(TOP_DIR)/mac/*.html $(DISTDIR)/mac
cp -p $(TOP_DIR)/license.terms $(DISTDIR)/mac
+ mkdir $(DISTDIR)/macosx
+ cp -p $(TOP_DIR)/macosx/Makefile \
+ $(TOP_DIR)/macosx/*.c \
+ $(DISTDIR)/macosx
+ mkdir $(DISTDIR)/macosx/Tcl.pbproj
+ cp -p $(TOP_DIR)/macosx/Tcl.pbproj/*.pbx* $(DISTDIR)/macosx/Tcl.pbproj
mkdir $(DISTDIR)/unix/dltest
cp -p $(UNIX_DIR)/dltest/*.c $(UNIX_DIR)/dltest/Makefile.in \
+ $(UNIX_DIR)/dltest/README \
$(DISTDIR)/unix/dltest
- cp -p $(UNIX_DIR)/dltest/configure.in $(UNIX_DIR)/dltest/configure \
- $(UNIX_DIR)/dltest/README $(DISTDIR)/unix/dltest
mkdir $(DISTDIR)/tools
- cp -p $(TOP_DIR)/tools/Makefile.in \
- $(TOP_DIR)/tools/README \
- $(TOP_DIR)/tools/configure.in \
- $(TOP_DIR)/tools/*.tcl \
- $(TOP_DIR)/tools/man2tcl.c \
- $(TOP_DIR)/tools/tcl.wse.in \
- $(TOP_DIR)/tools/*.bmp \
- $(TOP_DIR)/tools/tcl.hpj.in \
+ cp -p $(TOP_DIR)/tools/Makefile.in $(TOP_DIR)/tools/README \
+ $(TOP_DIR)/tools/configure $(TOP_DIR)/tools/configure.in \
+ $(TOP_DIR)/tools/*.tcl $(TOP_DIR)/tools/man2tcl.c \
+ $(TOP_DIR)/tools/tcl.wse.in $(TOP_DIR)/tools/*.bmp \
+ $(TOP_DIR)/tools/tcl.hpj.in \
$(DISTDIR)/tools
+ $(TCL_EXE) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/tools/tcl.hpj.in \
+ $(DISTDIR)/tools/tcl.wse.in
#
# The following target can only be used for non-patch releases. Use
diff --git a/tcl/unix/README b/tcl/unix/README
index 4cc02957513..05fa2c119c0 100644
--- a/tcl/unix/README
+++ b/tcl/unix/README
@@ -1,6 +1,8 @@
Tcl UNIX README
---------------
+RCS: @(#) $Id$
+
This is the directory where you configure, compile, test, and install
UNIX versions of Tcl. This directory also contains source files for Tcl
that are specific to UNIX. Some of the files in this directory are
@@ -8,11 +10,11 @@ used on the PC or Mac platform too, but they all depend on UNIX
(POSIX/ANSI C) interfaces and some of them only make sense under UNIX.
Updated forms of the information found in this file is available at:
- http://dev.scriptics.com/doc/howto/compile.html#unix
+ http://www.tcl.tk/doc/howto/compile.html#unix
For information on platforms where Tcl is known to compile, along
with any porting notes for getting it to work on those platforms, see:
- http://dev.scriptics.com/software/tcltk/platforms.html
+ http://www.tcl.tk/software/tcltk/platforms.html
The rest of this file contains instructions on how to do this. The
release should compile and run either "out of the box" or with trivial
@@ -22,41 +24,29 @@ SGI, as well as PCs running Linux, BSDI, and SCO UNIX. To compile for
a PC running Windows, see the README file in the directory ../win. To
compile for a Macintosh, see the README file in the directory ../mac.
-RCS: @(#) $Id$
-
How To Compile And Install Tcl:
-------------------------------
-(a) Check for patches as described in ../README.
-
-(b) If you have already compiled Tcl once in this directory and are now
+(a) If you have already compiled Tcl once in this directory and are now
preparing to compile again in the same directory but for a different
platform, or if you have applied patches, type "make distclean" to
discard all the configuration information computed previously.
-(c) If there is no "configure" script in this directory it is because you
- are working out of the source repository (i.e., CVS) instead of working
- from a source distribution. In this case you need to use "autoconf"
- to generate the configure script. It runs with no arguments.
- Remember to run it here and down in the dltest directory.
+(b) If you need to reconfigure because you changed any of the .in or
+ .m4 files, you will need to run autoconf to create a new
+ ./configure script. Most users will NOT need to do this since
+ a configure script is already provided.
(in the tcl/unix directory)
autoconf
- cd dltest ; autoconf ; cd ..
-(d) Type "./configure". This runs a configuration script created by GNU
+(c) Type "./configure". This runs a configuration script created by GNU
autoconf, which configures Tcl for your system and creates a
Makefile. The configure script allows you to customize the Tcl
configuration for your site; for details on how you can do this,
type "./configure -help" or refer to the autoconf documentation (not
included here). Tcl's "configure" supports the following special
switches in addition to the standard ones:
- --enable-gcc If this switch is set, Tcl will configure
- itself to use gcc if it is available on your
- system. Note: it is not safe to modify the
- Makefile to use gcc after configure is run;
- if you do this, then information related to
- dynamic linking will be incorrect.
--enable-threads If this switch is set, Tcl will compile
itself with multithreading support.
--disable-load If this switch is specified then Tcl will
@@ -72,38 +62,53 @@ How To Compile And Install Tcl:
how to build shared libraries.
--disable-shared If this switch is specified, Tcl will compile
itself as a static library.
+ --enable-symbols build with debugging symbols
+ --disable-symbols build without debugging symbols
+ --enable-64bit enable 64bit support (where applicable)
+ --disable-64bit disable 64bit support (where applicable)
+ --enable-64bit-vis enable 64bit Sparc VIS support
+ --disable-64bit-vis disable 64bit Sparc VIS support
+ --enable-langinfo Allows use of modern nl_langinfo check for
+ better localization support. This is on by
+ default on platforms where nl_langinfo is
+ found.
+ --disable-langinfo Specifically disables use of nl_langinfo.
+ --enable-man-symlinks Use symlinks for linking the manpages that
+ should be reachable under several names.
+ --enable-man-compression=PROG
+ Compress the manpages using PROG.
+
+ Note: by default gcc will be used if it can be located on the PATH.
+ if you want to use cc instead of gcc, set the CC environment variable
+ to "cc" before running configure. It is not safe to edit the
+ Makefile to use gcc after configure is run.
+
Note: be sure to use only absolute path names (those starting with "/")
- in the --prefix and --exec_prefix options.
+ in the --prefix and --exec-prefix options.
-(e) Type "make". This will create a library archive called
+(d) Type "make". This will create a library archive called
"libtcl<version>.a" or "libtcl<version>.so" and an interpreter
application called "tclsh" that allows you to type Tcl commands
interactively or execute script files.
-(f) If the make fails then you'll have to personalize the Makefile
+(e) If the make fails then you'll have to personalize the Makefile
for your site or possibly modify the distribution in other ways.
First check the porting Web page above to see if there are hints
for compiling on your system. If you need to modify Makefile,
are comments at the beginning of it that describe the things you
might want to change and how to change them.
-(g) Type "make install" to install Tcl binaries and script files in
+(f) Type "make install" to install Tcl binaries and script files in
standard places. You'll need write permission on the installation
directories to do this. The installation directories are
determined by the "configure" script and may be specified with
- the --prefix and --exec_prefix options to "configure". See the
+ the --prefix and --exec-prefix options to "configure". See the
Makefile for information on what directories were chosen; you
can override these choices by modifying the "prefix" and
"exec_prefix" variables in the Makefile.
-(h) At this point you can play with Tcl by invoking the "tclsh"
- program and typing Tcl commands. However, if you haven't installed
- Tcl then you'll first need to set your TCL_LIBRARY variable to
- hold the full path name of the "library" subdirectory. Note that
- the installed versions of tclsh, libtcl.a, and libtcl.so have a
- version number in their names, such as "tclsh8.3" or "libtcl8.3.so";
- to use the installed versions, either specify the version number
- or create a symbolic link (e.g. from "tclsh" to "tclsh8.3").
+(g) At this point you can play with Tcl by running "make shell"
+ and typing Tcl commands at the prompt.
If you have trouble compiling Tcl, see the URL noted above about working
platforms. It contains information that people have provided about changes
@@ -123,11 +128,10 @@ information on the test suite. Note: don't run the tests as superuser:
this will cause several of them to fail. If a test is failing
consistently, please send us a bug report with as much detail as you
can manage. Please use the online database at
- http://dev.scriptics.com/ticket/
+ http://tcl.sourceforge.net/
The Tcl test suite is very sensitive to proper implementation of
ANSI C library procedures such as sprintf and sscanf. If the test
suite generates errors, most likely they are due to non-conformance
of your system's ANSI C library; such problems are unlikely to
affect any real applications so it's probably safe to ignore them.
-
diff --git a/tcl/unix/aclocal.m4 b/tcl/unix/aclocal.m4
index 005783c4aae..bc7540da6cc 100644
--- a/tcl/unix/aclocal.m4
+++ b/tcl/unix/aclocal.m4
@@ -1,2 +1 @@
builtin(include,tcl.m4)
-builtin(include,../cygtcl.m4)
diff --git a/tcl/unix/configure b/tcl/unix/configure
index bfeb216565b..f005092f185 100755
--- a/tcl/unix/configure
+++ b/tcl/unix/configure
@@ -12,8 +12,18 @@ ac_help=
ac_default_prefix=/usr/local
# Any additions from configure.in:
ac_help="$ac_help
+ --enable-man-symlinks use symlinks for the manpages"
+ac_help="$ac_help
+ --enable-man-compression=PROG
+ compress the manpages with PROG"
+ac_help="$ac_help
--enable-threads build with threads"
ac_help="$ac_help
+ --enable-langinfo use nl_langinfo if possible to determine
+ encoding at startup, otherwise use old heuristic"
+ac_help="$ac_help
+ --enable-shared build and link with shared libraries [--enable-shared]"
+ac_help="$ac_help
--enable-64bit enable 64bit support (where applicable)"
ac_help="$ac_help
--enable-64bit-vis enable 64bit Sparc VIS support"
@@ -22,7 +32,9 @@ ac_help="$ac_help
ac_help="$ac_help
--enable-symbols build with debugging symbols [--disable-symbols]"
ac_help="$ac_help
- --enable-shared build and link with shared libraries [--enable-shared]"
+ --enable-memdebug build with memory debugging [--disable-memdebug]"
+ac_help="$ac_help
+ --enable-framework package shared libraries in frameworks [--disable-framework]"
# Initialize some variables set by options.
# The variables have the same names as the options, with
@@ -40,7 +52,6 @@ program_suffix=NONE
program_transform_name=s,x,x,
silent=
site=
-sitefile=
srcdir=
target=NONE
verbose=
@@ -155,7 +166,6 @@ Configuration:
--help print this message
--no-create do not create output files
--quiet, --silent do not print \`checking...' messages
- --site-file=FILE use FILE as the site file
--version print the version of autoconf that created configure
Directory and file names:
--prefix=PREFIX install architecture-independent files in PREFIX
@@ -326,11 +336,6 @@ EOF
-site=* | --site=* | --sit=*)
site="$ac_optarg" ;;
- -site-file | --site-file | --site-fil | --site-fi | --site-f)
- ac_prev=sitefile ;;
- -site-file=* | --site-file=* | --site-fil=* | --site-fi=* | --site-f=*)
- sitefile="$ac_optarg" ;;
-
-srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
ac_prev=srcdir ;;
-srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
@@ -496,16 +501,12 @@ fi
srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
# Prefer explicitly selected file to automatically selected ones.
-if test -z "$sitefile"; then
- if test -z "$CONFIG_SITE"; then
- if test "x$prefix" != xNONE; then
- CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
- else
- CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
- fi
+if test -z "$CONFIG_SITE"; then
+ if test "x$prefix" != xNONE; then
+ CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+ else
+ CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
fi
-else
- CONFIG_SITE="$sitefile"
fi
for ac_site_file in $CONFIG_SITE; do
if test -r "$ac_site_file"; then
@@ -544,12 +545,12 @@ else
fi
-# RCS: @(#) $Id$
-TCL_VERSION=8.3
+
+TCL_VERSION=8.4
TCL_MAJOR_VERSION=8
-TCL_MINOR_VERSION=3
-TCL_PATCH_LEVEL=".2"
+TCL_MINOR_VERSION=4
+TCL_PATCH_LEVEL=".0"
VERSION=${TCL_VERSION}
#------------------------------------------------------------------------
@@ -562,16 +563,57 @@ fi
if test "${exec_prefix}" = "NONE"; then
exec_prefix=$prefix
fi
+# libdir must be a fully qualified path and (not ${exec_prefix}/lib)
+eval libdir="$libdir"
TCL_SRC_DIR=`cd $srcdir/..; pwd`
#------------------------------------------------------------------------
+# Compress and/or soft link the manpages?
+#------------------------------------------------------------------------
+
+
+ echo $ac_n "checking whether to use symlinks for manpages""... $ac_c" 1>&6
+echo "configure:577: checking whether to use symlinks for manpages" >&5
+ # Check whether --enable-man-symlinks or --disable-man-symlinks was given.
+if test "${enable_man_symlinks+set}" = set; then
+ enableval="$enable_man_symlinks"
+ test "$enableval" != "no" && MKLINKS_FLAGS="$MKLINKS_FLAGS --symlinks"
+else
+ enableval="no"
+fi
+
+ echo "$ac_t""$enableval" 1>&6
+
+ echo $ac_n "checking compression for manpages""... $ac_c" 1>&6
+echo "configure:589: checking compression for manpages" >&5
+ # Check whether --enable-man-compression or --disable-man-compression was given.
+if test "${enable_man_compression+set}" = set; then
+ enableval="$enable_man_compression"
+ test "$enableval" = "yes" && echo && { echo "configure: error: missing argument to --enable-man-compression" 1>&2; exit 1; }
+ test "$enableval" != "no" && MKLINKS_FLAGS="$MKLINKS_FLAGS --compress $enableval"
+else
+ enableval="no"
+fi
+
+ echo "$ac_t""$enableval" 1>&6
+
+
+
+
+#------------------------------------------------------------------------
# Standard compiler checks
#------------------------------------------------------------------------
+# If the user did not set CFLAGS, set it now to keep
+# the AC_PROG_CC macro from adding "-g -O2".
+if test "${CFLAGS+set}" != "set" ; then
+ CFLAGS=""
+fi
+
# Extract the first word of "gcc", so it can be a program name with args.
set dummy gcc; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:575: checking for $ac_word" >&5
+echo "configure:617: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@@ -601,7 +643,7 @@ if test -z "$CC"; then
# Extract the first word of "cc", so it can be a program name with args.
set dummy cc; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:605: checking for $ac_word" >&5
+echo "configure:647: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@@ -652,7 +694,7 @@ fi
# Extract the first word of "cl", so it can be a program name with args.
set dummy cl; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:656: checking for $ac_word" >&5
+echo "configure:698: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@@ -684,7 +726,7 @@ fi
fi
echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6
-echo "configure:688: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5
+echo "configure:730: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5
ac_ext=c
# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
@@ -695,12 +737,12 @@ cross_compiling=$ac_cv_prog_cc_cross
cat > conftest.$ac_ext << EOF
-#line 699 "configure"
+#line 741 "configure"
#include "confdefs.h"
main(){return(0);}
EOF
-if { (eval echo configure:704: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:746: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
ac_cv_prog_cc_works=yes
# If we can't run a trivial program, we are probably using a cross compiler.
if (./conftest; exit) 2>/dev/null; then
@@ -726,12 +768,12 @@ if test $ac_cv_prog_cc_works = no; then
{ echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; }
fi
echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6
-echo "configure:730: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5
+echo "configure:772: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5
echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6
cross_compiling=$ac_cv_prog_cc_cross
echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6
-echo "configure:735: checking whether we are using GNU C" >&5
+echo "configure:777: checking whether we are using GNU C" >&5
if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@@ -740,7 +782,7 @@ else
yes;
#endif
EOF
-if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:744: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
+if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:786: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
ac_cv_prog_gcc=yes
else
ac_cv_prog_gcc=no
@@ -759,7 +801,7 @@ ac_test_CFLAGS="${CFLAGS+set}"
ac_save_CFLAGS="$CFLAGS"
CFLAGS=
echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6
-echo "configure:763: checking whether ${CC-cc} accepts -g" >&5
+echo "configure:805: checking whether ${CC-cc} accepts -g" >&5
if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@@ -790,39 +832,8 @@ else
fi
fi
-# Extract the first word of "ranlib", so it can be a program name with args.
-set dummy ranlib; ac_word=$2
-echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:797: checking for $ac_word" >&5
-if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- if test -n "$RANLIB"; then
- ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
-else
- IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
- ac_dummy="$PATH"
- for ac_dir in $ac_dummy; do
- test -z "$ac_dir" && ac_dir=.
- if test -f $ac_dir/$ac_word; then
- ac_cv_prog_RANLIB="ranlib"
- break
- fi
- done
- IFS="$ac_save_ifs"
- test -z "$ac_cv_prog_RANLIB" && ac_cv_prog_RANLIB=":"
-fi
-fi
-RANLIB="$ac_cv_prog_RANLIB"
-if test -n "$RANLIB"; then
- echo "$ac_t""$RANLIB" 1>&6
-else
- echo "$ac_t""no" 1>&6
-fi
-
-
echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6
-echo "configure:826: checking how to run the C preprocessor" >&5
+echo "configure:837: checking how to run the C preprocessor" >&5
# On Suns, sometimes $CPP names a directory.
if test -n "$CPP" && test -d "$CPP"; then
CPP=
@@ -837,13 +848,13 @@ else
# On the NeXT, cc -E runs the code through the compiler's parser,
# not just through cpp.
cat > conftest.$ac_ext <<EOF
-#line 841 "configure"
+#line 852 "configure"
#include "confdefs.h"
#include <assert.h>
Syntax Error
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:847: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:858: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
:
@@ -854,13 +865,13 @@ else
rm -rf conftest*
CPP="${CC-cc} -E -traditional-cpp"
cat > conftest.$ac_ext <<EOF
-#line 858 "configure"
+#line 869 "configure"
#include "confdefs.h"
#include <assert.h>
Syntax Error
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:864: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:875: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
:
@@ -871,13 +882,13 @@ else
rm -rf conftest*
CPP="${CC-cc} -nologo -E"
cat > conftest.$ac_ext <<EOF
-#line 875 "configure"
+#line 886 "configure"
#include "confdefs.h"
#include <assert.h>
Syntax Error
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:881: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:892: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
:
@@ -905,17 +916,17 @@ for ac_hdr in unistd.h limits.h
do
ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
-echo "configure:909: checking for $ac_hdr" >&5
+echo "configure:920: checking for $ac_hdr" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 914 "configure"
+#line 925 "configure"
#include "confdefs.h"
#include <$ac_hdr>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:919: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:930: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
@@ -942,189 +953,13 @@ fi
done
-# CYGNUS LOCAL
-# dje/win32
-AR=${AR-ar}
-# We need this for substitutions in Makefile.in.
-ac_aux_dir=
-for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do
- if test -f $ac_dir/install-sh; then
- ac_aux_dir=$ac_dir
- ac_install_sh="$ac_aux_dir/install-sh -c"
- break
- elif test -f $ac_dir/install.sh; then
- ac_aux_dir=$ac_dir
- ac_install_sh="$ac_aux_dir/install.sh -c"
- break
- fi
-done
-if test -z "$ac_aux_dir"; then
- { echo "configure: error: can not find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." 1>&2; exit 1; }
-fi
-ac_config_guess=$ac_aux_dir/config.guess
-ac_config_sub=$ac_aux_dir/config.sub
-ac_configure=$ac_aux_dir/configure # This should be Cygnus configure.
-
-# Find a good install program. We prefer a C program (faster),
-# so one script is as good as another. But avoid the broken or
-# incompatible versions:
-# SysV /etc/install, /usr/sbin/install
-# SunOS /usr/etc/install
-# IRIX /sbin/install
-# AIX /bin/install
-# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
-# AFS /usr/afsws/bin/install, which mishandles nonexistent args
-# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
-# ./install, which can be erroneously created by make from ./install.sh.
-echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6
-echo "configure:981: checking for a BSD compatible install" >&5
-if test -z "$INSTALL"; then
-if eval "test \"`echo '$''{'ac_cv_path_install'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS=":"
- for ac_dir in $PATH; do
- # Account for people who put trailing slashes in PATH elements.
- case "$ac_dir/" in
- /|./|.//|/etc/*|/usr/sbin/*|/usr/etc/*|/sbin/*|/usr/afsws/bin/*|/usr/ucb/*) ;;
- *)
- # OSF1 and SCO ODT 3.0 have their own names for install.
- # Don't use installbsd from OSF since it installs stuff as root
- # by default.
- for ac_prog in ginstall scoinst install; do
- if test -f $ac_dir/$ac_prog; then
- if test $ac_prog = install &&
- grep dspmsg $ac_dir/$ac_prog >/dev/null 2>&1; then
- # AIX install. It has an incompatible calling convention.
- :
- else
- ac_cv_path_install="$ac_dir/$ac_prog -c"
- break 2
- fi
- fi
- done
- ;;
- esac
- done
- IFS="$ac_save_IFS"
-
-fi
- if test "${ac_cv_path_install+set}" = set; then
- INSTALL="$ac_cv_path_install"
- else
- # As a last resort, use the slow shell script. We don't cache a
- # path for INSTALL within a source directory, because that will
- # break other packages using the cache if that directory is
- # removed, or if the path is relative.
- INSTALL="$ac_install_sh"
- fi
-fi
-echo "$ac_t""$INSTALL" 1>&6
-
-# Use test -z because SunOS4 sh mishandles braces in ${var-val}.
-# It thinks the first close brace ends the variable substitution.
-test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
-
-test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL_PROGRAM}'
-
-test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
-
-# END CYGNUS LOCAL
-
-#--------------------------------------------------------------------
-# CYGNUS LOCAL:
-# This is for LynxOS, which needs a flag to force true POSIX when
-# building. It's weirder than that, cause the flag varies depending
-# how old the compiler is. So...
-# -X is for the old "cc" and "gcc" (based on 1.42)
-# -mposix is for the new gcc (at least 2.5.8)
-# This modifies the value of $CC to have the POSIX flag added
-# so everything will configure correctly.
-#--------------------------------------------------------------------
-
-echo $ac_n "checking to see if this is LynxOS""... $ac_c" 1>&6
-echo "configure:1047: checking to see if this is LynxOS" >&5
-if eval "test \"`echo '$''{'ac_cv_os_lynx'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- cat > conftest.$ac_ext <<EOF
-#line 1052 "configure"
-#include "confdefs.h"
-/*
- * The old Lynx "cc" only defines "Lynx", but the newer one uses "__Lynx__"
- */
-#if defined(__Lynx__) || defined(Lynx)
-yes
-#endif
-
-EOF
-if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
- egrep "yes" >/dev/null 2>&1; then
- rm -rf conftest*
- ac_cv_os_lynx=yes
-else
- rm -rf conftest*
- ac_cv_os_lynx=no
-fi
-rm -f conftest*
-
-fi
-
-#
-if test "$ac_cv_os_lynx" = "yes" ; then
- echo "$ac_t""yes" 1>&6
- cat >> confdefs.h <<\EOF
-#define LYNX 1
-EOF
-
- echo $ac_n "checking whether -mposix or -X is available""... $ac_c" 1>&6
-echo "configure:1082: checking whether -mposix or -X is available" >&5
- if eval "test \"`echo '$''{'ac_cv_c_posix_flag'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- cat > conftest.$ac_ext <<EOF
-#line 1087 "configure"
-#include "confdefs.h"
-
-int main() {
-
- /*
- * This flag varies depending on how old the compiler is.
- * -X is for the old "cc" and "gcc" (based on 1.42).
- * -mposix is for the new gcc (at least 2.5.8).
- */
- #if defined(__GNUC__) && __GNUC__ >= 2
- choke me
- #endif
-
-; return 0; }
-EOF
-if { (eval echo configure:1103: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
- rm -rf conftest*
- ac_cv_c_posix_flag=" -mposix"
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- ac_cv_c_posix_flag=" -X"
-fi
-rm -f conftest*
-fi
-
- CC="$CC $ac_cv_c_posix_flag"
- echo "$ac_t""$ac_cv_c_posix_flag" 1>&6
- else
- echo "$ac_t""no" 1>&6
-fi
-
-
#------------------------------------------------------------------------
# Threads support
#------------------------------------------------------------------------
echo $ac_n "checking for building with threads""... $ac_c" 1>&6
-echo "configure:1128: checking for building with threads" >&5
+echo "configure:963: checking for building with threads" >&5
# Check whether --enable-threads or --disable-threads was given.
if test "${enable_threads+set}" = set; then
enableval="$enable_threads"
@@ -1141,6 +976,12 @@ fi
#define TCL_THREADS 1
EOF
+ # USE_THREAD_ALLOC tells us to try the special thread-based
+ # allocator that significantly reduces lock contention
+ cat >> confdefs.h <<\EOF
+#define USE_THREAD_ALLOC 1
+EOF
+
cat >> confdefs.h <<\EOF
#define _REENTRANT 1
EOF
@@ -1150,7 +991,7 @@ EOF
EOF
echo $ac_n "checking for pthread_mutex_init in -lpthread""... $ac_c" 1>&6
-echo "configure:1154: checking for pthread_mutex_init in -lpthread" >&5
+echo "configure:995: checking for pthread_mutex_init in -lpthread" >&5
ac_lib_var=`echo pthread'_'pthread_mutex_init | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
@@ -1158,7 +999,7 @@ else
ac_save_LIBS="$LIBS"
LIBS="-lpthread $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 1162 "configure"
+#line 1003 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
@@ -1169,7 +1010,7 @@ int main() {
pthread_mutex_init()
; return 0; }
EOF
-if { (eval echo configure:1173: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:1014: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
@@ -1197,7 +1038,7 @@ fi
# pthread.h, but that will work with libpthread really doesn't
# exist, like AIX 4.2. [Bug: 4359]
echo $ac_n "checking for __pthread_mutex_init in -lpthread""... $ac_c" 1>&6
-echo "configure:1201: checking for __pthread_mutex_init in -lpthread" >&5
+echo "configure:1042: checking for __pthread_mutex_init in -lpthread" >&5
ac_lib_var=`echo pthread'_'__pthread_mutex_init | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
@@ -1205,7 +1046,7 @@ else
ac_save_LIBS="$LIBS"
LIBS="-lpthread $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 1209 "configure"
+#line 1050 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
@@ -1216,7 +1057,7 @@ int main() {
__pthread_mutex_init()
; return 0; }
EOF
-if { (eval echo configure:1220: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:1061: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
@@ -1244,7 +1085,7 @@ fi
THREADS_LIBS=" -lpthread"
else
echo $ac_n "checking for pthread_mutex_init in -lpthreads""... $ac_c" 1>&6
-echo "configure:1248: checking for pthread_mutex_init in -lpthreads" >&5
+echo "configure:1089: checking for pthread_mutex_init in -lpthreads" >&5
ac_lib_var=`echo pthreads'_'pthread_mutex_init | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
@@ -1252,7 +1093,7 @@ else
ac_save_LIBS="$LIBS"
LIBS="-lpthreads $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 1256 "configure"
+#line 1097 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
@@ -1263,7 +1104,7 @@ int main() {
pthread_mutex_init()
; return 0; }
EOF
-if { (eval echo configure:1267: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:1108: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
@@ -1289,7 +1130,7 @@ fi
THREADS_LIBS=" -lpthreads"
else
echo $ac_n "checking for pthread_mutex_init in -lc""... $ac_c" 1>&6
-echo "configure:1293: checking for pthread_mutex_init in -lc" >&5
+echo "configure:1134: checking for pthread_mutex_init in -lc" >&5
ac_lib_var=`echo c'_'pthread_mutex_init | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
@@ -1297,7 +1138,7 @@ else
ac_save_LIBS="$LIBS"
LIBS="-lc $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 1301 "configure"
+#line 1142 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
@@ -1308,7 +1149,7 @@ int main() {
pthread_mutex_init()
; return 0; }
EOF
-if { (eval echo configure:1312: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:1153: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
@@ -1330,8 +1171,54 @@ tcl_ok=no
fi
if test "$tcl_ok" = "no"; then
- TCL_THREADS=0
- echo "configure: warning: "Don t know how to find pthread lib on your system - you must disable thread support or edit the LIBS in the Makefile..."" 1>&2
+ echo $ac_n "checking for pthread_mutex_init in -lc_r""... $ac_c" 1>&6
+echo "configure:1176: checking for pthread_mutex_init in -lc_r" >&5
+ac_lib_var=`echo c_r'_'pthread_mutex_init | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lc_r $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1184 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char pthread_mutex_init();
+
+int main() {
+pthread_mutex_init()
+; return 0; }
+EOF
+if { (eval echo configure:1195: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ tcl_ok=yes
+else
+ echo "$ac_t""no" 1>&6
+tcl_ok=no
+fi
+
+ if test "$tcl_ok" = "yes"; then
+ # The space is needed
+ THREADS_LIBS=" -pthread"
+ else
+ TCL_THREADS=0
+ echo "configure: warning: "Don t know how to find pthread lib on your system - you must disable thread support or edit the LIBS in the Makefile..."" 1>&2
+ fi
fi
fi
fi
@@ -1342,12 +1229,67 @@ fi
for ac_func in pthread_attr_setstacksize
do
echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
-echo "configure:1346: checking for $ac_func" >&5
+echo "configure:1233: checking for $ac_func" >&5
+if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1238 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char $ac_func(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char $ac_func();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
+choke me
+#else
+$ac_func();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:1261: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_$ac_func=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_$ac_func=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'`
+ cat >> confdefs.h <<EOF
+#define $ac_tr_func 1
+EOF
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+done
+
+ for ac_func in readdir_r
+do
+echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
+echo "configure:1288: checking for $ac_func" >&5
if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1351 "configure"
+#line 1293 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char $ac_func(); below. */
@@ -1370,7 +1312,7 @@ $ac_func();
; return 0; }
EOF
-if { (eval echo configure:1374: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:1316: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_$ac_func=yes"
else
@@ -1398,6 +1340,7 @@ done
TCL_THREADS=0
echo "$ac_t""no (default)" 1>&6
fi
+
#------------------------------------------------------------------------
@@ -1408,18 +1351,18 @@ done
if test -z "$no_pipe"; then
if test -n "$GCC"; then
echo $ac_n "checking if the compiler understands -pipe""... $ac_c" 1>&6
-echo "configure:1412: checking if the compiler understands -pipe" >&5
+echo "configure:1355: checking if the compiler understands -pipe" >&5
OLDCC="$CC"
CC="$CC -pipe"
cat > conftest.$ac_ext <<EOF
-#line 1416 "configure"
+#line 1359 "configure"
#include "confdefs.h"
int main() {
; return 0; }
EOF
-if { (eval echo configure:1423: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:1366: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
echo "$ac_t""yes" 1>&6
else
@@ -1434,6 +1377,377 @@ fi
fi
#--------------------------------------------------------------------
+# Detect what compiler flags to set for 64-bit support.
+#--------------------------------------------------------------------
+
+
+ echo $ac_n "checking for required early compiler flags""... $ac_c" 1>&6
+echo "configure:1386: checking for required early compiler flags" >&5
+ tcl_flags=""
+
+ if eval "test \"`echo '$''{'tcl_cv_flag__isoc99_source'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1393 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+int main() {
+char *p = (char *)strtoll; char *q = (char *)strtoull;
+; return 0; }
+EOF
+if { (eval echo configure:1400: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ tcl_cv_flag__isoc99_source=no
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ cat > conftest.$ac_ext <<EOF
+#line 1408 "configure"
+#include "confdefs.h"
+#define _ISOC99_SOURCE 1
+#include <stdlib.h>
+int main() {
+char *p = (char *)strtoll; char *q = (char *)strtoull;
+; return 0; }
+EOF
+if { (eval echo configure:1416: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ tcl_cv_flag__isoc99_source=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ tcl_cv_flag__isoc99_source=no
+fi
+rm -f conftest*
+fi
+rm -f conftest*
+fi
+
+ if test "x${tcl_cv_flag__isoc99_source}" = "xyes" ; then
+ cat >> confdefs.h <<\EOF
+#define _ISOC99_SOURCE 1
+EOF
+
+ tcl_flags="$tcl_flags _ISOC99_SOURCE"
+ fi
+
+ if eval "test \"`echo '$''{'tcl_cv_flag__largefile64_source'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1442 "configure"
+#include "confdefs.h"
+#include <sys/stat.h>
+int main() {
+struct stat64 buf; int i = stat64("/", &buf);
+; return 0; }
+EOF
+if { (eval echo configure:1449: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ tcl_cv_flag__largefile64_source=no
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ cat > conftest.$ac_ext <<EOF
+#line 1457 "configure"
+#include "confdefs.h"
+#define _LARGEFILE64_SOURCE 1
+#include <sys/stat.h>
+int main() {
+struct stat64 buf; int i = stat64("/", &buf);
+; return 0; }
+EOF
+if { (eval echo configure:1465: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ tcl_cv_flag__largefile64_source=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ tcl_cv_flag__largefile64_source=no
+fi
+rm -f conftest*
+fi
+rm -f conftest*
+fi
+
+ if test "x${tcl_cv_flag__largefile64_source}" = "xyes" ; then
+ cat >> confdefs.h <<\EOF
+#define _LARGEFILE64_SOURCE 1
+EOF
+
+ tcl_flags="$tcl_flags _LARGEFILE64_SOURCE"
+ fi
+ if test "x${tcl_flags}" = "x" ; then
+ echo "$ac_t""none" 1>&6
+ else
+ echo "$ac_t""${tcl_flags}" 1>&6
+ fi
+
+
+ echo $ac_n "checking for 64-bit integer type""... $ac_c" 1>&6
+echo "configure:1494: checking for 64-bit integer type" >&5
+ if eval "test \"`echo '$''{'tcl_cv_type_64bit'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+
+ cat > conftest.$ac_ext <<EOF
+#line 1500 "configure"
+#include "confdefs.h"
+
+int main() {
+__int64 value = (__int64) 0;
+; return 0; }
+EOF
+if { (eval echo configure:1507: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ tcl_cv_type_64bit=__int64
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ tcl_cv_type_64bit=none
+ if test "$cross_compiling" = yes; then
+ { echo "configure: error: can not run test program while cross compiling" 1>&2; exit 1; }
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1519 "configure"
+#include "confdefs.h"
+#include <unistd.h>
+ int main() {exit(!(sizeof(long long) > sizeof(long)));}
+
+EOF
+if { (eval echo configure:1525: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+then
+ tcl_cv_type_64bit="long long"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+fi
+rm -fr conftest*
+fi
+
+fi
+rm -f conftest*
+fi
+
+ if test "${tcl_cv_type_64bit}" = none ; then
+ echo "$ac_t""using long" 1>&6
+ else
+ cat >> confdefs.h <<EOF
+#define TCL_WIDE_INT_TYPE ${tcl_cv_type_64bit}
+EOF
+
+ echo "$ac_t""${tcl_cv_type_64bit}" 1>&6
+
+ # Now check for auxiliary declarations
+ echo $ac_n "checking for struct dirent64""... $ac_c" 1>&6
+echo "configure:1550: checking for struct dirent64" >&5
+ if eval "test \"`echo '$''{'tcl_cv_struct_dirent64'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+
+ cat > conftest.$ac_ext <<EOF
+#line 1556 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <sys/dirent.h>
+int main() {
+struct dirent64 p;
+; return 0; }
+EOF
+if { (eval echo configure:1564: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ tcl_cv_struct_dirent64=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ tcl_cv_struct_dirent64=no
+fi
+rm -f conftest*
+fi
+
+ if test "x${tcl_cv_struct_dirent64}" = "xyes" ; then
+ cat >> confdefs.h <<\EOF
+#define HAVE_STRUCT_DIRENT64 1
+EOF
+
+ fi
+ echo "$ac_t""${tcl_cv_struct_dirent64}" 1>&6
+
+ echo $ac_n "checking for struct stat64""... $ac_c" 1>&6
+echo "configure:1585: checking for struct stat64" >&5
+ if eval "test \"`echo '$''{'tcl_cv_struct_stat64'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+
+ cat > conftest.$ac_ext <<EOF
+#line 1591 "configure"
+#include "confdefs.h"
+#include <sys/stat.h>
+int main() {
+struct stat64 p;
+
+; return 0; }
+EOF
+if { (eval echo configure:1599: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ tcl_cv_struct_stat64=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ tcl_cv_struct_stat64=no
+fi
+rm -f conftest*
+fi
+
+ if test "x${tcl_cv_struct_stat64}" = "xyes" ; then
+ cat >> confdefs.h <<\EOF
+#define HAVE_STRUCT_STAT64 1
+EOF
+
+ fi
+ echo "$ac_t""${tcl_cv_struct_stat64}" 1>&6
+
+ echo $ac_n "checking for off64_t""... $ac_c" 1>&6
+echo "configure:1620: checking for off64_t" >&5
+ if eval "test \"`echo '$''{'tcl_cv_type_off64_t'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+
+ cat > conftest.$ac_ext <<EOF
+#line 1626 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+int main() {
+off64_t offset;
+
+; return 0; }
+EOF
+if { (eval echo configure:1634: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ tcl_cv_type_off64_t=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ tcl_cv_type_off64_t=no
+fi
+rm -f conftest*
+fi
+
+ if test "x${tcl_cv_type_off64_t}" = "xyes" ; then
+ cat >> confdefs.h <<\EOF
+#define HAVE_TYPE_OFF64_T 1
+EOF
+
+ fi
+ echo "$ac_t""${tcl_cv_type_off64_t}" 1>&6
+ fi
+
+#--------------------------------------------------------------------
+# Check endianness because we can optimize comparisons of
+# Tcl_UniChar strings to memcmp on big-endian systems.
+#--------------------------------------------------------------------
+
+echo $ac_n "checking whether byte ordering is bigendian""... $ac_c" 1>&6
+echo "configure:1661: checking whether byte ordering is bigendian" >&5
+if eval "test \"`echo '$''{'ac_cv_c_bigendian'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_cv_c_bigendian=unknown
+# See if sys/param.h defines the BYTE_ORDER macro.
+cat > conftest.$ac_ext <<EOF
+#line 1668 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <sys/param.h>
+int main() {
+
+#if !BYTE_ORDER || !BIG_ENDIAN || !LITTLE_ENDIAN
+ bogus endian macros
+#endif
+; return 0; }
+EOF
+if { (eval echo configure:1679: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ # It does; now see whether it defined to BIG_ENDIAN or not.
+cat > conftest.$ac_ext <<EOF
+#line 1683 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <sys/param.h>
+int main() {
+
+#if BYTE_ORDER != BIG_ENDIAN
+ not big endian
+#endif
+; return 0; }
+EOF
+if { (eval echo configure:1694: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ ac_cv_c_bigendian=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_cv_c_bigendian=no
+fi
+rm -f conftest*
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+fi
+rm -f conftest*
+if test $ac_cv_c_bigendian = unknown; then
+if test "$cross_compiling" = yes; then
+ { echo "configure: error: can not run test program while cross compiling" 1>&2; exit 1; }
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1714 "configure"
+#include "confdefs.h"
+main () {
+ /* Are we little or big endian? From Harbison&Steele. */
+ union
+ {
+ long l;
+ char c[sizeof (long)];
+ } u;
+ u.l = 1;
+ exit (u.c[sizeof (long) - 1] == 1);
+}
+EOF
+if { (eval echo configure:1727: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+then
+ ac_cv_c_bigendian=no
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -fr conftest*
+ ac_cv_c_bigendian=yes
+fi
+rm -fr conftest*
+fi
+
+fi
+fi
+
+echo "$ac_t""$ac_cv_c_bigendian" 1>&6
+if test $ac_cv_c_bigendian = yes; then
+ cat >> confdefs.h <<\EOF
+#define WORDS_BIGENDIAN 1
+EOF
+
+fi
+
+
+#--------------------------------------------------------------------
# Supply substitutes for missing POSIX library procedures, or
# set flags so Tcl uses alternate procedures.
#--------------------------------------------------------------------
@@ -1442,12 +1756,12 @@ fi
for ac_func in getcwd
do
echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
-echo "configure:1446: checking for $ac_func" >&5
+echo "configure:1760: checking for $ac_func" >&5
if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1451 "configure"
+#line 1765 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char $ac_func(); below. */
@@ -1470,7 +1784,7 @@ $ac_func();
; return 0; }
EOF
-if { (eval echo configure:1474: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:1788: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_$ac_func=yes"
else
@@ -1504,12 +1818,12 @@ done
for ac_func in opendir strstr
do
echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
-echo "configure:1508: checking for $ac_func" >&5
+echo "configure:1822: checking for $ac_func" >&5
if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1513 "configure"
+#line 1827 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char $ac_func(); below. */
@@ -1532,7 +1846,7 @@ $ac_func();
; return 0; }
EOF
-if { (eval echo configure:1536: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:1850: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_$ac_func=yes"
else
@@ -1559,15 +1873,15 @@ done
-for ac_func in strtol tmpnam waitpid
+for ac_func in strtol strtoll strtoull tmpnam waitpid
do
echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
-echo "configure:1566: checking for $ac_func" >&5
+echo "configure:1880: checking for $ac_func" >&5
if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1571 "configure"
+#line 1885 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char $ac_func(); below. */
@@ -1590,7 +1904,7 @@ $ac_func();
; return 0; }
EOF
-if { (eval echo configure:1594: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:1908: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_$ac_func=yes"
else
@@ -1617,12 +1931,12 @@ done
echo $ac_n "checking for strerror""... $ac_c" 1>&6
-echo "configure:1621: checking for strerror" >&5
+echo "configure:1935: checking for strerror" >&5
if eval "test \"`echo '$''{'ac_cv_func_strerror'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1626 "configure"
+#line 1940 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char strerror(); below. */
@@ -1645,7 +1959,7 @@ strerror();
; return 0; }
EOF
-if { (eval echo configure:1649: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:1963: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_strerror=yes"
else
@@ -1669,12 +1983,12 @@ EOF
fi
echo $ac_n "checking for getwd""... $ac_c" 1>&6
-echo "configure:1673: checking for getwd" >&5
+echo "configure:1987: checking for getwd" >&5
if eval "test \"`echo '$''{'ac_cv_func_getwd'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1678 "configure"
+#line 1992 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char getwd(); below. */
@@ -1697,7 +2011,7 @@ getwd();
; return 0; }
EOF
-if { (eval echo configure:1701: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:2015: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_getwd=yes"
else
@@ -1721,12 +2035,12 @@ EOF
fi
echo $ac_n "checking for wait3""... $ac_c" 1>&6
-echo "configure:1725: checking for wait3" >&5
+echo "configure:2039: checking for wait3" >&5
if eval "test \"`echo '$''{'ac_cv_func_wait3'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1730 "configure"
+#line 2044 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char wait3(); below. */
@@ -1749,7 +2063,7 @@ wait3();
; return 0; }
EOF
-if { (eval echo configure:1753: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:2067: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_wait3=yes"
else
@@ -1773,12 +2087,12 @@ EOF
fi
echo $ac_n "checking for uname""... $ac_c" 1>&6
-echo "configure:1777: checking for uname" >&5
+echo "configure:2091: checking for uname" >&5
if eval "test \"`echo '$''{'ac_cv_func_uname'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1782 "configure"
+#line 2096 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char uname(); below. */
@@ -1801,7 +2115,7 @@ uname();
; return 0; }
EOF
-if { (eval echo configure:1805: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:2119: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_uname=yes"
else
@@ -1825,12 +2139,12 @@ EOF
fi
echo $ac_n "checking for realpath""... $ac_c" 1>&6
-echo "configure:1829: checking for realpath" >&5
+echo "configure:2143: checking for realpath" >&5
if eval "test \"`echo '$''{'ac_cv_func_realpath'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1834 "configure"
+#line 2148 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char realpath(); below. */
@@ -1853,7 +2167,7 @@ realpath();
; return 0; }
EOF
-if { (eval echo configure:1857: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:2171: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_realpath=yes"
else
@@ -1887,11 +2201,10 @@ fi
#--------------------------------------------------------------------
-
echo $ac_n "checking dirent.h""... $ac_c" 1>&6
-echo "configure:1893: checking dirent.h" >&5
+echo "configure:2206: checking dirent.h" >&5
cat > conftest.$ac_ext <<EOF
-#line 1895 "configure"
+#line 2208 "configure"
#include "confdefs.h"
#include <sys/types.h>
#include <dirent.h>
@@ -1917,7 +2230,7 @@ closedir(d);
; return 0; }
EOF
-if { (eval echo configure:1921: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:2234: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
tcl_ok=yes
else
@@ -1938,17 +2251,17 @@ EOF
echo "$ac_t""$tcl_ok" 1>&6
ac_safe=`echo "errno.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for errno.h""... $ac_c" 1>&6
-echo "configure:1942: checking for errno.h" >&5
+echo "configure:2255: checking for errno.h" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1947 "configure"
+#line 2260 "configure"
#include "confdefs.h"
#include <errno.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:1952: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:2265: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
@@ -1975,17 +2288,17 @@ fi
ac_safe=`echo "float.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for float.h""... $ac_c" 1>&6
-echo "configure:1979: checking for float.h" >&5
+echo "configure:2292: checking for float.h" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1984 "configure"
+#line 2297 "configure"
#include "confdefs.h"
#include <float.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:1989: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:2302: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
@@ -2012,17 +2325,17 @@ fi
ac_safe=`echo "values.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for values.h""... $ac_c" 1>&6
-echo "configure:2016: checking for values.h" >&5
+echo "configure:2329: checking for values.h" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 2021 "configure"
+#line 2334 "configure"
#include "confdefs.h"
#include <values.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:2026: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:2339: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
@@ -2049,17 +2362,17 @@ fi
ac_safe=`echo "limits.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for limits.h""... $ac_c" 1>&6
-echo "configure:2053: checking for limits.h" >&5
+echo "configure:2366: checking for limits.h" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 2058 "configure"
+#line 2371 "configure"
#include "confdefs.h"
#include <limits.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:2063: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:2376: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
@@ -2086,17 +2399,17 @@ fi
ac_safe=`echo "stdlib.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for stdlib.h""... $ac_c" 1>&6
-echo "configure:2090: checking for stdlib.h" >&5
+echo "configure:2403: checking for stdlib.h" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 2095 "configure"
+#line 2408 "configure"
#include "confdefs.h"
#include <stdlib.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:2100: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:2413: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
@@ -2119,7 +2432,7 @@ tcl_ok=0
fi
cat > conftest.$ac_ext <<EOF
-#line 2123 "configure"
+#line 2436 "configure"
#include "confdefs.h"
#include <stdlib.h>
EOF
@@ -2133,7 +2446,7 @@ fi
rm -f conftest*
cat > conftest.$ac_ext <<EOF
-#line 2137 "configure"
+#line 2450 "configure"
#include "confdefs.h"
#include <stdlib.h>
EOF
@@ -2147,7 +2460,7 @@ fi
rm -f conftest*
cat > conftest.$ac_ext <<EOF
-#line 2151 "configure"
+#line 2464 "configure"
#include "confdefs.h"
#include <stdlib.h>
EOF
@@ -2168,17 +2481,17 @@ EOF
fi
ac_safe=`echo "string.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for string.h""... $ac_c" 1>&6
-echo "configure:2172: checking for string.h" >&5
+echo "configure:2485: checking for string.h" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 2177 "configure"
+#line 2490 "configure"
#include "confdefs.h"
#include <string.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:2182: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:2495: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
@@ -2201,7 +2514,7 @@ tcl_ok=0
fi
cat > conftest.$ac_ext <<EOF
-#line 2205 "configure"
+#line 2518 "configure"
#include "confdefs.h"
#include <string.h>
EOF
@@ -2215,7 +2528,7 @@ fi
rm -f conftest*
cat > conftest.$ac_ext <<EOF
-#line 2219 "configure"
+#line 2532 "configure"
#include "confdefs.h"
#include <string.h>
EOF
@@ -2241,17 +2554,17 @@ EOF
ac_safe=`echo "sys/wait.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for sys/wait.h""... $ac_c" 1>&6
-echo "configure:2245: checking for sys/wait.h" >&5
+echo "configure:2558: checking for sys/wait.h" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 2250 "configure"
+#line 2563 "configure"
#include "confdefs.h"
#include <sys/wait.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:2255: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:2568: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
@@ -2278,17 +2591,17 @@ fi
ac_safe=`echo "dlfcn.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for dlfcn.h""... $ac_c" 1>&6
-echo "configure:2282: checking for dlfcn.h" >&5
+echo "configure:2595: checking for dlfcn.h" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 2287 "configure"
+#line 2600 "configure"
#include "confdefs.h"
#include <dlfcn.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:2292: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:2605: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
@@ -2320,17 +2633,17 @@ fi
do
ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
-echo "configure:2324: checking for $ac_hdr" >&5
+echo "configure:2637: checking for $ac_hdr" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 2329 "configure"
+#line 2642 "configure"
#include "confdefs.h"
#include <$ac_hdr>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:2334: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:2647: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
@@ -2366,20 +2679,62 @@ done
#---------------------------------------------------------------------------
- echo $ac_n "checking termios vs. termio vs. sgtty""... $ac_c" 1>&6
-echo "configure:2371: checking termios vs. termio vs. sgtty" >&5
+ for ac_hdr in sys/modem.h
+do
+ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
+echo "configure:2687: checking for $ac_hdr" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2692 "configure"
+#include "confdefs.h"
+#include <$ac_hdr>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:2697: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=yes"
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'`
+ cat >> confdefs.h <<EOF
+#define $ac_tr_hdr 1
+EOF
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+done
+ echo $ac_n "checking termios vs. termio vs. sgtty""... $ac_c" 1>&6
+echo "configure:2724: checking termios vs. termio vs. sgtty" >&5
+ if eval "test \"`echo '$''{'tcl_cv_api_serial'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+
if test "$cross_compiling" = yes; then
- tk_ok=no
+ tcl_cv_api_serial=no
else
cat > conftest.$ac_ext <<EOF
-#line 2377 "configure"
+#line 2733 "configure"
#include "confdefs.h"
#include <termios.h>
-main()
-{
+int main() {
struct termios t;
if (tcgetattr(0, &t) == 0) {
cfsetospeed(&t, 0);
@@ -2389,74 +2744,61 @@ main()
return 1;
}
EOF
-if { (eval echo configure:2393: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+if { (eval echo configure:2748: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
then
- tk_ok=termios
+ tcl_cv_api_serial=termios
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -fr conftest*
- tk_ok=no
+ tcl_cv_api_serial=no
fi
rm -fr conftest*
fi
-
- if test $tk_ok = termios; then
- cat >> confdefs.h <<\EOF
-#define USE_TERMIOS 1
-EOF
-
- else
+ if test $tcl_cv_api_serial = no ; then
if test "$cross_compiling" = yes; then
- tk_ok=no
+ tcl_cv_api_serial=no
else
cat > conftest.$ac_ext <<EOF
-#line 2416 "configure"
+#line 2765 "configure"
#include "confdefs.h"
#include <termio.h>
-main()
-{
+int main() {
struct termio t;
if (ioctl(0, TCGETA, &t) == 0) {
t.c_cflag |= CBAUD | PARENB | PARODD | CSIZE | CSTOPB;
return 0;
}
return 1;
- }
+}
EOF
-if { (eval echo configure:2431: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+if { (eval echo configure:2779: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
then
- tk_ok=termio
+ tcl_cv_api_serial=termio
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -fr conftest*
- tk_ok=no
+ tcl_cv_api_serial=no
fi
rm -fr conftest*
fi
-
- if test $tk_ok = termio; then
- cat >> confdefs.h <<\EOF
-#define USE_TERMIO 1
-EOF
-
- else
+ fi
+ if test $tcl_cv_api_serial = no ; then
if test "$cross_compiling" = yes; then
- tk_ok=none
+ tcl_cv_api_serial=no
else
cat > conftest.$ac_ext <<EOF
-#line 2454 "configure"
+#line 2797 "configure"
#include "confdefs.h"
#include <sgtty.h>
-main()
-{
+int main() {
struct sgttyb t;
if (ioctl(0, TIOCGETP, &t) == 0) {
t.sg_ospeed = 0;
@@ -2466,27 +2808,140 @@ main()
return 1;
}
EOF
-if { (eval echo configure:2470: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+if { (eval echo configure:2812: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
then
- tk_ok=sgtty
+ tcl_cv_api_serial=sgtty
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -fr conftest*
- tk_ok=none
+ tcl_cv_api_serial=no
fi
rm -fr conftest*
fi
- if test $tk_ok = sgtty; then
- cat >> confdefs.h <<\EOF
-#define USE_SGTTY 1
+ fi
+ if test $tcl_cv_api_serial = no ; then
+ if test "$cross_compiling" = yes; then
+ tcl_cv_api_serial=no
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2830 "configure"
+#include "confdefs.h"
+
+#include <termios.h>
+#include <errno.h>
+
+int main() {
+ struct termios t;
+ if (tcgetattr(0, &t) == 0
+ || errno == ENOTTY || errno == ENXIO || errno == EINVAL) {
+ cfsetospeed(&t, 0);
+ t.c_cflag |= PARENB | PARODD | CSIZE | CSTOPB;
+ return 0;
+ }
+ return 1;
+}
EOF
+if { (eval echo configure:2847: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+then
+ tcl_cv_api_serial=termios
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -fr conftest*
+ tcl_cv_api_serial=no
+fi
+rm -fr conftest*
+fi
fi
+ if test $tcl_cv_api_serial = no; then
+ if test "$cross_compiling" = yes; then
+ tcl_cv_api_serial=no
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2865 "configure"
+#include "confdefs.h"
+
+#include <termio.h>
+#include <errno.h>
+
+int main() {
+ struct termio t;
+ if (ioctl(0, TCGETA, &t) == 0
+ || errno == ENOTTY || errno == ENXIO || errno == EINVAL) {
+ t.c_cflag |= CBAUD | PARENB | PARODD | CSIZE | CSTOPB;
+ return 0;
+ }
+ return 1;
+ }
+EOF
+if { (eval echo configure:2881: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+then
+ tcl_cv_api_serial=termio
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -fr conftest*
+ tcl_cv_api_serial=no
+fi
+rm -fr conftest*
+fi
+
fi
+ if test $tcl_cv_api_serial = no; then
+ if test "$cross_compiling" = yes; then
+ tcl_cv_api_serial=none
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2899 "configure"
+#include "confdefs.h"
+
+#include <sgtty.h>
+#include <errno.h>
+
+int main() {
+ struct sgttyb t;
+ if (ioctl(0, TIOCGETP, &t) == 0
+ || errno == ENOTTY || errno == ENXIO || errno == EINVAL) {
+ t.sg_ospeed = 0;
+ t.sg_flags |= ODDP | EVENP | RAW;
+ return 0;
+ }
+ return 1;
+}
+EOF
+if { (eval echo configure:2916: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+then
+ tcl_cv_api_serial=sgtty
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -fr conftest*
+ tcl_cv_api_serial=none
+fi
+rm -fr conftest*
+fi
+
fi
- echo "$ac_t""$tk_ok" 1>&6
+fi
+
+ case $tcl_cv_api_serial in
+ termios) cat >> confdefs.h <<\EOF
+#define USE_TERMIOS 1
+EOF
+;;
+ termio) cat >> confdefs.h <<\EOF
+#define USE_TERMIO 1
+EOF
+;;
+ sgtty) cat >> confdefs.h <<\EOF
+#define USE_SGTTY 1
+EOF
+;;
+ esac
+ echo "$ac_t""$tcl_cv_api_serial" 1>&6
#--------------------------------------------------------------------
@@ -2499,47 +2954,65 @@ EOF
# special flag.
#--------------------------------------------------------------------
-echo $ac_n "checking fd_set and sys/select""... $ac_c" 1>&6
-echo "configure:2504: checking fd_set and sys/select" >&5
-cat > conftest.$ac_ext <<EOF
-#line 2506 "configure"
+echo $ac_n "checking for fd_set in sys/types""... $ac_c" 1>&6
+echo "configure:2959: checking for fd_set in sys/types" >&5
+if eval "test \"`echo '$''{'tcl_cv_type_fd_set'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2964 "configure"
#include "confdefs.h"
#include <sys/types.h>
int main() {
fd_set readMask, writeMask;
; return 0; }
EOF
-if { (eval echo configure:2513: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:2971: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
- tk_ok=yes
+ tcl_cv_type_fd_set=yes
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
- tk_ok=no
+ tcl_cv_type_fd_set=no
fi
rm -f conftest*
-if test $tk_ok = no; then
- cat > conftest.$ac_ext <<EOF
-#line 2525 "configure"
+fi
+
+echo "$ac_t""$tcl_cv_type_fd_set" 1>&6
+tk_ok=$tcl_cv_type_fd_set
+if test $tcl_cv_type_fd_set = no; then
+ echo $ac_n "checking for fd_mask in sys/select""... $ac_c" 1>&6
+echo "configure:2987: checking for fd_mask in sys/select" >&5
+ if eval "test \"`echo '$''{'tcl_cv_grep_fd_mask'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2992 "configure"
#include "confdefs.h"
#include <sys/select.h>
EOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
egrep "fd_mask" >/dev/null 2>&1; then
rm -rf conftest*
- tk_ok=yes
+ tcl_cv_grep_fd_mask=present
+else
+ rm -rf conftest*
+ tcl_cv_grep_fd_mask=missing
fi
rm -f conftest*
- if test $tk_ok = yes; then
+fi
+
+ echo "$ac_t""$tcl_cv_grep_fd_mask" 1>&6
+ if test $tcl_cv_grep_fd_mask = present; then
cat >> confdefs.h <<\EOF
#define HAVE_SYS_SELECT_H 1
EOF
+ tk_ok=yes
fi
fi
-echo "$ac_t""$tk_ok" 1>&6
if test $tk_ok = no; then
cat >> confdefs.h <<\EOF
#define NO_FD_SET 1
@@ -2552,12 +3025,12 @@ fi
#------------------------------------------------------------------------------
echo $ac_n "checking whether struct tm is in sys/time.h or time.h""... $ac_c" 1>&6
-echo "configure:2556: checking whether struct tm is in sys/time.h or time.h" >&5
+echo "configure:3029: checking whether struct tm is in sys/time.h or time.h" >&5
if eval "test \"`echo '$''{'ac_cv_struct_tm'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 2561 "configure"
+#line 3034 "configure"
#include "confdefs.h"
#include <sys/types.h>
#include <time.h>
@@ -2565,7 +3038,7 @@ int main() {
struct tm *tp; tp->tm_sec;
; return 0; }
EOF
-if { (eval echo configure:2569: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:3042: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
ac_cv_struct_tm=time.h
else
@@ -2590,17 +3063,17 @@ fi
do
ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
-echo "configure:2594: checking for $ac_hdr" >&5
+echo "configure:3067: checking for $ac_hdr" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 2599 "configure"
+#line 3072 "configure"
#include "confdefs.h"
#include <$ac_hdr>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:2604: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:3077: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
@@ -2627,12 +3100,12 @@ fi
done
echo $ac_n "checking whether time.h and sys/time.h may both be included""... $ac_c" 1>&6
-echo "configure:2631: checking whether time.h and sys/time.h may both be included" >&5
+echo "configure:3104: checking whether time.h and sys/time.h may both be included" >&5
if eval "test \"`echo '$''{'ac_cv_header_time'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 2636 "configure"
+#line 3109 "configure"
#include "confdefs.h"
#include <sys/types.h>
#include <sys/time.h>
@@ -2641,7 +3114,7 @@ int main() {
struct tm *tp;
; return 0; }
EOF
-if { (eval echo configure:2645: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:3118: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
ac_cv_header_time=yes
else
@@ -2662,12 +3135,12 @@ EOF
fi
echo $ac_n "checking for tm_zone in struct tm""... $ac_c" 1>&6
-echo "configure:2666: checking for tm_zone in struct tm" >&5
+echo "configure:3139: checking for tm_zone in struct tm" >&5
if eval "test \"`echo '$''{'ac_cv_struct_tm_zone'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 2671 "configure"
+#line 3144 "configure"
#include "confdefs.h"
#include <sys/types.h>
#include <$ac_cv_struct_tm>
@@ -2675,7 +3148,7 @@ int main() {
struct tm tm; tm.tm_zone;
; return 0; }
EOF
-if { (eval echo configure:2679: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:3152: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
ac_cv_struct_tm_zone=yes
else
@@ -2695,12 +3168,12 @@ EOF
else
echo $ac_n "checking for tzname""... $ac_c" 1>&6
-echo "configure:2699: checking for tzname" >&5
+echo "configure:3172: checking for tzname" >&5
if eval "test \"`echo '$''{'ac_cv_var_tzname'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 2704 "configure"
+#line 3177 "configure"
#include "confdefs.h"
#include <time.h>
#ifndef tzname /* For SGI. */
@@ -2710,7 +3183,7 @@ int main() {
atoi(*tzname);
; return 0; }
EOF
-if { (eval echo configure:2714: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:3187: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
ac_cv_var_tzname=yes
else
@@ -2732,205 +3205,200 @@ EOF
fi
- echo $ac_n "checking tm_tzadj in struct tm""... $ac_c" 1>&6
-echo "configure:2737: checking tm_tzadj in struct tm" >&5
- cat > conftest.$ac_ext <<EOF
-#line 2739 "configure"
+ for ac_func in gmtime_r localtime_r
+do
+echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
+echo "configure:3212: checking for $ac_func" >&5
+if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 3217 "configure"
#include "confdefs.h"
-#include <time.h>
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char $ac_func(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char $ac_func();
+
int main() {
-struct tm tm; tm.tm_tzadj;
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
+choke me
+#else
+$ac_func();
+#endif
+
; return 0; }
EOF
-if { (eval echo configure:2746: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:3240: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
- cat >> confdefs.h <<\EOF
-#define HAVE_TM_TZADJ 1
-EOF
-
- echo "$ac_t""yes" 1>&6
+ eval "ac_cv_func_$ac_func=yes"
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
- echo "$ac_t""no" 1>&6
+ eval "ac_cv_func_$ac_func=no"
fi
rm -f conftest*
+fi
- echo $ac_n "checking tm_gmtoff in struct tm""... $ac_c" 1>&6
-echo "configure:2762: checking tm_gmtoff in struct tm" >&5
- cat > conftest.$ac_ext <<EOF
-#line 2764 "configure"
+if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'`
+ cat >> confdefs.h <<EOF
+#define $ac_tr_func 1
+EOF
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+done
+
+
+ echo $ac_n "checking tm_tzadj in struct tm""... $ac_c" 1>&6
+echo "configure:3266: checking tm_tzadj in struct tm" >&5
+ if eval "test \"`echo '$''{'tcl_cv_member_tm_tzadj'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 3271 "configure"
#include "confdefs.h"
#include <time.h>
int main() {
-struct tm tm; tm.tm_gmtoff;
+struct tm tm; tm.tm_tzadj;
; return 0; }
EOF
-if { (eval echo configure:2771: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:3278: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
- cat >> confdefs.h <<\EOF
-#define HAVE_TM_GMTOFF 1
-EOF
-
- echo "$ac_t""yes" 1>&6
+ tcl_cv_member_tm_tzadj=yes
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
- echo "$ac_t""no" 1>&6
+ tcl_cv_member_tm_tzadj=no
fi
rm -f conftest*
+fi
- #
- # Its important to include time.h in this check, as some systems
- # (like convex) have timezone functions, etc.
- #
- have_timezone=no
- echo $ac_n "checking long timezone variable""... $ac_c" 1>&6
-echo "configure:2792: checking long timezone variable" >&5
- cat > conftest.$ac_ext <<EOF
-#line 2794 "configure"
+ echo "$ac_t""$tcl_cv_member_tm_tzadj" 1>&6
+ if test $tcl_cv_member_tm_tzadj = yes ; then
+ cat >> confdefs.h <<\EOF
+#define HAVE_TM_TZADJ 1
+EOF
+
+ fi
+
+ echo $ac_n "checking tm_gmtoff in struct tm""... $ac_c" 1>&6
+echo "configure:3299: checking tm_gmtoff in struct tm" >&5
+ if eval "test \"`echo '$''{'tcl_cv_member_tm_gmtoff'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 3304 "configure"
#include "confdefs.h"
#include <time.h>
int main() {
-extern long timezone;
- timezone += 1;
- exit (0);
+struct tm tm; tm.tm_gmtoff;
; return 0; }
EOF
-if { (eval echo configure:2803: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:3311: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
- have_timezone=yes
- cat >> confdefs.h <<\EOF
-#define HAVE_TIMEZONE_VAR 1
-EOF
-
- echo "$ac_t""yes" 1>&6
+ tcl_cv_member_tm_gmtoff=yes
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
- echo "$ac_t""no" 1>&6
+ tcl_cv_member_tm_gmtoff=no
fi
rm -f conftest*
+fi
+
+ echo "$ac_t""$tcl_cv_member_tm_gmtoff" 1>&6
+ if test $tcl_cv_member_tm_gmtoff = yes ; then
+ cat >> confdefs.h <<\EOF
+#define HAVE_TM_GMTOFF 1
+EOF
+
+ fi
#
- # On some systems (eg IRIX 6.2), timezone is a time_t and not a long.
+ # Its important to include time.h in this check, as some systems
+ # (like convex) have timezone functions, etc.
#
- if test "$have_timezone" = no; then
- echo $ac_n "checking time_t timezone variable""... $ac_c" 1>&6
-echo "configure:2824: checking time_t timezone variable" >&5
- cat > conftest.$ac_ext <<EOF
-#line 2826 "configure"
+ echo $ac_n "checking long timezone variable""... $ac_c" 1>&6
+echo "configure:3336: checking long timezone variable" >&5
+ if eval "test \"`echo '$''{'tcl_cv_var_timezone'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 3341 "configure"
#include "confdefs.h"
#include <time.h>
int main() {
-extern time_t timezone;
+extern long timezone;
timezone += 1;
exit (0);
; return 0; }
EOF
-if { (eval echo configure:2835: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:3350: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
- cat >> confdefs.h <<\EOF
-#define HAVE_TIMEZONE_VAR 1
-EOF
-
- echo "$ac_t""yes" 1>&6
+ tcl_cv_timezone_long=yes
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
- echo "$ac_t""no" 1>&6
+ tcl_cv_timezone_long=no
fi
rm -f conftest*
- fi
-
- #
- # On some systems (eg Solaris 2.5.1), timezone is not declared in
- # time.h unless you jump through hoops. Instead of that, we just
- # declare it ourselves when necessary.
- #
- if test "$have_timezone" = yes; then
- echo $ac_n "checking for timezone declaration""... $ac_c" 1>&6
-echo "configure:2858: checking for timezone declaration" >&5
-
- tzrx='^[ ]*extern.*timezone'
-
- cat > conftest.$ac_ext <<EOF
-#line 2863 "configure"
-#include "confdefs.h"
-#include <time.h>
-EOF
-if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
- egrep "$tzrx" >/dev/null 2>&1; then
- rm -rf conftest*
-
- cat >> confdefs.h <<\EOF
-#define HAVE_TIMEZONE_DECL 1
-EOF
-
- echo "$ac_t""found" 1>&6
-else
- rm -rf conftest*
- echo "$ac_t""missing" 1>&6
fi
-rm -f conftest*
-
- fi
- #
- # AIX does not have a timezone field in struct tm. When the AIX bsd
- # library is used, the timezone global and the gettimeofday methods are
- # to be avoided for timezone deduction instead, we deduce the timezone
- # by comparing the localtime result on a known GMT value.
- #
+ echo "$ac_t""$tcl_cv_timezone_long" 1>&6
+ if test $tcl_cv_timezone_long = yes ; then
+ cat >> confdefs.h <<\EOF
+#define HAVE_TIMEZONE_VAR 1
+EOF
- if test "`uname -s`" = "AIX" ; then
- echo $ac_n "checking for gettimeofday in -lbsd""... $ac_c" 1>&6
-echo "configure:2893: checking for gettimeofday in -lbsd" >&5
-ac_lib_var=`echo bsd'_'gettimeofday | sed 'y%./+-%__p_%'`
-if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ else
+ #
+ # On some systems (eg IRIX 6.2), timezone is a time_t and not a long.
+ #
+ echo $ac_n "checking time_t timezone variable""... $ac_c" 1>&6
+echo "configure:3373: checking time_t timezone variable" >&5
+ if eval "test \"`echo '$''{'tcl_cv_timezone_time'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
- ac_save_LIBS="$LIBS"
-LIBS="-lbsd $LIBS"
-cat > conftest.$ac_ext <<EOF
-#line 2901 "configure"
+ cat > conftest.$ac_ext <<EOF
+#line 3378 "configure"
#include "confdefs.h"
-/* Override any gcc2 internal prototype to avoid an error. */
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char gettimeofday();
-
+#include <time.h>
int main() {
-gettimeofday()
+extern time_t timezone;
+ timezone += 1;
+ exit (0);
; return 0; }
EOF
-if { (eval echo configure:2912: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:3387: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
- eval "ac_cv_lib_$ac_lib_var=yes"
+ tcl_cv_timezone_time=yes
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
- eval "ac_cv_lib_$ac_lib_var=no"
+ tcl_cv_timezone_time=no
fi
rm -f conftest*
-LIBS="$ac_save_LIBS"
-
-fi
-if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
- echo "$ac_t""yes" 1>&6
- libbsd=yes
-else
- echo "$ac_t""no" 1>&6
fi
- if test $libbsd = yes; then
+ echo "$ac_t""$tcl_cv_timezone_time" 1>&6
+ if test $tcl_cv_timezone_time = yes ; then
cat >> confdefs.h <<\EOF
-#define USE_DELTA_FOR_TZ 1
+#define HAVE_TIMEZONE_VAR 1
EOF
fi
@@ -2942,12 +3410,12 @@ EOF
# in struct stat. But we might be able to use fstatfs instead.
#--------------------------------------------------------------------
echo $ac_n "checking for st_blksize in struct stat""... $ac_c" 1>&6
-echo "configure:2946: checking for st_blksize in struct stat" >&5
+echo "configure:3414: checking for st_blksize in struct stat" >&5
if eval "test \"`echo '$''{'ac_cv_struct_st_blksize'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 2951 "configure"
+#line 3419 "configure"
#include "confdefs.h"
#include <sys/types.h>
#include <sys/stat.h>
@@ -2955,7 +3423,7 @@ int main() {
struct stat s; s.st_blksize;
; return 0; }
EOF
-if { (eval echo configure:2959: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:3427: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
ac_cv_struct_st_blksize=yes
else
@@ -2976,12 +3444,12 @@ EOF
fi
echo $ac_n "checking for fstatfs""... $ac_c" 1>&6
-echo "configure:2980: checking for fstatfs" >&5
+echo "configure:3448: checking for fstatfs" >&5
if eval "test \"`echo '$''{'ac_cv_func_fstatfs'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 2985 "configure"
+#line 3453 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char fstatfs(); below. */
@@ -3004,7 +3472,7 @@ fstatfs();
; return 0; }
EOF
-if { (eval echo configure:3008: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:3476: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_fstatfs=yes"
else
@@ -3033,7 +3501,7 @@ fi
# data, this checks it and add memcmp.o to LIBOBJS if needed
#--------------------------------------------------------------------
echo $ac_n "checking for 8-bit clean memcmp""... $ac_c" 1>&6
-echo "configure:3037: checking for 8-bit clean memcmp" >&5
+echo "configure:3505: checking for 8-bit clean memcmp" >&5
if eval "test \"`echo '$''{'ac_cv_func_memcmp_clean'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@@ -3041,7 +3509,7 @@ else
ac_cv_func_memcmp_clean=no
else
cat > conftest.$ac_ext <<EOF
-#line 3045 "configure"
+#line 3513 "configure"
#include "confdefs.h"
main()
@@ -3051,7 +3519,7 @@ main()
}
EOF
-if { (eval echo configure:3055: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+if { (eval echo configure:3523: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
then
ac_cv_func_memcmp_clean=yes
else
@@ -3075,12 +3543,12 @@ test $ac_cv_func_memcmp_clean = no && LIBOBJS="$LIBOBJS memcmp.${ac_objext}"
# {The replacement define is in compat/string.h}
#--------------------------------------------------------------------
echo $ac_n "checking for memmove""... $ac_c" 1>&6
-echo "configure:3079: checking for memmove" >&5
+echo "configure:3547: checking for memmove" >&5
if eval "test \"`echo '$''{'ac_cv_func_memmove'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 3084 "configure"
+#line 3552 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char memmove(); below. */
@@ -3103,7 +3571,7 @@ memmove();
; return 0; }
EOF
-if { (eval echo configure:3107: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:3575: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_memmove=yes"
else
@@ -3136,12 +3604,12 @@ fi
#--------------------------------------------------------------------
echo $ac_n "checking proper strstr implementation""... $ac_c" 1>&6
-echo "configure:3140: checking proper strstr implementation" >&5
+echo "configure:3608: checking proper strstr implementation" >&5
if test "$cross_compiling" = yes; then
tcl_ok=no
else
cat > conftest.$ac_ext <<EOF
-#line 3145 "configure"
+#line 3613 "configure"
#include "confdefs.h"
extern int strstr();
@@ -3151,7 +3619,7 @@ int main()
}
EOF
-if { (eval echo configure:3155: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+if { (eval echo configure:3623: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
then
tcl_ok=yes
else
@@ -3177,12 +3645,12 @@ fi
#--------------------------------------------------------------------
echo $ac_n "checking for strtoul""... $ac_c" 1>&6
-echo "configure:3181: checking for strtoul" >&5
+echo "configure:3649: checking for strtoul" >&5
if eval "test \"`echo '$''{'ac_cv_func_strtoul'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 3186 "configure"
+#line 3654 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char strtoul(); below. */
@@ -3205,7 +3673,7 @@ strtoul();
; return 0; }
EOF
-if { (eval echo configure:3209: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:3677: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_strtoul=yes"
else
@@ -3229,7 +3697,7 @@ if test "$cross_compiling" = yes; then
tcl_ok=0
else
cat > conftest.$ac_ext <<EOF
-#line 3233 "configure"
+#line 3701 "configure"
#include "confdefs.h"
extern int strtoul();
@@ -3245,7 +3713,7 @@ int main()
exit(0);
}
EOF
-if { (eval echo configure:3249: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+if { (eval echo configure:3717: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
then
:
else
@@ -3268,12 +3736,12 @@ fi
#--------------------------------------------------------------------
echo $ac_n "checking for strtod""... $ac_c" 1>&6
-echo "configure:3272: checking for strtod" >&5
+echo "configure:3740: checking for strtod" >&5
if eval "test \"`echo '$''{'ac_cv_func_strtod'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 3277 "configure"
+#line 3745 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char strtod(); below. */
@@ -3296,7 +3764,7 @@ strtod();
; return 0; }
EOF
-if { (eval echo configure:3300: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:3768: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_strtod=yes"
else
@@ -3320,7 +3788,7 @@ if test "$cross_compiling" = yes; then
tcl_ok=0
else
cat > conftest.$ac_ext <<EOF
-#line 3324 "configure"
+#line 3792 "configure"
#include "confdefs.h"
extern double strtod();
@@ -3336,7 +3804,7 @@ int main()
exit(0);
}
EOF
-if { (eval echo configure:3340: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+if { (eval echo configure:3808: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
then
:
else
@@ -3362,12 +3830,12 @@ fi
echo $ac_n "checking for strtod""... $ac_c" 1>&6
-echo "configure:3366: checking for strtod" >&5
+echo "configure:3834: checking for strtod" >&5
if eval "test \"`echo '$''{'ac_cv_func_strtod'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 3371 "configure"
+#line 3839 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char strtod(); below. */
@@ -3390,7 +3858,7 @@ strtod();
; return 0; }
EOF
-if { (eval echo configure:3394: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:3862: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_strtod=yes"
else
@@ -3412,44 +3880,53 @@ fi
if test "$tcl_strtod" = 1; then
echo $ac_n "checking for Solaris2.4/Tru64 strtod bugs""... $ac_c" 1>&6
-echo "configure:3416: checking for Solaris2.4/Tru64 strtod bugs" >&5
- if test "$cross_compiling" = yes; then
- tcl_ok=0
+echo "configure:3884: checking for Solaris2.4/Tru64 strtod bugs" >&5
+ if eval "test \"`echo '$''{'tcl_cv_strtod_buggy'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+
+ if test "$cross_compiling" = yes; then
+ tcl_cv_strtod_buggy=0
else
cat > conftest.$ac_ext <<EOF
-#line 3421 "configure"
+#line 3893 "configure"
#include "confdefs.h"
- extern double strtod();
- int main()
- {
- char *string = "NaN", *spaceString = " ";
- char *term;
- double value;
- value = strtod(string, &term);
- if ((term != string) && (term[-1] == 0)) {
- exit(1);
- }
- value = strtod(spaceString, &term);
- if (term == (spaceString+1)) {
- exit(1);
+ extern double strtod();
+ int main() {
+ char *infString="Inf", *nanString="NaN", *spaceString=" ";
+ char *term;
+ double value;
+ value = strtod(infString, &term);
+ if ((term != infString) && (term[-1] == 0)) {
+ exit(1);
+ }
+ value = strtod(nanString, &term);
+ if ((term != nanString) && (term[-1] == 0)) {
+ exit(1);
+ }
+ value = strtod(spaceString, &term);
+ if (term == (spaceString+1)) {
+ exit(1);
+ }
+ exit(0);
}
- exit(0);
- }
EOF
-if { (eval echo configure:3441: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+if { (eval echo configure:3916: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
then
- tcl_ok=1
+ tcl_cv_strtod_buggy=1
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -fr conftest*
- tcl_ok=0
+ tcl_cv_strtod_buggy=0
fi
rm -fr conftest*
fi
- if test "$tcl_ok" = 1; then
+fi
+
+ if test "$tcl_cv_strtod_buggy" = 1; then
echo "$ac_t""ok" 1>&6
else
echo "$ac_t""buggy" 1>&6
@@ -3468,12 +3945,12 @@ EOF
#--------------------------------------------------------------------
echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6
-echo "configure:3472: checking for ANSI C header files" >&5
+echo "configure:3949: checking for ANSI C header files" >&5
if eval "test \"`echo '$''{'ac_cv_header_stdc'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 3477 "configure"
+#line 3954 "configure"
#include "confdefs.h"
#include <stdlib.h>
#include <stdarg.h>
@@ -3481,7 +3958,7 @@ else
#include <float.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:3485: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:3962: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
@@ -3498,7 +3975,7 @@ rm -f conftest*
if test $ac_cv_header_stdc = yes; then
# SunOS 4.x string.h does not declare mem*, contrary to ANSI.
cat > conftest.$ac_ext <<EOF
-#line 3502 "configure"
+#line 3979 "configure"
#include "confdefs.h"
#include <string.h>
EOF
@@ -3516,7 +3993,7 @@ fi
if test $ac_cv_header_stdc = yes; then
# ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.
cat > conftest.$ac_ext <<EOF
-#line 3520 "configure"
+#line 3997 "configure"
#include "confdefs.h"
#include <stdlib.h>
EOF
@@ -3537,7 +4014,7 @@ if test "$cross_compiling" = yes; then
:
else
cat > conftest.$ac_ext <<EOF
-#line 3541 "configure"
+#line 4018 "configure"
#include "confdefs.h"
#include <ctype.h>
#define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
@@ -3548,7 +4025,7 @@ if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) exit(2);
exit (0); }
EOF
-if { (eval echo configure:3552: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+if { (eval echo configure:4029: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
then
:
else
@@ -3572,12 +4049,12 @@ EOF
fi
echo $ac_n "checking for mode_t""... $ac_c" 1>&6
-echo "configure:3576: checking for mode_t" >&5
+echo "configure:4053: checking for mode_t" >&5
if eval "test \"`echo '$''{'ac_cv_type_mode_t'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 3581 "configure"
+#line 4058 "configure"
#include "confdefs.h"
#include <sys/types.h>
#if STDC_HEADERS
@@ -3605,12 +4082,12 @@ EOF
fi
echo $ac_n "checking for pid_t""... $ac_c" 1>&6
-echo "configure:3609: checking for pid_t" >&5
+echo "configure:4086: checking for pid_t" >&5
if eval "test \"`echo '$''{'ac_cv_type_pid_t'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 3614 "configure"
+#line 4091 "configure"
#include "confdefs.h"
#include <sys/types.h>
#if STDC_HEADERS
@@ -3638,12 +4115,12 @@ EOF
fi
echo $ac_n "checking for size_t""... $ac_c" 1>&6
-echo "configure:3642: checking for size_t" >&5
+echo "configure:4119: checking for size_t" >&5
if eval "test \"`echo '$''{'ac_cv_type_size_t'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 3647 "configure"
+#line 4124 "configure"
#include "confdefs.h"
#include <sys/types.h>
#if STDC_HEADERS
@@ -3671,12 +4148,12 @@ EOF
fi
echo $ac_n "checking for uid_t in sys/types.h""... $ac_c" 1>&6
-echo "configure:3675: checking for uid_t in sys/types.h" >&5
+echo "configure:4152: checking for uid_t in sys/types.h" >&5
if eval "test \"`echo '$''{'ac_cv_type_uid_t'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 3680 "configure"
+#line 4157 "configure"
#include "confdefs.h"
#include <sys/types.h>
EOF
@@ -3705,6 +4182,43 @@ EOF
fi
+echo $ac_n "checking for socklen_t""... $ac_c" 1>&6
+echo "configure:4187: checking for socklen_t" >&5
+if eval "test \"`echo '$''{'ac_cv_type_socklen_t'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 4192 "configure"
+#include "confdefs.h"
+
+ #include <sys/types.h>
+ #include <sys/socket.h>
+ #if STDC_HEADERS
+ #include <stdlib.h>
+ #include <stddef.h>
+ #endif
+
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "(^|[^a-zA-Z_0-9])socklen_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then
+ rm -rf conftest*
+ ac_cv_type_socklen_t=yes
+else
+ rm -rf conftest*
+ ac_cv_type_socklen_t=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_type_socklen_t" 1>&6
+if test $ac_cv_type_socklen_t = no; then
+ cat >> confdefs.h <<\EOF
+#define socklen_t unsigned
+EOF
+
+fi
+
#--------------------------------------------------------------------
# If a system doesn't have an opendir function (man, that's old!)
# then we have to supply a different version of dirent.h which
@@ -3713,12 +4227,12 @@ fi
#--------------------------------------------------------------------
echo $ac_n "checking for opendir""... $ac_c" 1>&6
-echo "configure:3717: checking for opendir" >&5
+echo "configure:4231: checking for opendir" >&5
if eval "test \"`echo '$''{'ac_cv_func_opendir'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 3722 "configure"
+#line 4236 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char opendir(); below. */
@@ -3741,7 +4255,7 @@ opendir();
; return 0; }
EOF
-if { (eval echo configure:3745: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:4259: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_opendir=yes"
else
@@ -3774,9 +4288,12 @@ fi
#--------------------------------------------------------------------
echo $ac_n "checking union wait""... $ac_c" 1>&6
-echo "configure:3778: checking union wait" >&5
-cat > conftest.$ac_ext <<EOF
-#line 3780 "configure"
+echo "configure:4292: checking union wait" >&5
+if eval "test \"`echo '$''{'tcl_cv_union_wait'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 4297 "configure"
#include "confdefs.h"
#include <sys/types.h>
#include <sys/wait.h>
@@ -3785,219 +4302,25 @@ int main() {
union wait x;
WIFEXITED(x); /* Generates compiler error if WIFEXITED
* uses an int. */
-
-; return 0; }
-EOF
-if { (eval echo configure:3792: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
- rm -rf conftest*
- tcl_ok=yes
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- tcl_ok=no
-fi
-rm -f conftest*
-echo "$ac_t""$tcl_ok" 1>&6
-if test $tcl_ok = no; then
- cat >> confdefs.h <<\EOF
-#define NO_UNION_WAIT 1
-EOF
-
-fi
-
-#--------------------------------------------------------------------
-# Check to see whether the system supports the matherr function
-# and its associated type "struct exception".
-#--------------------------------------------------------------------
-
-echo $ac_n "checking matherr support""... $ac_c" 1>&6
-echo "configure:3816: checking matherr support" >&5
-cat > conftest.$ac_ext <<EOF
-#line 3818 "configure"
-#include "confdefs.h"
-#include <math.h>
-int main() {
-
-struct exception x;
-x.type = DOMAIN;
-x.type = SING;
-
-; return 0; }
-EOF
-if { (eval echo configure:3829: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
- rm -rf conftest*
- tcl_ok=yes
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- tcl_ok=no
-fi
-rm -f conftest*
-echo "$ac_t""$tcl_ok" 1>&6
-if test $tcl_ok = yes; then
- cat >> confdefs.h <<\EOF
-#define NEED_MATHERR 1
-EOF
-
-fi
-
-#--------------------------------------------------------------------
-# Check to see whether the system provides a vfork kernel call.
-# If not, then use fork instead. Also, check for a problem with
-# vforks and signals that can cause core dumps if a vforked child
-# resets a signal handler. If the problem exists, then use fork
-# instead of vfork.
-#--------------------------------------------------------------------
-
-echo $ac_n "checking return type of signal handlers""... $ac_c" 1>&6
-echo "configure:3856: checking return type of signal handlers" >&5
-if eval "test \"`echo '$''{'ac_cv_type_signal'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- cat > conftest.$ac_ext <<EOF
-#line 3861 "configure"
-#include "confdefs.h"
-#include <sys/types.h>
-#include <signal.h>
-#ifdef signal
-#undef signal
-#endif
-#ifdef __cplusplus
-extern "C" void (*signal (int, void (*)(int)))(int);
-#else
-void (*signal ()) ();
-#endif
-
-int main() {
-int i;
-; return 0; }
-EOF
-if { (eval echo configure:3878: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
- rm -rf conftest*
- ac_cv_type_signal=void
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- ac_cv_type_signal=int
-fi
-rm -f conftest*
-fi
-
-echo "$ac_t""$ac_cv_type_signal" 1>&6
-cat >> confdefs.h <<EOF
-#define RETSIGTYPE $ac_cv_type_signal
-EOF
-
-
-echo $ac_n "checking for vfork""... $ac_c" 1>&6
-echo "configure:3897: checking for vfork" >&5
-if eval "test \"`echo '$''{'ac_cv_func_vfork'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- cat > conftest.$ac_ext <<EOF
-#line 3902 "configure"
-#include "confdefs.h"
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char vfork(); below. */
-#include <assert.h>
-/* Override any gcc2 internal prototype to avoid an error. */
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char vfork();
-
-int main() {
-
-/* The GNU C library defines this for functions which it implements
- to always fail with ENOSYS. Some functions are actually named
- something starting with __ and the normal name is an alias. */
-#if defined (__stub_vfork) || defined (__stub___vfork)
-choke me
-#else
-vfork();
-#endif
-
+
; return 0; }
EOF
-if { (eval echo configure:3925: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:4309: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
- eval "ac_cv_func_vfork=yes"
+ tcl_cv_union_wait=yes
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
- eval "ac_cv_func_vfork=no"
+ tcl_cv_union_wait=no
fi
rm -f conftest*
fi
-if eval "test \"`echo '$ac_cv_func_'vfork`\" = yes"; then
- echo "$ac_t""yes" 1>&6
- tcl_ok=1
-else
- echo "$ac_t""no" 1>&6
-tcl_ok=0
-fi
-
-if test "$tcl_ok" = 1; then
- echo $ac_n "checking vfork/signal bug""... $ac_c" 1>&6
-echo "configure:3947: checking vfork/signal bug" >&5;
- if test "$cross_compiling" = yes; then
- tcl_ok=0
-else
- cat > conftest.$ac_ext <<EOF
-#line 3952 "configure"
-#include "confdefs.h"
-
-#include <stdio.h>
-#include <signal.h>
-#include <sys/wait.h>
-int gotSignal = 0;
-sigProc(sig)
- int sig;
-{
- gotSignal = 1;
-}
-main()
-{
- int pid, sts;
- (void) signal(SIGCHLD, sigProc);
- pid = vfork();
- if (pid < 0) {
- exit(1);
- } else if (pid == 0) {
- (void) signal(SIGCHLD, SIG_DFL);
- _exit(0);
- } else {
- (void) wait(&sts);
- }
- exit((gotSignal) ? 0 : 1);
-}
-EOF
-if { (eval echo configure:3980: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
-then
- tcl_ok=1
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -fr conftest*
- tcl_ok=0
-fi
-rm -fr conftest*
-fi
-
- if test "$tcl_ok" = 1; then
- echo "$ac_t""ok" 1>&6
- else
- echo "$ac_t""buggy, using fork instead" 1>&6
- fi
-fi
-rm -f core
-if test "$tcl_ok" = 0; then
+echo "$ac_t""$tcl_cv_union_wait" 1>&6
+if test $tcl_cv_union_wait = no; then
cat >> confdefs.h <<\EOF
-#define vfork fork
+#define NO_UNION_WAIT 1
EOF
fi
@@ -4009,12 +4332,12 @@ fi
#--------------------------------------------------------------------
echo $ac_n "checking for strncasecmp""... $ac_c" 1>&6
-echo "configure:4013: checking for strncasecmp" >&5
+echo "configure:4336: checking for strncasecmp" >&5
if eval "test \"`echo '$''{'ac_cv_func_strncasecmp'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 4018 "configure"
+#line 4341 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char strncasecmp(); below. */
@@ -4037,7 +4360,7 @@ strncasecmp();
; return 0; }
EOF
-if { (eval echo configure:4041: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:4364: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_strncasecmp=yes"
else
@@ -4059,7 +4382,7 @@ fi
if test "$tcl_ok" = 0; then
echo $ac_n "checking for strncasecmp in -lsocket""... $ac_c" 1>&6
-echo "configure:4063: checking for strncasecmp in -lsocket" >&5
+echo "configure:4386: checking for strncasecmp in -lsocket" >&5
ac_lib_var=`echo socket'_'strncasecmp | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
@@ -4067,7 +4390,7 @@ else
ac_save_LIBS="$LIBS"
LIBS="-lsocket $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 4071 "configure"
+#line 4394 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
@@ -4078,7 +4401,7 @@ int main() {
strncasecmp()
; return 0; }
EOF
-if { (eval echo configure:4082: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:4405: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
@@ -4102,7 +4425,7 @@ fi
fi
if test "$tcl_ok" = 0; then
echo $ac_n "checking for strncasecmp in -linet""... $ac_c" 1>&6
-echo "configure:4106: checking for strncasecmp in -linet" >&5
+echo "configure:4429: checking for strncasecmp in -linet" >&5
ac_lib_var=`echo inet'_'strncasecmp | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
@@ -4110,7 +4433,7 @@ else
ac_save_LIBS="$LIBS"
LIBS="-linet $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 4114 "configure"
+#line 4437 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
@@ -4121,7 +4444,7 @@ int main() {
strncasecmp()
; return 0; }
EOF
-if { (eval echo configure:4125: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:4448: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
@@ -4159,12 +4482,12 @@ fi
#--------------------------------------------------------------------
echo $ac_n "checking for BSDgettimeofday""... $ac_c" 1>&6
-echo "configure:4163: checking for BSDgettimeofday" >&5
+echo "configure:4486: checking for BSDgettimeofday" >&5
if eval "test \"`echo '$''{'ac_cv_func_BSDgettimeofday'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 4168 "configure"
+#line 4491 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char BSDgettimeofday(); below. */
@@ -4187,7 +4510,7 @@ BSDgettimeofday();
; return 0; }
EOF
-if { (eval echo configure:4191: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:4514: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_BSDgettimeofday=yes"
else
@@ -4207,13 +4530,14 @@ EOF
else
echo "$ac_t""no" 1>&6
-echo $ac_n "checking for gettimeofday""... $ac_c" 1>&6
-echo "configure:4212: checking for gettimeofday" >&5
+
+ echo $ac_n "checking for gettimeofday""... $ac_c" 1>&6
+echo "configure:4536: checking for gettimeofday" >&5
if eval "test \"`echo '$''{'ac_cv_func_gettimeofday'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 4217 "configure"
+#line 4541 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char gettimeofday(); below. */
@@ -4236,7 +4560,7 @@ gettimeofday();
; return 0; }
EOF
-if { (eval echo configure:4240: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:4564: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_gettimeofday=yes"
else
@@ -4259,31 +4583,38 @@ EOF
fi
+
fi
echo $ac_n "checking for gettimeofday declaration""... $ac_c" 1>&6
-echo "configure:4266: checking for gettimeofday declaration" >&5
-cat > conftest.$ac_ext <<EOF
-#line 4268 "configure"
+echo "configure:4591: checking for gettimeofday declaration" >&5
+if eval "test \"`echo '$''{'tcl_cv_grep_gettimeofday'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 4596 "configure"
#include "confdefs.h"
#include <sys/time.h>
EOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
egrep "gettimeofday" >/dev/null 2>&1; then
rm -rf conftest*
- echo "$ac_t""present" 1>&6
+ tcl_cv_grep_gettimeofday=present
else
rm -rf conftest*
-
- echo "$ac_t""missing" 1>&6
+ tcl_cv_grep_gettimeofday=missing
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$tcl_cv_grep_gettimeofday" 1>&6
+if test $tcl_cv_grep_gettimeofday = missing ; then
cat >> confdefs.h <<\EOF
#define GETTOD_NOT_DECLARED 1
EOF
-
fi
-rm -f conftest*
-
#--------------------------------------------------------------------
# The following code checks to see whether it is possible to get
@@ -4292,14 +4623,14 @@ rm -f conftest*
#--------------------------------------------------------------------
echo $ac_n "checking whether char is unsigned""... $ac_c" 1>&6
-echo "configure:4296: checking whether char is unsigned" >&5
+echo "configure:4627: checking whether char is unsigned" >&5
if eval "test \"`echo '$''{'ac_cv_c_char_unsigned'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
if test "$GCC" = yes; then
# GCC predefines this symbol on systems where it applies.
cat > conftest.$ac_ext <<EOF
-#line 4303 "configure"
+#line 4634 "configure"
#include "confdefs.h"
#ifdef __CHAR_UNSIGNED__
yes
@@ -4321,7 +4652,7 @@ if test "$cross_compiling" = yes; then
{ echo "configure: error: can not run test program while cross compiling" 1>&2; exit 1; }
else
cat > conftest.$ac_ext <<EOF
-#line 4325 "configure"
+#line 4656 "configure"
#include "confdefs.h"
/* volatile prevents gcc2 from optimizing the test away on sparcs. */
#if !defined(__STDC__) || __STDC__ != 1
@@ -4331,7 +4662,7 @@ main() {
volatile char c = 255; exit(c < 0);
}
EOF
-if { (eval echo configure:4335: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+if { (eval echo configure:4666: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
then
ac_cv_c_char_unsigned=yes
else
@@ -4355,36 +4686,185 @@ EOF
fi
echo $ac_n "checking signed char declarations""... $ac_c" 1>&6
-echo "configure:4359: checking signed char declarations" >&5
-cat > conftest.$ac_ext <<EOF
-#line 4361 "configure"
+echo "configure:4690: checking signed char declarations" >&5
+if eval "test \"`echo '$''{'tcl_cv_char_signed'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 4695 "configure"
#include "confdefs.h"
int main() {
-signed char *p;
-p = 0;
-
+ signed char *p;
+ p = 0;
+
; return 0; }
EOF
-if { (eval echo configure:4371: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:4705: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
- tcl_ok=yes
+ tcl_cv_char_signed=yes
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
- tcl_ok=no
+ tcl_cv_char_signed=no
fi
rm -f conftest*
-echo "$ac_t""$tcl_ok" 1>&6
-if test $tcl_ok = yes; then
+fi
+
+echo "$ac_t""$tcl_cv_char_signed" 1>&6
+if test $tcl_cv_char_signed = yes; then
cat >> confdefs.h <<\EOF
#define HAVE_SIGNED_CHAR 1
EOF
fi
+#--------------------------------------------------------------------
+# Does putenv() copy or not? We need to know to avoid memory leaks.
+#--------------------------------------------------------------------
+
+echo $ac_n "checking for a putenv() that copies the buffer""... $ac_c" 1>&6
+echo "configure:4730: checking for a putenv() that copies the buffer" >&5
+if eval "test \"`echo '$''{'tcl_cv_putenv_copy'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test "$cross_compiling" = yes; then
+ tcl_cv_putenv_copy=no
+else
+ cat > conftest.$ac_ext <<EOF
+#line 4738 "configure"
+#include "confdefs.h"
+
+ #include <stdlib.h>
+ #define OURVAR "havecopy=yes"
+ int main (int argc, char *argv)
+ {
+ char *foo, *bar;
+ foo = (char *)strdup(OURVAR);
+ putenv(foo);
+ strcpy((char *)(strchr(foo, '=') + 1), "no");
+ bar = getenv("havecopy");
+ if (!strcmp(bar, "no")) {
+ /* doesnt copy */
+ return 0;
+ } else {
+ /* does copy */
+ return 1;
+ }
+ }
+
+EOF
+if { (eval echo configure:4760: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+then
+ tcl_cv_putenv_copy=no
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -fr conftest*
+ tcl_cv_putenv_copy=yes
+fi
+rm -fr conftest*
+fi
+
+
+fi
+
+echo "$ac_t""$tcl_cv_putenv_copy" 1>&6
+if test $tcl_cv_putenv_copy = yes; then
+ cat >> confdefs.h <<\EOF
+#define HAVE_PUTENV_THAT_COPIES 1
+EOF
+
+fi
+
+#--------------------------------------------------------------------
+# Check for support of nl_langinfo function
+#--------------------------------------------------------------------
+
+
+ # Check whether --enable-langinfo or --disable-langinfo was given.
+if test "${enable_langinfo+set}" = set; then
+ enableval="$enable_langinfo"
+ langinfo_ok=$enableval
+else
+ langinfo_ok=yes
+fi
+
+
+ HAVE_LANGINFO=0
+ if test "$langinfo_ok" = "yes"; then
+ if test "$langinfo_ok" = "yes"; then
+ ac_safe=`echo "langinfo.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for langinfo.h""... $ac_c" 1>&6
+echo "configure:4802: checking for langinfo.h" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 4807 "configure"
+#include "confdefs.h"
+#include <langinfo.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:4812: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=yes"
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ langinfo_ok=yes
+else
+ echo "$ac_t""no" 1>&6
+langinfo_ok=no
+fi
+
+ fi
+ fi
+ echo $ac_n "checking whether to use nl_langinfo""... $ac_c" 1>&6
+echo "configure:4837: checking whether to use nl_langinfo" >&5
+ if test "$langinfo_ok" = "yes"; then
+ cat > conftest.$ac_ext <<EOF
+#line 4840 "configure"
+#include "confdefs.h"
+#include <langinfo.h>
+int main() {
+nl_langinfo(CODESET);
+; return 0; }
+EOF
+if { (eval echo configure:4847: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ langinfo_ok=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ langinfo_ok=no
+fi
+rm -f conftest*
+ if test "$langinfo_ok" = "no"; then
+ langinfo_ok="no (could not compile with nl_langinfo)";
+ fi
+ if test "$langinfo_ok" = "yes"; then
+ cat >> confdefs.h <<\EOF
+#define HAVE_LANGINFO 1
+EOF
+
+ fi
+ fi
+ echo "$ac_t""$langinfo_ok" 1>&6
+
#--------------------------------------------------------------------
# Look for libraries that we will need when compiling the Tcl shell
@@ -4399,12 +4879,12 @@ fi
#--------------------------------------------------------------------
echo $ac_n "checking for sin""... $ac_c" 1>&6
-echo "configure:4403: checking for sin" >&5
+echo "configure:4883: checking for sin" >&5
if eval "test \"`echo '$''{'ac_cv_func_sin'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 4408 "configure"
+#line 4888 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char sin(); below. */
@@ -4427,7 +4907,7 @@ sin();
; return 0; }
EOF
-if { (eval echo configure:4431: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:4911: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_sin=yes"
else
@@ -4448,7 +4928,7 @@ MATH_LIBS="-lm"
fi
echo $ac_n "checking for main in -lieee""... $ac_c" 1>&6
-echo "configure:4452: checking for main in -lieee" >&5
+echo "configure:4932: checking for main in -lieee" >&5
ac_lib_var=`echo ieee'_'main | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
@@ -4456,14 +4936,14 @@ else
ac_save_LIBS="$LIBS"
LIBS="-lieee $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 4460 "configure"
+#line 4940 "configure"
#include "confdefs.h"
int main() {
main()
; return 0; }
EOF
-if { (eval echo configure:4467: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:4947: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
@@ -4485,68 +4965,12 @@ fi
#--------------------------------------------------------------------
- # On AIX systems, libbsd.a has to be linked in to support
- # non-blocking file IO. This library has to be linked in after
- # the MATH_LIBS or it breaks the pow() function. The way to
- # insure proper sequencing, is to add it to the tail of MATH_LIBS.
- # This library also supplies gettimeofday.
- #--------------------------------------------------------------------
-
- libbsd=no
- if test "`uname -s`" = "AIX" ; then
- echo $ac_n "checking for gettimeofday in -lbsd""... $ac_c" 1>&6
-echo "configure:4499: checking for gettimeofday in -lbsd" >&5
-ac_lib_var=`echo bsd'_'gettimeofday | sed 'y%./+-%__p_%'`
-if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- ac_save_LIBS="$LIBS"
-LIBS="-lbsd $LIBS"
-cat > conftest.$ac_ext <<EOF
-#line 4507 "configure"
-#include "confdefs.h"
-/* Override any gcc2 internal prototype to avoid an error. */
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char gettimeofday();
-
-int main() {
-gettimeofday()
-; return 0; }
-EOF
-if { (eval echo configure:4518: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
- rm -rf conftest*
- eval "ac_cv_lib_$ac_lib_var=yes"
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- eval "ac_cv_lib_$ac_lib_var=no"
-fi
-rm -f conftest*
-LIBS="$ac_save_LIBS"
-
-fi
-if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
- echo "$ac_t""yes" 1>&6
- libbsd=yes
-else
- echo "$ac_t""no" 1>&6
-fi
-
- if test $libbsd = yes; then
- MATH_LIBS="$MATH_LIBS -lbsd"
- fi
- fi
-
-
- #--------------------------------------------------------------------
# Interactive UNIX requires -linet instead of -lsocket, plus it
# needs net/errno.h to define the socket-related error codes.
#--------------------------------------------------------------------
echo $ac_n "checking for main in -linet""... $ac_c" 1>&6
-echo "configure:4550: checking for main in -linet" >&5
+echo "configure:4974: checking for main in -linet" >&5
ac_lib_var=`echo inet'_'main | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
@@ -4554,14 +4978,14 @@ else
ac_save_LIBS="$LIBS"
LIBS="-linet $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 4558 "configure"
+#line 4982 "configure"
#include "confdefs.h"
int main() {
main()
; return 0; }
EOF
-if { (eval echo configure:4565: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:4989: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
@@ -4583,17 +5007,17 @@ fi
ac_safe=`echo "net/errno.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for net/errno.h""... $ac_c" 1>&6
-echo "configure:4587: checking for net/errno.h" >&5
+echo "configure:5011: checking for net/errno.h" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 4592 "configure"
+#line 5016 "configure"
#include "confdefs.h"
#include <net/errno.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:4597: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:5021: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
@@ -4636,23 +5060,14 @@ fi
# if -lsocket doesn't work by itself.
#--------------------------------------------------------------------
- # CYGNUS LOCAL: Store any socket library(ies) in the cache, and don't
- # mess up the cache values of the functions we check for.
- echo $ac_n "checking for socket libraries""... $ac_c" 1>&6
-echo "configure:4643: checking for socket libraries" >&5
-if eval "test \"`echo '$''{'tcl_cv_lib_sockets'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- tcl_cv_lib_sockets=
- tcl_checkBoth=0
- unset ac_cv_func_connect
- echo $ac_n "checking for connect""... $ac_c" 1>&6
-echo "configure:4651: checking for connect" >&5
+ tcl_checkBoth=0
+ echo $ac_n "checking for connect""... $ac_c" 1>&6
+echo "configure:5066: checking for connect" >&5
if eval "test \"`echo '$''{'ac_cv_func_connect'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 4656 "configure"
+#line 5071 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char connect(); below. */
@@ -4675,7 +5090,7 @@ connect();
; return 0; }
EOF
-if { (eval echo configure:4679: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:5094: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_connect=yes"
else
@@ -4695,25 +5110,74 @@ else
tcl_checkSocket=1
fi
- if test "$tcl_checkSocket" = 1; then
- unset ac_cv_func_connect
- echo $ac_n "checking for main in -lsocket""... $ac_c" 1>&6
-echo "configure:4702: checking for main in -lsocket" >&5
-ac_lib_var=`echo socket'_'main | sed 'y%./+-%__p_%'`
+ if test "$tcl_checkSocket" = 1; then
+ echo $ac_n "checking for setsockopt""... $ac_c" 1>&6
+echo "configure:5116: checking for setsockopt" >&5
+if eval "test \"`echo '$''{'ac_cv_func_setsockopt'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 5121 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char setsockopt(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char setsockopt();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_setsockopt) || defined (__stub___setsockopt)
+choke me
+#else
+setsockopt();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:5144: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_setsockopt=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_setsockopt=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'setsockopt`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ :
+else
+ echo "$ac_t""no" 1>&6
+echo $ac_n "checking for setsockopt in -lsocket""... $ac_c" 1>&6
+echo "configure:5162: checking for setsockopt in -lsocket" >&5
+ac_lib_var=`echo socket'_'setsockopt | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
ac_save_LIBS="$LIBS"
LIBS="-lsocket $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 4710 "configure"
+#line 5170 "configure"
#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char setsockopt();
int main() {
-main()
+setsockopt()
; return 0; }
EOF
-if { (eval echo configure:4717: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:5181: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
@@ -4728,24 +5192,25 @@ LIBS="$ac_save_LIBS"
fi
if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
echo "$ac_t""yes" 1>&6
- tcl_cv_lib_sockets="-lsocket"
+ LIBS="$LIBS -lsocket"
else
echo "$ac_t""no" 1>&6
tcl_checkBoth=1
fi
- fi
- if test "$tcl_checkBoth" = 1; then
- tcl_oldLibs=$LIBS
- LIBS="$LIBS -lsocket -lnsl"
- unset ac_cv_func_accept
- echo $ac_n "checking for accept""... $ac_c" 1>&6
-echo "configure:4744: checking for accept" >&5
+fi
+
+ fi
+ if test "$tcl_checkBoth" = 1; then
+ tk_oldLibs=$LIBS
+ LIBS="$LIBS -lsocket -lnsl"
+ echo $ac_n "checking for accept""... $ac_c" 1>&6
+echo "configure:5209: checking for accept" >&5
if eval "test \"`echo '$''{'ac_cv_func_accept'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 4749 "configure"
+#line 5214 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char accept(); below. */
@@ -4768,7 +5233,7 @@ accept();
; return 0; }
EOF
-if { (eval echo configure:4772: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:5237: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_accept=yes"
else
@@ -4783,24 +5248,19 @@ fi
if eval "test \"`echo '$ac_cv_func_'accept`\" = yes"; then
echo "$ac_t""yes" 1>&6
tcl_checkNsl=0
- tcl_cv_lib_sockets="-lsocket -lnsl"
else
echo "$ac_t""no" 1>&6
+LIBS=$tk_oldLibs
fi
- unset ac_cv_func_accept
- LIBS=$tcl_oldLibs
- fi
- unset ac_cv_func_gethostbyname
- tcl_oldLibs=$LIBS
- LIBS="$LIBS $tcl_cv_lib_sockets"
- echo $ac_n "checking for gethostbyname""... $ac_c" 1>&6
-echo "configure:4799: checking for gethostbyname" >&5
+ fi
+ echo $ac_n "checking for gethostbyname""... $ac_c" 1>&6
+echo "configure:5259: checking for gethostbyname" >&5
if eval "test \"`echo '$''{'ac_cv_func_gethostbyname'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 4804 "configure"
+#line 5264 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char gethostbyname(); below. */
@@ -4823,7 +5283,7 @@ gethostbyname();
; return 0; }
EOF
-if { (eval echo configure:4827: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:5287: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_gethostbyname=yes"
else
@@ -4840,23 +5300,27 @@ if eval "test \"`echo '$ac_cv_func_'gethostbyname`\" = yes"; then
:
else
echo "$ac_t""no" 1>&6
-echo $ac_n "checking for main in -lnsl""... $ac_c" 1>&6
-echo "configure:4845: checking for main in -lnsl" >&5
-ac_lib_var=`echo nsl'_'main | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for gethostbyname in -lnsl""... $ac_c" 1>&6
+echo "configure:5305: checking for gethostbyname in -lnsl" >&5
+ac_lib_var=`echo nsl'_'gethostbyname | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
ac_save_LIBS="$LIBS"
LIBS="-lnsl $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 4853 "configure"
+#line 5313 "configure"
#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char gethostbyname();
int main() {
-main()
+gethostbyname()
; return 0; }
EOF
-if { (eval echo configure:4860: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:5324: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
@@ -4871,20 +5335,13 @@ LIBS="$ac_save_LIBS"
fi
if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
echo "$ac_t""yes" 1>&6
- tcl_cv_lib_sockets="$tcl_cv_lib_sockets -lnsl"
+ LIBS="$LIBS -lnsl"
else
echo "$ac_t""no" 1>&6
fi
fi
- unset ac_cv_func_gethostbyname
- LIBS=$tcl_oldLIBS
-
-fi
-
-echo "$ac_t""$tcl_cv_lib_sockets" 1>&6
- test -z "$tcl_cv_lib_sockets" || LIBS="$LIBS $tcl_cv_lib_sockets"
# Don't perform the eval of the libraries here because DL_LIBS
# won't be set until we call SC_CONFIG_CFLAGS
@@ -4898,18 +5355,80 @@ echo "$ac_t""$tcl_cv_lib_sockets" 1>&6
LIBS="$LIBS$THREADS_LIBS"
+
+ echo $ac_n "checking how to build libraries""... $ac_c" 1>&6
+echo "configure:5361: checking how to build libraries" >&5
+ # Check whether --enable-shared or --disable-shared was given.
+if test "${enable_shared+set}" = set; then
+ enableval="$enable_shared"
+ tcl_ok=$enableval
+else
+ tcl_ok=yes
+fi
+
+
+ if test "${enable_shared+set}" = set; then
+ enableval="$enable_shared"
+ tcl_ok=$enableval
+ else
+ tcl_ok=yes
+ fi
+
+ if test "$tcl_ok" = "yes" ; then
+ echo "$ac_t""shared" 1>&6
+ SHARED_BUILD=1
+ else
+ echo "$ac_t""static" 1>&6
+ SHARED_BUILD=0
+ cat >> confdefs.h <<\EOF
+#define STATIC_BUILD 1
+EOF
+
+ fi
+
+
#--------------------------------------------------------------------
# The statements below define a collection of compile flags. This
# macro depends on the value of SHARED_BUILD, and should be called
# after SC_ENABLE_SHARED checks the configure switches.
#--------------------------------------------------------------------
+# Extract the first word of "ranlib", so it can be a program name with args.
+set dummy ranlib; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:5400: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$RANLIB"; then
+ ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_RANLIB="ranlib"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ test -z "$ac_cv_prog_RANLIB" && ac_cv_prog_RANLIB=":"
+fi
+fi
+RANLIB="$ac_cv_prog_RANLIB"
+if test -n "$RANLIB"; then
+ echo "$ac_t""$RANLIB" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
# Step 0.a: Enable 64 bit support?
echo $ac_n "checking if 64bit support is requested""... $ac_c" 1>&6
-echo "configure:4913: checking if 64bit support is requested" >&5
+echo "configure:5432: checking if 64bit support is requested" >&5
# Check whether --enable-64bit or --disable-64bit was given.
if test "${enable_64bit+set}" = set; then
enableval="$enable_64bit"
@@ -4929,7 +5448,7 @@ fi
# Step 0.b: Enable Solaris 64 bit VIS support?
echo $ac_n "checking if 64bit Sparc VIS support is requested""... $ac_c" 1>&6
-echo "configure:4933: checking if 64bit Sparc VIS support is requested" >&5
+echo "configure:5452: checking if 64bit Sparc VIS support is requested" >&5
# Check whether --enable-64bit-vis or --disable-64bit-vis was given.
if test "${enable_64bit_vis+set}" = set; then
enableval="$enable_64bit_vis"
@@ -4953,7 +5472,7 @@ fi
# there are a few systems, like Next, where this doesn't work.
echo $ac_n "checking system version (for dynamic loading)""... $ac_c" 1>&6
-echo "configure:4957: checking system version (for dynamic loading)" >&5
+echo "configure:5476: checking system version (for dynamic loading)" >&5
if test -f /usr/lib/NextStep/software_version; then
system=NEXTSTEP-`awk '/3/,/3/' /usr/lib/NextStep/software_version`
else
@@ -4975,21 +5494,11 @@ echo "configure:4957: checking system version (for dynamic loading)" >&5
fi
fi
- echo $ac_n "checking if gcc is being used""... $ac_c" 1>&6
-echo "configure:4980: checking if gcc is being used" >&5
- if test "$CC" = "gcc" -o `$CC -v 2>&1 | grep -c gcc` != "0" ; then
- using_gcc="yes"
- else
- using_gcc="no"
- fi
-
- echo "$ac_t""$using_gcc ($CC)" 1>&6
-
# Step 2: check for existence of -ldl library. This is needed because
# Linux can use either -ldl or -ldld for dynamic loading.
echo $ac_n "checking for dlopen in -ldl""... $ac_c" 1>&6
-echo "configure:4993: checking for dlopen in -ldl" >&5
+echo "configure:5502: checking for dlopen in -ldl" >&5
ac_lib_var=`echo dl'_'dlopen | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
@@ -4997,7 +5506,7 @@ else
ac_save_LIBS="$LIBS"
LIBS="-ldl $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 5001 "configure"
+#line 5510 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
@@ -5008,7 +5517,7 @@ int main() {
dlopen()
; return 0; }
EOF
-if { (eval echo configure:5012: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:5521: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
@@ -5033,7 +5542,6 @@ fi
# Step 3: set configuration options based on system name and version.
do64bit_ok=no
- fullSrcDir=`cd $srcdir; pwd`
EXTRA_CFLAGS=""
TCL_EXPORT_FILE_SUFFIX=""
UNSHARED_LIB_SUFFIX=""
@@ -5042,7 +5550,7 @@ fi
TCL_LIB_VERSIONS_OK=ok
CFLAGS_DEBUG=-g
CFLAGS_OPTIMIZE=-O
- if test "$using_gcc" = "yes" ; then
+ if test "$GCC" = "yes" ; then
CFLAGS_WARNING="-Wall -Wconversion -Wno-implicit-int"
else
CFLAGS_WARNING=""
@@ -5053,7 +5561,7 @@ fi
# Extract the first word of "ar", so it can be a program name with args.
set dummy ar; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:5057: checking for $ac_word" >&5
+echo "configure:5565: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_AR'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@@ -5080,45 +5588,150 @@ else
fi
STLIB_LD='${AR} cr'
+ LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH"
+ PLAT_OBJS=""
case $system in
- AIX-4.[2-9])
- if test "${TCL_THREADS}" = "1" -a "$using_gcc" = "no" ; then
+ AIX-5.*)
+ if test "${TCL_THREADS}" = "1" -a "$GCC" != "yes" ; then
# AIX requires the _r compiler when gcc isn't being used
if test "${CC}" != "cc_r" ; then
CC=${CC}_r
fi
echo "$ac_t""Using $CC for compiling with threads" 1>&6
fi
+ LIBS="$LIBS -lc"
+ # AIX-5 uses ELF style dynamic libraries
SHLIB_CFLAGS=""
- SHLIB_LD="$fullSrcDir/ldAix /bin/ld -bhalt:4 -bM:SRE -bE:lib.exp -H512 -T512 -bnoentry"
+ SHLIB_LD="/usr/ccs/bin/ld -G -z text"
+
+ # Note: need the LIBS below, otherwise Tk won't find Tcl's
+ # symbols when dynamically loaded into tclsh.
+
SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
- DL_LIBS="-ldl"
+ # AIX-5 has dl* in libc.so
+ DL_LIBS=""
LDFLAGS=""
- LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
- TCL_NEEDS_EXP_FILE=1
- TCL_EXPORT_FILE_SUFFIX='${VERSION}\$\{DBGX\}.exp'
+
+ if test "$GCC" = "yes" ; then
+ CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}'
+ else
+ CC_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}'
+ fi
+ LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}'
+ LD_LIBRARY_PATH_VAR="LIBPATH"
+
+ # Check to enable 64-bit flags for compiler/linker
+ if test "$do64bit" = "yes" ; then
+ if test "$GCC" = "yes" ; then
+ echo "configure: warning: "64bit mode not supported with GCC on $system"" 1>&2
+ else
+ do64bit_ok=yes
+ EXTRA_CFLAGS="-q64"
+ LDFLAGS="-q64"
+ fi
+ fi
;;
AIX-*)
- if test "${TCL_THREADS}" = "1" -a "$using_gcc" = "no" ; then
+ if test "${TCL_THREADS}" = "1" -a "$GCC" != "yes" ; then
# AIX requires the _r compiler when gcc isn't being used
if test "${CC}" != "cc_r" ; then
CC=${CC}_r
fi
echo "$ac_t""Using $CC for compiling with threads" 1>&6
fi
+ LIBS="$LIBS -lc"
SHLIB_CFLAGS=""
- SHLIB_LD="$fullSrcDir/ldAix /bin/ld -bhalt:4 -bM:SRE -bE:lib.exp -H512 -T512 -bnoentry"
+ SHLIB_LD="${TCL_SRC_DIR}/unix/ldAix /bin/ld -bhalt:4 -bM:SRE -bE:lib.exp -H512 -T512 -bnoentry"
SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
- LIBOBJS="$LIBOBJS tclLoadAix.o"
- DL_LIBS="-lld"
+ DL_LIBS="-ldl"
LDFLAGS=""
- LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ CC_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
+ LD_LIBRARY_PATH_VAR="LIBPATH"
TCL_NEEDS_EXP_FILE=1
TCL_EXPORT_FILE_SUFFIX='${VERSION}\$\{DBGX\}.exp'
+
+ # AIX v<=4.1 has some different flags than 4.2+
+ if test "$system" = "AIX-4.1" -o "`uname -v`" -lt "4" ; then
+ LIBOBJS="$LIBOBJS tclLoadAix.o"
+ DL_LIBS="-lld"
+ fi
+
+ # On AIX <=v4 systems, libbsd.a has to be linked in to support
+ # non-blocking file IO. This library has to be linked in after
+ # the MATH_LIBS or it breaks the pow() function. The way to
+ # insure proper sequencing, is to add it to the tail of MATH_LIBS.
+ # This library also supplies gettimeofday.
+ #
+ # AIX does not have a timezone field in struct tm. When the AIX
+ # bsd library is used, the timezone global and the gettimeofday
+ # methods are to be avoided for timezone deduction instead, we
+ # deduce the timezone by comparing the localtime result on a
+ # known GMT value.
+
+ echo $ac_n "checking for gettimeofday in -lbsd""... $ac_c" 1>&6
+echo "configure:5678: checking for gettimeofday in -lbsd" >&5
+ac_lib_var=`echo bsd'_'gettimeofday | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lbsd $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 5686 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char gettimeofday();
+
+int main() {
+gettimeofday()
+; return 0; }
+EOF
+if { (eval echo configure:5697: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ libbsd=yes
+else
+ echo "$ac_t""no" 1>&6
+libbsd=no
+fi
+
+ if test $libbsd = yes; then
+ MATH_LIBS="$MATH_LIBS -lbsd"
+ cat >> confdefs.h <<\EOF
+#define USE_DELTA_FOR_TZ 1
+EOF
+
+ fi
+
+ # Check to enable 64-bit flags for compiler/linker
+ if test "$do64bit" = "yes" ; then
+ if test "$GCC" = "yes" ; then
+ echo "configure: warning: "64bit mode not supported with GCC on $system"" 1>&2
+ else
+ do64bit_ok=yes
+ EXTRA_CFLAGS="-q64"
+ LDFLAGS="-q64"
+ fi
+ fi
;;
BSD/OS-2.1*|BSD/OS-3*)
SHLIB_CFLAGS=""
@@ -5128,6 +5741,7 @@ fi
DL_OBJS="tclLoadDl.o"
DL_LIBS="-ldl"
LDFLAGS=""
+ CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
;;
BSD/OS-4.*)
@@ -5138,6 +5752,7 @@ fi
DL_OBJS="tclLoadDl.o"
DL_LIBS="-ldl"
LDFLAGS="-export-dynamic"
+ CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
;;
dgux*)
@@ -5148,12 +5763,100 @@ fi
DL_OBJS="tclLoadDl.o"
DL_LIBS="-ldl"
LDFLAGS=""
+ CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
;;
- HP-UX-*.08.*|HP-UX-*.09.*|HP-UX-*.10.*|HP-UX-*.11.*)
+ HP-UX-*.11.*)
+ # Use updated header definitions where possible
+ cat >> confdefs.h <<\EOF
+#define _XOPEN_SOURCE_EXTENDED 1
+EOF
+
+
+ SHLIB_SUFFIX=".sl"
+ echo $ac_n "checking for shl_load in -ldld""... $ac_c" 1>&6
+echo "configure:5779: checking for shl_load in -ldld" >&5
+ac_lib_var=`echo dld'_'shl_load | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-ldld $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 5787 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char shl_load();
+
+int main() {
+shl_load()
+; return 0; }
+EOF
+if { (eval echo configure:5798: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ tcl_ok=yes
+else
+ echo "$ac_t""no" 1>&6
+tcl_ok=no
+fi
+
+ if test "$tcl_ok" = yes; then
+ SHLIB_CFLAGS="+z"
+ SHLIB_LD="ld -b"
+ SHLIB_LD_LIBS='${LIBS}'
+ DL_OBJS="tclLoadShl.o"
+ DL_LIBS="-ldld"
+ LDFLAGS="-Wl,-E"
+ CC_SEARCH_FLAGS='-Wl,+s,+b,${LIB_RUNTIME_DIR}:.'
+ LD_SEARCH_FLAGS='+s +b ${LIB_RUNTIME_DIR}:.'
+ LD_LIBRARY_PATH_VAR="SHLIB_PATH"
+ fi
+
+ # Users may want PA-RISC 1.1/2.0 portable code - needs HP cc
+ #EXTRA_CFLAGS="+DAportable"
+
+ # Check to enable 64-bit flags for compiler/linker
+ if test "$do64bit" = "yes" ; then
+ if test "$GCC" = "yes" ; then
+ hpux_arch='`gcc -dumpmachine`'
+ case $hpux_arch in
+ hppa64*)
+ # 64-bit gcc in use. Fix flags for GNU ld.
+ do64bit_ok=yes
+ SHLIB_LD="gcc -shared"
+ SHLIB_LD_LIBS=""
+ LD_SEARCH_FLAGS=''
+ ;;
+ *)
+ echo "configure: warning: "64bit mode not supported with GCC on $system"" 1>&2
+ ;;
+ esac
+ else
+ do64bit_ok=yes
+ EXTRA_CFLAGS="+DA2.0W"
+ LDFLAGS="+DA2.0W $LDFLAGS"
+ fi
+ fi
+ ;;
+ HP-UX-*.08.*|HP-UX-*.09.*|HP-UX-*.10.*)
SHLIB_SUFFIX=".sl"
echo $ac_n "checking for shl_load in -ldld""... $ac_c" 1>&6
-echo "configure:5157: checking for shl_load in -ldld" >&5
+echo "configure:5860: checking for shl_load in -ldld" >&5
ac_lib_var=`echo dld'_'shl_load | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
@@ -5161,7 +5864,7 @@ else
ac_save_LIBS="$LIBS"
LIBS="-ldld $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 5165 "configure"
+#line 5868 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
@@ -5172,7 +5875,7 @@ int main() {
shl_load()
; return 0; }
EOF
-if { (eval echo configure:5176: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:5879: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
@@ -5200,7 +5903,9 @@ fi
DL_OBJS="tclLoadShl.o"
DL_LIBS="-ldld"
LDFLAGS="-Wl,-E"
- LD_SEARCH_FLAGS='-Wl,+s,+b,${LIB_RUNTIME_DIR}:.'
+ CC_SEARCH_FLAGS='-Wl,+s,+b,${LIB_RUNTIME_DIR}:.'
+ LD_SEARCH_FLAGS='+s +b ${LIB_RUNTIME_DIR}:.'
+ LD_LIBRARY_PATH_VAR="SHLIB_PATH"
fi
;;
IRIX-4.*)
@@ -5211,18 +5916,32 @@ fi
DL_OBJS="tclLoadAout.o"
DL_LIBS=""
LDFLAGS="-Wl,-D,08000000"
- LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ CC_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
SHARED_LIB_SUFFIX='${VERSION}\$\{DBGX\}.a'
;;
- IRIX-5.*|IRIX-6.*|IRIX64-6.5*)
+ IRIX-5.*)
+ SHLIB_CFLAGS=""
+ SHLIB_LD="ld -shared -rdata_shared"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS=""
+ CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}'
+ EXTRA_CFLAGS=""
+ LDFLAGS=""
+ ;;
+ IRIX-6.*|IRIX64-6.5*)
SHLIB_CFLAGS=""
SHLIB_LD="ld -n32 -shared -rdata_shared"
SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
- LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
- if test "$using_gcc" = "yes" ; then
+ CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}'
+ if test "$GCC" = "yes" ; then
EXTRA_CFLAGS="-mabi=n32"
LDFLAGS="-mabi=n32"
else
@@ -5240,13 +5959,28 @@ fi
;;
IRIX64-6.*)
SHLIB_CFLAGS=""
- SHLIB_LD="ld -32 -shared -rdata_shared"
+ SHLIB_LD="ld -n32 -shared -rdata_shared"
SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
LDFLAGS=""
- LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}'
+
+ # Check to enable 64-bit flags for compiler/linker
+
+ if test "$do64bit" = "yes" ; then
+ if test "$GCC" = "yes" ; then
+ echo "configure: warning: 64bit mode not supported by gcc" 1>&2
+ else
+ do64bit_ok=yes
+ SHLIB_LD="ld -64 -shared -rdata_shared"
+ EXTRA_CFLAGS="-64"
+ LDFLAGS="-64"
+ fi
+ fi
+
;;
Linux*)
SHLIB_CFLAGS="-fPIC"
@@ -5264,21 +5998,22 @@ fi
DL_OBJS="tclLoadDl.o"
DL_LIBS="-ldl"
LDFLAGS="-rdynamic"
- LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
else
ac_safe=`echo "dld.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for dld.h""... $ac_c" 1>&6
-echo "configure:5272: checking for dld.h" >&5
+echo "configure:6007: checking for dld.h" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 5277 "configure"
+#line 6012 "configure"
#include "confdefs.h"
#include <dld.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:5282: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:6017: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
@@ -5299,6 +6034,76 @@ if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
DL_OBJS="tclLoadDld.o"
DL_LIBS="-ldld"
LDFLAGS=""
+ CC_SEARCH_FLAGS=""
+ LD_SEARCH_FLAGS=""
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ fi
+ if test "`uname -m`" = "alpha" ; then
+ EXTRA_CFLAGS="-mieee"
+ fi
+
+ # The combo of gcc + glibc has a bug related
+ # to inlining of functions like strtod(). The
+ # -fno-builtin flag should address this problem
+ # but it does not work. The -fno-inline flag
+ # is kind of overkill but it works.
+ # Disable inlining only when one of the
+ # files in compat/*.c is being linked in.
+ if test x"${LIBOBJS}" != x ; then
+ EXTRA_CFLAGS="${EXTRA_CFLAGS} -fno-inline"
+ fi
+
+ ;;
+ GNU*)
+ SHLIB_CFLAGS="-fPIC"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+
+ if test "$have_dl" = yes; then
+ SHLIB_LD="${CC} -shared"
+ DL_OBJS=""
+ DL_LIBS="-ldl"
+ LDFLAGS="-rdynamic"
+ CC_SEARCH_FLAGS=""
+ LD_SEARCH_FLAGS=""
+ else
+ ac_safe=`echo "dld.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for dld.h""... $ac_c" 1>&6
+echo "configure:6076: checking for dld.h" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 6081 "configure"
+#include "confdefs.h"
+#include <dld.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:6086: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=yes"
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+
+ SHLIB_LD="ld -shared"
+ DL_OBJS=""
+ DL_LIBS="-ldld"
+ LDFLAGS=""
+ CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
else
echo "$ac_t""no" 1>&6
@@ -5317,6 +6122,7 @@ fi
DL_OBJS="tclLoadDl.o"
DL_LIBS="-ldl"
LDFLAGS=""
+ CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
;;
MP-RAS-*)
@@ -5327,23 +6133,24 @@ fi
DL_OBJS="tclLoadDl.o"
DL_LIBS="-ldl"
LDFLAGS="-Wl,-Bexport"
+ CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
;;
NetBSD-*|FreeBSD-[1-2].*|OpenBSD-*)
# Not available on all versions: check for include file.
ac_safe=`echo "dlfcn.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for dlfcn.h""... $ac_c" 1>&6
-echo "configure:5337: checking for dlfcn.h" >&5
+echo "configure:6144: checking for dlfcn.h" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 5342 "configure"
+#line 6149 "configure"
#include "confdefs.h"
#include <dlfcn.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:5347: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:6154: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
@@ -5368,11 +6175,12 @@ if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
LDFLAGS=""
- LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}'
echo $ac_n "checking for ELF""... $ac_c" 1>&6
-echo "configure:5374: checking for ELF" >&5
+echo "configure:6182: checking for ELF" >&5
cat > conftest.$ac_ext <<EOF
-#line 5376 "configure"
+#line 6184 "configure"
#include "confdefs.h"
#ifdef __ELF__
@@ -5404,7 +6212,8 @@ else
DL_OBJS="tclLoadAout.o"
DL_LIBS=""
LDFLAGS=""
- LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ CC_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.a'
fi
@@ -5419,12 +6228,47 @@ fi
# FreeBSD 3.* and greater have ELF.
SHLIB_CFLAGS="-fPIC"
SHLIB_LD="ld -Bshareable -x"
- SHLIB_LD_LIBS=""
+ SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
LDFLAGS="-export-dynamic"
+ CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}'
+ if test "${TCL_THREADS}" = "1" ; then
+ # The -pthread needs to go in the CFLAGS, not LIBS
+ LIBS=`echo $LIBS | sed s/-pthread//`
+ EXTRA_CFLAGS="-pthread"
+ LDFLAGS="$LDFLAGS -pthread"
+ fi
+ case $system in
+ FreeBSD-3.*)
+ # FreeBSD-3 doesn't handle version numbers with dots.
+ UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.a'
+ SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.so'
+ TCL_LIB_VERSIONS_OK=nodots
+ ;;
+ esac
+ ;;
+ Rhapsody-*|Darwin-*)
+ SHLIB_CFLAGS="-fno-common"
+ SHLIB_LD="cc -dynamiclib \${LDFLAGS}"
+ TCL_SHLIB_LD_EXTRAS="-compatibility_version ${TCL_VERSION} -current_version \${VERSION} -install_name \${DYLIB_INSTALL_DIR}/\${TCL_LIB_FILE} -prebind -seg1addr 0xa000000"
+ TK_SHLIB_LD_EXTRAS="-compatibility_version ${TK_VERSION} -current_version \${VERSION} -install_name \${DYLIB_INSTALL_DIR}/\${TK_LIB_FILE} -prebind -seg1addr 0xb000000"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".dylib"
+ DL_OBJS="tclLoadDyld.o"
+ PLAT_OBJS="tclMacOSXBundle.o"
+ DL_LIBS=""
+ LDFLAGS="-prebind"
+ CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
+ CFLAGS_OPTIMIZE="-Os"
+ LD_LIBRARY_PATH_VAR="DYLD_LIBRARY_PATH"
+ # for compatibility with autoconf vers 2.13 :
+ HACK=""
+ EXTRA_CFLAGS="-DMA${HACK}C_OSX_TCL -DHAVE_CFBUNDLE -DTCL_DEFAULT_ENCODING=\\\"utf-8\\\""
+ LIBS="$LIBS -framework CoreFoundation"
;;
NEXTSTEP-*)
SHLIB_CFLAGS=""
@@ -5434,6 +6278,7 @@ fi
DL_OBJS="tclLoadNext.o"
DL_LIBS=""
LDFLAGS=""
+ CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
;;
OS/390-*)
@@ -5453,45 +6298,71 @@ EOF
DL_OBJS="tclLoadOSF.o"
DL_LIBS=""
LDFLAGS=""
+ CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
;;
OSF1-1.*)
# OSF/1 1.3 from OSF using ELF, and derivatives, including AD2
SHLIB_CFLAGS="-fPIC"
- SHLIB_LD="ld -shared"
+ if test "$SHARED_BUILD" = "1" ; then
+ SHLIB_LD="ld -shared"
+ else
+ SHLIB_LD="ld -non_shared"
+ fi
SHLIB_LD_LIBS=""
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
LDFLAGS=""
+ CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
;;
OSF1-V*)
# Digital OSF/1
SHLIB_CFLAGS=""
- SHLIB_LD='ld -shared -expect_unresolved "*"'
+ if test "$SHARED_BUILD" = "1" ; then
+ SHLIB_LD='ld -shared -expect_unresolved "*"'
+ else
+ SHLIB_LD='ld -non_shared -expect_unresolved "*"'
+ fi
SHLIB_LD_LIBS=""
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
LDFLAGS=""
- LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
- if test "$using_gcc" = "no" ; then
+ CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}'
+ if test "$GCC" != "yes" ; then
EXTRA_CFLAGS="-DHAVE_TZSET -std1"
fi
# see pthread_intro(3) for pthread support on osf1, k.furukawa
if test "${TCL_THREADS}" = "1" ; then
+ EXTRA_CFLAGS="${EXTRA_CFLAGS} -DHAVE_PTHREAD_ATTR_SETSTACKSIZE"
EXTRA_CFLAGS="${EXTRA_CFLAGS} -DTCL_THREAD_STACK_MIN=PTHREAD_STACK_MIN*64"
- if test "$using_gcc" = "no" ; then
+ LIBS=`echo $LIBS | sed s/-lpthreads//`
+ if test "$GCC" = "yes" ; then
+ LIBS="$LIBS -lpthread -lmach -lexc"
+ else
EXTRA_CFLAGS="${EXTRA_CFLAGS} -pthread"
LDFLAGS="-pthread"
- else
- LIBS=`echo $LIBS | sed s/-lpthreads//`
- LIBS="$LIBS -lpthread -lmach -lexc"
fi
fi
;;
+ QNX-6*)
+ # QNX RTP
+ # This may work for all QNX, but it was only reported for v6.
+ SHLIB_CFLAGS="-fPIC"
+ SHLIB_LD="ld -Bshareable -x"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ # dlopen is in -lc on QNX
+ DL_LIBS=""
+ LDFLAGS=""
+ CC_SEARCH_FLAGS=""
+ LD_SEARCH_FLAGS=""
+ ;;
RISCos-*)
SHLIB_CFLAGS="-G 0"
SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r -G 0"
@@ -5500,13 +6371,14 @@ EOF
DL_OBJS="tclLoadAout.o"
DL_LIBS=""
LDFLAGS="-Wl,-D,08000000"
- LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ CC_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
;;
SCO_SV-3.2*)
# Note, dlopen is available only on SCO 3.2.5 and greater. However,
# this test works, since "uname -s" was non-standard in 3.2.4 and
# below.
- if test "$using_gcc" = "yes" ; then
+ if test "$GCC" = "yes" ; then
SHLIB_CFLAGS="-fPIC -melf"
LDFLAGS="-melf -Wl,-Bexport"
else
@@ -5518,7 +6390,7 @@ EOF
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
- LDFLAGS="-belf -Wl,-Bexport"
+ CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
;;
SINIX*5.4*)
@@ -5529,6 +6401,7 @@ EOF
DL_OBJS="tclLoadDl.o"
DL_LIBS="-ldl"
LDFLAGS=""
+ CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
;;
SunOS-4*)
@@ -5539,7 +6412,8 @@ EOF
DL_OBJS="tclLoadDl.o"
DL_LIBS="-ldl"
LDFLAGS=""
- LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ CC_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
# SunOS can't handle version numbers with dots in them in library
# specs, like -ltcl7.5, so use -ltcl75 instead. Also, it
@@ -5551,8 +6425,20 @@ EOF
TCL_LIB_VERSIONS_OK=nodots
;;
SunOS-5.[0-6]*)
+
+ # Note: If _REENTRANT isn't defined, then Solaris
+ # won't define thread-safe library routines.
+
+ cat >> confdefs.h <<\EOF
+#define _REENTRANT 1
+EOF
+
+ cat >> confdefs.h <<\EOF
+#define _POSIX_PTHREAD_SEMANTICS 1
+EOF
+
+
SHLIB_CFLAGS="-KPIC"
- SHLIB_LD="/usr/ccs/bin/ld -G -z text"
# Note: need the LIBS below, otherwise Tk won't find Tcl's
# symbols when dynamically loaded into tclsh.
@@ -5562,18 +6448,40 @@ EOF
DL_OBJS="tclLoadDl.o"
DL_LIBS="-ldl"
LDFLAGS=""
- LD_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}'
+ if test "$GCC" = "yes" ; then
+ SHLIB_LD="$CC -shared"
+ CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}'
+ LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
+ else
+ SHLIB_LD="/usr/ccs/bin/ld -G -z text"
+ CC_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}'
+ LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
+ fi
;;
SunOS-5*)
+
+ # Note: If _REENTRANT isn't defined, then Solaris
+ # won't define thread-safe library routines.
+
+ cat >> confdefs.h <<\EOF
+#define _REENTRANT 1
+EOF
+
+ cat >> confdefs.h <<\EOF
+#define _POSIX_PTHREAD_SEMANTICS 1
+EOF
+
+
SHLIB_CFLAGS="-KPIC"
- SHLIB_LD="/usr/ccs/bin/ld -G -z text"
LDFLAGS=""
- do64bit_ok=no
+ # Check to enable 64-bit flags for compiler/linker
if test "$do64bit" = "yes" ; then
arch=`isainfo`
if test "$arch" = "sparcv9 sparc" ; then
- if test "$using_gcc" = "no" ; then
+ if test "$GCC" = "yes" ; then
+ echo "configure: warning: "64bit mode not supported with GCC on $system"" 1>&2
+ else
do64bit_ok=yes
if test "$do64bitVIS" = "yes" ; then
EXTRA_CFLAGS="-xarch=v9a"
@@ -5582,8 +6490,6 @@ EOF
EXTRA_CFLAGS="-xarch=v9"
LDFLAGS="-xarch=v9"
fi
- else
- echo "configure: warning: "64bit mode not supported with GCC on $system"" 1>&2
fi
else
echo "configure: warning: "64bit mode only supported sparcv9 system"" 1>&2
@@ -5597,9 +6503,13 @@ EOF
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS="-ldl"
- if test "$using_gcc" = "yes" ; then
- LD_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}'
+ if test "$GCC" = "yes" ; then
+ SHLIB_LD="$CC -shared"
+ CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}'
+ LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
else
+ SHLIB_LD="/usr/ccs/bin/ld -G -z text"
+ CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}'
LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}'
fi
;;
@@ -5611,8 +6521,9 @@ EOF
DL_OBJS="tclLoadAout.o"
DL_LIBS=""
LDFLAGS="-Wl,-D,08000000"
- LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
- if test "$using_gcc" = "no" ; then
+ CC_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
+ if test "$GCC" != "yes" ; then
EXTRA_CFLAGS="-DHAVE_TZSET -std1"
fi
;;
@@ -5627,17 +6538,17 @@ EOF
# that don't grok the -Bexport option. Test that it does.
hold_ldflags=$LDFLAGS
echo $ac_n "checking for ld accepts -Bexport flag""... $ac_c" 1>&6
-echo "configure:5631: checking for ld accepts -Bexport flag" >&5
+echo "configure:6542: checking for ld accepts -Bexport flag" >&5
LDFLAGS="${LDFLAGS} -Wl,-Bexport"
cat > conftest.$ac_ext <<EOF
-#line 5634 "configure"
+#line 6545 "configure"
#include "confdefs.h"
int main() {
int i;
; return 0; }
EOF
-if { (eval echo configure:5641: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:6552: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
found=yes
else
@@ -5654,6 +6565,7 @@ rm -f conftest*
else
LDFLAGS=""
fi
+ CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
;;
esac
@@ -5683,9 +6595,9 @@ rm -f conftest*
if test "x$DL_OBJS" = "xtclLoadAout.o" ; then
echo $ac_n "checking sys/exec.h""... $ac_c" 1>&6
-echo "configure:5687: checking sys/exec.h" >&5
+echo "configure:6599: checking sys/exec.h" >&5
cat > conftest.$ac_ext <<EOF
-#line 5689 "configure"
+#line 6601 "configure"
#include "confdefs.h"
#include <sys/exec.h>
int main() {
@@ -5703,7 +6615,7 @@ int main() {
; return 0; }
EOF
-if { (eval echo configure:5707: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:6619: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
tcl_ok=usable
else
@@ -5721,9 +6633,9 @@ EOF
else
echo $ac_n "checking a.out.h""... $ac_c" 1>&6
-echo "configure:5725: checking a.out.h" >&5
+echo "configure:6637: checking a.out.h" >&5
cat > conftest.$ac_ext <<EOF
-#line 5727 "configure"
+#line 6639 "configure"
#include "confdefs.h"
#include <a.out.h>
int main() {
@@ -5741,7 +6653,7 @@ int main() {
; return 0; }
EOF
-if { (eval echo configure:5745: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:6657: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
tcl_ok=usable
else
@@ -5759,9 +6671,9 @@ EOF
else
echo $ac_n "checking sys/exec_aout.h""... $ac_c" 1>&6
-echo "configure:5763: checking sys/exec_aout.h" >&5
+echo "configure:6675: checking sys/exec_aout.h" >&5
cat > conftest.$ac_ext <<EOF
-#line 5765 "configure"
+#line 6677 "configure"
#include "confdefs.h"
#include <sys/exec_aout.h>
int main() {
@@ -5779,7 +6691,7 @@ int main() {
; return 0; }
EOF
-if { (eval echo configure:5783: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:6695: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
tcl_ok=usable
else
@@ -5827,6 +6739,7 @@ fi
DL_OBJS="tclLoadNone.o"
DL_LIBS=""
LDFLAGS=""
+ CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
BUILD_DLTEST=""
fi
@@ -5836,7 +6749,7 @@ fi
# standard manufacturer compiler.
if test "$DL_OBJS" != "tclLoadNone.o" ; then
- if test "$using_gcc" = "yes" ; then
+ if test "$GCC" = "yes" ; then
case $system in
AIX-*)
;;
@@ -5846,6 +6759,8 @@ fi
;;
NetBSD-*|FreeBSD-*|OpenBSD-*)
;;
+ Rhapsody-*|Darwin-*)
+ ;;
RISCos-*)
;;
SCO_SV-3.2*)
@@ -5866,11 +6781,62 @@ fi
UNSHARED_LIB_SUFFIX='${VERSION}\$\{DBGX\}.a'
fi
-# CYGNUS LOCAL
- TCL_LIB_SUFFIX=.a
-# END CYGNUS LOCAL
+ if test "${SHARED_BUILD}" = "1" && test "${SHLIB_SUFFIX}" != "" ; then
+ LIB_SUFFIX=${SHARED_LIB_SUFFIX}
+ MAKE_LIB='${SHLIB_LD} -o $@ ${SHLIB_LD_FLAGS} ${OBJS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}'
+ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) $(LIB_INSTALL_DIR)/$(LIB_FILE)'
+ else
+ LIB_SUFFIX=${UNSHARED_LIB_SUFFIX}
+
+ if test "$RANLIB" = "" ; then
+ MAKE_LIB='$(STLIB_LD) $@ ${OBJS}'
+ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) $(LIB_INSTALL_DIR)/$(LIB_FILE)'
+ else
+ MAKE_LIB='${STLIB_LD} $@ ${OBJS} ; ${RANLIB} $@'
+ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) $(LIB_INSTALL_DIR)/$(LIB_FILE) ; (cd $(LIB_INSTALL_DIR) ; $(RANLIB) $(LIB_FILE))'
+ fi
+
+ fi
+
+
+ # Stub lib does not depend on shared/static configuration
+ if test "$RANLIB" = "" ; then
+ MAKE_STUB_LIB='${STLIB_LD} $@ ${STUB_LIB_OBJS}'
+ INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) $(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)'
+ else
+ MAKE_STUB_LIB='${STLIB_LD} $@ ${STUB_LIB_OBJS} ; ${RANLIB} $@'
+ INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) $(LIB_INSTALL_DIR)/$(STUB_LIB_FILE) ; (cd $(LIB_INSTALL_DIR) ; $(RANLIB) $(STUB_LIB_FILE))'
+ fi
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
@@ -5879,7 +6845,7 @@ fi
echo $ac_n "checking for build with symbols""... $ac_c" 1>&6
-echo "configure:5883: checking for build with symbols" >&5
+echo "configure:6849: checking for build with symbols" >&5
# Check whether --enable-symbols or --disable-symbols was given.
if test "${enable_symbols+set}" = set; then
enableval="$enable_symbols"
@@ -5888,6 +6854,7 @@ else
tcl_ok=no
fi
+# FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT.
if test "$tcl_ok" = "yes"; then
CFLAGS_DEFAULT='$(CFLAGS_DEBUG)'
LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)'
@@ -5899,6 +6866,28 @@ fi
DBGX=""
echo "$ac_t""no" 1>&6
fi
+
+
+
+
+ echo $ac_n "checking for build with memory debugging""... $ac_c" 1>&6
+echo "configure:6875: checking for build with memory debugging" >&5
+ # Check whether --enable-memdebug or --disable-memdebug was given.
+if test "${enable_memdebug+set}" = set; then
+ enableval="$enable_memdebug"
+ tcl_ok=$enableval
+else
+ tcl_ok=no
+fi
+
+ if test "$tcl_ok" = "yes"; then
+ MEM_DEBUG_FLAGS=-DTCL_MEM_DEBUG
+ echo "$ac_t""yes" 1>&6
+ else
+ MEM_DEBUG_FLAGS=""
+ echo "$ac_t""no" 1>&6
+ fi
+
TCL_DBGX=${DBGX}
@@ -5915,17 +6904,17 @@ TCL_DBGX=${DBGX}
do
ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
-echo "configure:5919: checking for $ac_hdr" >&5
+echo "configure:6908: checking for $ac_hdr" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 5924 "configure"
+#line 6913 "configure"
#include "confdefs.h"
#include <$ac_hdr>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:5929: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:6918: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
@@ -5955,17 +6944,17 @@ done
do
ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
-echo "configure:5959: checking for $ac_hdr" >&5
+echo "configure:6948: checking for $ac_hdr" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 5964 "configure"
+#line 6953 "configure"
#include "confdefs.h"
#include <$ac_hdr>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:5969: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:6958: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
@@ -5992,7 +6981,7 @@ fi
done
echo $ac_n "checking FIONBIO vs. O_NONBLOCK for nonblocking I/O""... $ac_c" 1>&6
-echo "configure:5996: checking FIONBIO vs. O_NONBLOCK for nonblocking I/O" >&5
+echo "configure:6985: checking FIONBIO vs. O_NONBLOCK for nonblocking I/O" >&5
if test -f /usr/lib/NextStep/software_version; then
system=NEXTSTEP-`awk '/3/,/3/' /usr/lib/NextStep/software_version`
else
@@ -6051,339 +7040,79 @@ EOF
TCL_UNSHARED_LIB_SUFFIX=${UNSHARED_LIB_SUFFIX}
TCL_SHARED_LIB_SUFFIX=${SHARED_LIB_SUFFIX}
+eval "TCL_LIB_FILE=libtcl${LIB_SUFFIX}"
- echo $ac_n "checking how to build libraries""... $ac_c" 1>&6
-echo "configure:6058: checking how to build libraries" >&5
- # Check whether --enable-shared or --disable-shared was given.
-if test "${enable_shared+set}" = set; then
- enableval="$enable_shared"
+ echo $ac_n "checking how to package libraries""... $ac_c" 1>&6
+echo "configure:7048: checking how to package libraries" >&5
+ # Check whether --enable-framework or --disable-framework was given.
+if test "${enable_framework+set}" = set; then
+ enableval="$enable_framework"
tcl_ok=$enableval
else
tcl_ok=no
fi
- if test "${enable_shared+set}" = set; then
- enableval="$enable_shared"
+ if test "${enable_framework+set}" = set; then
+ enableval="$enable_framework"
tcl_ok=$enableval
else
tcl_ok=no
fi
if test "$tcl_ok" = "yes" ; then
- echo "$ac_t""shared" 1>&6
- SHARED_BUILD=1
- else
- echo "$ac_t""static" 1>&6
- SHARED_BUILD=0
- cat >> confdefs.h <<\EOF
-#define STATIC_BUILD 1
-EOF
-
- fi
-
-
-if test "${SHARED_BUILD}" = "1" -a "${SHLIB_SUFFIX}" != "" ; then
- TCL_SHLIB_CFLAGS="${SHLIB_CFLAGS}"
- TCL_LD_SEARCH_FLAGS="${LD_SEARCH_FLAGS}"
-
- libname=tcl
- suffix=${TCL_SHARED_LIB_SUFFIX}
-
- case "${host}" in
- *windows32* | *mingw32* | *cygwin*)
- eval "long_libname=\"${TCL_VENDOR_PREFIX}${libname}${suffix}\""
- ;;
- *)
- eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
- ;;
- esac
-
- eval "long_libname=${long_libname}"
-
- # Trick to replace DBGX with TCL_DBGX
- DBGX='${TCL_DBGX}'
- eval "long_libname=${long_libname}"
-
- TCL_LIB_FILE=$long_libname
-
-
- # FIXME: Why does MAKE_LIB not use a generic LIB_FILE variable
- # that is replaced with the Makefiles specific stub lib name?
- if test "x$DL_OBJS" = "xtclLoadAout.o"; then
- MAKE_LIB="\${STLIB_LD} \${TCL_LIB_FILE} \${OBJS}"
+ echo "$ac_t""framework" 1>&6
+ FRAMEWORK_BUILD=1
+ if test "${SHARED_BUILD}" = "0" ; then
+ echo "configure: warning: "Frameworks can only be built if --enable-shared is yes"" 1>&2
+ FRAMEWORK_BUILD=0
+ fi
else
- MAKE_LIB="\${SHLIB_LD} -o \${TCL_LIB_FILE} \${OBJS} ${SHLIB_LD_LIBS}"
- RANLIB=":"
+ echo "$ac_t""standard shared library" 1>&6
+ FRAMEWORK_BUILD=0
fi
-else
- case $system in
- BSD/OS*)
- ;;
-
- AIX-*)
- ;;
- *)
- SHLIB_LD_LIBS=""
- ;;
- esac
- TCL_SHLIB_CFLAGS=""
- TCL_LD_SEARCH_FLAGS="${LD_SEARCH_FLAGS}"
-
- libname=tcl
- suffix=${TCL_UNSHARED_LIB_SUFFIX}
-
- case "${host}" in
- *windows32* | *mingw32*)
- if test "$GCC" != yes; then
- eval "long_libname=\"${TCL_VENDOR_PREFIX}${libname}${suffix}\""
- else
- eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
- fi
- ;;
- *)
- eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
- ;;
- esac
-
- eval "long_libname=${long_libname}"
- # Trick to replace DBGX with TCL_DBGX
- DBGX='${TCL_DBGX}'
- eval "long_libname=${long_libname}"
+# tclConfig.sh needs a version of the _LIB_SUFFIX that has been eval'ed
+# so that the backslashes quoting the DBX braces are dropped.
- TCL_LIB_FILE=$long_libname
-
- MAKE_LIB="\${STLIB_LD} \${TCL_LIB_FILE} \${OBJS}"
-fi
+# Trick to replace DBGX with TCL_DBGX
+DBGX='${TCL_DBGX}'
+eval "TCL_LIB_FILE=${TCL_LIB_FILE}"
# Note: in the following variable, it's important to use the absolute
# path name of the Tcl directory rather than "..": this is because
# AIX remembers this path and will attempt to use it at run-time to look
# up the Tcl library.
-if test "$SHARED_BUILD" = "0" -o $TCL_NEEDS_EXP_FILE = 0; then
-
- libname=tcl
- version=$TCL_VERSION
-
- if test "$TCL_LIB_SUFFIX" = "" ; then
- { echo "configure: error: The TCL_LIB_SUFFIX variable is not defined" 1>&2; exit 1; }
- fi
-
- # If the . character is not allowed in lib name, remove it from version
- if test "${TCL_LIB_VERSIONS_OK}" != "ok"; then
- version=`echo $version | tr -d .`
- fi
-
- case "${host}" in
- *windows32* | *mingw32*)
- if test "$GCC" != yes; then
- eval "short_libname=\"${TCL_VENDOR_PREFIX}${libname}${version}${TCL_LIB_SUFFIX}\""
- else
- short_libname="-l${TCL_VENDOR_PREFIX}${libname}${version}${TCL_DBGX}"
- fi
- ;;
- *)
- short_libname="-l${TCL_VENDOR_PREFIX}${libname}${version}\${TCL_DBGX}"
- ;;
- esac
-
- TCL_LIB_FLAG=$short_libname
-
-
- case "${host}" in
- *windows32* | *mingw32*)
- if test "$GCC" != yes; then
-
- val="`pwd`/${TCL_LIB_FLAG}"
-
- if test "$val" = "" ; then
- { echo "configure: error: Empty value for variable TCL_BUILD_LIB_SPEC" 1>&2; exit 1; }
- fi
-
- case "${host}" in
- *windows32* | *mingw32*)
- if test "${CYGPATH}" = ""; then
- { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
- elif test "${CYGPATH}" = "echo"; then
- # No cygpath when cross compiling
- TCL_BUILD_LIB_SPEC=$val
- else
- # store literal argument text in a variable
- val=$val
- # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
- val="`${CYGPATH} $val`"
- # Convert path like C:\Tmp\foo to C:/Tmp/foo
- TCL_BUILD_LIB_SPEC="`echo $val | sed -e s#\\\\\\\\#/#g`"
- fi
- ;;
- *)
- # Default to a no-op under Unix or Cygwin gcc
- TCL_BUILD_LIB_SPEC=$val
- ;;
- esac
-
- else
-
- val=`pwd`
-
- if test "$val" = "" ; then
- { echo "configure: error: Empty value for variable dirname" 1>&2; exit 1; }
- fi
-
- case "${host}" in
- *windows32* | *mingw32*)
- if test "${CYGPATH}" = ""; then
- { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
- elif test "${CYGPATH}" = "echo"; then
- # No cygpath when cross compiling
- dirname=$val
- else
- # store literal argument text in a variable
- val=$val
- # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
- val="`${CYGPATH} $val`"
- # Convert path like C:\Tmp\foo to C:/Tmp/foo
- dirname="`echo $val | sed -e s#\\\\\\\\#/#g`"
- fi
- ;;
- *)
- # Default to a no-op under Unix or Cygwin gcc
- dirname=$val
- ;;
- esac
-
- TCL_BUILD_LIB_SPEC="-L${dirname} ${TCL_LIB_FLAG}"
- fi
- ;;
- *)
- TCL_BUILD_LIB_SPEC="-L`pwd` ${TCL_LIB_FLAG}"
- ;;
- esac
-
-
- case "${host}" in
- *windows32* | *mingw32*)
- if test "$GCC" != yes; then
-
- val="${exec_prefix}/lib/${TCL_LIB_FLAG}"
-
- if test "$val" = "" ; then
- { echo "configure: error: Empty value for variable TCL_LIB_SPEC" 1>&2; exit 1; }
- fi
-
- case "${host}" in
- *windows32* | *mingw32*)
- if test "${CYGPATH}" = ""; then
- { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
- elif test "${CYGPATH}" = "echo"; then
- # No cygpath when cross compiling
- TCL_LIB_SPEC=$val
- else
- # store literal argument text in a variable
- val=$val
- # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
- val="`${CYGPATH} $val`"
- # Convert path like C:\Tmp\foo to C:/Tmp/foo
- TCL_LIB_SPEC="`echo $val | sed -e s#\\\\\\\\#/#g`"
- fi
- ;;
- *)
- # Default to a no-op under Unix or Cygwin gcc
- TCL_LIB_SPEC=$val
- ;;
- esac
-
- else
-
- val=${exec_prefix}/lib
-
- if test "$val" = "" ; then
- { echo "configure: error: Empty value for variable dirname" 1>&2; exit 1; }
- fi
-
- case "${host}" in
- *windows32* | *mingw32*)
- if test "${CYGPATH}" = ""; then
- { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
- elif test "${CYGPATH}" = "echo"; then
- # No cygpath when cross compiling
- dirname=$val
- else
- # store literal argument text in a variable
- val=$val
- # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
- val="`${CYGPATH} $val`"
- # Convert path like C:\Tmp\foo to C:/Tmp/foo
- dirname="`echo $val | sed -e s#\\\\\\\\#/#g`"
- fi
- ;;
- *)
- # Default to a no-op under Unix or Cygwin gcc
- dirname=$val
- ;;
- esac
-
- TCL_LIB_SPEC="-L${dirname} ${TCL_LIB_FLAG}"
- fi
- ;;
- *)
- TCL_LIB_SPEC="-L${exec_prefix}/lib ${TCL_LIB_FLAG}"
- ;;
- esac
-
+if test "$FRAMEWORK_BUILD" = "1" ; then
+ TCL_BUILD_LIB_SPEC="-F`pwd` -framework Tcl"
+ TCL_LIB_SPEC="-framework Tcl"
+ TCL_LIB_FILE="Tcl"
+elif test "$SHARED_BUILD" = "0" || test "$TCL_NEEDS_EXP_FILE" = "0"; then
+ if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then
+ TCL_LIB_FLAG="-ltcl${TCL_VERSION}\${TCL_DBGX}"
+ else
+ TCL_LIB_FLAG="-ltcl`echo ${TCL_VERSION} | tr -d .`\${TCL_DBGX}"
+ fi
+ TCL_BUILD_LIB_SPEC="-L`pwd` ${TCL_LIB_FLAG}"
+ TCL_LIB_SPEC="-L${libdir} ${TCL_LIB_FLAG}"
else
- # FIXME: This if branch needs to be updated with respect
- # to the library macro changes above!
TCL_BUILD_EXP_FILE="lib.exp"
eval "TCL_EXP_FILE=libtcl${TCL_EXPORT_FILE_SUFFIX}"
# Replace DBGX with TCL_DBGX
eval "TCL_EXP_FILE=\"${TCL_EXP_FILE}\""
- if test "$using_gcc" = "yes" ; then
+ if test "$GCC" = "yes" ; then
TCL_BUILD_LIB_SPEC="-Wl,-bI:`pwd`/${TCL_BUILD_EXP_FILE} -L`pwd`"
- TCL_LIB_SPEC="-Wl,-bI:${exec_prefix}/lib/${TCL_EXP_FILE} -L`pwd`"
+ TCL_LIB_SPEC="-Wl,-bI:${libdir}/${TCL_EXP_FILE} -L`pwd`"
else
TCL_BUILD_LIB_SPEC="-bI:`pwd`/${TCL_BUILD_EXP_FILE}"
- TCL_LIB_SPEC="-bI:${exec_prefix}/lib/${TCL_EXP_FILE}"
+ TCL_LIB_SPEC="-bI:${libdir}/${TCL_EXP_FILE}"
fi
fi
-
-
- val="`pwd`/${TCL_LIB_FILE}"
-
- if test "$val" = "" ; then
- { echo "configure: error: Empty value for variable TCL_LIB_FULL_PATH" 1>&2; exit 1; }
- fi
-
- case "${host}" in
- *windows32* | *mingw32*)
- if test "${CYGPATH}" = ""; then
- { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
- elif test "${CYGPATH}" = "echo"; then
- # No cygpath when cross compiling
- TCL_LIB_FULL_PATH=$val
- else
- # store literal argument text in a variable
- val=$val
- # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
- val="`${CYGPATH} $val`"
- # Convert path like C:\Tmp\foo to C:/Tmp/foo
- TCL_LIB_FULL_PATH="`echo $val | sed -e s#\\\\\\\\#/#g`"
- fi
- ;;
- *)
- # Default to a no-op under Unix or Cygwin gcc
- TCL_LIB_FULL_PATH=$val
- ;;
- esac
-
-
-
VERSION='${VERSION}'
eval "CFG_TCL_SHARED_LIB_SUFFIX=${TCL_SHARED_LIB_SUFFIX}"
eval "CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX}"
@@ -6397,279 +7126,37 @@ VERSION=${TCL_VERSION}
# another for platform-independent scripts.
#--------------------------------------------------------------------
-if test "$prefix" != "$exec_prefix"; then
- TCL_PACKAGE_PATH="${exec_prefix}/lib ${prefix}/lib"
+if test "$FRAMEWORK_BUILD" = "1" ; then
+ TCL_PACKAGE_PATH="${libdir}/Resources/Scripts"
+elif test "$prefix" != "$exec_prefix"; then
+ TCL_PACKAGE_PATH="${libdir} ${prefix}/lib"
else
TCL_PACKAGE_PATH="${prefix}/lib"
fi
#--------------------------------------------------------------------
# The statements below define various symbols relating to Tcl
-# stub support. Note that the STUB_LIB_FILE variable must
-# be set in the Makefile before running MAKE_STUB_LIB.
+# stub support.
#--------------------------------------------------------------------
-MAKE_STUB_LIB="\${STLIB_LD} \${STUB_LIB_FILE} \${STUB_LIB_OBJS}"
-
-
- libname=tclstub
- suffix=${TCL_UNSHARED_LIB_SUFFIX}
-
- case "${host}" in
- *windows32* | *mingw32*)
- if test "$GCC" != yes; then
- eval "long_libname=\"${TCL_VENDOR_PREFIX}${libname}${suffix}\""
- else
- eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
- fi
- ;;
- *)
- eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
- ;;
- esac
-
- eval "long_libname=${long_libname}"
-
- # Trick to replace DBGX with TCL_DBGX
- DBGX='${TCL_DBGX}'
- eval "long_libname=${long_libname}"
-
- TCL_STUB_LIB_FILE=$long_libname
-
-
-
- libname=tclstub
- version=$TCL_VERSION
-
- if test "$TCL_LIB_SUFFIX" = "" ; then
- { echo "configure: error: The TCL_LIB_SUFFIX variable is not defined" 1>&2; exit 1; }
- fi
-
- # If the . character is not allowed in lib name, remove it from version
- if test "${TCL_LIB_VERSIONS_OK}" != "ok"; then
- version=`echo $version | tr -d .`
- fi
-
- case "${host}" in
- *windows32* | *mingw32*)
- if test "$GCC" != yes; then
- eval "short_libname=\"${TCL_VENDOR_PREFIX}${libname}${version}${TCL_LIB_SUFFIX}\""
- else
- short_libname="-l${TCL_VENDOR_PREFIX}${libname}${version}${TCL_DBGX}"
- fi
- ;;
- *)
- short_libname="-l${TCL_VENDOR_PREFIX}${libname}${version}\${TCL_DBGX}"
- ;;
- esac
-
- TCL_STUB_LIB_FLAG=$short_libname
-
-
- case "${host}" in
- *windows32* | *mingw32*)
- if test "$GCC" != yes; then
-
- val="`pwd`/${TCL_STUB_LIB_FLAG}"
-
- if test "$val" = "" ; then
- { echo "configure: error: Empty value for variable TCL_BUILD_STUB_LIB_SPEC" 1>&2; exit 1; }
- fi
-
- case "${host}" in
- *windows32* | *mingw32*)
- if test "${CYGPATH}" = ""; then
- { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
- elif test "${CYGPATH}" = "echo"; then
- # No cygpath when cross compiling
- TCL_BUILD_STUB_LIB_SPEC=$val
- else
- # store literal argument text in a variable
- val=$val
- # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
- val="`${CYGPATH} $val`"
- # Convert path like C:\Tmp\foo to C:/Tmp/foo
- TCL_BUILD_STUB_LIB_SPEC="`echo $val | sed -e s#\\\\\\\\#/#g`"
- fi
- ;;
- *)
- # Default to a no-op under Unix or Cygwin gcc
- TCL_BUILD_STUB_LIB_SPEC=$val
- ;;
- esac
-
- else
-
- val=`pwd`
-
- if test "$val" = "" ; then
- { echo "configure: error: Empty value for variable dirname" 1>&2; exit 1; }
- fi
-
- case "${host}" in
- *windows32* | *mingw32*)
- if test "${CYGPATH}" = ""; then
- { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
- elif test "${CYGPATH}" = "echo"; then
- # No cygpath when cross compiling
- dirname=$val
- else
- # store literal argument text in a variable
- val=$val
- # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
- val="`${CYGPATH} $val`"
- # Convert path like C:\Tmp\foo to C:/Tmp/foo
- dirname="`echo $val | sed -e s#\\\\\\\\#/#g`"
- fi
- ;;
- *)
- # Default to a no-op under Unix or Cygwin gcc
- dirname=$val
- ;;
- esac
-
- TCL_BUILD_STUB_LIB_SPEC="-L${dirname} ${TCL_STUB_LIB_FLAG}"
- fi
- ;;
- *)
- TCL_BUILD_STUB_LIB_SPEC="-L`pwd` ${TCL_STUB_LIB_FLAG}"
- ;;
- esac
-
-
- case "${host}" in
- *windows32* | *mingw32*)
- if test "$GCC" != yes; then
-
- val="${exec_prefix}/lib/${TCL_STUB_LIB_FLAG}"
+# Replace ${VERSION} with contents of ${TCL_VERSION}
+eval "TCL_STUB_LIB_FILE=libtclstub${TCL_UNSHARED_LIB_SUFFIX}"
+# Replace DBGX with TCL_DBGX
+eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\""
- if test "$val" = "" ; then
- { echo "configure: error: Empty value for variable TCL_STUB_LIB_SPEC" 1>&2; exit 1; }
- fi
-
- case "${host}" in
- *windows32* | *mingw32*)
- if test "${CYGPATH}" = ""; then
- { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
- elif test "${CYGPATH}" = "echo"; then
- # No cygpath when cross compiling
- TCL_STUB_LIB_SPEC=$val
- else
- # store literal argument text in a variable
- val=$val
- # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
- val="`${CYGPATH} $val`"
- # Convert path like C:\Tmp\foo to C:/Tmp/foo
- TCL_STUB_LIB_SPEC="`echo $val | sed -e s#\\\\\\\\#/#g`"
- fi
- ;;
- *)
- # Default to a no-op under Unix or Cygwin gcc
- TCL_STUB_LIB_SPEC=$val
- ;;
- esac
-
- else
-
- val=${exec_prefix}/lib
-
- if test "$val" = "" ; then
- { echo "configure: error: Empty value for variable dirname" 1>&2; exit 1; }
- fi
-
- case "${host}" in
- *windows32* | *mingw32*)
- if test "${CYGPATH}" = ""; then
- { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
- elif test "${CYGPATH}" = "echo"; then
- # No cygpath when cross compiling
- dirname=$val
- else
- # store literal argument text in a variable
- val=$val
- # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
- val="`${CYGPATH} $val`"
- # Convert path like C:\Tmp\foo to C:/Tmp/foo
- dirname="`echo $val | sed -e s#\\\\\\\\#/#g`"
- fi
- ;;
- *)
- # Default to a no-op under Unix or Cygwin gcc
- dirname=$val
- ;;
- esac
-
- TCL_STUB_LIB_SPEC="-L${dirname} ${TCL_STUB_LIB_FLAG}"
- fi
- ;;
- *)
- TCL_STUB_LIB_SPEC="-L${exec_prefix}/lib ${TCL_STUB_LIB_FLAG}"
- ;;
- esac
-
-
-
-
- val="`pwd`/${TCL_STUB_LIB_FILE}"
-
- if test "$val" = "" ; then
- { echo "configure: error: Empty value for variable TCL_BUILD_STUB_LIB_PATH" 1>&2; exit 1; }
- fi
-
- case "${host}" in
- *windows32* | *mingw32*)
- if test "${CYGPATH}" = ""; then
- { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
- elif test "${CYGPATH}" = "echo"; then
- # No cygpath when cross compiling
- TCL_BUILD_STUB_LIB_PATH=$val
- else
- # store literal argument text in a variable
- val=$val
- # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
- val="`${CYGPATH} $val`"
- # Convert path like C:\Tmp\foo to C:/Tmp/foo
- TCL_BUILD_STUB_LIB_PATH="`echo $val | sed -e s#\\\\\\\\#/#g`"
- fi
- ;;
- *)
- # Default to a no-op under Unix or Cygwin gcc
- TCL_BUILD_STUB_LIB_PATH=$val
- ;;
- esac
-
-
-
-
- val="${exec_prefix}/lib/${TCL_STUB_LIB_FILE}"
-
- if test "$val" = "" ; then
- { echo "configure: error: Empty value for variable TCL_STUB_LIB_PATH" 1>&2; exit 1; }
- fi
-
- case "${host}" in
- *windows32* | *mingw32*)
- if test "${CYGPATH}" = ""; then
- { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
- elif test "${CYGPATH}" = "echo"; then
- # No cygpath when cross compiling
- TCL_STUB_LIB_PATH=$val
- else
- # store literal argument text in a variable
- val=$val
- # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
- val="`${CYGPATH} $val`"
- # Convert path like C:\Tmp\foo to C:/Tmp/foo
- TCL_STUB_LIB_PATH="`echo $val | sed -e s#\\\\\\\\#/#g`"
- fi
- ;;
- *)
- # Default to a no-op under Unix or Cygwin gcc
- TCL_STUB_LIB_PATH=$val
- ;;
- esac
+if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then
+ TCL_STUB_LIB_FLAG="-ltclstub${TCL_VERSION}\${TCL_DBGX}"
+else
+ TCL_STUB_LIB_FLAG="-ltclstub`echo ${TCL_VERSION} | tr -d .`\${TCL_DBGX}"
+fi
+TCL_BUILD_STUB_LIB_SPEC="-L`pwd` ${TCL_STUB_LIB_FLAG}"
+TCL_STUB_LIB_SPEC="-L${libdir} ${TCL_STUB_LIB_FLAG}"
+TCL_BUILD_STUB_LIB_PATH="`pwd`/${TCL_STUB_LIB_FILE}"
+TCL_STUB_LIB_PATH="${libdir}/${TCL_STUB_LIB_FILE}"
+# Install time header dir can be set via --includedir
+eval "TCL_INCLUDE_SPEC=\"-I${includedir}\""
#------------------------------------------------------------------------
# tclConfig.sh refers to this by a different name
@@ -6716,19 +7203,6 @@ TCL_SHARED_BUILD=${SHARED_BUILD}
-
-
-
-
-
-
-
-
-
-
-
-
-
trap '' 1 2 15
cat > confcache <<\EOF
# This file is a shell script that caches the results of configure
@@ -6840,9 +7314,8 @@ do
done
ac_given_srcdir=$srcdir
-ac_given_INSTALL="$INSTALL"
-trap 'rm -fr `echo "Makefile tclConfig.sh" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
+trap 'rm -fr `echo "Makefile dltest/Makefile tclConfig.sh" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
EOF
cat >> $CONFIG_STATUS <<EOF
@@ -6874,69 +7347,72 @@ s%@includedir@%$includedir%g
s%@oldincludedir@%$oldincludedir%g
s%@infodir@%$infodir%g
s%@mandir@%$mandir%g
+s%@MKLINKS_FLAGS@%$MKLINKS_FLAGS%g
s%@CC@%$CC%g
-s%@RANLIB@%$RANLIB%g
s%@CPP@%$CPP%g
-s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g
-s%@INSTALL_SCRIPT@%$INSTALL_SCRIPT%g
-s%@INSTALL_DATA@%$INSTALL_DATA%g
+s%@TCL_THREADS@%$TCL_THREADS%g
s%@LIBOBJS@%$LIBOBJS%g
s%@TCL_LIBS@%$TCL_LIBS%g
s%@MATH_LIBS@%$MATH_LIBS%g
s%@AR@%$AR%g
-s%@TCL_LIB_SUFFIX@%$TCL_LIB_SUFFIX%g
+s%@RANLIB@%$RANLIB%g
s%@DL_LIBS@%$DL_LIBS%g
+s%@DL_OBJS@%$DL_OBJS%g
+s%@PLAT_OBJS@%$PLAT_OBJS%g
s%@CFLAGS_DEBUG@%$CFLAGS_DEBUG%g
s%@CFLAGS_OPTIMIZE@%$CFLAGS_OPTIMIZE%g
s%@CFLAGS_WARNING@%$CFLAGS_WARNING%g
+s%@EXTRA_CFLAGS@%$EXTRA_CFLAGS%g
+s%@LDFLAGS_DEBUG@%$LDFLAGS_DEBUG%g
+s%@LDFLAGS_OPTIMIZE@%$LDFLAGS_OPTIMIZE%g
+s%@CC_SEARCH_FLAGS@%$CC_SEARCH_FLAGS%g
+s%@LD_SEARCH_FLAGS@%$LD_SEARCH_FLAGS%g
+s%@STLIB_LD@%$STLIB_LD%g
+s%@SHLIB_LD@%$SHLIB_LD%g
+s%@TCL_SHLIB_LD_EXTRAS@%$TCL_SHLIB_LD_EXTRAS%g
+s%@TK_SHLIB_LD_EXTRAS@%$TK_SHLIB_LD_EXTRAS%g
+s%@SHLIB_LD_FLAGS@%$SHLIB_LD_FLAGS%g
+s%@SHLIB_LD_LIBS@%$SHLIB_LD_LIBS%g
+s%@SHLIB_CFLAGS@%$SHLIB_CFLAGS%g
+s%@SHLIB_SUFFIX@%$SHLIB_SUFFIX%g
+s%@MAKE_LIB@%$MAKE_LIB%g
+s%@MAKE_STUB_LIB@%$MAKE_STUB_LIB%g
+s%@INSTALL_LIB@%$INSTALL_LIB%g
+s%@INSTALL_STUB_LIB@%$INSTALL_STUB_LIB%g
+s%@CFLAGS_DEFAULT@%$CFLAGS_DEFAULT%g
+s%@LDFLAGS_DEFAULT@%$LDFLAGS_DEFAULT%g
+s%@MEM_DEBUG_FLAGS@%$MEM_DEBUG_FLAGS%g
+s%@TCL_VERSION@%$TCL_VERSION%g
+s%@TCL_MAJOR_VERSION@%$TCL_MAJOR_VERSION%g
+s%@TCL_MINOR_VERSION@%$TCL_MINOR_VERSION%g
+s%@TCL_PATCH_LEVEL@%$TCL_PATCH_LEVEL%g
+s%@TCL_LIB_FILE@%$TCL_LIB_FILE%g
+s%@TCL_LIB_FLAG@%$TCL_LIB_FLAG%g
+s%@TCL_LIB_SPEC@%$TCL_LIB_SPEC%g
s%@TCL_STUB_LIB_FILE@%$TCL_STUB_LIB_FILE%g
s%@TCL_STUB_LIB_FLAG@%$TCL_STUB_LIB_FLAG%g
-s%@TCL_BUILD_STUB_LIB_SPEC@%$TCL_BUILD_STUB_LIB_SPEC%g
s%@TCL_STUB_LIB_SPEC@%$TCL_STUB_LIB_SPEC%g
-s%@TCL_BUILD_STUB_LIB_PATH@%$TCL_BUILD_STUB_LIB_PATH%g
s%@TCL_STUB_LIB_PATH@%$TCL_STUB_LIB_PATH%g
-s%@MAKE_STUB_LIB@%$MAKE_STUB_LIB%g
-s%@BUILD_DLTEST@%$BUILD_DLTEST%g
-s%@CFLAGS_DEFAULT@%$CFLAGS_DEFAULT%g
+s%@TCL_INCLUDE_SPEC@%$TCL_INCLUDE_SPEC%g
+s%@TCL_BUILD_STUB_LIB_SPEC@%$TCL_BUILD_STUB_LIB_SPEC%g
+s%@TCL_BUILD_STUB_LIB_PATH@%$TCL_BUILD_STUB_LIB_PATH%g
+s%@TCL_SRC_DIR@%$TCL_SRC_DIR%g
+s%@TCL_DBGX@%$TCL_DBGX%g
s%@CFG_TCL_SHARED_LIB_SUFFIX@%$CFG_TCL_SHARED_LIB_SUFFIX%g
s%@CFG_TCL_UNSHARED_LIB_SUFFIX@%$CFG_TCL_UNSHARED_LIB_SUFFIX%g
s%@CFG_TCL_EXPORT_FILE_SUFFIX@%$CFG_TCL_EXPORT_FILE_SUFFIX%g
-s%@TCL_DBGX@%$TCL_DBGX%g
-s%@DL_OBJS@%$DL_OBJS%g
-s%@EXTRA_CFLAGS@%$EXTRA_CFLAGS%g
-s%@LDFLAGS_DEFAULT@%$LDFLAGS_DEFAULT%g
-s%@LDFLAGS_DEBUG@%$LDFLAGS_DEBUG%g
-s%@LDFLAGS_OPTIMIZE@%$LDFLAGS_OPTIMIZE%g
-s%@MAKE_LIB@%$MAKE_LIB%g
s%@TCL_SHARED_BUILD@%$TCL_SHARED_BUILD%g
-s%@SHLIB_CFLAGS@%$SHLIB_CFLAGS%g
-s%@SHLIB_LD@%$SHLIB_LD%g
-s%@STLIB_LD@%$STLIB_LD%g
-s%@SHLIB_LD_LIBS@%$SHLIB_LD_LIBS%g
-s%@SHLIB_SUFFIX@%$SHLIB_SUFFIX%g
+s%@LD_LIBRARY_PATH_VAR@%$LD_LIBRARY_PATH_VAR%g
s%@TCL_BUILD_LIB_SPEC@%$TCL_BUILD_LIB_SPEC%g
-s%@TCL_LD_SEARCH_FLAGS@%$TCL_LD_SEARCH_FLAGS%g
-s%@TCL_LDFLAGS_DEBUG@%$TCL_LDFLAGS_DEBUG%g
-s%@TCL_LDFLAGS_OPTIMIZE@%$TCL_LDFLAGS_OPTIMIZE%g
-s%@TCL_LIB_FILE@%$TCL_LIB_FILE%g
-s%@TCL_LIB_FULL_PATH@%$TCL_LIB_FULL_PATH%g
-s%@TCL_LIB_FLAG@%$TCL_LIB_FLAG%g
s%@TCL_NEEDS_EXP_FILE@%$TCL_NEEDS_EXP_FILE%g
s%@TCL_BUILD_EXP_FILE@%$TCL_BUILD_EXP_FILE%g
s%@TCL_EXP_FILE@%$TCL_EXP_FILE%g
-s%@TCL_LIB_SPEC@%$TCL_LIB_SPEC%g
s%@TCL_LIB_VERSIONS_OK@%$TCL_LIB_VERSIONS_OK%g
-s%@TCL_MAJOR_VERSION@%$TCL_MAJOR_VERSION%g
-s%@TCL_MINOR_VERSION@%$TCL_MINOR_VERSION%g
-s%@TCL_PACKAGE_PATH@%$TCL_PACKAGE_PATH%g
-s%@TCL_PATCH_LEVEL@%$TCL_PATCH_LEVEL%g
s%@TCL_SHARED_LIB_SUFFIX@%$TCL_SHARED_LIB_SUFFIX%g
-s%@TCL_SHLIB_CFLAGS@%$TCL_SHLIB_CFLAGS%g
-s%@TCL_SRC_DIR@%$TCL_SRC_DIR%g
-s%@TCL_BIN_DIR@%$TCL_BIN_DIR%g
s%@TCL_UNSHARED_LIB_SUFFIX@%$TCL_UNSHARED_LIB_SUFFIX%g
-s%@TCL_VERSION@%$TCL_VERSION%g
-s%@VENDORPREFIX@%$VENDORPREFIX%g
+s%@TCL_HAS_LONGLONG@%$TCL_HAS_LONGLONG%g
+s%@BUILD_DLTEST@%$BUILD_DLTEST%g
+s%@TCL_PACKAGE_PATH@%$TCL_PACKAGE_PATH%g
CEOF
EOF
@@ -6978,7 +7454,7 @@ EOF
cat >> $CONFIG_STATUS <<EOF
-CONFIG_FILES=\${CONFIG_FILES-"Makefile tclConfig.sh"}
+CONFIG_FILES=\${CONFIG_FILES-"Makefile dltest/Makefile tclConfig.sh"}
EOF
cat >> $CONFIG_STATUS <<\EOF
for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
@@ -7013,10 +7489,6 @@ for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
top_srcdir="$ac_dots$ac_given_srcdir" ;;
esac
- case "$ac_given_INSTALL" in
- [/$]*) INSTALL="$ac_given_INSTALL" ;;
- *) INSTALL="$ac_dots$ac_given_INSTALL" ;;
- esac
echo creating "$ac_file"
rm -f "$ac_file"
@@ -7032,7 +7504,6 @@ for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
s%@configure_input@%$configure_input%g
s%@srcdir@%$srcdir%g
s%@top_srcdir@%$top_srcdir%g
-s%@INSTALL@%$INSTALL%g
" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file
fi; done
rm -f conftest.s*
@@ -7049,4 +7520,3 @@ chmod +x $CONFIG_STATUS
rm -fr confdefs* $ac_clean_files
test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1
-
diff --git a/tcl/unix/configure.in b/tcl/unix/configure.in
index 1572528d56a..da46dc2d3e4 100755
--- a/tcl/unix/configure.in
+++ b/tcl/unix/configure.in
@@ -2,18 +2,16 @@
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.
-
-# CYGNUS LOCAL, need 2.5 or higher for --bindir et al
-AC_PREREQ(2.5)
-# END CYGNUS LOCAL
+#
+# RCS: @(#) $Id$
AC_INIT(../generic/tcl.h)
-# RCS: @(#) $Id$
+AC_PREREQ(2.13)
-TCL_VERSION=8.3
+TCL_VERSION=8.4
TCL_MAJOR_VERSION=8
-TCL_MINOR_VERSION=3
-TCL_PATCH_LEVEL=".2"
+TCL_MINOR_VERSION=4
+TCL_PATCH_LEVEL=".0"
VERSION=${TCL_VERSION}
#------------------------------------------------------------------------
@@ -26,36 +24,28 @@ fi
if test "${exec_prefix}" = "NONE"; then
exec_prefix=$prefix
fi
+# libdir must be a fully qualified path and (not ${exec_prefix}/lib)
+eval libdir="$libdir"
TCL_SRC_DIR=`cd $srcdir/..; pwd`
#------------------------------------------------------------------------
+# Compress and/or soft link the manpages?
+#------------------------------------------------------------------------
+SC_CONFIG_MANPAGES
+
+#------------------------------------------------------------------------
# Standard compiler checks
#------------------------------------------------------------------------
-AC_PROG_CC
-AC_PROG_RANLIB
+# If the user did not set CFLAGS, set it now to keep
+# the AC_PROG_CC macro from adding "-g -O2".
+if test "${CFLAGS+set}" != "set" ; then
+ CFLAGS=""
+fi
+AC_PROG_CC
AC_HAVE_HEADERS(unistd.h limits.h)
-# CYGNUS LOCAL
-# dje/win32
-AR=${AR-ar}
-# We need this for substitutions in Makefile.in.
-AC_PROG_INSTALL
-# END CYGNUS LOCAL
-
-#--------------------------------------------------------------------
-# CYGNUS LOCAL:
-# This is for LynxOS, which needs a flag to force true POSIX when
-# building. It's weirder than that, cause the flag varies depending
-# how old the compiler is. So...
-# -X is for the old "cc" and "gcc" (based on 1.42)
-# -mposix is for the new gcc (at least 2.5.8)
-# This modifies the value of $CC to have the POSIX flag added
-# so everything will configure correctly.
-#--------------------------------------------------------------------
-CY_AC_TCL_LYNX_POSIX
-
#------------------------------------------------------------------------
# Threads support
#------------------------------------------------------------------------
@@ -80,23 +70,38 @@ fi
fi
#--------------------------------------------------------------------
+# Detect what compiler flags to set for 64-bit support.
+#--------------------------------------------------------------------
+
+SC_TCL_EARLY_FLAGS
+
+SC_TCL_64BIT_FLAGS
+
+#--------------------------------------------------------------------
+# Check endianness because we can optimize comparisons of
+# Tcl_UniChar strings to memcmp on big-endian systems.
+#--------------------------------------------------------------------
+
+AC_C_BIGENDIAN
+
+#--------------------------------------------------------------------
# Supply substitutes for missing POSIX library procedures, or
# set flags so Tcl uses alternate procedures.
#--------------------------------------------------------------------
# Check if Posix compliant getcwd exists, if not we'll use getwd.
-AC_CHECK_FUNCS(getcwd, , AC_DEFINE(USEGETWD))
+AC_CHECK_FUNCS(getcwd, , [AC_DEFINE(USEGETWD)])
# Nb: if getcwd uses popen and pwd(1) (like SunOS 4) we should really
# define USEGETWD even if the posix getcwd exists. Add a test ?
AC_REPLACE_FUNCS(opendir strstr)
-AC_REPLACE_FUNCS(strtol tmpnam waitpid)
-AC_CHECK_FUNC(strerror, , AC_DEFINE(NO_STRERROR))
-AC_CHECK_FUNC(getwd, , AC_DEFINE(NO_GETWD))
-AC_CHECK_FUNC(wait3, , AC_DEFINE(NO_WAIT3))
-AC_CHECK_FUNC(uname, , AC_DEFINE(NO_UNAME))
-AC_CHECK_FUNC(realpath, , AC_DEFINE(NO_REALPATH))
+AC_REPLACE_FUNCS(strtol strtoll strtoull tmpnam waitpid)
+AC_CHECK_FUNC(strerror, , [AC_DEFINE(NO_STRERROR)])
+AC_CHECK_FUNC(getwd, , [AC_DEFINE(NO_GETWD)])
+AC_CHECK_FUNC(wait3, , [AC_DEFINE(NO_WAIT3)])
+AC_CHECK_FUNC(uname, , [AC_DEFINE(NO_UNAME)])
+AC_CHECK_FUNC(realpath, , [AC_DEFINE(NO_REALPATH)])
#--------------------------------------------------------------------
# Supply substitutes for missing POSIX header files. Special
@@ -127,16 +132,23 @@ SC_SERIAL_PORT
# special flag.
#--------------------------------------------------------------------
-AC_MSG_CHECKING([fd_set and sys/select])
-AC_TRY_COMPILE([#include <sys/types.h>],
- [fd_set readMask, writeMask;], tk_ok=yes, tk_ok=no)
-if test $tk_ok = no; then
- AC_HEADER_EGREP(fd_mask, sys/select.h, tk_ok=yes)
- if test $tk_ok = yes; then
+AC_MSG_CHECKING([for fd_set in sys/types])
+AC_CACHE_VAL(tcl_cv_type_fd_set,
+ AC_TRY_COMPILE([#include <sys/types.h>],[fd_set readMask, writeMask;],
+ tcl_cv_type_fd_set=yes, tcl_cv_type_fd_set=no))
+AC_MSG_RESULT($tcl_cv_type_fd_set)
+tk_ok=$tcl_cv_type_fd_set
+if test $tcl_cv_type_fd_set = no; then
+ AC_MSG_CHECKING([for fd_mask in sys/select])
+ AC_CACHE_VAL(tcl_cv_grep_fd_mask,
+ AC_HEADER_EGREP(fd_mask, sys/select.h,
+ tcl_cv_grep_fd_mask=present, tcl_cv_grep_fd_mask=missing))
+ AC_MSG_RESULT($tcl_cv_grep_fd_mask)
+ if test $tcl_cv_grep_fd_mask = present; then
AC_DEFINE(HAVE_SYS_SELECT_H)
+ tk_ok=yes
fi
fi
-AC_MSG_RESULT($tk_ok)
if test $tk_ok = no; then
AC_DEFINE(NO_FD_SET)
fi
@@ -152,7 +164,7 @@ SC_TIME_HANDLER
# in struct stat. But we might be able to use fstatfs instead.
#--------------------------------------------------------------------
AC_STRUCT_ST_BLKSIZE
-AC_CHECK_FUNC(fstatfs, , AC_DEFINE(NO_FSTATFS))
+AC_CHECK_FUNC(fstatfs, , [AC_DEFINE(NO_FSTATFS)])
#--------------------------------------------------------------------
# Some system have no memcmp or it does not work with 8 bit
@@ -165,7 +177,7 @@ AC_FUNC_MEMCMP
# have no memmove (we assume they have bcopy instead).
# {The replacement define is in compat/string.h}
#--------------------------------------------------------------------
-AC_CHECK_FUNC(memmove, , AC_DEFINE(NO_MEMMOVE) AC_DEFINE(NO_STRING_H))
+AC_CHECK_FUNC(memmove, , [AC_DEFINE(NO_MEMMOVE) AC_DEFINE(NO_STRING_H)])
#--------------------------------------------------------------------
# On some systems strstr is broken: it returns a pointer even
@@ -255,6 +267,22 @@ AC_TYPE_PID_T
AC_TYPE_SIZE_T
AC_TYPE_UID_T
+AC_MSG_CHECKING([for socklen_t])
+AC_CACHE_VAL(ac_cv_type_socklen_t,[AC_EGREP_CPP(changequote(<<,>>)dnl
+<<(^|[^a-zA-Z_0-9])socklen_t[^a-zA-Z_0-9]>>dnl
+changequote([,]),[
+ #include <sys/types.h>
+ #include <sys/socket.h>
+ #if STDC_HEADERS
+ #include <stdlib.h>
+ #include <stddef.h>
+ #endif
+ ], ac_cv_type_socklen_t=yes, ac_cv_type_socklen_t=no)])
+AC_MSG_RESULT($ac_cv_type_socklen_t)
+if test $ac_cv_type_socklen_t = no; then
+ AC_DEFINE(socklen_t, unsigned)
+fi
+
#--------------------------------------------------------------------
# If a system doesn't have an opendir function (man, that's old!)
# then we have to supply a different version of dirent.h which
@@ -262,7 +290,7 @@ AC_TYPE_UID_T
# provided. This version only works with V7-style directories.
#--------------------------------------------------------------------
-AC_CHECK_FUNC(opendir, , AC_DEFINE(USE_DIRENT2_H))
+AC_CHECK_FUNC(opendir, , [AC_DEFINE(USE_DIRENT2_H)])
#--------------------------------------------------------------------
# The check below checks whether <sys/wait.h> defines the type
@@ -273,82 +301,19 @@ AC_CHECK_FUNC(opendir, , AC_DEFINE(USE_DIRENT2_H))
#--------------------------------------------------------------------
AC_MSG_CHECKING([union wait])
-AC_TRY_LINK([#include <sys/types.h>
+AC_CACHE_VAL(tcl_cv_union_wait,
+ AC_TRY_LINK([#include <sys/types.h>
#include <sys/wait.h>], [
union wait x;
WIFEXITED(x); /* Generates compiler error if WIFEXITED
* uses an int. */
-], tcl_ok=yes, tcl_ok=no)
-AC_MSG_RESULT($tcl_ok)
-if test $tcl_ok = no; then
+ ], tcl_cv_union_wait=yes, tcl_cv_union_wait=no))
+AC_MSG_RESULT($tcl_cv_union_wait)
+if test $tcl_cv_union_wait = no; then
AC_DEFINE(NO_UNION_WAIT)
fi
#--------------------------------------------------------------------
-# Check to see whether the system supports the matherr function
-# and its associated type "struct exception".
-#--------------------------------------------------------------------
-
-AC_MSG_CHECKING([matherr support])
-AC_TRY_COMPILE([#include <math.h>], [
-struct exception x;
-x.type = DOMAIN;
-x.type = SING;
-], tcl_ok=yes, tcl_ok=no)
-AC_MSG_RESULT($tcl_ok)
-if test $tcl_ok = yes; then
- AC_DEFINE(NEED_MATHERR)
-fi
-
-#--------------------------------------------------------------------
-# Check to see whether the system provides a vfork kernel call.
-# If not, then use fork instead. Also, check for a problem with
-# vforks and signals that can cause core dumps if a vforked child
-# resets a signal handler. If the problem exists, then use fork
-# instead of vfork.
-#--------------------------------------------------------------------
-
-AC_TYPE_SIGNAL()
-AC_CHECK_FUNC(vfork, tcl_ok=1, tcl_ok=0)
-if test "$tcl_ok" = 1; then
- AC_MSG_CHECKING([vfork/signal bug]);
- AC_TRY_RUN([
-#include <stdio.h>
-#include <signal.h>
-#include <sys/wait.h>
-int gotSignal = 0;
-sigProc(sig)
- int sig;
-{
- gotSignal = 1;
-}
-main()
-{
- int pid, sts;
- (void) signal(SIGCHLD, sigProc);
- pid = vfork();
- if (pid < 0) {
- exit(1);
- } else if (pid == 0) {
- (void) signal(SIGCHLD, SIG_DFL);
- _exit(0);
- } else {
- (void) wait(&sts);
- }
- exit((gotSignal) ? 0 : 1);
-}], tcl_ok=1, tcl_ok=0, tcl_ok=0)
- if test "$tcl_ok" = 1; then
- AC_MSG_RESULT(ok)
- else
- AC_MSG_RESULT([buggy, using fork instead])
- fi
-fi
-rm -f core
-if test "$tcl_ok" = 0; then
- AC_DEFINE(vfork, fork)
-fi
-
-#--------------------------------------------------------------------
# Check whether there is an strncasecmp function on this system.
# This is a bit tricky because under SCO it's in -lsocket and
# under Sequent Dynix it's in -linet.
@@ -376,13 +341,18 @@ fi
# declare it.
#--------------------------------------------------------------------
-AC_CHECK_FUNC(BSDgettimeofday, AC_DEFINE(HAVE_BSDGETTIMEOFDAY),
- AC_CHECK_FUNC(gettimeofday, , AC_DEFINE(NO_GETTOD)))
+AC_CHECK_FUNC(BSDgettimeofday,
+ [AC_DEFINE(HAVE_BSDGETTIMEOFDAY)], [
+ AC_CHECK_FUNC(gettimeofday, , [AC_DEFINE(NO_GETTOD)])
+])
AC_MSG_CHECKING([for gettimeofday declaration])
-AC_EGREP_HEADER(gettimeofday, sys/time.h, AC_MSG_RESULT(present), [
- AC_MSG_RESULT(missing)
+AC_CACHE_VAL(tcl_cv_grep_gettimeofday,
+ AC_EGREP_HEADER(gettimeofday, sys/time.h,
+ tcl_cv_grep_gettimeofday=present, tcl_cv_grep_gettimeofday=missing))
+AC_MSG_RESULT($tcl_cv_grep_gettimeofday)
+if test $tcl_cv_grep_gettimeofday = missing ; then
AC_DEFINE(GETTOD_NOT_DECLARED)
-])
+fi
#--------------------------------------------------------------------
# The following code checks to see whether it is possible to get
@@ -392,15 +362,55 @@ AC_EGREP_HEADER(gettimeofday, sys/time.h, AC_MSG_RESULT(present), [
AC_C_CHAR_UNSIGNED
AC_MSG_CHECKING([signed char declarations])
-AC_TRY_COMPILE(, [
-signed char *p;
-p = 0;
-], tcl_ok=yes, tcl_ok=no)
-AC_MSG_RESULT($tcl_ok)
-if test $tcl_ok = yes; then
+AC_CACHE_VAL(tcl_cv_char_signed,
+ AC_TRY_COMPILE(, [
+ signed char *p;
+ p = 0;
+ ], tcl_cv_char_signed=yes, tcl_cv_char_signed=no))
+AC_MSG_RESULT($tcl_cv_char_signed)
+if test $tcl_cv_char_signed = yes; then
AC_DEFINE(HAVE_SIGNED_CHAR)
fi
+#--------------------------------------------------------------------
+# Does putenv() copy or not? We need to know to avoid memory leaks.
+#--------------------------------------------------------------------
+
+AC_MSG_CHECKING([for a putenv() that copies the buffer])
+AC_CACHE_VAL(tcl_cv_putenv_copy,
+ AC_TRY_RUN([
+ #include <stdlib.h>
+ #define OURVAR "havecopy=yes"
+ int main (int argc, char *argv[])
+ {
+ char *foo, *bar;
+ foo = (char *)strdup(OURVAR);
+ putenv(foo);
+ strcpy((char *)(strchr(foo, '=') + 1), "no");
+ bar = getenv("havecopy");
+ if (!strcmp(bar, "no")) {
+ /* doesnt copy */
+ return 0;
+ } else {
+ /* does copy */
+ return 1;
+ }
+ }
+ ],
+ tcl_cv_putenv_copy=no,
+ tcl_cv_putenv_copy=yes,
+ tcl_cv_putenv_copy=no)
+)
+AC_MSG_RESULT($tcl_cv_putenv_copy)
+if test $tcl_cv_putenv_copy = yes; then
+ AC_DEFINE(HAVE_PUTENV_THAT_COPIES)
+fi
+
+#--------------------------------------------------------------------
+# Check for support of nl_langinfo function
+#--------------------------------------------------------------------
+
+SC_ENABLE_LANGINFO
#--------------------------------------------------------------------
# Look for libraries that we will need when compiling the Tcl shell
@@ -412,6 +422,8 @@ SC_TCL_LINK_LIBS
LIBS="$LIBS$THREADS_LIBS"
+SC_ENABLE_SHARED
+
#--------------------------------------------------------------------
# The statements below define a collection of compile flags. This
# macro depends on the value of SHARED_BUILD, and should be called
@@ -421,6 +433,7 @@ LIBS="$LIBS$THREADS_LIBS"
SC_CONFIG_CFLAGS
SC_ENABLE_SYMBOLS
+SC_ENABLE_MEMDEBUG
TCL_DBGX=${DBGX}
@@ -440,68 +453,49 @@ SC_BLOCKING_STYLE
TCL_UNSHARED_LIB_SUFFIX=${UNSHARED_LIB_SUFFIX}
TCL_SHARED_LIB_SUFFIX=${SHARED_LIB_SUFFIX}
+eval "TCL_LIB_FILE=libtcl${LIB_SUFFIX}"
-SC_ENABLE_SHARED
+SC_ENABLE_FRAMEWORK
-if test "${SHARED_BUILD}" = "1" -a "${SHLIB_SUFFIX}" != "" ; then
- TCL_SHLIB_CFLAGS="${SHLIB_CFLAGS}"
- TCL_LD_SEARCH_FLAGS="${LD_SEARCH_FLAGS}"
- TCL_TOOL_SHARED_LIB_LONGNAME(TCL_LIB_FILE, tcl, ${TCL_SHARED_LIB_SUFFIX})
-
- # FIXME: Why does MAKE_LIB not use a generic LIB_FILE variable
- # that is replaced with the Makefiles specific stub lib name?
- if test "x$DL_OBJS" = "xtclLoadAout.o"; then
- MAKE_LIB="\${STLIB_LD} \${TCL_LIB_FILE} \${OBJS}"
- else
- MAKE_LIB="\${SHLIB_LD} -o \${TCL_LIB_FILE} \${OBJS} ${SHLIB_LD_LIBS}"
- RANLIB=":"
- fi
-else
- case $system in
- BSD/OS*)
- ;;
-
- AIX-*)
- ;;
-
- *)
- SHLIB_LD_LIBS=""
- ;;
- esac
- TCL_SHLIB_CFLAGS=""
- TCL_LD_SEARCH_FLAGS="${LD_SEARCH_FLAGS}"
- TCL_TOOL_STATIC_LIB_LONGNAME(TCL_LIB_FILE, tcl, ${TCL_UNSHARED_LIB_SUFFIX})
- MAKE_LIB="\${STLIB_LD} \${TCL_LIB_FILE} \${OBJS}"
-fi
+# tclConfig.sh needs a version of the _LIB_SUFFIX that has been eval'ed
+# so that the backslashes quoting the DBX braces are dropped.
+
+# Trick to replace DBGX with TCL_DBGX
+DBGX='${TCL_DBGX}'
+eval "TCL_LIB_FILE=${TCL_LIB_FILE}"
# Note: in the following variable, it's important to use the absolute
# path name of the Tcl directory rather than "..": this is because
# AIX remembers this path and will attempt to use it at run-time to look
# up the Tcl library.
-if test "$SHARED_BUILD" = "0" -o $TCL_NEEDS_EXP_FILE = 0; then
- TCL_TOOL_LIB_SHORTNAME(TCL_LIB_FLAG, tcl, $TCL_VERSION)
- TCL_TOOL_LIB_SPEC(TCL_BUILD_LIB_SPEC, `pwd`, ${TCL_LIB_FLAG})
- TCL_TOOL_LIB_SPEC(TCL_LIB_SPEC, ${exec_prefix}/lib, ${TCL_LIB_FLAG})
+if test "$FRAMEWORK_BUILD" = "1" ; then
+ TCL_BUILD_LIB_SPEC="-F`pwd` -framework Tcl"
+ TCL_LIB_SPEC="-framework Tcl"
+ TCL_LIB_FILE="Tcl"
+elif test "$SHARED_BUILD" = "0" || test "$TCL_NEEDS_EXP_FILE" = "0"; then
+ if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then
+ TCL_LIB_FLAG="-ltcl${TCL_VERSION}\${TCL_DBGX}"
+ else
+ TCL_LIB_FLAG="-ltcl`echo ${TCL_VERSION} | tr -d .`\${TCL_DBGX}"
+ fi
+ TCL_BUILD_LIB_SPEC="-L`pwd` ${TCL_LIB_FLAG}"
+ TCL_LIB_SPEC="-L${libdir} ${TCL_LIB_FLAG}"
else
- # FIXME: This if branch needs to be updated with respect
- # to the library macro changes above!
TCL_BUILD_EXP_FILE="lib.exp"
eval "TCL_EXP_FILE=libtcl${TCL_EXPORT_FILE_SUFFIX}"
# Replace DBGX with TCL_DBGX
eval "TCL_EXP_FILE=\"${TCL_EXP_FILE}\""
- if test "$using_gcc" = "yes" ; then
+ if test "$GCC" = "yes" ; then
TCL_BUILD_LIB_SPEC="-Wl,-bI:`pwd`/${TCL_BUILD_EXP_FILE} -L`pwd`"
- TCL_LIB_SPEC="-Wl,-bI:${exec_prefix}/lib/${TCL_EXP_FILE} -L`pwd`"
+ TCL_LIB_SPEC="-Wl,-bI:${libdir}/${TCL_EXP_FILE} -L`pwd`"
else
TCL_BUILD_LIB_SPEC="-bI:`pwd`/${TCL_BUILD_EXP_FILE}"
- TCL_LIB_SPEC="-bI:${exec_prefix}/lib/${TCL_EXP_FILE}"
+ TCL_LIB_SPEC="-bI:${libdir}/${TCL_EXP_FILE}"
fi
fi
-TCL_TOOL_LIB_PATH(TCL_LIB_FULL_PATH, `pwd`, ${TCL_LIB_FILE})
-
VERSION='${VERSION}'
eval "CFG_TCL_SHARED_LIB_SUFFIX=${TCL_SHARED_LIB_SUFFIX}"
eval "CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX}"
@@ -515,28 +509,37 @@ VERSION=${TCL_VERSION}
# another for platform-independent scripts.
#--------------------------------------------------------------------
-if test "$prefix" != "$exec_prefix"; then
- TCL_PACKAGE_PATH="${exec_prefix}/lib ${prefix}/lib"
+if test "$FRAMEWORK_BUILD" = "1" ; then
+ TCL_PACKAGE_PATH="${libdir}/Resources/Scripts"
+elif test "$prefix" != "$exec_prefix"; then
+ TCL_PACKAGE_PATH="${libdir} ${prefix}/lib"
else
TCL_PACKAGE_PATH="${prefix}/lib"
fi
#--------------------------------------------------------------------
# The statements below define various symbols relating to Tcl
-# stub support. Note that the STUB_LIB_FILE variable must
-# be set in the Makefile before running MAKE_STUB_LIB.
+# stub support.
#--------------------------------------------------------------------
-MAKE_STUB_LIB="\${STLIB_LD} \${STUB_LIB_FILE} \${STUB_LIB_OBJS}"
+# Replace ${VERSION} with contents of ${TCL_VERSION}
+eval "TCL_STUB_LIB_FILE=libtclstub${TCL_UNSHARED_LIB_SUFFIX}"
+# Replace DBGX with TCL_DBGX
+eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\""
-TCL_TOOL_STATIC_LIB_LONGNAME(TCL_STUB_LIB_FILE, tclstub, ${TCL_UNSHARED_LIB_SUFFIX})
+if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then
+ TCL_STUB_LIB_FLAG="-ltclstub${TCL_VERSION}\${TCL_DBGX}"
+else
+ TCL_STUB_LIB_FLAG="-ltclstub`echo ${TCL_VERSION} | tr -d .`\${TCL_DBGX}"
+fi
-TCL_TOOL_LIB_SHORTNAME(TCL_STUB_LIB_FLAG, tclstub, $TCL_VERSION)
-TCL_TOOL_LIB_SPEC(TCL_BUILD_STUB_LIB_SPEC, `pwd`, ${TCL_STUB_LIB_FLAG})
-TCL_TOOL_LIB_SPEC(TCL_STUB_LIB_SPEC, ${exec_prefix}/lib, ${TCL_STUB_LIB_FLAG})
+TCL_BUILD_STUB_LIB_SPEC="-L`pwd` ${TCL_STUB_LIB_FLAG}"
+TCL_STUB_LIB_SPEC="-L${libdir} ${TCL_STUB_LIB_FLAG}"
+TCL_BUILD_STUB_LIB_PATH="`pwd`/${TCL_STUB_LIB_FILE}"
+TCL_STUB_LIB_PATH="${libdir}/${TCL_STUB_LIB_FILE}"
-TCL_TOOL_LIB_PATH(TCL_BUILD_STUB_LIB_PATH, `pwd`, ${TCL_STUB_LIB_FILE})
-TCL_TOOL_LIB_PATH(TCL_STUB_LIB_PATH, ${exec_prefix}/lib, ${TCL_STUB_LIB_FILE})
+# Install time header dir can be set via --includedir
+eval "TCL_INCLUDE_SPEC=\"-I${includedir}\""
#------------------------------------------------------------------------
# tclConfig.sh refers to this by a different name
@@ -544,57 +547,43 @@ TCL_TOOL_LIB_PATH(TCL_STUB_LIB_PATH, ${exec_prefix}/lib, ${TCL_STUB_LIB_FILE})
TCL_SHARED_BUILD=${SHARED_BUILD}
+AC_SUBST(TCL_VERSION)
+AC_SUBST(TCL_MAJOR_VERSION)
+AC_SUBST(TCL_MINOR_VERSION)
+AC_SUBST(TCL_PATCH_LEVEL)
+
+AC_SUBST(TCL_LIB_FILE)
+AC_SUBST(TCL_LIB_FLAG)
+AC_SUBST(TCL_LIB_SPEC)
AC_SUBST(TCL_STUB_LIB_FILE)
AC_SUBST(TCL_STUB_LIB_FLAG)
-AC_SUBST(TCL_BUILD_STUB_LIB_SPEC)
AC_SUBST(TCL_STUB_LIB_SPEC)
-AC_SUBST(TCL_BUILD_STUB_LIB_PATH)
AC_SUBST(TCL_STUB_LIB_PATH)
-AC_SUBST(MAKE_STUB_LIB)
+AC_SUBST(TCL_INCLUDE_SPEC)
+AC_SUBST(TCL_BUILD_STUB_LIB_SPEC)
+AC_SUBST(TCL_BUILD_STUB_LIB_PATH)
-AC_SUBST(BUILD_DLTEST)
-AC_SUBST(CFLAGS_DEFAULT)
+AC_SUBST(TCL_SRC_DIR)
+AC_SUBST(TCL_DBGX)
AC_SUBST(CFG_TCL_SHARED_LIB_SUFFIX)
AC_SUBST(CFG_TCL_UNSHARED_LIB_SUFFIX)
AC_SUBST(CFG_TCL_EXPORT_FILE_SUFFIX)
-AC_SUBST(TCL_DBGX)
-AC_SUBST(DL_OBJS)
-AC_SUBST(EXTRA_CFLAGS)
-AC_SUBST(LDFLAGS_DEFAULT)
-AC_SUBST(LDFLAGS_DEBUG)
-AC_SUBST(LDFLAGS_OPTIMIZE)
-AC_SUBST(AR)
-AC_SUBST(RANLIB)
-AC_SUBST(MAKE_LIB)
+
AC_SUBST(TCL_SHARED_BUILD)
-AC_SUBST(SHLIB_CFLAGS)
-AC_SUBST(SHLIB_LD)
-AC_SUBST(STLIB_LD)
-AC_SUBST(SHLIB_LD_LIBS)
-AC_SUBST(SHLIB_SUFFIX)
+AC_SUBST(LD_LIBRARY_PATH_VAR)
+
AC_SUBST(TCL_BUILD_LIB_SPEC)
-AC_SUBST(TCL_LD_SEARCH_FLAGS)
-AC_SUBST(TCL_LDFLAGS_DEBUG)
-AC_SUBST(TCL_LDFLAGS_OPTIMIZE)
-AC_SUBST(TCL_LIB_FILE)
-AC_SUBST(TCL_LIB_FULL_PATH)
-AC_SUBST(TCL_LIB_FLAG)
AC_SUBST(TCL_NEEDS_EXP_FILE)
AC_SUBST(TCL_BUILD_EXP_FILE)
AC_SUBST(TCL_EXP_FILE)
-AC_SUBST(TCL_LIB_SPEC)
+
AC_SUBST(TCL_LIB_VERSIONS_OK)
-AC_SUBST(TCL_MAJOR_VERSION)
-AC_SUBST(TCL_MINOR_VERSION)
-AC_SUBST(TCL_PACKAGE_PATH)
-AC_SUBST(TCL_PATCH_LEVEL)
AC_SUBST(TCL_SHARED_LIB_SUFFIX)
-AC_SUBST(TCL_SHLIB_CFLAGS)
-AC_SUBST(TCL_SRC_DIR)
-AC_SUBST(TCL_BIN_DIR)
AC_SUBST(TCL_UNSHARED_LIB_SUFFIX)
-AC_SUBST(TCL_VERSION)
-AC_SUBST(VENDORPREFIX)
-AC_OUTPUT(Makefile tclConfig.sh)
+AC_SUBST(TCL_HAS_LONGLONG)
+
+AC_SUBST(BUILD_DLTEST)
+AC_SUBST(TCL_PACKAGE_PATH)
+AC_OUTPUT(Makefile dltest/Makefile tclConfig.sh)
diff --git a/tcl/unix/dltest/Makefile.in b/tcl/unix/dltest/Makefile.in
index 49c9d9f0169..510254a2e5e 100644
--- a/tcl/unix/dltest/Makefile.in
+++ b/tcl/unix/dltest/Makefile.in
@@ -5,47 +5,48 @@
TCL_DBGX = @TCL_DBGX@
CC = @CC@
-LIBS = @TCL_BUILD_STUB_LIB_SPEC@ @TCL_LIBS@ -lc
+LIBS = @TCL_BUILD_STUB_LIB_SPEC@ @DL_LIBS@ @LIBS@ @MATH_LIBS@
AC_FLAGS = @EXTRA_CFLAGS@
SHLIB_CFLAGS = @SHLIB_CFLAGS@
SHLIB_LD = @SHLIB_LD@
+SHLIB_LD_LIBS = @SHLIB_LD_LIBS@
SHLIB_SUFFIX = @SHLIB_SUFFIX@
-SHLIB_VERSION = @SHLIB_VERSION@
SRC_DIR = @srcdir@
TCL_VERSION= @TCL_VERSION@
-TCL_CFLAGS= @TCL_CFLAGS@
-CFLAGS = -g
-#CC_SWITCHES = $(CFLAGS) ${TCL_CFLAGS} -I${SRC_DIR}/../../generic \
-# -DTCL_MEM_DEBUG ${SHLIB_CFLAGS}
+CFLAGS_DEBUG = @CFLAGS_DEBUG@
+CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@
+
+CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@
CC_SWITCHES = $(CFLAGS) -I${SRC_DIR}/../../generic -DTCL_MEM_DEBUG \
${SHLIB_CFLAGS} -DUSE_TCL_STUBS ${AC_FLAGS}
all: pkga${SHLIB_SUFFIX} pkgb${SHLIB_SUFFIX} pkgc${SHLIB_SUFFIX} pkgd${SHLIB_SUFFIX} pkge${SHLIB_SUFFIX}
+ @touch ../dltest.marker
pkga${SHLIB_SUFFIX}: $(SRC_DIR)/pkga.c
$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkga.c
- ${SHLIB_LD} -o pkga${SHLIB_SUFFIX} pkga.o ${LIBS}
+ ${SHLIB_LD} -o pkga${SHLIB_SUFFIX} pkga.o ${SHLIB_LD_LIBS}
pkgb${SHLIB_SUFFIX}: $(SRC_DIR)/pkgb.c
$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgb.c
- ${SHLIB_LD} -o pkgb${SHLIB_SUFFIX} pkgb.o ${LIBS}
+ ${SHLIB_LD} -o pkgb${SHLIB_SUFFIX} pkgb.o ${SHLIB_LD_LIBS}
pkgc${SHLIB_SUFFIX}: $(SRC_DIR)/pkgc.c
$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgc.c
- ${SHLIB_LD} -o pkgc${SHLIB_SUFFIX} pkgc.o ${LIBS}
+ ${SHLIB_LD} -o pkgc${SHLIB_SUFFIX} pkgc.o ${SHLIB_LD_LIBS}
pkgd${SHLIB_SUFFIX}: $(SRC_DIR)/pkgd.c
$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgd.c
- ${SHLIB_LD} -o pkgd${SHLIB_SUFFIX} pkgd.o ${LIBS}
+ ${SHLIB_LD} -o pkgd${SHLIB_SUFFIX} pkgd.o ${SHLIB_LD_LIBS}
pkge${SHLIB_SUFFIX}: $(SRC_DIR)/pkge.c
$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkge.c
- ${SHLIB_LD} -o pkge${SHLIB_SUFFIX} pkge.o ${LIBS}
+ ${SHLIB_LD} -o pkge${SHLIB_SUFFIX} pkge.o ${SHLIB_LD_LIBS}
clean:
- rm -f *.o *${SHLIB_SUFFIX} lib.exp
+ rm -f *.o *${SHLIB_SUFFIX} config.cache config.log config.status
+ rm -f lib.exp ../dltest.marker
distclean: clean
- rm -f Makefile config.cache config.log config.status
-
+ rm -f Makefile
diff --git a/tcl/unix/dltest/README b/tcl/unix/dltest/README
index 4b6baedbab4..ffc14aba4b4 100644
--- a/tcl/unix/dltest/README
+++ b/tcl/unix/dltest/README
@@ -1,13 +1,6 @@
This directory contains several files for testing Tcl's dynamic
-loading capabilities. If this directory is present and the files
-in here have been compiled, then the "load" test will use the shared
-libraries present here to run a series of tests. To compile the
-shared libraries, first type "./configure". This will read
-configuration information created when Tcl was configured and
-create Makefile from Makefile.in. Be sure that you have configured
-Tcl before configuring here, since information learned during Tcl's
-configure is needed here. Then type "make" to create the shared
-libraries.
+loading capabilities. If shared libraries are supported then
+the build system in the parent directory will create
+the shared libs and load them into the tcltest executable.
RCS: @(#) $Id$
-
diff --git a/tcl/unix/dltest/pkga.c b/tcl/unix/dltest/pkga.c
index aae4c3a1ae1..38d80d26d54 100644
--- a/tcl/unix/dltest/pkga.c
+++ b/tcl/unix/dltest/pkga.c
@@ -128,5 +128,3 @@ Pkga_Init(interp)
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
return TCL_OK;
}
-
-
diff --git a/tcl/unix/dltest/pkgb.c b/tcl/unix/dltest/pkgb.c
index 361688f838c..80dc4e0490a 100644
--- a/tcl/unix/dltest/pkgb.c
+++ b/tcl/unix/dltest/pkgb.c
@@ -162,5 +162,3 @@ Pkgb_SafeInit(interp)
(Tcl_CmdDeleteProc *) NULL);
return TCL_OK;
}
-
-
diff --git a/tcl/unix/dltest/pkgc.c b/tcl/unix/dltest/pkgc.c
index d6306680348..f445869da3e 100644
--- a/tcl/unix/dltest/pkgc.c
+++ b/tcl/unix/dltest/pkgc.c
@@ -162,5 +162,3 @@ Pkgc_SafeInit(interp)
(Tcl_CmdDeleteProc *) NULL);
return TCL_OK;
}
-
-
diff --git a/tcl/unix/dltest/pkgd.c b/tcl/unix/dltest/pkgd.c
index 57b57c7521d..49133343098 100644
--- a/tcl/unix/dltest/pkgd.c
+++ b/tcl/unix/dltest/pkgd.c
@@ -163,5 +163,3 @@ Pkgd_SafeInit(interp)
(Tcl_CmdDeleteProc *) NULL);
return TCL_OK;
}
-
-
diff --git a/tcl/unix/dltest/pkge.c b/tcl/unix/dltest/pkge.c
index 6a815a975e6..b32a6b4d954 100644
--- a/tcl/unix/dltest/pkge.c
+++ b/tcl/unix/dltest/pkge.c
@@ -44,5 +44,3 @@ Pkge_Init(interp)
}
return Tcl_Eval(interp, script);
}
-
-
diff --git a/tcl/unix/dltest/pkgf.c b/tcl/unix/dltest/pkgf.c
index 3cfb956bc00..364a70f7991 100644
--- a/tcl/unix/dltest/pkgf.c
+++ b/tcl/unix/dltest/pkgf.c
@@ -51,4 +51,3 @@ Pkgf_Init(interp)
}
return Tcl_Eval(interp, script);
}
-
diff --git a/tcl/unix/install-sh b/tcl/unix/install-sh
index 0ff4b6a08e8..a9a1f276493 100755
--- a/tcl/unix/install-sh
+++ b/tcl/unix/install-sh
@@ -62,6 +62,11 @@ while [ x"$1" != x ]; do
shift
continue;;
+ -S) stripcmd="$stripprog $2"
+ shift
+ shift
+ continue;;
+
*) if [ x"$src" = x ]
then
src=$1
diff --git a/tcl/unix/ldAix b/tcl/unix/ldAix
index 31b6b222582..cabddff3916 100755
--- a/tcl/unix/ldAix
+++ b/tcl/unix/ldAix
@@ -72,4 +72,3 @@ if test "$noDotA" = "" ; then
else
eval $args
fi
-
diff --git a/tcl/unix/mkLinks b/tcl/unix/mkLinks
index ba3d9ec32f9..a41ea06d37f 100755
--- a/tcl/unix/mkLinks
+++ b/tcl/unix/mkLinks
@@ -15,997 +15,1843 @@
# The script takes one argument, which is the name of the directory
# where the manual entries have been installed.
+ZIP=true
+while true; do
+ case $1 in
+ -s | --symlinks )
+ S=-s
+ ;;
+ -z | --compress )
+ ZIP=$2
+ shift
+ ;;
+ *) break
+ ;;
+ esac
+ shift
+done
+
if test $# != 1; then
- echo "Usage: mkLinks dir"
+ echo "Usage: mkLinks <options> dir"
exit 1
fi
+if test "x$ZIP" != "xtrue"; then
+ touch TeST
+ $ZIP TeST
+ Z=`ls TeST* | sed 's/^[^.]*//'`
+ rm -f TeST*
+fi
+
cd $1
echo foo > xyzzyTestingAVeryLongFileName.foo
x=`echo xyzzyTe*`
+echo foo > xyzzyTestingaverylongfilename.foo
+y=`echo xyzzyTestingav*`
rm xyzzyTe*
if test "$x" != "xyzzyTestingAVeryLongFileName.foo"; then
exit
fi
+if test "$y" != "xyzzyTestingaverylongfilename.foo"; then
+ CASEINSENSITIVEFS=1
+fi
if test -r Access.3; then
- rm -f Tcl_Access.3
- rm -f Tcl_Stat.3
- cp Access.3 Tcl_Access.3
- cp Access.3 Tcl_Stat.3
+ rm -f Access.3.*
+ $ZIP Access.3
+ rm -f Tcl_Access.3 Tcl_Access.3.*
+ rm -f Tcl_Stat.3 Tcl_Stat.3.*
+ ln $S Access.3$Z Tcl_Access.3$Z
+ ln $S Access.3$Z Tcl_Stat.3$Z
fi
if test -r AddErrInfo.3; then
- rm -f Tcl_AddObjErrorInfo.3
- rm -f Tcl_AddErrorInfo.3
- rm -f Tcl_SetObjErrorCode.3
- rm -f Tcl_SetErrorCode.3
- rm -f Tcl_SetErrorCodeVA.3
- rm -f Tcl_PosixError.3
- rm -f Tcl_LogCommandInfo.3
- cp AddErrInfo.3 Tcl_AddObjErrorInfo.3
- cp AddErrInfo.3 Tcl_AddErrorInfo.3
- cp AddErrInfo.3 Tcl_SetObjErrorCode.3
- cp AddErrInfo.3 Tcl_SetErrorCode.3
- cp AddErrInfo.3 Tcl_SetErrorCodeVA.3
- cp AddErrInfo.3 Tcl_PosixError.3
- cp AddErrInfo.3 Tcl_LogCommandInfo.3
+ rm -f AddErrInfo.3.*
+ $ZIP AddErrInfo.3
+ rm -f Tcl_AddObjErrorInfo.3 Tcl_AddObjErrorInfo.3.*
+ rm -f Tcl_AddErrorInfo.3 Tcl_AddErrorInfo.3.*
+ rm -f Tcl_SetObjErrorCode.3 Tcl_SetObjErrorCode.3.*
+ rm -f Tcl_SetErrorCode.3 Tcl_SetErrorCode.3.*
+ rm -f Tcl_SetErrorCodeVA.3 Tcl_SetErrorCodeVA.3.*
+ rm -f Tcl_PosixError.3 Tcl_PosixError.3.*
+ rm -f Tcl_LogCommandInfo.3 Tcl_LogCommandInfo.3.*
+ ln $S AddErrInfo.3$Z Tcl_AddObjErrorInfo.3$Z
+ ln $S AddErrInfo.3$Z Tcl_AddErrorInfo.3$Z
+ ln $S AddErrInfo.3$Z Tcl_SetObjErrorCode.3$Z
+ ln $S AddErrInfo.3$Z Tcl_SetErrorCode.3$Z
+ ln $S AddErrInfo.3$Z Tcl_SetErrorCodeVA.3$Z
+ ln $S AddErrInfo.3$Z Tcl_PosixError.3$Z
+ ln $S AddErrInfo.3$Z Tcl_LogCommandInfo.3$Z
fi
if test -r Alloc.3; then
- rm -f Tcl_Alloc.3
- rm -f Tcl_Free.3
- rm -f Tcl_Realloc.3
- cp Alloc.3 Tcl_Alloc.3
- cp Alloc.3 Tcl_Free.3
- cp Alloc.3 Tcl_Realloc.3
+ rm -f Alloc.3.*
+ $ZIP Alloc.3
+ rm -f Tcl_Alloc.3 Tcl_Alloc.3.*
+ rm -f Tcl_Free.3 Tcl_Free.3.*
+ rm -f Tcl_Realloc.3 Tcl_Realloc.3.*
+ rm -f Tcl_AttemptAlloc.3 Tcl_AttemptAlloc.3.*
+ rm -f Tcl_AttemptRealloc.3 Tcl_AttemptRealloc.3.*
+ rm -f ckalloc.3 ckalloc.3.*
+ rm -f ckfree.3 ckfree.3.*
+ rm -f ckrealloc.3 ckrealloc.3.*
+ rm -f attemptckalloc.3 attemptckalloc.3.*
+ rm -f attemptckrealloc.3 attemptckrealloc.3.*
+ ln $S Alloc.3$Z Tcl_Alloc.3$Z
+ ln $S Alloc.3$Z Tcl_Free.3$Z
+ ln $S Alloc.3$Z Tcl_Realloc.3$Z
+ ln $S Alloc.3$Z Tcl_AttemptAlloc.3$Z
+ ln $S Alloc.3$Z Tcl_AttemptRealloc.3$Z
+ ln $S Alloc.3$Z ckalloc.3$Z
+ ln $S Alloc.3$Z ckfree.3$Z
+ ln $S Alloc.3$Z ckrealloc.3$Z
+ ln $S Alloc.3$Z attemptckalloc.3$Z
+ ln $S Alloc.3$Z attemptckrealloc.3$Z
fi
if test -r AllowExc.3; then
- rm -f Tcl_AllowExceptions.3
- cp AllowExc.3 Tcl_AllowExceptions.3
+ rm -f AllowExc.3.*
+ $ZIP AllowExc.3
+ rm -f Tcl_AllowExceptions.3 Tcl_AllowExceptions.3.*
+ ln $S AllowExc.3$Z Tcl_AllowExceptions.3$Z
fi
if test -r AppInit.3; then
- rm -f Tcl_AppInit.3
- cp AppInit.3 Tcl_AppInit.3
+ rm -f AppInit.3.*
+ $ZIP AppInit.3
+ rm -f Tcl_AppInit.3 Tcl_AppInit.3.*
+ ln $S AppInit.3$Z Tcl_AppInit.3$Z
fi
if test -r AssocData.3; then
- rm -f Tcl_GetAssocData.3
- rm -f Tcl_SetAssocData.3
- rm -f Tcl_DeleteAssocData.3
- cp AssocData.3 Tcl_GetAssocData.3
- cp AssocData.3 Tcl_SetAssocData.3
- cp AssocData.3 Tcl_DeleteAssocData.3
+ rm -f AssocData.3.*
+ $ZIP AssocData.3
+ rm -f Tcl_GetAssocData.3 Tcl_GetAssocData.3.*
+ rm -f Tcl_SetAssocData.3 Tcl_SetAssocData.3.*
+ rm -f Tcl_DeleteAssocData.3 Tcl_DeleteAssocData.3.*
+ ln $S AssocData.3$Z Tcl_GetAssocData.3$Z
+ ln $S AssocData.3$Z Tcl_SetAssocData.3$Z
+ ln $S AssocData.3$Z Tcl_DeleteAssocData.3$Z
fi
if test -r Async.3; then
- rm -f Tcl_AsyncCreate.3
- rm -f Tcl_AsyncMark.3
- rm -f Tcl_AsyncInvoke.3
- rm -f Tcl_AsyncDelete.3
- rm -f Tcl_AsyncReady.3
- cp Async.3 Tcl_AsyncCreate.3
- cp Async.3 Tcl_AsyncMark.3
- cp Async.3 Tcl_AsyncInvoke.3
- cp Async.3 Tcl_AsyncDelete.3
- cp Async.3 Tcl_AsyncReady.3
+ rm -f Async.3.*
+ $ZIP Async.3
+ rm -f Tcl_AsyncCreate.3 Tcl_AsyncCreate.3.*
+ rm -f Tcl_AsyncMark.3 Tcl_AsyncMark.3.*
+ rm -f Tcl_AsyncInvoke.3 Tcl_AsyncInvoke.3.*
+ rm -f Tcl_AsyncDelete.3 Tcl_AsyncDelete.3.*
+ rm -f Tcl_AsyncReady.3 Tcl_AsyncReady.3.*
+ ln $S Async.3$Z Tcl_AsyncCreate.3$Z
+ ln $S Async.3$Z Tcl_AsyncMark.3$Z
+ ln $S Async.3$Z Tcl_AsyncInvoke.3$Z
+ ln $S Async.3$Z Tcl_AsyncDelete.3$Z
+ ln $S Async.3$Z Tcl_AsyncReady.3$Z
fi
if test -r BackgdErr.3; then
- rm -f Tcl_BackgroundError.3
- cp BackgdErr.3 Tcl_BackgroundError.3
+ rm -f BackgdErr.3.*
+ $ZIP BackgdErr.3
+ rm -f Tcl_BackgroundError.3 Tcl_BackgroundError.3.*
+ ln $S BackgdErr.3$Z Tcl_BackgroundError.3$Z
fi
if test -r Backslash.3; then
- rm -f Tcl_Backslash.3
- cp Backslash.3 Tcl_Backslash.3
+ rm -f Backslash.3.*
+ $ZIP Backslash.3
+ rm -f Tcl_Backslash.3 Tcl_Backslash.3.*
+ ln $S Backslash.3$Z Tcl_Backslash.3$Z
fi
if test -r BoolObj.3; then
- rm -f Tcl_NewBooleanObj.3
- rm -f Tcl_SetBooleanObj.3
- rm -f Tcl_GetBooleanFromObj.3
- cp BoolObj.3 Tcl_NewBooleanObj.3
- cp BoolObj.3 Tcl_SetBooleanObj.3
- cp BoolObj.3 Tcl_GetBooleanFromObj.3
+ rm -f BoolObj.3.*
+ $ZIP BoolObj.3
+ rm -f Tcl_NewBooleanObj.3 Tcl_NewBooleanObj.3.*
+ rm -f Tcl_SetBooleanObj.3 Tcl_SetBooleanObj.3.*
+ rm -f Tcl_GetBooleanFromObj.3 Tcl_GetBooleanFromObj.3.*
+ ln $S BoolObj.3$Z Tcl_NewBooleanObj.3$Z
+ ln $S BoolObj.3$Z Tcl_SetBooleanObj.3$Z
+ ln $S BoolObj.3$Z Tcl_GetBooleanFromObj.3$Z
fi
if test -r ByteArrObj.3; then
- rm -f Tcl_NewByteArrayObj.3
- rm -f Tcl_SetByteArrayObj.3
- rm -f Tcl_GetByteArrayFromObj.3
- rm -f Tcl_SetByteArrayLength.3
- cp ByteArrObj.3 Tcl_NewByteArrayObj.3
- cp ByteArrObj.3 Tcl_SetByteArrayObj.3
- cp ByteArrObj.3 Tcl_GetByteArrayFromObj.3
- cp ByteArrObj.3 Tcl_SetByteArrayLength.3
+ rm -f ByteArrObj.3.*
+ $ZIP ByteArrObj.3
+ rm -f Tcl_NewByteArrayObj.3 Tcl_NewByteArrayObj.3.*
+ rm -f Tcl_SetByteArrayObj.3 Tcl_SetByteArrayObj.3.*
+ rm -f Tcl_GetByteArrayFromObj.3 Tcl_GetByteArrayFromObj.3.*
+ rm -f Tcl_SetByteArrayLength.3 Tcl_SetByteArrayLength.3.*
+ ln $S ByteArrObj.3$Z Tcl_NewByteArrayObj.3$Z
+ ln $S ByteArrObj.3$Z Tcl_SetByteArrayObj.3$Z
+ ln $S ByteArrObj.3$Z Tcl_GetByteArrayFromObj.3$Z
+ ln $S ByteArrObj.3$Z Tcl_SetByteArrayLength.3$Z
fi
if test -r CallDel.3; then
- rm -f Tcl_CallWhenDeleted.3
- rm -f Tcl_DontCallWhenDeleted.3
- cp CallDel.3 Tcl_CallWhenDeleted.3
- cp CallDel.3 Tcl_DontCallWhenDeleted.3
+ rm -f CallDel.3.*
+ $ZIP CallDel.3
+ rm -f Tcl_CallWhenDeleted.3 Tcl_CallWhenDeleted.3.*
+ rm -f Tcl_DontCallWhenDeleted.3 Tcl_DontCallWhenDeleted.3.*
+ ln $S CallDel.3$Z Tcl_CallWhenDeleted.3$Z
+ ln $S CallDel.3$Z Tcl_DontCallWhenDeleted.3$Z
fi
if test -r ChnlStack.3; then
- rm -f Tcl_StackChannel.3
- rm -f Tcl_UnstackChannel.3
- rm -f Tcl_GetStackedChannel.3
- cp ChnlStack.3 Tcl_StackChannel.3
- cp ChnlStack.3 Tcl_UnstackChannel.3
- cp ChnlStack.3 Tcl_GetStackedChannel.3
+ rm -f ChnlStack.3.*
+ $ZIP ChnlStack.3
+ rm -f Tcl_StackChannel.3 Tcl_StackChannel.3.*
+ rm -f Tcl_UnstackChannel.3 Tcl_UnstackChannel.3.*
+ rm -f Tcl_GetStackedChannel.3 Tcl_GetStackedChannel.3.*
+ rm -f Tcl_GetTopChannel.3 Tcl_GetTopChannel.3.*
+ ln $S ChnlStack.3$Z Tcl_StackChannel.3$Z
+ ln $S ChnlStack.3$Z Tcl_UnstackChannel.3$Z
+ ln $S ChnlStack.3$Z Tcl_GetStackedChannel.3$Z
+ ln $S ChnlStack.3$Z Tcl_GetTopChannel.3$Z
fi
if test -r CmdCmplt.3; then
- rm -f Tcl_CommandComplete.3
- cp CmdCmplt.3 Tcl_CommandComplete.3
+ rm -f CmdCmplt.3.*
+ $ZIP CmdCmplt.3
+ rm -f Tcl_CommandComplete.3 Tcl_CommandComplete.3.*
+ ln $S CmdCmplt.3$Z Tcl_CommandComplete.3$Z
fi
if test -r Concat.3; then
- rm -f Tcl_Concat.3
- cp Concat.3 Tcl_Concat.3
+ rm -f Concat.3.*
+ $ZIP Concat.3
+ rm -f Tcl_Concat.3 Tcl_Concat.3.*
+ ln $S Concat.3$Z Tcl_Concat.3$Z
fi
if test -r CrtChannel.3; then
- rm -f Tcl_CreateChannel.3
- rm -f Tcl_GetChannelInstanceData.3
- rm -f Tcl_GetChannelType.3
- rm -f Tcl_GetChannelName.3
- rm -f Tcl_GetChannelHandle.3
- rm -f Tcl_GetChannelMode.3
- rm -f Tcl_GetChannelBufferSize.3
- rm -f Tcl_SetChannelBufferSize.3
- rm -f Tcl_NotifyChannel.3
- rm -f Tcl_BadChannelOption.3
- rm -f Tcl_ChannelName.3
- rm -f Tcl_ChannelVersion.3
- rm -f Tcl_ChannelBlockModeProc.3
- rm -f Tcl_ChannelCloseProc.3
- rm -f Tcl_ChannelClose2Proc.3
- rm -f Tcl_ChannelInputProc.3
- rm -f Tcl_ChannelOutputProc.3
- rm -f Tcl_ChannelSeekProc.3
- rm -f Tcl_ChannelSetOptionProc.3
- rm -f Tcl_ChannelGetOptionProc.3
- rm -f Tcl_ChannelWatchProc.3
- rm -f Tcl_ChannelGetHandleProc.3
- rm -f Tcl_ChannelFlushProc.3
- rm -f Tcl_ChannelHandlerProc.3
- cp CrtChannel.3 Tcl_CreateChannel.3
- cp CrtChannel.3 Tcl_GetChannelInstanceData.3
- cp CrtChannel.3 Tcl_GetChannelType.3
- cp CrtChannel.3 Tcl_GetChannelName.3
- cp CrtChannel.3 Tcl_GetChannelHandle.3
- cp CrtChannel.3 Tcl_GetChannelMode.3
- cp CrtChannel.3 Tcl_GetChannelBufferSize.3
- cp CrtChannel.3 Tcl_SetChannelBufferSize.3
- cp CrtChannel.3 Tcl_NotifyChannel.3
- cp CrtChannel.3 Tcl_BadChannelOption.3
- cp CrtChannel.3 Tcl_ChannelName.3
- cp CrtChannel.3 Tcl_ChannelVersion.3
- cp CrtChannel.3 Tcl_ChannelBlockModeProc.3
- cp CrtChannel.3 Tcl_ChannelCloseProc.3
- cp CrtChannel.3 Tcl_ChannelClose2Proc.3
- cp CrtChannel.3 Tcl_ChannelInputProc.3
- cp CrtChannel.3 Tcl_ChannelOutputProc.3
- cp CrtChannel.3 Tcl_ChannelSeekProc.3
- cp CrtChannel.3 Tcl_ChannelSetOptionProc.3
- cp CrtChannel.3 Tcl_ChannelGetOptionProc.3
- cp CrtChannel.3 Tcl_ChannelWatchProc.3
- cp CrtChannel.3 Tcl_ChannelGetHandleProc.3
- cp CrtChannel.3 Tcl_ChannelFlushProc.3
- cp CrtChannel.3 Tcl_ChannelHandlerProc.3
+ rm -f CrtChannel.3.*
+ $ZIP CrtChannel.3
+ rm -f Tcl_CreateChannel.3 Tcl_CreateChannel.3.*
+ rm -f Tcl_GetChannelInstanceData.3 Tcl_GetChannelInstanceData.3.*
+ rm -f Tcl_GetChannelType.3 Tcl_GetChannelType.3.*
+ rm -f Tcl_GetChannelName.3 Tcl_GetChannelName.3.*
+ rm -f Tcl_GetChannelHandle.3 Tcl_GetChannelHandle.3.*
+ rm -f Tcl_GetChannelMode.3 Tcl_GetChannelMode.3.*
+ rm -f Tcl_GetChannelBufferSize.3 Tcl_GetChannelBufferSize.3.*
+ rm -f Tcl_SetChannelBufferSize.3 Tcl_SetChannelBufferSize.3.*
+ rm -f Tcl_NotifyChannel.3 Tcl_NotifyChannel.3.*
+ rm -f Tcl_BadChannelOption.3 Tcl_BadChannelOption.3.*
+ rm -f Tcl_ChannelName.3 Tcl_ChannelName.3.*
+ rm -f Tcl_ChannelVersion.3 Tcl_ChannelVersion.3.*
+ rm -f Tcl_ChannelBlockModeProc.3 Tcl_ChannelBlockModeProc.3.*
+ rm -f Tcl_ChannelCloseProc.3 Tcl_ChannelCloseProc.3.*
+ rm -f Tcl_ChannelClose2Proc.3 Tcl_ChannelClose2Proc.3.*
+ rm -f Tcl_ChannelInputProc.3 Tcl_ChannelInputProc.3.*
+ rm -f Tcl_ChannelOutputProc.3 Tcl_ChannelOutputProc.3.*
+ rm -f Tcl_ChannelSeekProc.3 Tcl_ChannelSeekProc.3.*
+ rm -f Tcl_ChannelWideSeekProc.3 Tcl_ChannelWideSeekProc.3.*
+ rm -f Tcl_ChannelSetOptionProc.3 Tcl_ChannelSetOptionProc.3.*
+ rm -f Tcl_ChannelGetOptionProc.3 Tcl_ChannelGetOptionProc.3.*
+ rm -f Tcl_ChannelWatchProc.3 Tcl_ChannelWatchProc.3.*
+ rm -f Tcl_ChannelGetHandleProc.3 Tcl_ChannelGetHandleProc.3.*
+ rm -f Tcl_ChannelFlushProc.3 Tcl_ChannelFlushProc.3.*
+ rm -f Tcl_ChannelHandlerProc.3 Tcl_ChannelHandlerProc.3.*
+ rm -f Tcl_IsChannelShared.3 Tcl_IsChannelShared.3.*
+ rm -f Tcl_IsChannelRegistered.3 Tcl_IsChannelRegistered.3.*
+ rm -f Tcl_CutChannel.3 Tcl_CutChannel.3.*
+ rm -f Tcl_SpliceChannel.3 Tcl_SpliceChannel.3.*
+ rm -f Tcl_IsChannelExisting.3 Tcl_IsChannelExisting.3.*
+ rm -f Tcl_ClearChannelHandlers.3 Tcl_ClearChannelHandlers.3.*
+ rm -f Tcl_GetChannelThread.3 Tcl_GetChannelThread.3.*
+ rm -f Tcl_ChannelBuffered.3 Tcl_ChannelBuffered.3.*
+ ln $S CrtChannel.3$Z Tcl_CreateChannel.3$Z
+ ln $S CrtChannel.3$Z Tcl_GetChannelInstanceData.3$Z
+ ln $S CrtChannel.3$Z Tcl_GetChannelType.3$Z
+ ln $S CrtChannel.3$Z Tcl_GetChannelName.3$Z
+ ln $S CrtChannel.3$Z Tcl_GetChannelHandle.3$Z
+ ln $S CrtChannel.3$Z Tcl_GetChannelMode.3$Z
+ ln $S CrtChannel.3$Z Tcl_GetChannelBufferSize.3$Z
+ ln $S CrtChannel.3$Z Tcl_SetChannelBufferSize.3$Z
+ ln $S CrtChannel.3$Z Tcl_NotifyChannel.3$Z
+ ln $S CrtChannel.3$Z Tcl_BadChannelOption.3$Z
+ ln $S CrtChannel.3$Z Tcl_ChannelName.3$Z
+ ln $S CrtChannel.3$Z Tcl_ChannelVersion.3$Z
+ ln $S CrtChannel.3$Z Tcl_ChannelBlockModeProc.3$Z
+ ln $S CrtChannel.3$Z Tcl_ChannelCloseProc.3$Z
+ ln $S CrtChannel.3$Z Tcl_ChannelClose2Proc.3$Z
+ ln $S CrtChannel.3$Z Tcl_ChannelInputProc.3$Z
+ ln $S CrtChannel.3$Z Tcl_ChannelOutputProc.3$Z
+ ln $S CrtChannel.3$Z Tcl_ChannelSeekProc.3$Z
+ ln $S CrtChannel.3$Z Tcl_ChannelWideSeekProc.3$Z
+ ln $S CrtChannel.3$Z Tcl_ChannelSetOptionProc.3$Z
+ ln $S CrtChannel.3$Z Tcl_ChannelGetOptionProc.3$Z
+ ln $S CrtChannel.3$Z Tcl_ChannelWatchProc.3$Z
+ ln $S CrtChannel.3$Z Tcl_ChannelGetHandleProc.3$Z
+ ln $S CrtChannel.3$Z Tcl_ChannelFlushProc.3$Z
+ ln $S CrtChannel.3$Z Tcl_ChannelHandlerProc.3$Z
+ ln $S CrtChannel.3$Z Tcl_IsChannelShared.3$Z
+ ln $S CrtChannel.3$Z Tcl_IsChannelRegistered.3$Z
+ ln $S CrtChannel.3$Z Tcl_CutChannel.3$Z
+ ln $S CrtChannel.3$Z Tcl_SpliceChannel.3$Z
+ ln $S CrtChannel.3$Z Tcl_IsChannelExisting.3$Z
+ ln $S CrtChannel.3$Z Tcl_ClearChannelHandlers.3$Z
+ ln $S CrtChannel.3$Z Tcl_GetChannelThread.3$Z
+ ln $S CrtChannel.3$Z Tcl_ChannelBuffered.3$Z
fi
if test -r CrtChnlHdlr.3; then
- rm -f Tcl_CreateChannelHandler.3
- rm -f Tcl_DeleteChannelHandler.3
- cp CrtChnlHdlr.3 Tcl_CreateChannelHandler.3
- cp CrtChnlHdlr.3 Tcl_DeleteChannelHandler.3
+ rm -f CrtChnlHdlr.3.*
+ $ZIP CrtChnlHdlr.3
+ rm -f Tcl_CreateChannelHandler.3 Tcl_CreateChannelHandler.3.*
+ rm -f Tcl_DeleteChannelHandler.3 Tcl_DeleteChannelHandler.3.*
+ ln $S CrtChnlHdlr.3$Z Tcl_CreateChannelHandler.3$Z
+ ln $S CrtChnlHdlr.3$Z Tcl_DeleteChannelHandler.3$Z
fi
if test -r CrtCloseHdlr.3; then
- rm -f Tcl_CreateCloseHandler.3
- rm -f Tcl_DeleteCloseHandler.3
- cp CrtCloseHdlr.3 Tcl_CreateCloseHandler.3
- cp CrtCloseHdlr.3 Tcl_DeleteCloseHandler.3
+ rm -f CrtCloseHdlr.3.*
+ $ZIP CrtCloseHdlr.3
+ rm -f Tcl_CreateCloseHandler.3 Tcl_CreateCloseHandler.3.*
+ rm -f Tcl_DeleteCloseHandler.3 Tcl_DeleteCloseHandler.3.*
+ ln $S CrtCloseHdlr.3$Z Tcl_CreateCloseHandler.3$Z
+ ln $S CrtCloseHdlr.3$Z Tcl_DeleteCloseHandler.3$Z
fi
if test -r CrtCommand.3; then
- rm -f Tcl_CreateCommand.3
- cp CrtCommand.3 Tcl_CreateCommand.3
+ rm -f CrtCommand.3.*
+ $ZIP CrtCommand.3
+ rm -f Tcl_CreateCommand.3 Tcl_CreateCommand.3.*
+ ln $S CrtCommand.3$Z Tcl_CreateCommand.3$Z
fi
if test -r CrtFileHdlr.3; then
- rm -f Tcl_CreateFileHandler.3
- rm -f Tcl_DeleteFileHandler.3
- cp CrtFileHdlr.3 Tcl_CreateFileHandler.3
- cp CrtFileHdlr.3 Tcl_DeleteFileHandler.3
+ rm -f CrtFileHdlr.3.*
+ $ZIP CrtFileHdlr.3
+ rm -f Tcl_CreateFileHandler.3 Tcl_CreateFileHandler.3.*
+ rm -f Tcl_DeleteFileHandler.3 Tcl_DeleteFileHandler.3.*
+ ln $S CrtFileHdlr.3$Z Tcl_CreateFileHandler.3$Z
+ ln $S CrtFileHdlr.3$Z Tcl_DeleteFileHandler.3$Z
fi
if test -r CrtInterp.3; then
- rm -f Tcl_CreateInterp.3
- rm -f Tcl_DeleteInterp.3
- rm -f Tcl_InterpDeleted.3
- cp CrtInterp.3 Tcl_CreateInterp.3
- cp CrtInterp.3 Tcl_DeleteInterp.3
- cp CrtInterp.3 Tcl_InterpDeleted.3
+ rm -f CrtInterp.3.*
+ $ZIP CrtInterp.3
+ rm -f Tcl_CreateInterp.3 Tcl_CreateInterp.3.*
+ rm -f Tcl_DeleteInterp.3 Tcl_DeleteInterp.3.*
+ rm -f Tcl_InterpDeleted.3 Tcl_InterpDeleted.3.*
+ ln $S CrtInterp.3$Z Tcl_CreateInterp.3$Z
+ ln $S CrtInterp.3$Z Tcl_DeleteInterp.3$Z
+ ln $S CrtInterp.3$Z Tcl_InterpDeleted.3$Z
fi
if test -r CrtMathFnc.3; then
- rm -f Tcl_CreateMathFunc.3
- cp CrtMathFnc.3 Tcl_CreateMathFunc.3
+ rm -f CrtMathFnc.3.*
+ $ZIP CrtMathFnc.3
+ rm -f Tcl_CreateMathFunc.3 Tcl_CreateMathFunc.3.*
+ rm -f Tcl_GetMathFuncInfo.3 Tcl_GetMathFuncInfo.3.*
+ rm -f Tcl_ListMathFuncs.3 Tcl_ListMathFuncs.3.*
+ ln $S CrtMathFnc.3$Z Tcl_CreateMathFunc.3$Z
+ ln $S CrtMathFnc.3$Z Tcl_GetMathFuncInfo.3$Z
+ ln $S CrtMathFnc.3$Z Tcl_ListMathFuncs.3$Z
fi
if test -r CrtObjCmd.3; then
- rm -f Tcl_CreateObjCommand.3
- rm -f Tcl_DeleteCommand.3
- rm -f Tcl_DeleteCommandFromToken.3
- rm -f Tcl_GetCommandInfo.3
- rm -f Tcl_SetCommandInfo.3
- rm -f Tcl_GetCommandName.3
- cp CrtObjCmd.3 Tcl_CreateObjCommand.3
- cp CrtObjCmd.3 Tcl_DeleteCommand.3
- cp CrtObjCmd.3 Tcl_DeleteCommandFromToken.3
- cp CrtObjCmd.3 Tcl_GetCommandInfo.3
- cp CrtObjCmd.3 Tcl_SetCommandInfo.3
- cp CrtObjCmd.3 Tcl_GetCommandName.3
+ rm -f CrtObjCmd.3.*
+ $ZIP CrtObjCmd.3
+ rm -f Tcl_CreateObjCommand.3 Tcl_CreateObjCommand.3.*
+ rm -f Tcl_DeleteCommand.3 Tcl_DeleteCommand.3.*
+ rm -f Tcl_DeleteCommandFromToken.3 Tcl_DeleteCommandFromToken.3.*
+ rm -f Tcl_GetCommandInfo.3 Tcl_GetCommandInfo.3.*
+ rm -f Tcl_GetCommandInfoFromToken.3 Tcl_GetCommandInfoFromToken.3.*
+ rm -f Tcl_SetCommandInfo.3 Tcl_SetCommandInfo.3.*
+ rm -f Tcl_SetCommandInfoFromToken.3 Tcl_SetCommandInfoFromToken.3.*
+ rm -f Tcl_GetCommandName.3 Tcl_GetCommandName.3.*
+ rm -f Tcl_GetCommandFullName.3 Tcl_GetCommandFullName.3.*
+ rm -f Tcl_GetCommandFromObj.3 Tcl_GetCommandFromObj.3.*
+ ln $S CrtObjCmd.3$Z Tcl_CreateObjCommand.3$Z
+ ln $S CrtObjCmd.3$Z Tcl_DeleteCommand.3$Z
+ ln $S CrtObjCmd.3$Z Tcl_DeleteCommandFromToken.3$Z
+ ln $S CrtObjCmd.3$Z Tcl_GetCommandInfo.3$Z
+ ln $S CrtObjCmd.3$Z Tcl_GetCommandInfoFromToken.3$Z
+ ln $S CrtObjCmd.3$Z Tcl_SetCommandInfo.3$Z
+ ln $S CrtObjCmd.3$Z Tcl_SetCommandInfoFromToken.3$Z
+ ln $S CrtObjCmd.3$Z Tcl_GetCommandName.3$Z
+ ln $S CrtObjCmd.3$Z Tcl_GetCommandFullName.3$Z
+ ln $S CrtObjCmd.3$Z Tcl_GetCommandFromObj.3$Z
fi
if test -r CrtSlave.3; then
- rm -f Tcl_IsSafe.3
- rm -f Tcl_MakeSafe.3
- rm -f Tcl_CreateSlave.3
- rm -f Tcl_GetSlave.3
- rm -f Tcl_GetMaster.3
- rm -f Tcl_GetInterpPath.3
- rm -f Tcl_CreateAlias.3
- rm -f Tcl_CreateAliasObj.3
- rm -f Tcl_GetAlias.3
- rm -f Tcl_GetAliasObj.3
- rm -f Tcl_ExposeCommand.3
- rm -f Tcl_HideCommand.3
- cp CrtSlave.3 Tcl_IsSafe.3
- cp CrtSlave.3 Tcl_MakeSafe.3
- cp CrtSlave.3 Tcl_CreateSlave.3
- cp CrtSlave.3 Tcl_GetSlave.3
- cp CrtSlave.3 Tcl_GetMaster.3
- cp CrtSlave.3 Tcl_GetInterpPath.3
- cp CrtSlave.3 Tcl_CreateAlias.3
- cp CrtSlave.3 Tcl_CreateAliasObj.3
- cp CrtSlave.3 Tcl_GetAlias.3
- cp CrtSlave.3 Tcl_GetAliasObj.3
- cp CrtSlave.3 Tcl_ExposeCommand.3
- cp CrtSlave.3 Tcl_HideCommand.3
+ rm -f CrtSlave.3.*
+ $ZIP CrtSlave.3
+ rm -f Tcl_IsSafe.3 Tcl_IsSafe.3.*
+ rm -f Tcl_MakeSafe.3 Tcl_MakeSafe.3.*
+ rm -f Tcl_CreateSlave.3 Tcl_CreateSlave.3.*
+ rm -f Tcl_GetSlave.3 Tcl_GetSlave.3.*
+ rm -f Tcl_GetMaster.3 Tcl_GetMaster.3.*
+ rm -f Tcl_GetInterpPath.3 Tcl_GetInterpPath.3.*
+ rm -f Tcl_CreateAlias.3 Tcl_CreateAlias.3.*
+ rm -f Tcl_CreateAliasObj.3 Tcl_CreateAliasObj.3.*
+ rm -f Tcl_GetAlias.3 Tcl_GetAlias.3.*
+ rm -f Tcl_GetAliasObj.3 Tcl_GetAliasObj.3.*
+ rm -f Tcl_ExposeCommand.3 Tcl_ExposeCommand.3.*
+ rm -f Tcl_HideCommand.3 Tcl_HideCommand.3.*
+ ln $S CrtSlave.3$Z Tcl_IsSafe.3$Z
+ ln $S CrtSlave.3$Z Tcl_MakeSafe.3$Z
+ ln $S CrtSlave.3$Z Tcl_CreateSlave.3$Z
+ ln $S CrtSlave.3$Z Tcl_GetSlave.3$Z
+ ln $S CrtSlave.3$Z Tcl_GetMaster.3$Z
+ ln $S CrtSlave.3$Z Tcl_GetInterpPath.3$Z
+ ln $S CrtSlave.3$Z Tcl_CreateAlias.3$Z
+ ln $S CrtSlave.3$Z Tcl_CreateAliasObj.3$Z
+ ln $S CrtSlave.3$Z Tcl_GetAlias.3$Z
+ ln $S CrtSlave.3$Z Tcl_GetAliasObj.3$Z
+ ln $S CrtSlave.3$Z Tcl_ExposeCommand.3$Z
+ ln $S CrtSlave.3$Z Tcl_HideCommand.3$Z
fi
if test -r CrtTimerHdlr.3; then
- rm -f Tcl_CreateTimerHandler.3
- rm -f Tcl_DeleteTimerHandler.3
- cp CrtTimerHdlr.3 Tcl_CreateTimerHandler.3
- cp CrtTimerHdlr.3 Tcl_DeleteTimerHandler.3
+ rm -f CrtTimerHdlr.3.*
+ $ZIP CrtTimerHdlr.3
+ rm -f Tcl_CreateTimerHandler.3 Tcl_CreateTimerHandler.3.*
+ rm -f Tcl_DeleteTimerHandler.3 Tcl_DeleteTimerHandler.3.*
+ ln $S CrtTimerHdlr.3$Z Tcl_CreateTimerHandler.3$Z
+ ln $S CrtTimerHdlr.3$Z Tcl_DeleteTimerHandler.3$Z
fi
if test -r CrtTrace.3; then
- rm -f Tcl_CreateTrace.3
- rm -f Tcl_DeleteTrace.3
- cp CrtTrace.3 Tcl_CreateTrace.3
- cp CrtTrace.3 Tcl_DeleteTrace.3
+ rm -f CrtTrace.3.*
+ $ZIP CrtTrace.3
+ rm -f Tcl_CreateTrace.3 Tcl_CreateTrace.3.*
+ rm -f Tcl_CreateObjTrace.3 Tcl_CreateObjTrace.3.*
+ rm -f Tcl_DeleteTrace.3 Tcl_DeleteTrace.3.*
+ ln $S CrtTrace.3$Z Tcl_CreateTrace.3$Z
+ ln $S CrtTrace.3$Z Tcl_CreateObjTrace.3$Z
+ ln $S CrtTrace.3$Z Tcl_DeleteTrace.3$Z
fi
if test -r DString.3; then
- rm -f Tcl_DStringInit.3
- rm -f Tcl_DStringAppend.3
- rm -f Tcl_DStringAppendElement.3
- rm -f Tcl_DStringStartSublist.3
- rm -f Tcl_DStringEndSublist.3
- rm -f Tcl_DStringLength.3
- rm -f Tcl_DStringValue.3
- rm -f Tcl_DStringSetLength.3
- rm -f Tcl_DStringFree.3
- rm -f Tcl_DStringResult.3
- rm -f Tcl_DStringGetResult.3
- cp DString.3 Tcl_DStringInit.3
- cp DString.3 Tcl_DStringAppend.3
- cp DString.3 Tcl_DStringAppendElement.3
- cp DString.3 Tcl_DStringStartSublist.3
- cp DString.3 Tcl_DStringEndSublist.3
- cp DString.3 Tcl_DStringLength.3
- cp DString.3 Tcl_DStringValue.3
- cp DString.3 Tcl_DStringSetLength.3
- cp DString.3 Tcl_DStringFree.3
- cp DString.3 Tcl_DStringResult.3
- cp DString.3 Tcl_DStringGetResult.3
+ rm -f DString.3.*
+ $ZIP DString.3
+ rm -f Tcl_DStringInit.3 Tcl_DStringInit.3.*
+ rm -f Tcl_DStringAppend.3 Tcl_DStringAppend.3.*
+ rm -f Tcl_DStringAppendElement.3 Tcl_DStringAppendElement.3.*
+ rm -f Tcl_DStringStartSublist.3 Tcl_DStringStartSublist.3.*
+ rm -f Tcl_DStringEndSublist.3 Tcl_DStringEndSublist.3.*
+ rm -f Tcl_DStringLength.3 Tcl_DStringLength.3.*
+ rm -f Tcl_DStringValue.3 Tcl_DStringValue.3.*
+ rm -f Tcl_DStringSetLength.3 Tcl_DStringSetLength.3.*
+ rm -f Tcl_DStringTrunc.3 Tcl_DStringTrunc.3.*
+ rm -f Tcl_DStringFree.3 Tcl_DStringFree.3.*
+ rm -f Tcl_DStringResult.3 Tcl_DStringResult.3.*
+ rm -f Tcl_DStringGetResult.3 Tcl_DStringGetResult.3.*
+ ln $S DString.3$Z Tcl_DStringInit.3$Z
+ ln $S DString.3$Z Tcl_DStringAppend.3$Z
+ ln $S DString.3$Z Tcl_DStringAppendElement.3$Z
+ ln $S DString.3$Z Tcl_DStringStartSublist.3$Z
+ ln $S DString.3$Z Tcl_DStringEndSublist.3$Z
+ ln $S DString.3$Z Tcl_DStringLength.3$Z
+ ln $S DString.3$Z Tcl_DStringValue.3$Z
+ ln $S DString.3$Z Tcl_DStringSetLength.3$Z
+ ln $S DString.3$Z Tcl_DStringTrunc.3$Z
+ ln $S DString.3$Z Tcl_DStringFree.3$Z
+ ln $S DString.3$Z Tcl_DStringResult.3$Z
+ ln $S DString.3$Z Tcl_DStringGetResult.3$Z
fi
if test -r DetachPids.3; then
- rm -f Tcl_DetachPids.3
- rm -f Tcl_ReapDetachedProcs.3
- cp DetachPids.3 Tcl_DetachPids.3
- cp DetachPids.3 Tcl_ReapDetachedProcs.3
+ rm -f DetachPids.3.*
+ $ZIP DetachPids.3
+ rm -f Tcl_DetachPids.3 Tcl_DetachPids.3.*
+ rm -f Tcl_ReapDetachedProcs.3 Tcl_ReapDetachedProcs.3.*
+ rm -f Tcl_WaitPid.3 Tcl_WaitPid.3.*
+ ln $S DetachPids.3$Z Tcl_DetachPids.3$Z
+ ln $S DetachPids.3$Z Tcl_ReapDetachedProcs.3$Z
+ ln $S DetachPids.3$Z Tcl_WaitPid.3$Z
fi
if test -r DoOneEvent.3; then
- rm -f Tcl_DoOneEvent.3
- cp DoOneEvent.3 Tcl_DoOneEvent.3
+ rm -f DoOneEvent.3.*
+ $ZIP DoOneEvent.3
+ rm -f Tcl_DoOneEvent.3 Tcl_DoOneEvent.3.*
+ ln $S DoOneEvent.3$Z Tcl_DoOneEvent.3$Z
fi
if test -r DoWhenIdle.3; then
- rm -f Tcl_DoWhenIdle.3
- rm -f Tcl_CancelIdleCall.3
- cp DoWhenIdle.3 Tcl_DoWhenIdle.3
- cp DoWhenIdle.3 Tcl_CancelIdleCall.3
+ rm -f DoWhenIdle.3.*
+ $ZIP DoWhenIdle.3
+ rm -f Tcl_DoWhenIdle.3 Tcl_DoWhenIdle.3.*
+ rm -f Tcl_CancelIdleCall.3 Tcl_CancelIdleCall.3.*
+ ln $S DoWhenIdle.3$Z Tcl_DoWhenIdle.3$Z
+ ln $S DoWhenIdle.3$Z Tcl_CancelIdleCall.3$Z
fi
if test -r DoubleObj.3; then
- rm -f Tcl_NewDoubleObj.3
- rm -f Tcl_SetDoubleObj.3
- rm -f Tcl_GetDoubleFromObj.3
- cp DoubleObj.3 Tcl_NewDoubleObj.3
- cp DoubleObj.3 Tcl_SetDoubleObj.3
- cp DoubleObj.3 Tcl_GetDoubleFromObj.3
+ rm -f DoubleObj.3.*
+ $ZIP DoubleObj.3
+ rm -f Tcl_NewDoubleObj.3 Tcl_NewDoubleObj.3.*
+ rm -f Tcl_SetDoubleObj.3 Tcl_SetDoubleObj.3.*
+ rm -f Tcl_GetDoubleFromObj.3 Tcl_GetDoubleFromObj.3.*
+ ln $S DoubleObj.3$Z Tcl_NewDoubleObj.3$Z
+ ln $S DoubleObj.3$Z Tcl_SetDoubleObj.3$Z
+ ln $S DoubleObj.3$Z Tcl_GetDoubleFromObj.3$Z
fi
if test -r DumpActiveMemory.3; then
- rm -f Tcl_DumpActiveMemory.3
- rm -f Tcl_InitMemory.3
- rm -f Tcl_ValidateAllMemory.3
- cp DumpActiveMemory.3 Tcl_DumpActiveMemory.3
- cp DumpActiveMemory.3 Tcl_InitMemory.3
- cp DumpActiveMemory.3 Tcl_ValidateAllMemory.3
+ rm -f DumpActiveMemory.3.*
+ $ZIP DumpActiveMemory.3
+ rm -f Tcl_DumpActiveMemory.3 Tcl_DumpActiveMemory.3.*
+ rm -f Tcl_InitMemory.3 Tcl_InitMemory.3.*
+ rm -f Tcl_ValidateAllMemory.3 Tcl_ValidateAllMemory.3.*
+ ln $S DumpActiveMemory.3$Z Tcl_DumpActiveMemory.3$Z
+ ln $S DumpActiveMemory.3$Z Tcl_InitMemory.3$Z
+ ln $S DumpActiveMemory.3$Z Tcl_ValidateAllMemory.3$Z
fi
if test -r Encoding.3; then
- rm -f Tcl_GetEncoding.3
- rm -f Tcl_FreeEncoding.3
- rm -f Tcl_ExternalToUtfDString.3
- rm -f Tcl_ExternalToUtf.3
- rm -f Tcl_UtfToExternalDString.3
- rm -f Tcl_UtfToExternal.3
- rm -f Tcl_WinTCharToUtf.3
- rm -f Tcl_WinUtfToTChar.3
- rm -f Tcl_GetEncodingName.3
- rm -f Tcl_SetSystemEncoding.3
- rm -f Tcl_GetEncodingNames.3
- rm -f Tcl_CreateEncoding.3
- rm -f Tcl_GetDefaultEncodingDir.3
- rm -f Tcl_SetDefaultEncodingDir.3
- cp Encoding.3 Tcl_GetEncoding.3
- cp Encoding.3 Tcl_FreeEncoding.3
- cp Encoding.3 Tcl_ExternalToUtfDString.3
- cp Encoding.3 Tcl_ExternalToUtf.3
- cp Encoding.3 Tcl_UtfToExternalDString.3
- cp Encoding.3 Tcl_UtfToExternal.3
- cp Encoding.3 Tcl_WinTCharToUtf.3
- cp Encoding.3 Tcl_WinUtfToTChar.3
- cp Encoding.3 Tcl_GetEncodingName.3
- cp Encoding.3 Tcl_SetSystemEncoding.3
- cp Encoding.3 Tcl_GetEncodingNames.3
- cp Encoding.3 Tcl_CreateEncoding.3
- cp Encoding.3 Tcl_GetDefaultEncodingDir.3
- cp Encoding.3 Tcl_SetDefaultEncodingDir.3
+ rm -f Encoding.3.*
+ $ZIP Encoding.3
+ rm -f Tcl_GetEncoding.3 Tcl_GetEncoding.3.*
+ rm -f Tcl_FreeEncoding.3 Tcl_FreeEncoding.3.*
+ rm -f Tcl_ExternalToUtfDString.3 Tcl_ExternalToUtfDString.3.*
+ rm -f Tcl_ExternalToUtf.3 Tcl_ExternalToUtf.3.*
+ rm -f Tcl_UtfToExternalDString.3 Tcl_UtfToExternalDString.3.*
+ rm -f Tcl_UtfToExternal.3 Tcl_UtfToExternal.3.*
+ rm -f Tcl_WinTCharToUtf.3 Tcl_WinTCharToUtf.3.*
+ rm -f Tcl_WinUtfToTChar.3 Tcl_WinUtfToTChar.3.*
+ rm -f Tcl_GetEncodingName.3 Tcl_GetEncodingName.3.*
+ rm -f Tcl_SetSystemEncoding.3 Tcl_SetSystemEncoding.3.*
+ rm -f Tcl_GetEncodingNames.3 Tcl_GetEncodingNames.3.*
+ rm -f Tcl_CreateEncoding.3 Tcl_CreateEncoding.3.*
+ rm -f Tcl_GetDefaultEncodingDir.3 Tcl_GetDefaultEncodingDir.3.*
+ rm -f Tcl_SetDefaultEncodingDir.3 Tcl_SetDefaultEncodingDir.3.*
+ ln $S Encoding.3$Z Tcl_GetEncoding.3$Z
+ ln $S Encoding.3$Z Tcl_FreeEncoding.3$Z
+ ln $S Encoding.3$Z Tcl_ExternalToUtfDString.3$Z
+ ln $S Encoding.3$Z Tcl_ExternalToUtf.3$Z
+ ln $S Encoding.3$Z Tcl_UtfToExternalDString.3$Z
+ ln $S Encoding.3$Z Tcl_UtfToExternal.3$Z
+ ln $S Encoding.3$Z Tcl_WinTCharToUtf.3$Z
+ ln $S Encoding.3$Z Tcl_WinUtfToTChar.3$Z
+ ln $S Encoding.3$Z Tcl_GetEncodingName.3$Z
+ ln $S Encoding.3$Z Tcl_SetSystemEncoding.3$Z
+ ln $S Encoding.3$Z Tcl_GetEncodingNames.3$Z
+ ln $S Encoding.3$Z Tcl_CreateEncoding.3$Z
+ ln $S Encoding.3$Z Tcl_GetDefaultEncodingDir.3$Z
+ ln $S Encoding.3$Z Tcl_SetDefaultEncodingDir.3$Z
+fi
+if test -r Environment.3; then
+ rm -f Environment.3.*
+ $ZIP Environment.3
+ rm -f Tcl_PutEnv.3 Tcl_PutEnv.3.*
+ ln $S Environment.3$Z Tcl_PutEnv.3$Z
fi
if test -r Eval.3; then
- rm -f Tcl_EvalObjEx.3
- rm -f Tcl_EvalFile.3
- rm -f Tcl_EvalObjv.3
- rm -f Tcl_Eval.3
- rm -f Tcl_EvalEx.3
- rm -f Tcl_GlobalEval.3
- rm -f Tcl_GlobalEvalObj.3
- rm -f Tcl_VarEval.3
- rm -f Tcl_VarEvalVA.3
- cp Eval.3 Tcl_EvalObjEx.3
- cp Eval.3 Tcl_EvalFile.3
- cp Eval.3 Tcl_EvalObjv.3
- cp Eval.3 Tcl_Eval.3
- cp Eval.3 Tcl_EvalEx.3
- cp Eval.3 Tcl_GlobalEval.3
- cp Eval.3 Tcl_GlobalEvalObj.3
- cp Eval.3 Tcl_VarEval.3
- cp Eval.3 Tcl_VarEvalVA.3
+ rm -f Eval.3.*
+ $ZIP Eval.3
+ rm -f Tcl_EvalObjEx.3 Tcl_EvalObjEx.3.*
+ rm -f Tcl_EvalFile.3 Tcl_EvalFile.3.*
+ rm -f Tcl_EvalObjv.3 Tcl_EvalObjv.3.*
+ rm -f Tcl_Eval.3 Tcl_Eval.3.*
+ rm -f Tcl_EvalEx.3 Tcl_EvalEx.3.*
+ rm -f Tcl_GlobalEval.3 Tcl_GlobalEval.3.*
+ rm -f Tcl_GlobalEvalObj.3 Tcl_GlobalEvalObj.3.*
+ rm -f Tcl_VarEval.3 Tcl_VarEval.3.*
+ rm -f Tcl_VarEvalVA.3 Tcl_VarEvalVA.3.*
+ ln $S Eval.3$Z Tcl_EvalObjEx.3$Z
+ ln $S Eval.3$Z Tcl_EvalFile.3$Z
+ ln $S Eval.3$Z Tcl_EvalObjv.3$Z
+ ln $S Eval.3$Z Tcl_Eval.3$Z
+ ln $S Eval.3$Z Tcl_EvalEx.3$Z
+ ln $S Eval.3$Z Tcl_GlobalEval.3$Z
+ ln $S Eval.3$Z Tcl_GlobalEvalObj.3$Z
+ ln $S Eval.3$Z Tcl_VarEval.3$Z
+ ln $S Eval.3$Z Tcl_VarEvalVA.3$Z
fi
if test -r Exit.3; then
- rm -f Tcl_Exit.3
- rm -f Tcl_Finalize.3
- rm -f Tcl_CreateExitHandler.3
- rm -f Tcl_DeleteExitHandler.3
- rm -f Tcl_ExitThread.3
- rm -f Tcl_FinalizeThread.3
- rm -f Tcl_CreateThreadExitHandler.3
- rm -f Tcl_DeleteThreadExitHandler.3
- cp Exit.3 Tcl_Exit.3
- cp Exit.3 Tcl_Finalize.3
- cp Exit.3 Tcl_CreateExitHandler.3
- cp Exit.3 Tcl_DeleteExitHandler.3
- cp Exit.3 Tcl_ExitThread.3
- cp Exit.3 Tcl_FinalizeThread.3
- cp Exit.3 Tcl_CreateThreadExitHandler.3
- cp Exit.3 Tcl_DeleteThreadExitHandler.3
+ rm -f Exit.3.*
+ $ZIP Exit.3
+ rm -f Tcl_Exit.3 Tcl_Exit.3.*
+ rm -f Tcl_Finalize.3 Tcl_Finalize.3.*
+ rm -f Tcl_CreateExitHandler.3 Tcl_CreateExitHandler.3.*
+ rm -f Tcl_DeleteExitHandler.3 Tcl_DeleteExitHandler.3.*
+ rm -f Tcl_ExitThread.3 Tcl_ExitThread.3.*
+ rm -f Tcl_FinalizeThread.3 Tcl_FinalizeThread.3.*
+ rm -f Tcl_CreateThreadExitHandler.3 Tcl_CreateThreadExitHandler.3.*
+ rm -f Tcl_DeleteThreadExitHandler.3 Tcl_DeleteThreadExitHandler.3.*
+ ln $S Exit.3$Z Tcl_Exit.3$Z
+ ln $S Exit.3$Z Tcl_Finalize.3$Z
+ ln $S Exit.3$Z Tcl_CreateExitHandler.3$Z
+ ln $S Exit.3$Z Tcl_DeleteExitHandler.3$Z
+ ln $S Exit.3$Z Tcl_ExitThread.3$Z
+ ln $S Exit.3$Z Tcl_FinalizeThread.3$Z
+ ln $S Exit.3$Z Tcl_CreateThreadExitHandler.3$Z
+ ln $S Exit.3$Z Tcl_DeleteThreadExitHandler.3$Z
fi
if test -r ExprLong.3; then
- rm -f Tcl_ExprLong.3
- rm -f Tcl_ExprDouble.3
- rm -f Tcl_ExprBoolean.3
- rm -f Tcl_ExprString.3
- cp ExprLong.3 Tcl_ExprLong.3
- cp ExprLong.3 Tcl_ExprDouble.3
- cp ExprLong.3 Tcl_ExprBoolean.3
- cp ExprLong.3 Tcl_ExprString.3
+ rm -f ExprLong.3.*
+ $ZIP ExprLong.3
+ rm -f Tcl_ExprLong.3 Tcl_ExprLong.3.*
+ rm -f Tcl_ExprDouble.3 Tcl_ExprDouble.3.*
+ rm -f Tcl_ExprBoolean.3 Tcl_ExprBoolean.3.*
+ rm -f Tcl_ExprString.3 Tcl_ExprString.3.*
+ ln $S ExprLong.3$Z Tcl_ExprLong.3$Z
+ ln $S ExprLong.3$Z Tcl_ExprDouble.3$Z
+ ln $S ExprLong.3$Z Tcl_ExprBoolean.3$Z
+ ln $S ExprLong.3$Z Tcl_ExprString.3$Z
fi
if test -r ExprLongObj.3; then
- rm -f Tcl_ExprLongObj.3
- rm -f Tcl_ExprDoubleObj.3
- rm -f Tcl_ExprBooleanObj.3
- rm -f Tcl_ExprObj.3
- cp ExprLongObj.3 Tcl_ExprLongObj.3
- cp ExprLongObj.3 Tcl_ExprDoubleObj.3
- cp ExprLongObj.3 Tcl_ExprBooleanObj.3
- cp ExprLongObj.3 Tcl_ExprObj.3
+ rm -f ExprLongObj.3.*
+ $ZIP ExprLongObj.3
+ rm -f Tcl_ExprLongObj.3 Tcl_ExprLongObj.3.*
+ rm -f Tcl_ExprDoubleObj.3 Tcl_ExprDoubleObj.3.*
+ rm -f Tcl_ExprBooleanObj.3 Tcl_ExprBooleanObj.3.*
+ rm -f Tcl_ExprObj.3 Tcl_ExprObj.3.*
+ ln $S ExprLongObj.3$Z Tcl_ExprLongObj.3$Z
+ ln $S ExprLongObj.3$Z Tcl_ExprDoubleObj.3$Z
+ ln $S ExprLongObj.3$Z Tcl_ExprBooleanObj.3$Z
+ ln $S ExprLongObj.3$Z Tcl_ExprObj.3$Z
+fi
+if test -r FileSystem.3; then
+ rm -f FileSystem.3.*
+ $ZIP FileSystem.3
+ rm -f Tcl_FSRegister.3 Tcl_FSRegister.3.*
+ rm -f Tcl_FSUnregister.3 Tcl_FSUnregister.3.*
+ rm -f Tcl_FSData.3 Tcl_FSData.3.*
+ rm -f Tcl_FSMountsChanged.3 Tcl_FSMountsChanged.3.*
+ rm -f Tcl_FSGetFileSystemForPath.3 Tcl_FSGetFileSystemForPath.3.*
+ rm -f Tcl_FSGetPathType.3 Tcl_FSGetPathType.3.*
+ rm -f Tcl_FSCopyFile.3 Tcl_FSCopyFile.3.*
+ rm -f Tcl_FSCopyDirectory.3 Tcl_FSCopyDirectory.3.*
+ rm -f Tcl_FSCreateDirectory.3 Tcl_FSCreateDirectory.3.*
+ rm -f Tcl_FSDeleteFile.3 Tcl_FSDeleteFile.3.*
+ rm -f Tcl_FSRemoveDirectory.3 Tcl_FSRemoveDirectory.3.*
+ rm -f Tcl_FSRenameFile.3 Tcl_FSRenameFile.3.*
+ rm -f Tcl_FSListVolumes.3 Tcl_FSListVolumes.3.*
+ rm -f Tcl_FSEvalFile.3 Tcl_FSEvalFile.3.*
+ rm -f Tcl_FSLoadFile.3 Tcl_FSLoadFile.3.*
+ rm -f Tcl_FSMatchInDirectory.3 Tcl_FSMatchInDirectory.3.*
+ rm -f Tcl_FSLink.3 Tcl_FSLink.3.*
+ rm -f Tcl_FSLstat.3 Tcl_FSLstat.3.*
+ rm -f Tcl_FSUtime.3 Tcl_FSUtime.3.*
+ rm -f Tcl_FSFileAttrsGet.3 Tcl_FSFileAttrsGet.3.*
+ rm -f Tcl_FSFileAttrsSet.3 Tcl_FSFileAttrsSet.3.*
+ rm -f Tcl_FSFileAttrStrings.3 Tcl_FSFileAttrStrings.3.*
+ rm -f Tcl_FSStat.3 Tcl_FSStat.3.*
+ rm -f Tcl_FSAccess.3 Tcl_FSAccess.3.*
+ rm -f Tcl_FSOpenFileChannel.3 Tcl_FSOpenFileChannel.3.*
+ rm -f Tcl_FSGetCwd.3 Tcl_FSGetCwd.3.*
+ rm -f Tcl_FSChdir.3 Tcl_FSChdir.3.*
+ rm -f Tcl_FSPathSeparator.3 Tcl_FSPathSeparator.3.*
+ rm -f Tcl_FSJoinPath.3 Tcl_FSJoinPath.3.*
+ rm -f Tcl_FSSplitPath.3 Tcl_FSSplitPath.3.*
+ rm -f Tcl_FSEqualPaths.3 Tcl_FSEqualPaths.3.*
+ rm -f Tcl_FSGetNormalizedPath.3 Tcl_FSGetNormalizedPath.3.*
+ rm -f Tcl_FSJoinToPath.3 Tcl_FSJoinToPath.3.*
+ rm -f Tcl_FSConvertToPathType.3 Tcl_FSConvertToPathType.3.*
+ rm -f Tcl_FSGetInternalRep.3 Tcl_FSGetInternalRep.3.*
+ rm -f Tcl_FSGetTranslatedPath.3 Tcl_FSGetTranslatedPath.3.*
+ rm -f Tcl_FSGetTranslatedStringPath.3 Tcl_FSGetTranslatedStringPath.3.*
+ rm -f Tcl_FSNewNativePath.3 Tcl_FSNewNativePath.3.*
+ rm -f Tcl_FSGetNativePath.3 Tcl_FSGetNativePath.3.*
+ rm -f Tcl_FSFileSystemInfo.3 Tcl_FSFileSystemInfo.3.*
+ rm -f Tcl_AllocStatBuf.3 Tcl_AllocStatBuf.3.*
+ ln $S FileSystem.3$Z Tcl_FSRegister.3$Z
+ ln $S FileSystem.3$Z Tcl_FSUnregister.3$Z
+ ln $S FileSystem.3$Z Tcl_FSData.3$Z
+ ln $S FileSystem.3$Z Tcl_FSMountsChanged.3$Z
+ ln $S FileSystem.3$Z Tcl_FSGetFileSystemForPath.3$Z
+ ln $S FileSystem.3$Z Tcl_FSGetPathType.3$Z
+ ln $S FileSystem.3$Z Tcl_FSCopyFile.3$Z
+ ln $S FileSystem.3$Z Tcl_FSCopyDirectory.3$Z
+ ln $S FileSystem.3$Z Tcl_FSCreateDirectory.3$Z
+ ln $S FileSystem.3$Z Tcl_FSDeleteFile.3$Z
+ ln $S FileSystem.3$Z Tcl_FSRemoveDirectory.3$Z
+ ln $S FileSystem.3$Z Tcl_FSRenameFile.3$Z
+ ln $S FileSystem.3$Z Tcl_FSListVolumes.3$Z
+ ln $S FileSystem.3$Z Tcl_FSEvalFile.3$Z
+ ln $S FileSystem.3$Z Tcl_FSLoadFile.3$Z
+ ln $S FileSystem.3$Z Tcl_FSMatchInDirectory.3$Z
+ ln $S FileSystem.3$Z Tcl_FSLink.3$Z
+ ln $S FileSystem.3$Z Tcl_FSLstat.3$Z
+ ln $S FileSystem.3$Z Tcl_FSUtime.3$Z
+ ln $S FileSystem.3$Z Tcl_FSFileAttrsGet.3$Z
+ ln $S FileSystem.3$Z Tcl_FSFileAttrsSet.3$Z
+ ln $S FileSystem.3$Z Tcl_FSFileAttrStrings.3$Z
+ ln $S FileSystem.3$Z Tcl_FSStat.3$Z
+ ln $S FileSystem.3$Z Tcl_FSAccess.3$Z
+ ln $S FileSystem.3$Z Tcl_FSOpenFileChannel.3$Z
+ ln $S FileSystem.3$Z Tcl_FSGetCwd.3$Z
+ ln $S FileSystem.3$Z Tcl_FSChdir.3$Z
+ ln $S FileSystem.3$Z Tcl_FSPathSeparator.3$Z
+ ln $S FileSystem.3$Z Tcl_FSJoinPath.3$Z
+ ln $S FileSystem.3$Z Tcl_FSSplitPath.3$Z
+ ln $S FileSystem.3$Z Tcl_FSEqualPaths.3$Z
+ ln $S FileSystem.3$Z Tcl_FSGetNormalizedPath.3$Z
+ ln $S FileSystem.3$Z Tcl_FSJoinToPath.3$Z
+ ln $S FileSystem.3$Z Tcl_FSConvertToPathType.3$Z
+ ln $S FileSystem.3$Z Tcl_FSGetInternalRep.3$Z
+ ln $S FileSystem.3$Z Tcl_FSGetTranslatedPath.3$Z
+ ln $S FileSystem.3$Z Tcl_FSGetTranslatedStringPath.3$Z
+ ln $S FileSystem.3$Z Tcl_FSNewNativePath.3$Z
+ ln $S FileSystem.3$Z Tcl_FSGetNativePath.3$Z
+ ln $S FileSystem.3$Z Tcl_FSFileSystemInfo.3$Z
+ ln $S FileSystem.3$Z Tcl_AllocStatBuf.3$Z
fi
if test -r FindExec.3; then
- rm -f Tcl_FindExecutable.3
- rm -f Tcl_GetNameOfExecutable.3
- cp FindExec.3 Tcl_FindExecutable.3
- cp FindExec.3 Tcl_GetNameOfExecutable.3
+ rm -f FindExec.3.*
+ $ZIP FindExec.3
+ rm -f Tcl_FindExecutable.3 Tcl_FindExecutable.3.*
+ rm -f Tcl_GetNameOfExecutable.3 Tcl_GetNameOfExecutable.3.*
+ ln $S FindExec.3$Z Tcl_FindExecutable.3$Z
+ ln $S FindExec.3$Z Tcl_GetNameOfExecutable.3$Z
fi
if test -r GetCwd.3; then
- rm -f Tcl_GetCwd.3
- rm -f Tcl_Chdir.3
- cp GetCwd.3 Tcl_GetCwd.3
- cp GetCwd.3 Tcl_Chdir.3
+ rm -f GetCwd.3.*
+ $ZIP GetCwd.3
+ rm -f Tcl_GetCwd.3 Tcl_GetCwd.3.*
+ rm -f Tcl_Chdir.3 Tcl_Chdir.3.*
+ ln $S GetCwd.3$Z Tcl_GetCwd.3$Z
+ ln $S GetCwd.3$Z Tcl_Chdir.3$Z
fi
if test -r GetHostName.3; then
- rm -f Tcl_GetHostName.3
- cp GetHostName.3 Tcl_GetHostName.3
+ rm -f GetHostName.3.*
+ $ZIP GetHostName.3
+ rm -f Tcl_GetHostName.3 Tcl_GetHostName.3.*
+ ln $S GetHostName.3$Z Tcl_GetHostName.3$Z
fi
if test -r GetIndex.3; then
- rm -f Tcl_GetIndexFromObj.3
- rm -f Tcl_GetIndexFromObjStruct.3
- cp GetIndex.3 Tcl_GetIndexFromObj.3
- cp GetIndex.3 Tcl_GetIndexFromObjStruct.3
+ rm -f GetIndex.3.*
+ $ZIP GetIndex.3
+ rm -f Tcl_GetIndexFromObj.3 Tcl_GetIndexFromObj.3.*
+ rm -f Tcl_GetIndexFromObjStruct.3 Tcl_GetIndexFromObjStruct.3.*
+ ln $S GetIndex.3$Z Tcl_GetIndexFromObj.3$Z
+ ln $S GetIndex.3$Z Tcl_GetIndexFromObjStruct.3$Z
fi
if test -r GetInt.3; then
- rm -f Tcl_GetInt.3
- rm -f Tcl_GetDouble.3
- rm -f Tcl_GetBoolean.3
- cp GetInt.3 Tcl_GetInt.3
- cp GetInt.3 Tcl_GetDouble.3
- cp GetInt.3 Tcl_GetBoolean.3
+ rm -f GetInt.3.*
+ $ZIP GetInt.3
+ rm -f Tcl_GetInt.3 Tcl_GetInt.3.*
+ rm -f Tcl_GetDouble.3 Tcl_GetDouble.3.*
+ rm -f Tcl_GetBoolean.3 Tcl_GetBoolean.3.*
+ ln $S GetInt.3$Z Tcl_GetInt.3$Z
+ ln $S GetInt.3$Z Tcl_GetDouble.3$Z
+ ln $S GetInt.3$Z Tcl_GetBoolean.3$Z
fi
if test -r GetOpnFl.3; then
- rm -f Tcl_GetOpenFile.3
- cp GetOpnFl.3 Tcl_GetOpenFile.3
+ rm -f GetOpnFl.3.*
+ $ZIP GetOpnFl.3
+ rm -f Tcl_GetOpenFile.3 Tcl_GetOpenFile.3.*
+ ln $S GetOpnFl.3$Z Tcl_GetOpenFile.3$Z
fi
if test -r GetStdChan.3; then
- rm -f Tcl_GetStdChannel.3
- rm -f Tcl_SetStdChannel.3
- cp GetStdChan.3 Tcl_GetStdChannel.3
- cp GetStdChan.3 Tcl_SetStdChannel.3
+ rm -f GetStdChan.3.*
+ $ZIP GetStdChan.3
+ rm -f Tcl_GetStdChannel.3 Tcl_GetStdChannel.3.*
+ rm -f Tcl_SetStdChannel.3 Tcl_SetStdChannel.3.*
+ ln $S GetStdChan.3$Z Tcl_GetStdChannel.3$Z
+ ln $S GetStdChan.3$Z Tcl_SetStdChannel.3$Z
+fi
+if test -r GetTime.3; then
+ rm -f GetTime.3.*
+ $ZIP GetTime.3
+ rm -f Tcl_GetTime.3 Tcl_GetTime.3.*
+ ln $S GetTime.3$Z Tcl_GetTime.3$Z
fi
if test -r GetVersion.3; then
- rm -f Tcl_GetVersion.3
- cp GetVersion.3 Tcl_GetVersion.3
+ rm -f GetVersion.3.*
+ $ZIP GetVersion.3
+ rm -f Tcl_GetVersion.3 Tcl_GetVersion.3.*
+ ln $S GetVersion.3$Z Tcl_GetVersion.3$Z
fi
if test -r Hash.3; then
- rm -f Tcl_InitHashTable.3
- rm -f Tcl_DeleteHashTable.3
- rm -f Tcl_CreateHashEntry.3
- rm -f Tcl_DeleteHashEntry.3
- rm -f Tcl_FindHashEntry.3
- rm -f Tcl_GetHashValue.3
- rm -f Tcl_SetHashValue.3
- rm -f Tcl_GetHashKey.3
- rm -f Tcl_FirstHashEntry.3
- rm -f Tcl_NextHashEntry.3
- rm -f Tcl_HashStats.3
- cp Hash.3 Tcl_InitHashTable.3
- cp Hash.3 Tcl_DeleteHashTable.3
- cp Hash.3 Tcl_CreateHashEntry.3
- cp Hash.3 Tcl_DeleteHashEntry.3
- cp Hash.3 Tcl_FindHashEntry.3
- cp Hash.3 Tcl_GetHashValue.3
- cp Hash.3 Tcl_SetHashValue.3
- cp Hash.3 Tcl_GetHashKey.3
- cp Hash.3 Tcl_FirstHashEntry.3
- cp Hash.3 Tcl_NextHashEntry.3
- cp Hash.3 Tcl_HashStats.3
+ rm -f Hash.3.*
+ $ZIP Hash.3
+ rm -f Tcl_InitHashTable.3 Tcl_InitHashTable.3.*
+ rm -f Tcl_InitCustomHashTable.3 Tcl_InitCustomHashTable.3.*
+ rm -f Tcl_InitObjHashTable.3 Tcl_InitObjHashTable.3.*
+ rm -f Tcl_DeleteHashTable.3 Tcl_DeleteHashTable.3.*
+ rm -f Tcl_CreateHashEntry.3 Tcl_CreateHashEntry.3.*
+ rm -f Tcl_DeleteHashEntry.3 Tcl_DeleteHashEntry.3.*
+ rm -f Tcl_FindHashEntry.3 Tcl_FindHashEntry.3.*
+ rm -f Tcl_GetHashValue.3 Tcl_GetHashValue.3.*
+ rm -f Tcl_SetHashValue.3 Tcl_SetHashValue.3.*
+ rm -f Tcl_GetHashKey.3 Tcl_GetHashKey.3.*
+ rm -f Tcl_FirstHashEntry.3 Tcl_FirstHashEntry.3.*
+ rm -f Tcl_NextHashEntry.3 Tcl_NextHashEntry.3.*
+ rm -f Tcl_HashStats.3 Tcl_HashStats.3.*
+ ln $S Hash.3$Z Tcl_InitHashTable.3$Z
+ ln $S Hash.3$Z Tcl_InitCustomHashTable.3$Z
+ ln $S Hash.3$Z Tcl_InitObjHashTable.3$Z
+ ln $S Hash.3$Z Tcl_DeleteHashTable.3$Z
+ ln $S Hash.3$Z Tcl_CreateHashEntry.3$Z
+ ln $S Hash.3$Z Tcl_DeleteHashEntry.3$Z
+ ln $S Hash.3$Z Tcl_FindHashEntry.3$Z
+ ln $S Hash.3$Z Tcl_GetHashValue.3$Z
+ ln $S Hash.3$Z Tcl_SetHashValue.3$Z
+ ln $S Hash.3$Z Tcl_GetHashKey.3$Z
+ ln $S Hash.3$Z Tcl_FirstHashEntry.3$Z
+ ln $S Hash.3$Z Tcl_NextHashEntry.3$Z
+ ln $S Hash.3$Z Tcl_HashStats.3$Z
fi
if test -r Init.3; then
- rm -f Tcl_Init.3
- cp Init.3 Tcl_Init.3
+ rm -f Init.3.*
+ $ZIP Init.3
+ rm -f Tcl_Init.3 Tcl_Init.3.*
+ ln $S Init.3$Z Tcl_Init.3$Z
fi
if test -r InitStubs.3; then
- rm -f Tcl_InitStubs.3
- cp InitStubs.3 Tcl_InitStubs.3
+ rm -f InitStubs.3.*
+ $ZIP InitStubs.3
+ rm -f Tcl_InitStubs.3 Tcl_InitStubs.3.*
+ ln $S InitStubs.3$Z Tcl_InitStubs.3$Z
fi
if test -r IntObj.3; then
- rm -f Tcl_NewIntObj.3
- rm -f Tcl_NewLongObj.3
- rm -f Tcl_SetIntObj.3
- rm -f Tcl_SetLongObj.3
- rm -f Tcl_GetIntFromObj.3
- rm -f Tcl_GetLongFromObj.3
- cp IntObj.3 Tcl_NewIntObj.3
- cp IntObj.3 Tcl_NewLongObj.3
- cp IntObj.3 Tcl_SetIntObj.3
- cp IntObj.3 Tcl_SetLongObj.3
- cp IntObj.3 Tcl_GetIntFromObj.3
- cp IntObj.3 Tcl_GetLongFromObj.3
+ rm -f IntObj.3.*
+ $ZIP IntObj.3
+ rm -f Tcl_NewIntObj.3 Tcl_NewIntObj.3.*
+ rm -f Tcl_NewLongObj.3 Tcl_NewLongObj.3.*
+ rm -f Tcl_NewWideIntObj.3 Tcl_NewWideIntObj.3.*
+ rm -f Tcl_SetIntObj.3 Tcl_SetIntObj.3.*
+ rm -f Tcl_SetLongObj.3 Tcl_SetLongObj.3.*
+ rm -f Tcl_SetWideIntObj.3 Tcl_SetWideIntObj.3.*
+ rm -f Tcl_GetIntFromObj.3 Tcl_GetIntFromObj.3.*
+ rm -f Tcl_GetLongFromObj.3 Tcl_GetLongFromObj.3.*
+ rm -f Tcl_GetWideIntFromObj.3 Tcl_GetWideIntFromObj.3.*
+ ln $S IntObj.3$Z Tcl_NewIntObj.3$Z
+ ln $S IntObj.3$Z Tcl_NewLongObj.3$Z
+ ln $S IntObj.3$Z Tcl_NewWideIntObj.3$Z
+ ln $S IntObj.3$Z Tcl_SetIntObj.3$Z
+ ln $S IntObj.3$Z Tcl_SetLongObj.3$Z
+ ln $S IntObj.3$Z Tcl_SetWideIntObj.3$Z
+ ln $S IntObj.3$Z Tcl_GetIntFromObj.3$Z
+ ln $S IntObj.3$Z Tcl_GetLongFromObj.3$Z
+ ln $S IntObj.3$Z Tcl_GetWideIntFromObj.3$Z
fi
if test -r Interp.3; then
- rm -f Tcl_Interp.3
- cp Interp.3 Tcl_Interp.3
+ rm -f Interp.3.*
+ $ZIP Interp.3
+ rm -f Tcl_Interp.3 Tcl_Interp.3.*
+ ln $S Interp.3$Z Tcl_Interp.3$Z
fi
if test -r LinkVar.3; then
- rm -f Tcl_LinkVar.3
- rm -f Tcl_UnlinkVar.3
- rm -f Tcl_UpdateLinkedVar.3
- cp LinkVar.3 Tcl_LinkVar.3
- cp LinkVar.3 Tcl_UnlinkVar.3
- cp LinkVar.3 Tcl_UpdateLinkedVar.3
+ rm -f LinkVar.3.*
+ $ZIP LinkVar.3
+ rm -f Tcl_LinkVar.3 Tcl_LinkVar.3.*
+ rm -f Tcl_UnlinkVar.3 Tcl_UnlinkVar.3.*
+ rm -f Tcl_UpdateLinkedVar.3 Tcl_UpdateLinkedVar.3.*
+ ln $S LinkVar.3$Z Tcl_LinkVar.3$Z
+ ln $S LinkVar.3$Z Tcl_UnlinkVar.3$Z
+ ln $S LinkVar.3$Z Tcl_UpdateLinkedVar.3$Z
fi
if test -r ListObj.3; then
- rm -f Tcl_ListObjAppendList.3
- rm -f Tcl_ListObjAppendElement.3
- rm -f Tcl_NewListObj.3
- rm -f Tcl_SetListObj.3
- rm -f Tcl_ListObjGetElements.3
- rm -f Tcl_ListObjLength.3
- rm -f Tcl_ListObjIndex.3
- rm -f Tcl_ListObjReplace.3
- cp ListObj.3 Tcl_ListObjAppendList.3
- cp ListObj.3 Tcl_ListObjAppendElement.3
- cp ListObj.3 Tcl_NewListObj.3
- cp ListObj.3 Tcl_SetListObj.3
- cp ListObj.3 Tcl_ListObjGetElements.3
- cp ListObj.3 Tcl_ListObjLength.3
- cp ListObj.3 Tcl_ListObjIndex.3
- cp ListObj.3 Tcl_ListObjReplace.3
+ rm -f ListObj.3.*
+ $ZIP ListObj.3
+ rm -f Tcl_ListObjAppendList.3 Tcl_ListObjAppendList.3.*
+ rm -f Tcl_ListObjAppendElement.3 Tcl_ListObjAppendElement.3.*
+ rm -f Tcl_NewListObj.3 Tcl_NewListObj.3.*
+ rm -f Tcl_SetListObj.3 Tcl_SetListObj.3.*
+ rm -f Tcl_ListObjGetElements.3 Tcl_ListObjGetElements.3.*
+ rm -f Tcl_ListObjLength.3 Tcl_ListObjLength.3.*
+ rm -f Tcl_ListObjIndex.3 Tcl_ListObjIndex.3.*
+ rm -f Tcl_ListObjReplace.3 Tcl_ListObjReplace.3.*
+ ln $S ListObj.3$Z Tcl_ListObjAppendList.3$Z
+ ln $S ListObj.3$Z Tcl_ListObjAppendElement.3$Z
+ ln $S ListObj.3$Z Tcl_NewListObj.3$Z
+ ln $S ListObj.3$Z Tcl_SetListObj.3$Z
+ ln $S ListObj.3$Z Tcl_ListObjGetElements.3$Z
+ ln $S ListObj.3$Z Tcl_ListObjLength.3$Z
+ ln $S ListObj.3$Z Tcl_ListObjIndex.3$Z
+ ln $S ListObj.3$Z Tcl_ListObjReplace.3$Z
+fi
+if test -r Macintosh.3; then
+ rm -f Macintosh.3.*
+ $ZIP Macintosh.3
+ rm -f Tcl_MacSetEventProc.3 Tcl_MacSetEventProc.3.*
+ rm -f Tcl_MacConvertTextResource.3 Tcl_MacConvertTextResource.3.*
+ rm -f Tcl_MacEvalResource.3 Tcl_MacEvalResource.3.*
+ rm -f Tcl_MacFindResource.3 Tcl_MacFindResource.3.*
+ rm -f Tcl_GetOSTypeFromObj.3 Tcl_GetOSTypeFromObj.3.*
+ rm -f Tcl_SetOSTypeObj.3 Tcl_SetOSTypeObj.3.*
+ rm -f Tcl_NewOSTypeObj.3 Tcl_NewOSTypeObj.3.*
+ ln $S Macintosh.3$Z Tcl_MacSetEventProc.3$Z
+ ln $S Macintosh.3$Z Tcl_MacConvertTextResource.3$Z
+ ln $S Macintosh.3$Z Tcl_MacEvalResource.3$Z
+ ln $S Macintosh.3$Z Tcl_MacFindResource.3$Z
+ ln $S Macintosh.3$Z Tcl_GetOSTypeFromObj.3$Z
+ ln $S Macintosh.3$Z Tcl_SetOSTypeObj.3$Z
+ ln $S Macintosh.3$Z Tcl_NewOSTypeObj.3$Z
fi
if test -r Notifier.3; then
- rm -f Tcl_CreateEventSource.3
- rm -f Tcl_DeleteEventSource.3
- rm -f Tcl_SetMaxBlockTime.3
- rm -f Tcl_QueueEvent.3
- rm -f Tcl_ThreadQueueEvent.3
- rm -f Tcl_ThreadAlert.3
- rm -f Tcl_GetCurrentThread.3
- rm -f Tcl_DeleteEvents.3
- rm -f Tcl_InitNotifier.3
- rm -f Tcl_FinalizeNotifier.3
- rm -f Tcl_WaitForEvent.3
- rm -f Tcl_AlertNotifier.3
- rm -f Tcl_SetTimer.3
- rm -f Tcl_ServiceAll.3
- rm -f Tcl_ServiceEvent.3
- rm -f Tcl_GetServiceMode.3
- rm -f Tcl_SetServiceMode.3
- cp Notifier.3 Tcl_CreateEventSource.3
- cp Notifier.3 Tcl_DeleteEventSource.3
- cp Notifier.3 Tcl_SetMaxBlockTime.3
- cp Notifier.3 Tcl_QueueEvent.3
- cp Notifier.3 Tcl_ThreadQueueEvent.3
- cp Notifier.3 Tcl_ThreadAlert.3
- cp Notifier.3 Tcl_GetCurrentThread.3
- cp Notifier.3 Tcl_DeleteEvents.3
- cp Notifier.3 Tcl_InitNotifier.3
- cp Notifier.3 Tcl_FinalizeNotifier.3
- cp Notifier.3 Tcl_WaitForEvent.3
- cp Notifier.3 Tcl_AlertNotifier.3
- cp Notifier.3 Tcl_SetTimer.3
- cp Notifier.3 Tcl_ServiceAll.3
- cp Notifier.3 Tcl_ServiceEvent.3
- cp Notifier.3 Tcl_GetServiceMode.3
- cp Notifier.3 Tcl_SetServiceMode.3
+ rm -f Notifier.3.*
+ $ZIP Notifier.3
+ rm -f Tcl_CreateEventSource.3 Tcl_CreateEventSource.3.*
+ rm -f Tcl_DeleteEventSource.3 Tcl_DeleteEventSource.3.*
+ rm -f Tcl_SetMaxBlockTime.3 Tcl_SetMaxBlockTime.3.*
+ rm -f Tcl_QueueEvent.3 Tcl_QueueEvent.3.*
+ rm -f Tcl_ThreadQueueEvent.3 Tcl_ThreadQueueEvent.3.*
+ rm -f Tcl_ThreadAlert.3 Tcl_ThreadAlert.3.*
+ rm -f Tcl_GetCurrentThread.3 Tcl_GetCurrentThread.3.*
+ rm -f Tcl_DeleteEvents.3 Tcl_DeleteEvents.3.*
+ rm -f Tcl_InitNotifier.3 Tcl_InitNotifier.3.*
+ rm -f Tcl_FinalizeNotifier.3 Tcl_FinalizeNotifier.3.*
+ rm -f Tcl_WaitForEvent.3 Tcl_WaitForEvent.3.*
+ rm -f Tcl_AlertNotifier.3 Tcl_AlertNotifier.3.*
+ rm -f Tcl_SetTimer.3 Tcl_SetTimer.3.*
+ rm -f Tcl_ServiceAll.3 Tcl_ServiceAll.3.*
+ rm -f Tcl_ServiceEvent.3 Tcl_ServiceEvent.3.*
+ rm -f Tcl_GetServiceMode.3 Tcl_GetServiceMode.3.*
+ rm -f Tcl_SetServiceMode.3 Tcl_SetServiceMode.3.*
+ ln $S Notifier.3$Z Tcl_CreateEventSource.3$Z
+ ln $S Notifier.3$Z Tcl_DeleteEventSource.3$Z
+ ln $S Notifier.3$Z Tcl_SetMaxBlockTime.3$Z
+ ln $S Notifier.3$Z Tcl_QueueEvent.3$Z
+ ln $S Notifier.3$Z Tcl_ThreadQueueEvent.3$Z
+ ln $S Notifier.3$Z Tcl_ThreadAlert.3$Z
+ ln $S Notifier.3$Z Tcl_GetCurrentThread.3$Z
+ ln $S Notifier.3$Z Tcl_DeleteEvents.3$Z
+ ln $S Notifier.3$Z Tcl_InitNotifier.3$Z
+ ln $S Notifier.3$Z Tcl_FinalizeNotifier.3$Z
+ ln $S Notifier.3$Z Tcl_WaitForEvent.3$Z
+ ln $S Notifier.3$Z Tcl_AlertNotifier.3$Z
+ ln $S Notifier.3$Z Tcl_SetTimer.3$Z
+ ln $S Notifier.3$Z Tcl_ServiceAll.3$Z
+ ln $S Notifier.3$Z Tcl_ServiceEvent.3$Z
+ ln $S Notifier.3$Z Tcl_GetServiceMode.3$Z
+ ln $S Notifier.3$Z Tcl_SetServiceMode.3$Z
fi
if test -r Object.3; then
- rm -f Tcl_NewObj.3
- rm -f Tcl_DuplicateObj.3
- rm -f Tcl_IncrRefCount.3
- rm -f Tcl_DecrRefCount.3
- rm -f Tcl_IsShared.3
- rm -f Tcl_InvalidateStringRep.3
- cp Object.3 Tcl_NewObj.3
- cp Object.3 Tcl_DuplicateObj.3
- cp Object.3 Tcl_IncrRefCount.3
- cp Object.3 Tcl_DecrRefCount.3
- cp Object.3 Tcl_IsShared.3
- cp Object.3 Tcl_InvalidateStringRep.3
+ rm -f Object.3.*
+ $ZIP Object.3
+ rm -f Tcl_NewObj.3 Tcl_NewObj.3.*
+ rm -f Tcl_DuplicateObj.3 Tcl_DuplicateObj.3.*
+ rm -f Tcl_IncrRefCount.3 Tcl_IncrRefCount.3.*
+ rm -f Tcl_DecrRefCount.3 Tcl_DecrRefCount.3.*
+ rm -f Tcl_IsShared.3 Tcl_IsShared.3.*
+ rm -f Tcl_InvalidateStringRep.3 Tcl_InvalidateStringRep.3.*
+ ln $S Object.3$Z Tcl_NewObj.3$Z
+ ln $S Object.3$Z Tcl_DuplicateObj.3$Z
+ ln $S Object.3$Z Tcl_IncrRefCount.3$Z
+ ln $S Object.3$Z Tcl_DecrRefCount.3$Z
+ ln $S Object.3$Z Tcl_IsShared.3$Z
+ ln $S Object.3$Z Tcl_InvalidateStringRep.3$Z
fi
if test -r ObjectType.3; then
- rm -f Tcl_RegisterObjType.3
- rm -f Tcl_GetObjType.3
- rm -f Tcl_AppendAllObjTypes.3
- rm -f Tcl_ConvertToType.3
- cp ObjectType.3 Tcl_RegisterObjType.3
- cp ObjectType.3 Tcl_GetObjType.3
- cp ObjectType.3 Tcl_AppendAllObjTypes.3
- cp ObjectType.3 Tcl_ConvertToType.3
+ rm -f ObjectType.3.*
+ $ZIP ObjectType.3
+ rm -f Tcl_RegisterObjType.3 Tcl_RegisterObjType.3.*
+ rm -f Tcl_GetObjType.3 Tcl_GetObjType.3.*
+ rm -f Tcl_AppendAllObjTypes.3 Tcl_AppendAllObjTypes.3.*
+ rm -f Tcl_ConvertToType.3 Tcl_ConvertToType.3.*
+ ln $S ObjectType.3$Z Tcl_RegisterObjType.3$Z
+ ln $S ObjectType.3$Z Tcl_GetObjType.3$Z
+ ln $S ObjectType.3$Z Tcl_AppendAllObjTypes.3$Z
+ ln $S ObjectType.3$Z Tcl_ConvertToType.3$Z
fi
if test -r OpenFileChnl.3; then
- rm -f Tcl_OpenFileChannel.3
- rm -f Tcl_OpenCommandChannel.3
- rm -f Tcl_MakeFileChannel.3
- rm -f Tcl_GetChannel.3
- rm -f Tcl_GetChannelNames.3
- rm -f Tcl_GetChannelNamesEx.3
- rm -f Tcl_RegisterChannel.3
- rm -f Tcl_UnregisterChannel.3
- rm -f Tcl_Close.3
- rm -f Tcl_ReadChars.3
- rm -f Tcl_Read.3
- rm -f Tcl_GetsObj.3
- rm -f Tcl_Gets.3
- rm -f Tcl_WriteObj.3
- rm -f Tcl_WriteChars.3
- rm -f Tcl_Write.3
- rm -f Tcl_Flush.3
- rm -f Tcl_Seek.3
- rm -f Tcl_Tell.3
- rm -f Tcl_GetChannelOption.3
- rm -f Tcl_SetChannelOption.3
- rm -f Tcl_Eof.3
- rm -f Tcl_InputBlocked.3
- rm -f Tcl_InputBuffered.3
- rm -f Tcl_Ungets.3
- cp OpenFileChnl.3 Tcl_OpenFileChannel.3
- cp OpenFileChnl.3 Tcl_OpenCommandChannel.3
- cp OpenFileChnl.3 Tcl_MakeFileChannel.3
- cp OpenFileChnl.3 Tcl_GetChannel.3
- cp OpenFileChnl.3 Tcl_GetChannelNames.3
- cp OpenFileChnl.3 Tcl_GetChannelNamesEx.3
- cp OpenFileChnl.3 Tcl_RegisterChannel.3
- cp OpenFileChnl.3 Tcl_UnregisterChannel.3
- cp OpenFileChnl.3 Tcl_Close.3
- cp OpenFileChnl.3 Tcl_ReadChars.3
- cp OpenFileChnl.3 Tcl_Read.3
- cp OpenFileChnl.3 Tcl_GetsObj.3
- cp OpenFileChnl.3 Tcl_Gets.3
- cp OpenFileChnl.3 Tcl_WriteObj.3
- cp OpenFileChnl.3 Tcl_WriteChars.3
- cp OpenFileChnl.3 Tcl_Write.3
- cp OpenFileChnl.3 Tcl_Flush.3
- cp OpenFileChnl.3 Tcl_Seek.3
- cp OpenFileChnl.3 Tcl_Tell.3
- cp OpenFileChnl.3 Tcl_GetChannelOption.3
- cp OpenFileChnl.3 Tcl_SetChannelOption.3
- cp OpenFileChnl.3 Tcl_Eof.3
- cp OpenFileChnl.3 Tcl_InputBlocked.3
- cp OpenFileChnl.3 Tcl_InputBuffered.3
- cp OpenFileChnl.3 Tcl_Ungets.3
+ rm -f OpenFileChnl.3.*
+ $ZIP OpenFileChnl.3
+ rm -f Tcl_OpenFileChannel.3 Tcl_OpenFileChannel.3.*
+ rm -f Tcl_OpenCommandChannel.3 Tcl_OpenCommandChannel.3.*
+ rm -f Tcl_MakeFileChannel.3 Tcl_MakeFileChannel.3.*
+ rm -f Tcl_GetChannel.3 Tcl_GetChannel.3.*
+ rm -f Tcl_GetChannelNames.3 Tcl_GetChannelNames.3.*
+ rm -f Tcl_GetChannelNamesEx.3 Tcl_GetChannelNamesEx.3.*
+ rm -f Tcl_RegisterChannel.3 Tcl_RegisterChannel.3.*
+ rm -f Tcl_UnregisterChannel.3 Tcl_UnregisterChannel.3.*
+ rm -f Tcl_DetachChannel.3 Tcl_DetachChannel.3.*
+ rm -f Tcl_IsStandardChannel.3 Tcl_IsStandardChannel.3.*
+ rm -f Tcl_Close.3 Tcl_Close.3.*
+ rm -f Tcl_ReadChars.3 Tcl_ReadChars.3.*
+ rm -f Tcl_Read.3 Tcl_Read.3.*
+ rm -f Tcl_GetsObj.3 Tcl_GetsObj.3.*
+ rm -f Tcl_Gets.3 Tcl_Gets.3.*
+ rm -f Tcl_WriteObj.3 Tcl_WriteObj.3.*
+ rm -f Tcl_WriteChars.3 Tcl_WriteChars.3.*
+ rm -f Tcl_Write.3 Tcl_Write.3.*
+ rm -f Tcl_Flush.3 Tcl_Flush.3.*
+ rm -f Tcl_Seek.3 Tcl_Seek.3.*
+ rm -f Tcl_Tell.3 Tcl_Tell.3.*
+ rm -f Tcl_GetChannelOption.3 Tcl_GetChannelOption.3.*
+ rm -f Tcl_SetChannelOption.3 Tcl_SetChannelOption.3.*
+ rm -f Tcl_Eof.3 Tcl_Eof.3.*
+ rm -f Tcl_InputBlocked.3 Tcl_InputBlocked.3.*
+ rm -f Tcl_InputBuffered.3 Tcl_InputBuffered.3.*
+ rm -f Tcl_OutputBuffered.3 Tcl_OutputBuffered.3.*
+ rm -f Tcl_Ungets.3 Tcl_Ungets.3.*
+ rm -f Tcl_ReadRaw.3 Tcl_ReadRaw.3.*
+ rm -f Tcl_WriteRaw.3 Tcl_WriteRaw.3.*
+ ln $S OpenFileChnl.3$Z Tcl_OpenFileChannel.3$Z
+ ln $S OpenFileChnl.3$Z Tcl_OpenCommandChannel.3$Z
+ ln $S OpenFileChnl.3$Z Tcl_MakeFileChannel.3$Z
+ ln $S OpenFileChnl.3$Z Tcl_GetChannel.3$Z
+ ln $S OpenFileChnl.3$Z Tcl_GetChannelNames.3$Z
+ ln $S OpenFileChnl.3$Z Tcl_GetChannelNamesEx.3$Z
+ ln $S OpenFileChnl.3$Z Tcl_RegisterChannel.3$Z
+ ln $S OpenFileChnl.3$Z Tcl_UnregisterChannel.3$Z
+ ln $S OpenFileChnl.3$Z Tcl_DetachChannel.3$Z
+ ln $S OpenFileChnl.3$Z Tcl_IsStandardChannel.3$Z
+ ln $S OpenFileChnl.3$Z Tcl_Close.3$Z
+ ln $S OpenFileChnl.3$Z Tcl_ReadChars.3$Z
+ ln $S OpenFileChnl.3$Z Tcl_Read.3$Z
+ ln $S OpenFileChnl.3$Z Tcl_GetsObj.3$Z
+ ln $S OpenFileChnl.3$Z Tcl_Gets.3$Z
+ ln $S OpenFileChnl.3$Z Tcl_WriteObj.3$Z
+ ln $S OpenFileChnl.3$Z Tcl_WriteChars.3$Z
+ ln $S OpenFileChnl.3$Z Tcl_Write.3$Z
+ ln $S OpenFileChnl.3$Z Tcl_Flush.3$Z
+ ln $S OpenFileChnl.3$Z Tcl_Seek.3$Z
+ ln $S OpenFileChnl.3$Z Tcl_Tell.3$Z
+ ln $S OpenFileChnl.3$Z Tcl_GetChannelOption.3$Z
+ ln $S OpenFileChnl.3$Z Tcl_SetChannelOption.3$Z
+ ln $S OpenFileChnl.3$Z Tcl_Eof.3$Z
+ ln $S OpenFileChnl.3$Z Tcl_InputBlocked.3$Z
+ ln $S OpenFileChnl.3$Z Tcl_InputBuffered.3$Z
+ ln $S OpenFileChnl.3$Z Tcl_OutputBuffered.3$Z
+ ln $S OpenFileChnl.3$Z Tcl_Ungets.3$Z
+ ln $S OpenFileChnl.3$Z Tcl_ReadRaw.3$Z
+ ln $S OpenFileChnl.3$Z Tcl_WriteRaw.3$Z
fi
if test -r OpenTcp.3; then
- rm -f Tcl_OpenTcpClient.3
- rm -f Tcl_MakeTcpClientChannel.3
- rm -f Tcl_OpenTcpServer.3
- cp OpenTcp.3 Tcl_OpenTcpClient.3
- cp OpenTcp.3 Tcl_MakeTcpClientChannel.3
- cp OpenTcp.3 Tcl_OpenTcpServer.3
+ rm -f OpenTcp.3.*
+ $ZIP OpenTcp.3
+ rm -f Tcl_OpenTcpClient.3 Tcl_OpenTcpClient.3.*
+ rm -f Tcl_MakeTcpClientChannel.3 Tcl_MakeTcpClientChannel.3.*
+ rm -f Tcl_OpenTcpServer.3 Tcl_OpenTcpServer.3.*
+ ln $S OpenTcp.3$Z Tcl_OpenTcpClient.3$Z
+ ln $S OpenTcp.3$Z Tcl_MakeTcpClientChannel.3$Z
+ ln $S OpenTcp.3$Z Tcl_OpenTcpServer.3$Z
+fi
+if test -r Panic.3; then
+ rm -f Panic.3.*
+ $ZIP Panic.3
+ rm -f Tcl_Panic.3 Tcl_Panic.3.*
+ rm -f Tcl_PanicVA.3 Tcl_PanicVA.3.*
+ rm -f Tcl_SetPanicProc.3 Tcl_SetPanicProc.3.*
+ if test "${CASEINSENSITIVEFS:-}" != "1"; then rm -f panic.3 panic.3.* ; fi
+ rm -f panicVA.3 panicVA.3.*
+ ln $S Panic.3$Z Tcl_Panic.3$Z
+ ln $S Panic.3$Z Tcl_PanicVA.3$Z
+ ln $S Panic.3$Z Tcl_SetPanicProc.3$Z
+ if test "${CASEINSENSITIVEFS:-}" != "1"; then ln $S Panic.3$Z panic.3$Z ; fi
+ ln $S Panic.3$Z panicVA.3$Z
fi
if test -r ParseCmd.3; then
- rm -f Tcl_ParseCommand.3
- rm -f Tcl_ParseExpr.3
- rm -f Tcl_ParseBraces.3
- rm -f Tcl_ParseQuotedString.3
- rm -f Tcl_ParseVarName.3
- rm -f Tcl_ParseVar.3
- rm -f Tcl_FreeParse.3
- rm -f Tcl_EvalTokens.3
- cp ParseCmd.3 Tcl_ParseCommand.3
- cp ParseCmd.3 Tcl_ParseExpr.3
- cp ParseCmd.3 Tcl_ParseBraces.3
- cp ParseCmd.3 Tcl_ParseQuotedString.3
- cp ParseCmd.3 Tcl_ParseVarName.3
- cp ParseCmd.3 Tcl_ParseVar.3
- cp ParseCmd.3 Tcl_FreeParse.3
- cp ParseCmd.3 Tcl_EvalTokens.3
+ rm -f ParseCmd.3.*
+ $ZIP ParseCmd.3
+ rm -f Tcl_ParseCommand.3 Tcl_ParseCommand.3.*
+ rm -f Tcl_ParseExpr.3 Tcl_ParseExpr.3.*
+ rm -f Tcl_ParseBraces.3 Tcl_ParseBraces.3.*
+ rm -f Tcl_ParseQuotedString.3 Tcl_ParseQuotedString.3.*
+ rm -f Tcl_ParseVarName.3 Tcl_ParseVarName.3.*
+ rm -f Tcl_ParseVar.3 Tcl_ParseVar.3.*
+ rm -f Tcl_FreeParse.3 Tcl_FreeParse.3.*
+ rm -f Tcl_EvalTokens.3 Tcl_EvalTokens.3.*
+ rm -f Tcl_EvalTokensStandard.3 Tcl_EvalTokensStandard.3.*
+ ln $S ParseCmd.3$Z Tcl_ParseCommand.3$Z
+ ln $S ParseCmd.3$Z Tcl_ParseExpr.3$Z
+ ln $S ParseCmd.3$Z Tcl_ParseBraces.3$Z
+ ln $S ParseCmd.3$Z Tcl_ParseQuotedString.3$Z
+ ln $S ParseCmd.3$Z Tcl_ParseVarName.3$Z
+ ln $S ParseCmd.3$Z Tcl_ParseVar.3$Z
+ ln $S ParseCmd.3$Z Tcl_FreeParse.3$Z
+ ln $S ParseCmd.3$Z Tcl_EvalTokens.3$Z
+ ln $S ParseCmd.3$Z Tcl_EvalTokensStandard.3$Z
fi
if test -r PkgRequire.3; then
- rm -f Tcl_PkgRequire.3
- rm -f Tcl_PkgRequireEx.3
- rm -f Tcl_PkgPresent.3
- rm -f Tcl_PkgPresentEx.3
- rm -f Tcl_PkgProvide.3
- rm -f Tcl_PkgProvideEx.3
- cp PkgRequire.3 Tcl_PkgRequire.3
- cp PkgRequire.3 Tcl_PkgRequireEx.3
- cp PkgRequire.3 Tcl_PkgPresent.3
- cp PkgRequire.3 Tcl_PkgPresentEx.3
- cp PkgRequire.3 Tcl_PkgProvide.3
- cp PkgRequire.3 Tcl_PkgProvideEx.3
+ rm -f PkgRequire.3.*
+ $ZIP PkgRequire.3
+ rm -f Tcl_PkgRequire.3 Tcl_PkgRequire.3.*
+ rm -f Tcl_PkgRequireEx.3 Tcl_PkgRequireEx.3.*
+ rm -f Tcl_PkgPresent.3 Tcl_PkgPresent.3.*
+ rm -f Tcl_PkgPresentEx.3 Tcl_PkgPresentEx.3.*
+ rm -f Tcl_PkgProvide.3 Tcl_PkgProvide.3.*
+ rm -f Tcl_PkgProvideEx.3 Tcl_PkgProvideEx.3.*
+ ln $S PkgRequire.3$Z Tcl_PkgRequire.3$Z
+ ln $S PkgRequire.3$Z Tcl_PkgRequireEx.3$Z
+ ln $S PkgRequire.3$Z Tcl_PkgPresent.3$Z
+ ln $S PkgRequire.3$Z Tcl_PkgPresentEx.3$Z
+ ln $S PkgRequire.3$Z Tcl_PkgProvide.3$Z
+ ln $S PkgRequire.3$Z Tcl_PkgProvideEx.3$Z
fi
if test -r Preserve.3; then
- rm -f Tcl_Preserve.3
- rm -f Tcl_Release.3
- rm -f Tcl_EventuallyFree.3
- cp Preserve.3 Tcl_Preserve.3
- cp Preserve.3 Tcl_Release.3
- cp Preserve.3 Tcl_EventuallyFree.3
+ rm -f Preserve.3.*
+ $ZIP Preserve.3
+ rm -f Tcl_Preserve.3 Tcl_Preserve.3.*
+ rm -f Tcl_Release.3 Tcl_Release.3.*
+ rm -f Tcl_EventuallyFree.3 Tcl_EventuallyFree.3.*
+ ln $S Preserve.3$Z Tcl_Preserve.3$Z
+ ln $S Preserve.3$Z Tcl_Release.3$Z
+ ln $S Preserve.3$Z Tcl_EventuallyFree.3$Z
fi
if test -r PrintDbl.3; then
- rm -f Tcl_PrintDouble.3
- cp PrintDbl.3 Tcl_PrintDouble.3
+ rm -f PrintDbl.3.*
+ $ZIP PrintDbl.3
+ rm -f Tcl_PrintDouble.3 Tcl_PrintDouble.3.*
+ ln $S PrintDbl.3$Z Tcl_PrintDouble.3$Z
fi
if test -r RecEvalObj.3; then
- rm -f Tcl_RecordAndEvalObj.3
- cp RecEvalObj.3 Tcl_RecordAndEvalObj.3
+ rm -f RecEvalObj.3.*
+ $ZIP RecEvalObj.3
+ rm -f Tcl_RecordAndEvalObj.3 Tcl_RecordAndEvalObj.3.*
+ ln $S RecEvalObj.3$Z Tcl_RecordAndEvalObj.3$Z
fi
if test -r RecordEval.3; then
- rm -f Tcl_RecordAndEval.3
- cp RecordEval.3 Tcl_RecordAndEval.3
+ rm -f RecordEval.3.*
+ $ZIP RecordEval.3
+ rm -f Tcl_RecordAndEval.3 Tcl_RecordAndEval.3.*
+ ln $S RecordEval.3$Z Tcl_RecordAndEval.3$Z
fi
if test -r RegExp.3; then
- rm -f Tcl_RegExpMatch.3
- rm -f Tcl_RegExpCompile.3
- rm -f Tcl_RegExpExec.3
- rm -f Tcl_RegExpRange.3
- rm -f Tcl_GetRegExpFromObj.3
- rm -f Tcl_RegExpMatchObj.3
- rm -f Tcl_RegExpExecObj.3
- rm -f Tcl_RegExpGetInfo.3
- cp RegExp.3 Tcl_RegExpMatch.3
- cp RegExp.3 Tcl_RegExpCompile.3
- cp RegExp.3 Tcl_RegExpExec.3
- cp RegExp.3 Tcl_RegExpRange.3
- cp RegExp.3 Tcl_GetRegExpFromObj.3
- cp RegExp.3 Tcl_RegExpMatchObj.3
- cp RegExp.3 Tcl_RegExpExecObj.3
- cp RegExp.3 Tcl_RegExpGetInfo.3
+ rm -f RegExp.3.*
+ $ZIP RegExp.3
+ rm -f Tcl_RegExpMatch.3 Tcl_RegExpMatch.3.*
+ rm -f Tcl_RegExpCompile.3 Tcl_RegExpCompile.3.*
+ rm -f Tcl_RegExpExec.3 Tcl_RegExpExec.3.*
+ rm -f Tcl_RegExpRange.3 Tcl_RegExpRange.3.*
+ rm -f Tcl_GetRegExpFromObj.3 Tcl_GetRegExpFromObj.3.*
+ rm -f Tcl_RegExpMatchObj.3 Tcl_RegExpMatchObj.3.*
+ rm -f Tcl_RegExpExecObj.3 Tcl_RegExpExecObj.3.*
+ rm -f Tcl_RegExpGetInfo.3 Tcl_RegExpGetInfo.3.*
+ ln $S RegExp.3$Z Tcl_RegExpMatch.3$Z
+ ln $S RegExp.3$Z Tcl_RegExpCompile.3$Z
+ ln $S RegExp.3$Z Tcl_RegExpExec.3$Z
+ ln $S RegExp.3$Z Tcl_RegExpRange.3$Z
+ ln $S RegExp.3$Z Tcl_GetRegExpFromObj.3$Z
+ ln $S RegExp.3$Z Tcl_RegExpMatchObj.3$Z
+ ln $S RegExp.3$Z Tcl_RegExpExecObj.3$Z
+ ln $S RegExp.3$Z Tcl_RegExpGetInfo.3$Z
fi
if test -r SaveResult.3; then
- rm -f Tcl_SaveResult.3
- rm -f Tcl_RestoreResult.3
- rm -f Tcl_DiscardResult.3
- cp SaveResult.3 Tcl_SaveResult.3
- cp SaveResult.3 Tcl_RestoreResult.3
- cp SaveResult.3 Tcl_DiscardResult.3
+ rm -f SaveResult.3.*
+ $ZIP SaveResult.3
+ rm -f Tcl_SaveResult.3 Tcl_SaveResult.3.*
+ rm -f Tcl_RestoreResult.3 Tcl_RestoreResult.3.*
+ rm -f Tcl_DiscardResult.3 Tcl_DiscardResult.3.*
+ ln $S SaveResult.3$Z Tcl_SaveResult.3$Z
+ ln $S SaveResult.3$Z Tcl_RestoreResult.3$Z
+ ln $S SaveResult.3$Z Tcl_DiscardResult.3$Z
fi
if test -r SetErrno.3; then
- rm -f Tcl_SetErrno.3
- rm -f Tcl_GetErrno.3
- rm -f Tcl_ErrnoId.3
- rm -f Tcl_ErrnoMsg.3
- cp SetErrno.3 Tcl_SetErrno.3
- cp SetErrno.3 Tcl_GetErrno.3
- cp SetErrno.3 Tcl_ErrnoId.3
- cp SetErrno.3 Tcl_ErrnoMsg.3
+ rm -f SetErrno.3.*
+ $ZIP SetErrno.3
+ rm -f Tcl_SetErrno.3 Tcl_SetErrno.3.*
+ rm -f Tcl_GetErrno.3 Tcl_GetErrno.3.*
+ rm -f Tcl_ErrnoId.3 Tcl_ErrnoId.3.*
+ rm -f Tcl_ErrnoMsg.3 Tcl_ErrnoMsg.3.*
+ ln $S SetErrno.3$Z Tcl_SetErrno.3$Z
+ ln $S SetErrno.3$Z Tcl_GetErrno.3$Z
+ ln $S SetErrno.3$Z Tcl_ErrnoId.3$Z
+ ln $S SetErrno.3$Z Tcl_ErrnoMsg.3$Z
fi
if test -r SetRecLmt.3; then
- rm -f Tcl_SetRecursionLimit.3
- cp SetRecLmt.3 Tcl_SetRecursionLimit.3
+ rm -f SetRecLmt.3.*
+ $ZIP SetRecLmt.3
+ rm -f Tcl_SetRecursionLimit.3 Tcl_SetRecursionLimit.3.*
+ ln $S SetRecLmt.3$Z Tcl_SetRecursionLimit.3$Z
fi
if test -r SetResult.3; then
- rm -f Tcl_SetObjResult.3
- rm -f Tcl_GetObjResult.3
- rm -f Tcl_SetResult.3
- rm -f Tcl_GetStringResult.3
- rm -f Tcl_AppendResult.3
- rm -f Tcl_AppendResultVA.3
- rm -f Tcl_AppendElement.3
- rm -f Tcl_ResetResult.3
- rm -f Tcl_FreeResult.3
- cp SetResult.3 Tcl_SetObjResult.3
- cp SetResult.3 Tcl_GetObjResult.3
- cp SetResult.3 Tcl_SetResult.3
- cp SetResult.3 Tcl_GetStringResult.3
- cp SetResult.3 Tcl_AppendResult.3
- cp SetResult.3 Tcl_AppendResultVA.3
- cp SetResult.3 Tcl_AppendElement.3
- cp SetResult.3 Tcl_ResetResult.3
- cp SetResult.3 Tcl_FreeResult.3
+ rm -f SetResult.3.*
+ $ZIP SetResult.3
+ rm -f Tcl_SetObjResult.3 Tcl_SetObjResult.3.*
+ rm -f Tcl_GetObjResult.3 Tcl_GetObjResult.3.*
+ rm -f Tcl_SetResult.3 Tcl_SetResult.3.*
+ rm -f Tcl_GetStringResult.3 Tcl_GetStringResult.3.*
+ rm -f Tcl_AppendResult.3 Tcl_AppendResult.3.*
+ rm -f Tcl_AppendResultVA.3 Tcl_AppendResultVA.3.*
+ rm -f Tcl_AppendElement.3 Tcl_AppendElement.3.*
+ rm -f Tcl_ResetResult.3 Tcl_ResetResult.3.*
+ rm -f Tcl_FreeResult.3 Tcl_FreeResult.3.*
+ ln $S SetResult.3$Z Tcl_SetObjResult.3$Z
+ ln $S SetResult.3$Z Tcl_GetObjResult.3$Z
+ ln $S SetResult.3$Z Tcl_SetResult.3$Z
+ ln $S SetResult.3$Z Tcl_GetStringResult.3$Z
+ ln $S SetResult.3$Z Tcl_AppendResult.3$Z
+ ln $S SetResult.3$Z Tcl_AppendResultVA.3$Z
+ ln $S SetResult.3$Z Tcl_AppendElement.3$Z
+ ln $S SetResult.3$Z Tcl_ResetResult.3$Z
+ ln $S SetResult.3$Z Tcl_FreeResult.3$Z
fi
if test -r SetVar.3; then
- rm -f Tcl_SetVar2Ex.3
- rm -f Tcl_SetVar.3
- rm -f Tcl_SetVar2.3
- rm -f Tcl_ObjSetVar2.3
- rm -f Tcl_GetVar2Ex.3
- rm -f Tcl_GetVar.3
- rm -f Tcl_GetVar2.3
- rm -f Tcl_ObjGetVar2.3
- rm -f Tcl_UnsetVar.3
- rm -f Tcl_UnsetVar2.3
- cp SetVar.3 Tcl_SetVar2Ex.3
- cp SetVar.3 Tcl_SetVar.3
- cp SetVar.3 Tcl_SetVar2.3
- cp SetVar.3 Tcl_ObjSetVar2.3
- cp SetVar.3 Tcl_GetVar2Ex.3
- cp SetVar.3 Tcl_GetVar.3
- cp SetVar.3 Tcl_GetVar2.3
- cp SetVar.3 Tcl_ObjGetVar2.3
- cp SetVar.3 Tcl_UnsetVar.3
- cp SetVar.3 Tcl_UnsetVar2.3
+ rm -f SetVar.3.*
+ $ZIP SetVar.3
+ rm -f Tcl_SetVar2Ex.3 Tcl_SetVar2Ex.3.*
+ rm -f Tcl_SetVar.3 Tcl_SetVar.3.*
+ rm -f Tcl_SetVar2.3 Tcl_SetVar2.3.*
+ rm -f Tcl_ObjSetVar2.3 Tcl_ObjSetVar2.3.*
+ rm -f Tcl_GetVar2Ex.3 Tcl_GetVar2Ex.3.*
+ rm -f Tcl_GetVar.3 Tcl_GetVar.3.*
+ rm -f Tcl_GetVar2.3 Tcl_GetVar2.3.*
+ rm -f Tcl_ObjGetVar2.3 Tcl_ObjGetVar2.3.*
+ rm -f Tcl_UnsetVar.3 Tcl_UnsetVar.3.*
+ rm -f Tcl_UnsetVar2.3 Tcl_UnsetVar2.3.*
+ ln $S SetVar.3$Z Tcl_SetVar2Ex.3$Z
+ ln $S SetVar.3$Z Tcl_SetVar.3$Z
+ ln $S SetVar.3$Z Tcl_SetVar2.3$Z
+ ln $S SetVar.3$Z Tcl_ObjSetVar2.3$Z
+ ln $S SetVar.3$Z Tcl_GetVar2Ex.3$Z
+ ln $S SetVar.3$Z Tcl_GetVar.3$Z
+ ln $S SetVar.3$Z Tcl_GetVar2.3$Z
+ ln $S SetVar.3$Z Tcl_ObjGetVar2.3$Z
+ ln $S SetVar.3$Z Tcl_UnsetVar.3$Z
+ ln $S SetVar.3$Z Tcl_UnsetVar2.3$Z
+fi
+if test -r Signal.3; then
+ rm -f Signal.3.*
+ $ZIP Signal.3
+ rm -f Tcl_SignalId.3 Tcl_SignalId.3.*
+ rm -f Tcl_SignalMsg.3 Tcl_SignalMsg.3.*
+ ln $S Signal.3$Z Tcl_SignalId.3$Z
+ ln $S Signal.3$Z Tcl_SignalMsg.3$Z
fi
if test -r Sleep.3; then
- rm -f Tcl_Sleep.3
- cp Sleep.3 Tcl_Sleep.3
+ rm -f Sleep.3.*
+ $ZIP Sleep.3
+ rm -f Tcl_Sleep.3 Tcl_Sleep.3.*
+ ln $S Sleep.3$Z Tcl_Sleep.3$Z
fi
if test -r SourceRCFile.3; then
- rm -f Tcl_SourceRCFile.3
- cp SourceRCFile.3 Tcl_SourceRCFile.3
+ rm -f SourceRCFile.3.*
+ $ZIP SourceRCFile.3
+ rm -f Tcl_SourceRCFile.3 Tcl_SourceRCFile.3.*
+ ln $S SourceRCFile.3$Z Tcl_SourceRCFile.3$Z
fi
if test -r SplitList.3; then
- rm -f Tcl_SplitList.3
- rm -f Tcl_Merge.3
- rm -f Tcl_ScanElement.3
- rm -f Tcl_ConvertElement.3
- rm -f Tcl_ScanCountedElement.3
- rm -f Tcl_ConvertCountedElement.3
- cp SplitList.3 Tcl_SplitList.3
- cp SplitList.3 Tcl_Merge.3
- cp SplitList.3 Tcl_ScanElement.3
- cp SplitList.3 Tcl_ConvertElement.3
- cp SplitList.3 Tcl_ScanCountedElement.3
- cp SplitList.3 Tcl_ConvertCountedElement.3
+ rm -f SplitList.3.*
+ $ZIP SplitList.3
+ rm -f Tcl_SplitList.3 Tcl_SplitList.3.*
+ rm -f Tcl_Merge.3 Tcl_Merge.3.*
+ rm -f Tcl_ScanElement.3 Tcl_ScanElement.3.*
+ rm -f Tcl_ConvertElement.3 Tcl_ConvertElement.3.*
+ rm -f Tcl_ScanCountedElement.3 Tcl_ScanCountedElement.3.*
+ rm -f Tcl_ConvertCountedElement.3 Tcl_ConvertCountedElement.3.*
+ ln $S SplitList.3$Z Tcl_SplitList.3$Z
+ ln $S SplitList.3$Z Tcl_Merge.3$Z
+ ln $S SplitList.3$Z Tcl_ScanElement.3$Z
+ ln $S SplitList.3$Z Tcl_ConvertElement.3$Z
+ ln $S SplitList.3$Z Tcl_ScanCountedElement.3$Z
+ ln $S SplitList.3$Z Tcl_ConvertCountedElement.3$Z
fi
if test -r SplitPath.3; then
- rm -f Tcl_SplitPath.3
- rm -f Tcl_JoinPath.3
- rm -f Tcl_GetPathType.3
- cp SplitPath.3 Tcl_SplitPath.3
- cp SplitPath.3 Tcl_JoinPath.3
- cp SplitPath.3 Tcl_GetPathType.3
+ rm -f SplitPath.3.*
+ $ZIP SplitPath.3
+ rm -f Tcl_SplitPath.3 Tcl_SplitPath.3.*
+ rm -f Tcl_JoinPath.3 Tcl_JoinPath.3.*
+ rm -f Tcl_GetPathType.3 Tcl_GetPathType.3.*
+ ln $S SplitPath.3$Z Tcl_SplitPath.3$Z
+ ln $S SplitPath.3$Z Tcl_JoinPath.3$Z
+ ln $S SplitPath.3$Z Tcl_GetPathType.3$Z
fi
if test -r StaticPkg.3; then
- rm -f Tcl_StaticPackage.3
- cp StaticPkg.3 Tcl_StaticPackage.3
+ rm -f StaticPkg.3.*
+ $ZIP StaticPkg.3
+ rm -f Tcl_StaticPackage.3 Tcl_StaticPackage.3.*
+ ln $S StaticPkg.3$Z Tcl_StaticPackage.3$Z
+fi
+if test -r StdChannels.3; then
+ rm -f StdChannels.3.*
+ $ZIP StdChannels.3
+ rm -f Tcl_StandardChannels.3 Tcl_StandardChannels.3.*
+ ln $S StdChannels.3$Z Tcl_StandardChannels.3$Z
fi
if test -r StrMatch.3; then
- rm -f Tcl_StringMatch.3
- rm -f Tcl_StringCaseMatch.3
- cp StrMatch.3 Tcl_StringMatch.3
- cp StrMatch.3 Tcl_StringCaseMatch.3
+ rm -f StrMatch.3.*
+ $ZIP StrMatch.3
+ rm -f Tcl_StringMatch.3 Tcl_StringMatch.3.*
+ rm -f Tcl_StringCaseMatch.3 Tcl_StringCaseMatch.3.*
+ ln $S StrMatch.3$Z Tcl_StringMatch.3$Z
+ ln $S StrMatch.3$Z Tcl_StringCaseMatch.3$Z
fi
if test -r StringObj.3; then
- rm -f Tcl_NewStringObj.3
- rm -f Tcl_NewUnicodeObj.3
- rm -f Tcl_SetStringObj.3
- rm -f Tcl_SetUnicodeObj.3
- rm -f Tcl_GetStringFromObj.3
- rm -f Tcl_GetString.3
- rm -f Tcl_GetUnicode.3
- rm -f Tcl_GetUniChar.3
- rm -f Tcl_GetCharLength.3
- rm -f Tcl_GetRange.3
- rm -f Tcl_AppendToObj.3
- rm -f Tcl_AppendUnicodeToObj.3
- rm -f Tcl_AppendStringsToObj.3
- rm -f Tcl_AppendStringsToObjVA.3
- rm -f Tcl_AppendObjToObj.3
- rm -f Tcl_SetObjLength.3
- rm -f Tcl_ConcatObj.3
- cp StringObj.3 Tcl_NewStringObj.3
- cp StringObj.3 Tcl_NewUnicodeObj.3
- cp StringObj.3 Tcl_SetStringObj.3
- cp StringObj.3 Tcl_SetUnicodeObj.3
- cp StringObj.3 Tcl_GetStringFromObj.3
- cp StringObj.3 Tcl_GetString.3
- cp StringObj.3 Tcl_GetUnicode.3
- cp StringObj.3 Tcl_GetUniChar.3
- cp StringObj.3 Tcl_GetCharLength.3
- cp StringObj.3 Tcl_GetRange.3
- cp StringObj.3 Tcl_AppendToObj.3
- cp StringObj.3 Tcl_AppendUnicodeToObj.3
- cp StringObj.3 Tcl_AppendStringsToObj.3
- cp StringObj.3 Tcl_AppendStringsToObjVA.3
- cp StringObj.3 Tcl_AppendObjToObj.3
- cp StringObj.3 Tcl_SetObjLength.3
- cp StringObj.3 Tcl_ConcatObj.3
+ rm -f StringObj.3.*
+ $ZIP StringObj.3
+ rm -f Tcl_NewStringObj.3 Tcl_NewStringObj.3.*
+ rm -f Tcl_NewUnicodeObj.3 Tcl_NewUnicodeObj.3.*
+ rm -f Tcl_SetStringObj.3 Tcl_SetStringObj.3.*
+ rm -f Tcl_SetUnicodeObj.3 Tcl_SetUnicodeObj.3.*
+ rm -f Tcl_GetStringFromObj.3 Tcl_GetStringFromObj.3.*
+ rm -f Tcl_GetString.3 Tcl_GetString.3.*
+ rm -f Tcl_GetUnicodeFromObj.3 Tcl_GetUnicodeFromObj.3.*
+ rm -f Tcl_GetUnicode.3 Tcl_GetUnicode.3.*
+ rm -f Tcl_GetUniChar.3 Tcl_GetUniChar.3.*
+ rm -f Tcl_GetCharLength.3 Tcl_GetCharLength.3.*
+ rm -f Tcl_GetRange.3 Tcl_GetRange.3.*
+ rm -f Tcl_AppendToObj.3 Tcl_AppendToObj.3.*
+ rm -f Tcl_AppendUnicodeToObj.3 Tcl_AppendUnicodeToObj.3.*
+ rm -f Tcl_AppendStringsToObj.3 Tcl_AppendStringsToObj.3.*
+ rm -f Tcl_AppendStringsToObjVA.3 Tcl_AppendStringsToObjVA.3.*
+ rm -f Tcl_AppendObjToObj.3 Tcl_AppendObjToObj.3.*
+ rm -f Tcl_SetObjLength.3 Tcl_SetObjLength.3.*
+ rm -f Tcl_ConcatObj.3 Tcl_ConcatObj.3.*
+ rm -f Tcl_AttemptSetObjLength.3 Tcl_AttemptSetObjLength.3.*
+ ln $S StringObj.3$Z Tcl_NewStringObj.3$Z
+ ln $S StringObj.3$Z Tcl_NewUnicodeObj.3$Z
+ ln $S StringObj.3$Z Tcl_SetStringObj.3$Z
+ ln $S StringObj.3$Z Tcl_SetUnicodeObj.3$Z
+ ln $S StringObj.3$Z Tcl_GetStringFromObj.3$Z
+ ln $S StringObj.3$Z Tcl_GetString.3$Z
+ ln $S StringObj.3$Z Tcl_GetUnicodeFromObj.3$Z
+ ln $S StringObj.3$Z Tcl_GetUnicode.3$Z
+ ln $S StringObj.3$Z Tcl_GetUniChar.3$Z
+ ln $S StringObj.3$Z Tcl_GetCharLength.3$Z
+ ln $S StringObj.3$Z Tcl_GetRange.3$Z
+ ln $S StringObj.3$Z Tcl_AppendToObj.3$Z
+ ln $S StringObj.3$Z Tcl_AppendUnicodeToObj.3$Z
+ ln $S StringObj.3$Z Tcl_AppendStringsToObj.3$Z
+ ln $S StringObj.3$Z Tcl_AppendStringsToObjVA.3$Z
+ ln $S StringObj.3$Z Tcl_AppendObjToObj.3$Z
+ ln $S StringObj.3$Z Tcl_SetObjLength.3$Z
+ ln $S StringObj.3$Z Tcl_ConcatObj.3$Z
+ ln $S StringObj.3$Z Tcl_AttemptSetObjLength.3$Z
+fi
+if test -r SubstObj.3; then
+ rm -f SubstObj.3.*
+ $ZIP SubstObj.3
+ rm -f Tcl_SubstObj.3 Tcl_SubstObj.3.*
+ ln $S SubstObj.3$Z Tcl_SubstObj.3$Z
+fi
+if test -r TCL_MEM_DEBUG.3; then
+ rm -f TCL_MEM_DEBUG.3.*
+ $ZIP TCL_MEM_DEBUG.3
+fi
+if test -r Tcl.n; then
+ rm -f Tcl.n.*
+ $ZIP Tcl.n
+fi
+if test -r Tcl_Main.3; then
+ rm -f Tcl_Main.3.*
+ $ZIP Tcl_Main.3
+ rm -f Tcl_SetMainLoop.3 Tcl_SetMainLoop.3.*
+ ln $S Tcl_Main.3$Z Tcl_SetMainLoop.3$Z
fi
if test -r Thread.3; then
- rm -f Tcl_ConditionNotify.3
- rm -f Tcl_ConditionWait.3
- rm -f Tcl_ConditionFinalize.3
- rm -f Tcl_GetThreadData.3
- rm -f Tcl_MutexLock.3
- rm -f Tcl_MutexUnlock.3
- rm -f Tcl_MutexFinalize.3
- rm -f Tcl_CreateThread.3
- cp Thread.3 Tcl_ConditionNotify.3
- cp Thread.3 Tcl_ConditionWait.3
- cp Thread.3 Tcl_ConditionFinalize.3
- cp Thread.3 Tcl_GetThreadData.3
- cp Thread.3 Tcl_MutexLock.3
- cp Thread.3 Tcl_MutexUnlock.3
- cp Thread.3 Tcl_MutexFinalize.3
- cp Thread.3 Tcl_CreateThread.3
+ rm -f Thread.3.*
+ $ZIP Thread.3
+ rm -f Tcl_ConditionNotify.3 Tcl_ConditionNotify.3.*
+ rm -f Tcl_ConditionWait.3 Tcl_ConditionWait.3.*
+ rm -f Tcl_ConditionFinalize.3 Tcl_ConditionFinalize.3.*
+ rm -f Tcl_GetThreadData.3 Tcl_GetThreadData.3.*
+ rm -f Tcl_MutexLock.3 Tcl_MutexLock.3.*
+ rm -f Tcl_MutexUnlock.3 Tcl_MutexUnlock.3.*
+ rm -f Tcl_MutexFinalize.3 Tcl_MutexFinalize.3.*
+ rm -f Tcl_CreateThread.3 Tcl_CreateThread.3.*
+ rm -f Tcl_JoinThread.3 Tcl_JoinThread.3.*
+ ln $S Thread.3$Z Tcl_ConditionNotify.3$Z
+ ln $S Thread.3$Z Tcl_ConditionWait.3$Z
+ ln $S Thread.3$Z Tcl_ConditionFinalize.3$Z
+ ln $S Thread.3$Z Tcl_GetThreadData.3$Z
+ ln $S Thread.3$Z Tcl_MutexLock.3$Z
+ ln $S Thread.3$Z Tcl_MutexUnlock.3$Z
+ ln $S Thread.3$Z Tcl_MutexFinalize.3$Z
+ ln $S Thread.3$Z Tcl_CreateThread.3$Z
+ ln $S Thread.3$Z Tcl_JoinThread.3$Z
fi
if test -r ToUpper.3; then
- rm -f Tcl_UniCharToUpper.3
- rm -f Tcl_UniCharToLower.3
- rm -f Tcl_UniCharToTitle.3
- rm -f Tcl_UtfToUpper.3
- rm -f Tcl_UtfToLower.3
- rm -f Tcl_UtfToTitle.3
- cp ToUpper.3 Tcl_UniCharToUpper.3
- cp ToUpper.3 Tcl_UniCharToLower.3
- cp ToUpper.3 Tcl_UniCharToTitle.3
- cp ToUpper.3 Tcl_UtfToUpper.3
- cp ToUpper.3 Tcl_UtfToLower.3
- cp ToUpper.3 Tcl_UtfToTitle.3
+ rm -f ToUpper.3.*
+ $ZIP ToUpper.3
+ rm -f Tcl_UniCharToUpper.3 Tcl_UniCharToUpper.3.*
+ rm -f Tcl_UniCharToLower.3 Tcl_UniCharToLower.3.*
+ rm -f Tcl_UniCharToTitle.3 Tcl_UniCharToTitle.3.*
+ rm -f Tcl_UtfToUpper.3 Tcl_UtfToUpper.3.*
+ rm -f Tcl_UtfToLower.3 Tcl_UtfToLower.3.*
+ rm -f Tcl_UtfToTitle.3 Tcl_UtfToTitle.3.*
+ ln $S ToUpper.3$Z Tcl_UniCharToUpper.3$Z
+ ln $S ToUpper.3$Z Tcl_UniCharToLower.3$Z
+ ln $S ToUpper.3$Z Tcl_UniCharToTitle.3$Z
+ ln $S ToUpper.3$Z Tcl_UtfToUpper.3$Z
+ ln $S ToUpper.3$Z Tcl_UtfToLower.3$Z
+ ln $S ToUpper.3$Z Tcl_UtfToTitle.3$Z
+fi
+if test -r TraceCmd.3; then
+ rm -f TraceCmd.3.*
+ $ZIP TraceCmd.3
+ rm -f Tcl_CommandTraceInfo.3 Tcl_CommandTraceInfo.3.*
+ rm -f Tcl_TraceCommand.3 Tcl_TraceCommand.3.*
+ rm -f Tcl_UntraceCommand.3 Tcl_UntraceCommand.3.*
+ ln $S TraceCmd.3$Z Tcl_CommandTraceInfo.3$Z
+ ln $S TraceCmd.3$Z Tcl_TraceCommand.3$Z
+ ln $S TraceCmd.3$Z Tcl_UntraceCommand.3$Z
fi
if test -r TraceVar.3; then
- rm -f Tcl_TraceVar.3
- rm -f Tcl_TraceVar2.3
- rm -f Tcl_UntraceVar.3
- rm -f Tcl_UntraceVar2.3
- rm -f Tcl_VarTraceInfo.3
- rm -f Tcl_VarTraceInfo2.3
- cp TraceVar.3 Tcl_TraceVar.3
- cp TraceVar.3 Tcl_TraceVar2.3
- cp TraceVar.3 Tcl_UntraceVar.3
- cp TraceVar.3 Tcl_UntraceVar2.3
- cp TraceVar.3 Tcl_VarTraceInfo.3
- cp TraceVar.3 Tcl_VarTraceInfo2.3
+ rm -f TraceVar.3.*
+ $ZIP TraceVar.3
+ rm -f Tcl_TraceVar.3 Tcl_TraceVar.3.*
+ rm -f Tcl_TraceVar2.3 Tcl_TraceVar2.3.*
+ rm -f Tcl_UntraceVar.3 Tcl_UntraceVar.3.*
+ rm -f Tcl_UntraceVar2.3 Tcl_UntraceVar2.3.*
+ rm -f Tcl_VarTraceInfo.3 Tcl_VarTraceInfo.3.*
+ rm -f Tcl_VarTraceInfo2.3 Tcl_VarTraceInfo2.3.*
+ ln $S TraceVar.3$Z Tcl_TraceVar.3$Z
+ ln $S TraceVar.3$Z Tcl_TraceVar2.3$Z
+ ln $S TraceVar.3$Z Tcl_UntraceVar.3$Z
+ ln $S TraceVar.3$Z Tcl_UntraceVar2.3$Z
+ ln $S TraceVar.3$Z Tcl_VarTraceInfo.3$Z
+ ln $S TraceVar.3$Z Tcl_VarTraceInfo2.3$Z
fi
if test -r Translate.3; then
- rm -f Tcl_TranslateFileName.3
- cp Translate.3 Tcl_TranslateFileName.3
+ rm -f Translate.3.*
+ $ZIP Translate.3
+ rm -f Tcl_TranslateFileName.3 Tcl_TranslateFileName.3.*
+ ln $S Translate.3$Z Tcl_TranslateFileName.3$Z
+fi
+if test -r UniCharIsAlpha.3; then
+ rm -f UniCharIsAlpha.3.*
+ $ZIP UniCharIsAlpha.3
+ rm -f Tcl_UniCharIsAlnum.3 Tcl_UniCharIsAlnum.3.*
+ rm -f Tcl_UniCharIsAlpha.3 Tcl_UniCharIsAlpha.3.*
+ rm -f Tcl_UniCharIsControl.3 Tcl_UniCharIsControl.3.*
+ rm -f Tcl_UniCharIsDigit.3 Tcl_UniCharIsDigit.3.*
+ rm -f Tcl_UniCharIsGraph.3 Tcl_UniCharIsGraph.3.*
+ rm -f Tcl_UniCharIsLower.3 Tcl_UniCharIsLower.3.*
+ rm -f Tcl_UniCharIsPrint.3 Tcl_UniCharIsPrint.3.*
+ rm -f Tcl_UniCharIsPunct.3 Tcl_UniCharIsPunct.3.*
+ rm -f Tcl_UniCharIsSpace.3 Tcl_UniCharIsSpace.3.*
+ rm -f Tcl_UniCharIsUpper.3 Tcl_UniCharIsUpper.3.*
+ rm -f Tcl_UniCharIsWordChar.3 Tcl_UniCharIsWordChar.3.*
+ ln $S UniCharIsAlpha.3$Z Tcl_UniCharIsAlnum.3$Z
+ ln $S UniCharIsAlpha.3$Z Tcl_UniCharIsAlpha.3$Z
+ ln $S UniCharIsAlpha.3$Z Tcl_UniCharIsControl.3$Z
+ ln $S UniCharIsAlpha.3$Z Tcl_UniCharIsDigit.3$Z
+ ln $S UniCharIsAlpha.3$Z Tcl_UniCharIsGraph.3$Z
+ ln $S UniCharIsAlpha.3$Z Tcl_UniCharIsLower.3$Z
+ ln $S UniCharIsAlpha.3$Z Tcl_UniCharIsPrint.3$Z
+ ln $S UniCharIsAlpha.3$Z Tcl_UniCharIsPunct.3$Z
+ ln $S UniCharIsAlpha.3$Z Tcl_UniCharIsSpace.3$Z
+ ln $S UniCharIsAlpha.3$Z Tcl_UniCharIsUpper.3$Z
+ ln $S UniCharIsAlpha.3$Z Tcl_UniCharIsWordChar.3$Z
fi
if test -r UpVar.3; then
- rm -f Tcl_UpVar.3
- rm -f Tcl_UpVar2.3
- cp UpVar.3 Tcl_UpVar.3
- cp UpVar.3 Tcl_UpVar2.3
+ rm -f UpVar.3.*
+ $ZIP UpVar.3
+ rm -f Tcl_UpVar.3 Tcl_UpVar.3.*
+ rm -f Tcl_UpVar2.3 Tcl_UpVar2.3.*
+ ln $S UpVar.3$Z Tcl_UpVar.3$Z
+ ln $S UpVar.3$Z Tcl_UpVar2.3$Z
fi
if test -r Utf.3; then
- rm -f Tcl_UniChar.3
- rm -f Tcl_UniCharToUtf.3
- rm -f Tcl_UtfToUniChar.3
- rm -f Tcl_UniCharToUtfDString.3
- rm -f Tcl_UtfToUniCharDString.3
- rm -f Tcl_UniCharLen.3
- rm -f Tcl_UniCharNcmp.3
- rm -f Tcl_UtfCharComplete.3
- rm -f Tcl_NumUtfChars.3
- rm -f Tcl_UtfFindFirst.3
- rm -f Tcl_UtfFindLast.3
- rm -f Tcl_UtfNext.3
- rm -f Tcl_UtfPrev.3
- rm -f Tcl_UniCharAtIndex.3
- rm -f Tcl_UtfAtIndex.3
- rm -f Tcl_UtfBackslash.3
- cp Utf.3 Tcl_UniChar.3
- cp Utf.3 Tcl_UniCharToUtf.3
- cp Utf.3 Tcl_UtfToUniChar.3
- cp Utf.3 Tcl_UniCharToUtfDString.3
- cp Utf.3 Tcl_UtfToUniCharDString.3
- cp Utf.3 Tcl_UniCharLen.3
- cp Utf.3 Tcl_UniCharNcmp.3
- cp Utf.3 Tcl_UtfCharComplete.3
- cp Utf.3 Tcl_NumUtfChars.3
- cp Utf.3 Tcl_UtfFindFirst.3
- cp Utf.3 Tcl_UtfFindLast.3
- cp Utf.3 Tcl_UtfNext.3
- cp Utf.3 Tcl_UtfPrev.3
- cp Utf.3 Tcl_UniCharAtIndex.3
- cp Utf.3 Tcl_UtfAtIndex.3
- cp Utf.3 Tcl_UtfBackslash.3
+ rm -f Utf.3.*
+ $ZIP Utf.3
+ rm -f Tcl_UniChar.3 Tcl_UniChar.3.*
+ rm -f Tcl_UniCharCaseMatch.3 Tcl_UniCharCaseMatch.3.*
+ rm -f Tcl_UniCharNcasecmp.3 Tcl_UniCharNcasecmp.3.*
+ rm -f Tcl_UniCharToUtf.3 Tcl_UniCharToUtf.3.*
+ rm -f Tcl_UtfToUniChar.3 Tcl_UtfToUniChar.3.*
+ rm -f Tcl_UniCharToUtfDString.3 Tcl_UniCharToUtfDString.3.*
+ rm -f Tcl_UtfToUniCharDString.3 Tcl_UtfToUniCharDString.3.*
+ rm -f Tcl_UniCharLen.3 Tcl_UniCharLen.3.*
+ rm -f Tcl_UniCharNcmp.3 Tcl_UniCharNcmp.3.*
+ rm -f Tcl_UtfCharComplete.3 Tcl_UtfCharComplete.3.*
+ rm -f Tcl_NumUtfChars.3 Tcl_NumUtfChars.3.*
+ rm -f Tcl_UtfFindFirst.3 Tcl_UtfFindFirst.3.*
+ rm -f Tcl_UtfFindLast.3 Tcl_UtfFindLast.3.*
+ rm -f Tcl_UtfNext.3 Tcl_UtfNext.3.*
+ rm -f Tcl_UtfPrev.3 Tcl_UtfPrev.3.*
+ rm -f Tcl_UniCharAtIndex.3 Tcl_UniCharAtIndex.3.*
+ rm -f Tcl_UtfAtIndex.3 Tcl_UtfAtIndex.3.*
+ rm -f Tcl_UtfBackslash.3 Tcl_UtfBackslash.3.*
+ ln $S Utf.3$Z Tcl_UniChar.3$Z
+ ln $S Utf.3$Z Tcl_UniCharCaseMatch.3$Z
+ ln $S Utf.3$Z Tcl_UniCharNcasecmp.3$Z
+ ln $S Utf.3$Z Tcl_UniCharToUtf.3$Z
+ ln $S Utf.3$Z Tcl_UtfToUniChar.3$Z
+ ln $S Utf.3$Z Tcl_UniCharToUtfDString.3$Z
+ ln $S Utf.3$Z Tcl_UtfToUniCharDString.3$Z
+ ln $S Utf.3$Z Tcl_UniCharLen.3$Z
+ ln $S Utf.3$Z Tcl_UniCharNcmp.3$Z
+ ln $S Utf.3$Z Tcl_UtfCharComplete.3$Z
+ ln $S Utf.3$Z Tcl_NumUtfChars.3$Z
+ ln $S Utf.3$Z Tcl_UtfFindFirst.3$Z
+ ln $S Utf.3$Z Tcl_UtfFindLast.3$Z
+ ln $S Utf.3$Z Tcl_UtfNext.3$Z
+ ln $S Utf.3$Z Tcl_UtfPrev.3$Z
+ ln $S Utf.3$Z Tcl_UniCharAtIndex.3$Z
+ ln $S Utf.3$Z Tcl_UtfAtIndex.3$Z
+ ln $S Utf.3$Z Tcl_UtfBackslash.3$Z
fi
if test -r WrongNumArgs.3; then
- rm -f Tcl_WrongNumArgs.3
- cp WrongNumArgs.3 Tcl_WrongNumArgs.3
+ rm -f WrongNumArgs.3.*
+ $ZIP WrongNumArgs.3
+ rm -f Tcl_WrongNumArgs.3 Tcl_WrongNumArgs.3.*
+ ln $S WrongNumArgs.3$Z Tcl_WrongNumArgs.3$Z
+fi
+if test -r after.n; then
+ rm -f after.n.*
+ $ZIP after.n
+fi
+if test -r append.n; then
+ rm -f append.n.*
+ $ZIP append.n
+fi
+if test -r array.n; then
+ rm -f array.n.*
+ $ZIP array.n
+fi
+if test -r bgerror.n; then
+ rm -f bgerror.n.*
+ $ZIP bgerror.n
+fi
+if test -r binary.n; then
+ rm -f binary.n.*
+ $ZIP binary.n
+fi
+if test -r break.n; then
+ rm -f break.n.*
+ $ZIP break.n
+fi
+if test -r case.n; then
+ rm -f case.n.*
+ $ZIP case.n
+fi
+if test -r catch.n; then
+ rm -f catch.n.*
+ $ZIP catch.n
+fi
+if test -r cd.n; then
+ rm -f cd.n.*
+ $ZIP cd.n
+fi
+if test -r clock.n; then
+ rm -f clock.n.*
+ $ZIP clock.n
+fi
+if test -r close.n; then
+ rm -f close.n.*
+ $ZIP close.n
+fi
+if test -r concat.n; then
+ rm -f concat.n.*
+ $ZIP concat.n
+fi
+if test -r continue.n; then
+ rm -f continue.n.*
+ $ZIP continue.n
+fi
+if test -r dde.n; then
+ rm -f dde.n.*
+ $ZIP dde.n
+fi
+if test -r encoding.n; then
+ rm -f encoding.n.*
+ $ZIP encoding.n
+fi
+if test -r eof.n; then
+ rm -f eof.n.*
+ $ZIP eof.n
+fi
+if test -r error.n; then
+ rm -f error.n.*
+ $ZIP error.n
+fi
+if test -r eval.n; then
+ rm -f eval.n.*
+ $ZIP eval.n
+fi
+if test -r exec.n; then
+ rm -f exec.n.*
+ $ZIP exec.n
+fi
+if test -r exit.n; then
+ rm -f exit.n.*
+ $ZIP exit.n
+fi
+if test -r expr.n; then
+ rm -f expr.n.*
+ $ZIP expr.n
+fi
+if test -r fblocked.n; then
+ rm -f fblocked.n.*
+ $ZIP fblocked.n
+fi
+if test -r fconfigure.n; then
+ rm -f fconfigure.n.*
+ $ZIP fconfigure.n
+fi
+if test -r fcopy.n; then
+ rm -f fcopy.n.*
+ $ZIP fcopy.n
+fi
+if test -r file.n; then
+ rm -f file.n.*
+ $ZIP file.n
+fi
+if test -r fileevent.n; then
+ rm -f fileevent.n.*
+ $ZIP fileevent.n
+fi
+if test -r filename.n; then
+ rm -f filename.n.*
+ $ZIP filename.n
+fi
+if test -r flush.n; then
+ rm -f flush.n.*
+ $ZIP flush.n
+fi
+if test -r for.n; then
+ rm -f for.n.*
+ $ZIP for.n
+fi
+if test -r foreach.n; then
+ rm -f foreach.n.*
+ $ZIP foreach.n
+fi
+if test -r format.n; then
+ rm -f format.n.*
+ $ZIP format.n
+fi
+if test -r gets.n; then
+ rm -f gets.n.*
+ $ZIP gets.n
+fi
+if test -r glob.n; then
+ rm -f glob.n.*
+ $ZIP glob.n
+fi
+if test -r global.n; then
+ rm -f global.n.*
+ $ZIP global.n
+fi
+if test -r history.n; then
+ rm -f history.n.*
+ $ZIP history.n
fi
if test -r http.n; then
- rm -f Http.n
- cp http.n Http.n
+ rm -f http.n.*
+ $ZIP http.n
+fi
+if test -r if.n; then
+ rm -f if.n.*
+ $ZIP if.n
+fi
+if test -r incr.n; then
+ rm -f incr.n.*
+ $ZIP incr.n
+fi
+if test -r info.n; then
+ rm -f info.n.*
+ $ZIP info.n
+fi
+if test -r interp.n; then
+ rm -f interp.n.*
+ $ZIP interp.n
+fi
+if test -r join.n; then
+ rm -f join.n.*
+ $ZIP join.n
+fi
+if test -r lappend.n; then
+ rm -f lappend.n.*
+ $ZIP lappend.n
fi
if test -r library.n; then
- rm -f auto_execok.n
- rm -f auto_import.n
- rm -f auto_load.n
- rm -f auto_mkindex.n
- rm -f auto_mkindex_old.n
- rm -f auto_qualify.n
- rm -f auto_reset.n
- rm -f tcl_findLibrary.n
- rm -f parray.n
- rm -f tcl_endOfWord.n
- rm -f tcl_startOfNextWord.n
- rm -f tcl_startOfPreviousWord.n
- rm -f tcl_wordBreakAfter.n
- rm -f tcl_wordBreakBefore.n
- cp library.n auto_execok.n
- cp library.n auto_import.n
- cp library.n auto_load.n
- cp library.n auto_mkindex.n
- cp library.n auto_mkindex_old.n
- cp library.n auto_qualify.n
- cp library.n auto_reset.n
- cp library.n tcl_findLibrary.n
- cp library.n parray.n
- cp library.n tcl_endOfWord.n
- cp library.n tcl_startOfNextWord.n
- cp library.n tcl_startOfPreviousWord.n
- cp library.n tcl_wordBreakAfter.n
- cp library.n tcl_wordBreakBefore.n
+ rm -f library.n.*
+ $ZIP library.n
+ rm -f auto_execok.n auto_execok.n.*
+ rm -f auto_import.n auto_import.n.*
+ rm -f auto_load.n auto_load.n.*
+ rm -f auto_mkindex.n auto_mkindex.n.*
+ rm -f auto_mkindex_old.n auto_mkindex_old.n.*
+ rm -f auto_qualify.n auto_qualify.n.*
+ rm -f auto_reset.n auto_reset.n.*
+ rm -f tcl_findLibrary.n tcl_findLibrary.n.*
+ rm -f parray.n parray.n.*
+ rm -f tcl_endOfWord.n tcl_endOfWord.n.*
+ rm -f tcl_startOfNextWord.n tcl_startOfNextWord.n.*
+ rm -f tcl_startOfPreviousWord.n tcl_startOfPreviousWord.n.*
+ rm -f tcl_wordBreakAfter.n tcl_wordBreakAfter.n.*
+ rm -f tcl_wordBreakBefore.n tcl_wordBreakBefore.n.*
+ ln $S library.n$Z auto_execok.n$Z
+ ln $S library.n$Z auto_import.n$Z
+ ln $S library.n$Z auto_load.n$Z
+ ln $S library.n$Z auto_mkindex.n$Z
+ ln $S library.n$Z auto_mkindex_old.n$Z
+ ln $S library.n$Z auto_qualify.n$Z
+ ln $S library.n$Z auto_reset.n$Z
+ ln $S library.n$Z tcl_findLibrary.n$Z
+ ln $S library.n$Z parray.n$Z
+ ln $S library.n$Z tcl_endOfWord.n$Z
+ ln $S library.n$Z tcl_startOfNextWord.n$Z
+ ln $S library.n$Z tcl_startOfPreviousWord.n$Z
+ ln $S library.n$Z tcl_wordBreakAfter.n$Z
+ ln $S library.n$Z tcl_wordBreakBefore.n$Z
+fi
+if test -r lindex.n; then
+ rm -f lindex.n.*
+ $ZIP lindex.n
+fi
+if test -r linsert.n; then
+ rm -f linsert.n.*
+ $ZIP linsert.n
+fi
+if test -r list.n; then
+ rm -f list.n.*
+ $ZIP list.n
+fi
+if test -r llength.n; then
+ rm -f llength.n.*
+ $ZIP llength.n
+fi
+if test -r load.n; then
+ rm -f load.n.*
+ $ZIP load.n
+fi
+if test -r lrange.n; then
+ rm -f lrange.n.*
+ $ZIP lrange.n
+fi
+if test -r lreplace.n; then
+ rm -f lreplace.n.*
+ $ZIP lreplace.n
+fi
+if test -r lsearch.n; then
+ rm -f lsearch.n.*
+ $ZIP lsearch.n
+fi
+if test -r lset.n; then
+ rm -f lset.n.*
+ $ZIP lset.n
+fi
+if test -r lsort.n; then
+ rm -f lsort.n.*
+ $ZIP lsort.n
+fi
+if test -r memory.n; then
+ rm -f memory.n.*
+ $ZIP memory.n
+fi
+if test -r msgcat.n; then
+ rm -f msgcat.n.*
+ $ZIP msgcat.n
+fi
+if test -r namespace.n; then
+ rm -f namespace.n.*
+ $ZIP namespace.n
+fi
+if test -r open.n; then
+ rm -f open.n.*
+ $ZIP open.n
+fi
+if test -r package.n; then
+ rm -f package.n.*
+ $ZIP package.n
fi
if test -r packagens.n; then
- rm -f pkg::create.n
- cp packagens.n pkg::create.n
+ rm -f packagens.n.*
+ $ZIP packagens.n
+ rm -f pkg::create.n pkg::create.n.*
+ ln $S packagens.n$Z pkg::create.n$Z
+fi
+if test -r pid.n; then
+ rm -f pid.n.*
+ $ZIP pid.n
fi
if test -r pkgMkIndex.n; then
- rm -f pkg_mkIndex.n
- cp pkgMkIndex.n pkg_mkIndex.n
+ rm -f pkgMkIndex.n.*
+ $ZIP pkgMkIndex.n
+ rm -f pkg_mkIndex.n pkg_mkIndex.n.*
+ ln $S pkgMkIndex.n$Z pkg_mkIndex.n$Z
+fi
+if test -r proc.n; then
+ rm -f proc.n.*
+ $ZIP proc.n
+fi
+if test -r puts.n; then
+ rm -f puts.n.*
+ $ZIP puts.n
+fi
+if test -r pwd.n; then
+ rm -f pwd.n.*
+ $ZIP pwd.n
+fi
+if test -r re_syntax.n; then
+ rm -f re_syntax.n.*
+ $ZIP re_syntax.n
+fi
+if test -r read.n; then
+ rm -f read.n.*
+ $ZIP read.n
+fi
+if test -r regexp.n; then
+ rm -f regexp.n.*
+ $ZIP regexp.n
+fi
+if test -r registry.n; then
+ rm -f registry.n.*
+ $ZIP registry.n
+fi
+if test -r regsub.n; then
+ rm -f regsub.n.*
+ $ZIP regsub.n
+fi
+if test -r rename.n; then
+ rm -f rename.n.*
+ $ZIP rename.n
+fi
+if test -r resource.n; then
+ rm -f resource.n.*
+ $ZIP resource.n
+fi
+if test -r return.n; then
+ rm -f return.n.*
+ $ZIP return.n
fi
if test -r safe.n; then
- rm -f SafeBase.n
- cp safe.n SafeBase.n
+ rm -f safe.n.*
+ $ZIP safe.n
+ rm -f SafeBase.n SafeBase.n.*
+ ln $S safe.n$Z SafeBase.n$Z
+fi
+if test -r scan.n; then
+ rm -f scan.n.*
+ $ZIP scan.n
+fi
+if test -r seek.n; then
+ rm -f seek.n.*
+ $ZIP seek.n
+fi
+if test -r set.n; then
+ rm -f set.n.*
+ $ZIP set.n
+fi
+if test -r socket.n; then
+ rm -f socket.n.*
+ $ZIP socket.n
+fi
+if test -r source.n; then
+ rm -f source.n.*
+ $ZIP source.n
+fi
+if test -r split.n; then
+ rm -f split.n.*
+ $ZIP split.n
+fi
+if test -r string.n; then
+ rm -f string.n.*
+ $ZIP string.n
+fi
+if test -r subst.n; then
+ rm -f subst.n.*
+ $ZIP subst.n
+fi
+if test -r switch.n; then
+ rm -f switch.n.*
+ $ZIP switch.n
+fi
+if test -r tclsh.1; then
+ rm -f tclsh.1.*
+ $ZIP tclsh.1
fi
if test -r tcltest.n; then
- rm -f Tcltest.n
- cp tcltest.n Tcltest.n
+ rm -f tcltest.n.*
+ $ZIP tcltest.n
+fi
+if test -r tclvars.n; then
+ rm -f tclvars.n.*
+ $ZIP tclvars.n
+fi
+if test -r tell.n; then
+ rm -f tell.n.*
+ $ZIP tell.n
+fi
+if test -r time.n; then
+ rm -f time.n.*
+ $ZIP time.n
+fi
+if test -r trace.n; then
+ rm -f trace.n.*
+ $ZIP trace.n
+fi
+if test -r unknown.n; then
+ rm -f unknown.n.*
+ $ZIP unknown.n
+fi
+if test -r unset.n; then
+ rm -f unset.n.*
+ $ZIP unset.n
+fi
+if test -r update.n; then
+ rm -f update.n.*
+ $ZIP update.n
+fi
+if test -r uplevel.n; then
+ rm -f uplevel.n.*
+ $ZIP uplevel.n
+fi
+if test -r upvar.n; then
+ rm -f upvar.n.*
+ $ZIP upvar.n
+fi
+if test -r variable.n; then
+ rm -f variable.n.*
+ $ZIP variable.n
+fi
+if test -r vwait.n; then
+ rm -f vwait.n.*
+ $ZIP vwait.n
+fi
+if test -r while.n; then
+ rm -f while.n.*
+ $ZIP while.n
fi
exit 0
diff --git a/tcl/unix/tcl.m4 b/tcl/unix/tcl.m4
index 6ebd6a4b805..31f43a95fb0 100644
--- a/tcl/unix/tcl.m4
+++ b/tcl/unix/tcl.m4
@@ -31,7 +31,7 @@ AC_DEFUN(SC_PATH_TCLCONFIG, [
AC_MSG_CHECKING([for Tcl configuration])
AC_CACHE_VAL(ac_cv_c_tclconfig,[
- # First check to see if --with-tclconfig was specified.
+ # First check to see if --with-tcl was specified.
if test x"${with_tclconfig}" != x ; then
if test -f "${with_tclconfig}/tclConfig.sh" ; then
ac_cv_c_tclconfig=`(cd ${with_tclconfig}; pwd)`
@@ -53,17 +53,16 @@ AC_DEFUN(SC_PATH_TCLCONFIG, [
ac_cv_c_tclconfig=`(cd $i/unix; pwd)`
break
fi
- if test -f "$i/win/tclConfig.sh" ; then
- ac_cv_c_tclconfig=`(cd $i/win; pwd)`
- break
- fi
done
fi
# check in a few common install locations
if test x"${ac_cv_c_tclconfig}" = x ; then
- for i in `ls -d ${prefix}/lib 2>/dev/null` \
- `ls -d /usr/local/lib 2>/dev/null` ; do
+ for i in `ls -d ${libdir} 2>/dev/null` \
+ `ls -d /usr/local/lib 2>/dev/null` \
+ `ls -d /usr/contrib/lib 2>/dev/null` \
+ `ls -d /usr/lib 2>/dev/null` \
+ ; do
if test -f "$i/tclConfig.sh" ; then
ac_cv_c_tclconfig=`(cd $i; pwd)`
break
@@ -79,18 +78,14 @@ AC_DEFUN(SC_PATH_TCLCONFIG, [
if test -f "$i/unix/tclConfig.sh" ; then
ac_cv_c_tclconfig=`(cd $i/unix; pwd)`
break
- fi
- if test -f "$i/win/tclConfig.sh" ; then
- ac_cv_c_tclconfig=`(cd $i/win; pwd)`
- break
- fi
+ fi
done
fi
])
if test x"${ac_cv_c_tclconfig}" = x ; then
TCL_BIN_DIR="# no Tcl configs found"
- AC_MSG_ERROR(Can't find Tcl configuration definitions)
+ AC_MSG_WARN(Can't find Tcl configuration definitions)
exit 0
else
no_tcl=
@@ -154,16 +149,15 @@ AC_DEFUN(SC_PATH_TKCONFIG, [
ac_cv_c_tkconfig=`(cd $i/unix; pwd)`
break
fi
- if test -f "$i/win/tkConfig.sh" ; then
- ac_cv_c_tkconfig=`(cd $i/win; pwd)`
- break
- fi
done
fi
# check in a few common install locations
if test x"${ac_cv_c_tkconfig}" = x ; then
- for i in `ls -d ${prefix}/lib 2>/dev/null` \
- `ls -d /usr/local/lib 2>/dev/null` ; do
+ for i in `ls -d ${libdir} 2>/dev/null` \
+ `ls -d /usr/local/lib 2>/dev/null` \
+ `ls -d /usr/contrib/lib 2>/dev/null` \
+ `ls -d /usr/lib 2>/dev/null` \
+ ; do
if test -f "$i/tkConfig.sh" ; then
ac_cv_c_tkconfig=`(cd $i; pwd)`
break
@@ -179,16 +173,12 @@ AC_DEFUN(SC_PATH_TKCONFIG, [
ac_cv_c_tkconfig=`(cd $i/unix; pwd)`
break
fi
- if test -f "$i/win/tkConfig.sh" ; then
- ac_cv_c_tkconfig=`(cd $i/win; pwd)`
- break
- fi
done
fi
])
if test x"${ac_cv_c_tkconfig}" = x ; then
TK_BIN_DIR="# no Tk configs found"
- AC_MSG_ERROR(Can't find Tk configuration definitions)
+ AC_MSG_WARN(Can't find Tk configuration definitions)
exit 0
else
no_tk=
@@ -229,16 +219,43 @@ AC_DEFUN(SC_LOAD_TCLCONFIG, [
fi
#
- # The eval is required to do the TCL_DBGX substitution in the
- # TCL_LIB_FILE variable
+ # If the TCL_BIN_DIR is the build directory (not the install directory),
+ # then set the common variable name to the value of the build variables.
+ # For example, the variable TCL_LIB_SPEC will be set to the value
+ # of TCL_BUILD_LIB_SPEC. An extension should make use of TCL_LIB_SPEC
+ # instead of TCL_BUILD_LIB_SPEC since it will work with both an
+ # installed and uninstalled version of Tcl.
#
- eval TCL_LIB_FILE=${TCL_LIB_FILE}
- eval TCL_LIB_FLAG=${TCL_LIB_FLAG}
+ if test -f $TCL_BIN_DIR/Makefile ; then
+ TCL_LIB_SPEC=${TCL_BUILD_LIB_SPEC}
+ TCL_STUB_LIB_SPEC=${TCL_BUILD_STUB_LIB_SPEC}
+ TCL_STUB_LIB_PATH=${TCL_BUILD_STUB_LIB_PATH}
+ fi
+ #
+ # eval is required to do the TCL_DBGX substitution
+ #
+
+ eval "TCL_LIB_FILE=\"${TCL_LIB_FILE}\""
+ eval "TCL_LIB_FLAG=\"${TCL_LIB_FLAG}\""
+ eval "TCL_LIB_SPEC=\"${TCL_LIB_SPEC}\""
+
+ eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\""
+ eval "TCL_STUB_LIB_FLAG=\"${TCL_STUB_LIB_FLAG}\""
+ eval "TCL_STUB_LIB_SPEC=\"${TCL_STUB_LIB_SPEC}\""
+
+ AC_SUBST(TCL_VERSION)
AC_SUBST(TCL_BIN_DIR)
AC_SUBST(TCL_SRC_DIR)
+
AC_SUBST(TCL_LIB_FILE)
+ AC_SUBST(TCL_LIB_FLAG)
+ AC_SUBST(TCL_LIB_SPEC)
+
+ AC_SUBST(TCL_STUB_LIB_FILE)
+ AC_SUBST(TCL_STUB_LIB_FLAG)
+ AC_SUBST(TCL_STUB_LIB_SPEC)
])
#------------------------------------------------------------------------
@@ -258,15 +275,16 @@ AC_DEFUN(SC_LOAD_TCLCONFIG, [
#------------------------------------------------------------------------
AC_DEFUN(SC_LOAD_TKCONFIG, [
- AC_MSG_CHECKING([for existence of $TCLCONFIG])
+ AC_MSG_CHECKING([for existence of $TK_BIN_DIR/tkConfig.sh])
if test -f "$TK_BIN_DIR/tkConfig.sh" ; then
- AC_MSG_CHECKING([loading $TK_BIN_DIR/tkConfig.sh])
+ AC_MSG_RESULT([loading])
. $TK_BIN_DIR/tkConfig.sh
else
AC_MSG_RESULT([could not find $TK_BIN_DIR/tkConfig.sh])
fi
+ AC_SUBST(TK_VERSION)
AC_SUBST(TK_BIN_DIR)
AC_SUBST(TK_SRC_DIR)
AC_SUBST(TK_LIB_FILE)
@@ -297,13 +315,13 @@ AC_DEFUN(SC_ENABLE_SHARED, [
AC_MSG_CHECKING([how to build libraries])
AC_ARG_ENABLE(shared,
[ --enable-shared build and link with shared libraries [--enable-shared]],
- [tcl_ok=$enableval], [tcl_ok=no])
+ [tcl_ok=$enableval], [tcl_ok=yes])
if test "${enable_shared+set}" = set; then
enableval="$enable_shared"
tcl_ok=$enableval
else
- tcl_ok=no
+ tcl_ok=yes
fi
if test "$tcl_ok" = "yes" ; then
@@ -317,6 +335,49 @@ AC_DEFUN(SC_ENABLE_SHARED, [
])
#------------------------------------------------------------------------
+# SC_ENABLE_FRAMEWORK --
+#
+# Allows the building of shared libraries into frameworks
+#
+# Arguments:
+# none
+#
+# Results:
+#
+# Adds the following arguments to configure:
+# --enable-framework=yes|no
+#
+# Sets the following vars:
+# FRAMEWORK_BUILD Value of 1 or 0
+#------------------------------------------------------------------------
+
+AC_DEFUN(SC_ENABLE_FRAMEWORK, [
+ AC_MSG_CHECKING([how to package libraries])
+ AC_ARG_ENABLE(framework,
+ [ --enable-framework package shared libraries in frameworks [--disable-framework]],
+ [tcl_ok=$enableval], [tcl_ok=no])
+
+ if test "${enable_framework+set}" = set; then
+ enableval="$enable_framework"
+ tcl_ok=$enableval
+ else
+ tcl_ok=no
+ fi
+
+ if test "$tcl_ok" = "yes" ; then
+ AC_MSG_RESULT([framework])
+ FRAMEWORK_BUILD=1
+ if test "${SHARED_BUILD}" = "0" ; then
+ AC_MSG_WARN("Frameworks can only be built if --enable-shared is yes")
+ FRAMEWORK_BUILD=0
+ fi
+ else
+ AC_MSG_RESULT([standard shared library])
+ FRAMEWORK_BUILD=0
+ fi
+])
+
+#------------------------------------------------------------------------
# SC_ENABLE_THREADS --
#
# Specify if thread support should be enabled
@@ -335,6 +396,7 @@ AC_DEFUN(SC_ENABLE_SHARED, [
# Defines the following vars:
# TCL_THREADS
# _REENTRANT
+# _THREAD_SAFE
#
#------------------------------------------------------------------------
@@ -347,6 +409,9 @@ AC_DEFUN(SC_ENABLE_THREADS, [
AC_MSG_RESULT(yes)
TCL_THREADS=1
AC_DEFINE(TCL_THREADS)
+ # USE_THREAD_ALLOC tells us to try the special thread-based
+ # allocator that significantly reduces lock contention
+ AC_DEFINE(USE_THREAD_ALLOC)
AC_DEFINE(_REENTRANT)
AC_DEFINE(_THREAD_SAFE)
AC_CHECK_LIB(pthread,pthread_mutex_init,tcl_ok=yes,tcl_ok=no)
@@ -370,8 +435,14 @@ AC_DEFUN(SC_ENABLE_THREADS, [
else
AC_CHECK_LIB(c,pthread_mutex_init,tcl_ok=yes,tcl_ok=no)
if test "$tcl_ok" = "no"; then
- TCL_THREADS=0
- AC_MSG_WARN("Don t know how to find pthread lib on your system - you must disable thread support or edit the LIBS in the Makefile...")
+ AC_CHECK_LIB(c_r,pthread_mutex_init,tcl_ok=yes,tcl_ok=no)
+ if test "$tcl_ok" = "yes"; then
+ # The space is needed
+ THREADS_LIBS=" -pthread"
+ else
+ TCL_THREADS=0
+ AC_MSG_WARN("Don t know how to find pthread lib on your system - you must disable thread support or edit the LIBS in the Makefile...")
+ fi
fi
fi
fi
@@ -380,10 +451,12 @@ AC_DEFUN(SC_ENABLE_THREADS, [
# 'pthread_attr_setstacksize' ?
AC_CHECK_FUNCS(pthread_attr_setstacksize)
+ AC_CHECK_FUNCS(readdir_r)
else
TCL_THREADS=0
- AC_MSG_RESULT(no (default))
+ AC_MSG_RESULT([no (default)])
fi
+ AC_SUBST(TCL_THREADS)
])
#------------------------------------------------------------------------
@@ -417,6 +490,7 @@ AC_DEFUN(SC_ENABLE_THREADS, [
AC_DEFUN(SC_ENABLE_SYMBOLS, [
AC_MSG_CHECKING([for build with symbols])
AC_ARG_ENABLE(symbols, [ --enable-symbols build with debugging symbols [--disable-symbols]], [tcl_ok=$enableval], [tcl_ok=no])
+# FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT.
if test "$tcl_ok" = "yes"; then
CFLAGS_DEFAULT='$(CFLAGS_DEBUG)'
LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)'
@@ -428,9 +502,134 @@ AC_DEFUN(SC_ENABLE_SYMBOLS, [
DBGX=""
AC_MSG_RESULT([no])
fi
+ AC_SUBST(CFLAGS_DEFAULT)
+ AC_SUBST(LDFLAGS_DEFAULT)
+])
+
+#------------------------------------------------------------------------
+# SC_ENABLE_LANGINFO --
+#
+# Allows use of modern nl_langinfo check for better l10n.
+# This is only relevant for Unix.
+#
+# Arguments:
+# none
+#
+# Results:
+#
+# Adds the following arguments to configure:
+# --enable-langinfo=yes|no (default is yes)
+#
+# Defines the following vars:
+# HAVE_LANGINFO Triggers use of nl_langinfo if defined.
+#
+#------------------------------------------------------------------------
+
+AC_DEFUN(SC_ENABLE_LANGINFO, [
+ AC_ARG_ENABLE(langinfo,
+ [ --enable-langinfo use nl_langinfo if possible to determine
+ encoding at startup, otherwise use old heuristic],
+ [langinfo_ok=$enableval], [langinfo_ok=yes])
+
+ HAVE_LANGINFO=0
+ if test "$langinfo_ok" = "yes"; then
+ if test "$langinfo_ok" = "yes"; then
+ AC_CHECK_HEADER(langinfo.h,[langinfo_ok=yes],[langinfo_ok=no])
+ fi
+ fi
+ AC_MSG_CHECKING([whether to use nl_langinfo])
+ if test "$langinfo_ok" = "yes"; then
+ AC_TRY_COMPILE([#include <langinfo.h>],
+ [nl_langinfo(CODESET);],[langinfo_ok=yes],[langinfo_ok=no])
+ if test "$langinfo_ok" = "no"; then
+ langinfo_ok="no (could not compile with nl_langinfo)";
+ fi
+ if test "$langinfo_ok" = "yes"; then
+ AC_DEFINE(HAVE_LANGINFO)
+ fi
+ fi
+ AC_MSG_RESULT([$langinfo_ok])
])
#--------------------------------------------------------------------
+# SC_CONFIG_MANPAGES
+#
+# Decide whether to use symlinks for linking the manpages and
+# whether to compress the manpages after installation.
+#
+# Arguments:
+# none
+#
+# Results:
+#
+# Adds the following arguments to configure:
+# --enable-man-symlinks
+# --enable-man-compression=PROG
+#
+# Defines the following variable:
+#
+# MKLINKS_FLAGS - The apropriate flags for mkLinks
+# according to the user's selection.
+#
+#--------------------------------------------------------------------
+AC_DEFUN(SC_CONFIG_MANPAGES, [
+
+ AC_MSG_CHECKING([whether to use symlinks for manpages])
+ AC_ARG_ENABLE(man-symlinks,
+ [ --enable-man-symlinks use symlinks for the manpages],
+ test "$enableval" != "no" && MKLINKS_FLAGS="$MKLINKS_FLAGS --symlinks",
+ enableval="no")
+ AC_MSG_RESULT([$enableval])
+
+ AC_MSG_CHECKING([compression for manpages])
+ AC_ARG_ENABLE(man-compression,
+ [ --enable-man-compression=PROG
+ compress the manpages with PROG],
+ test "$enableval" = "yes" && echo && AC_MSG_ERROR([missing argument to --enable-man-compression])
+ test "$enableval" != "no" && MKLINKS_FLAGS="$MKLINKS_FLAGS --compress $enableval",
+ enableval="no")
+ AC_MSG_RESULT([$enableval])
+
+ AC_SUBST(MKLINKS_FLAGS)
+])
+
+#------------------------------------------------------------------------
+# SC_ENABLE_MEMDEBUG --
+#
+# Specify if the memory debugging code should be used
+#
+# Arguments:
+# none
+#
+# Requires the following vars to be set in the Makefile:
+# None.
+#
+# Results:
+#
+# Adds the following arguments to configure:
+# --enable-memdebug
+#
+# Defines the following @vars@:
+# MEM_DEBUG_FLAGS Sets to -DTCL_MEM_DEBUG if true
+# Sets to "" if false
+#
+#------------------------------------------------------------------------
+
+AC_DEFUN(SC_ENABLE_MEMDEBUG, [
+ AC_MSG_CHECKING([for build with memory debugging])
+ AC_ARG_ENABLE(memdebug, [ --enable-memdebug build with memory debugging [--disable-memdebug]], [tcl_ok=$enableval], [tcl_ok=no])
+ if test "$tcl_ok" = "yes"; then
+ MEM_DEBUG_FLAGS=-DTCL_MEM_DEBUG
+ AC_MSG_RESULT([yes])
+ else
+ MEM_DEBUG_FLAGS=""
+ AC_MSG_RESULT([no])
+ fi
+ AC_SUBST(MEM_DEBUG_FLAGS)
+])
+
+
+#--------------------------------------------------------------------
# SC_CONFIG_CFLAGS
#
# Try to determine the proper flags to pass to the compiler
@@ -441,7 +640,7 @@ AC_DEFUN(SC_ENABLE_SYMBOLS, [
#
# Results:
#
-# Defines the following vars:
+# Defines and substitutes the following vars:
#
# DL_OBJS - Name of the object file that implements dynamic
# loading for Tcl on this system.
@@ -453,10 +652,20 @@ AC_DEFUN(SC_ENABLE_SYMBOLS, [
# LD_SEARCH_FLAGS-Flags to pass to ld, such as "-R /usr/local/tcl/lib",
# that tell the run-time dynamic linker where to look
# for shared libraries such as libtcl.so. Depends on
+# the variable LIB_RUNTIME_DIR in the Makefile. Could
+# be the same as CC_SEARCH_FLAGS if ${CC} is used to link.
+# CC_SEARCH_FLAGS-Flags to pass to ${CC}, such as "-Wl,-rpath,/usr/local/tcl/lib",
+# that tell the run-time dynamic linker where to look
+# for shared libraries such as libtcl.so. Depends on
# the variable LIB_RUNTIME_DIR in the Makefile.
-# MAKE_LIB - Command to execute to build the Tcl library;
-# differs depending on whether or not Tcl is being
-# compiled as a shared library.
+# MAKE_LIB - Command to execute to build the a library;
+# differs when building shared or static.
+# MAKE_STUB_LIB -
+# Command to execute to build a stub library.
+# INSTALL_LIB - Command to execute to install a library;
+# differs when building shared or static.
+# INSTALL_STUB_LIB -
+# Command to execute to install a stub library.
# STLIB_LD - Base command to use for combining object files
# into a static library.
# SHLIB_CFLAGS - Flags to pass to cc when compiling the components
@@ -464,6 +673,9 @@ AC_DEFUN(SC_ENABLE_SYMBOLS, [
# code, among other things).
# SHLIB_LD - Base command to use for combining object files
# into a shared library.
+# SHLIB_LD_FLAGS -Flags to pass when building a shared library. This
+# differes from the SHLIB_CFLAGS as it is not used
+# when building object files or executables.
# SHLIB_LD_LIBS - Dependent libraries for the linker to scan when
# creating shared libraries. This symbol typically
# goes at the end of the "ld" commands that build
@@ -478,15 +690,20 @@ AC_DEFUN(SC_ENABLE_SYMBOLS, [
# SHLIB_SUFFIX - Suffix to use for the names of dynamically loadable
# extensions. An empty string means we don't know how
# to use shared libraries on this platform.
-# TCL_LIB_FILE - Name of the file that contains the Tcl library, such
-# as libtcl7.8.so or libtcl7.8.a.
-# TCL_LIB_SUFFIX -Specifies everything that comes after the "libtcl"
-# in the shared library name, using the $VERSION variable
+# TCL_SHLIB_LD_EXTRAS - Additional element which are added to SHLIB_LD_LIBS
+# TK_SHLIB_LD_EXTRAS for the build of Tcl and Tk, but not recorded in the
+# tclConfig.sh, since they are only used for the build
+# of Tcl and Tk.
+# Examples: MacOS X records the library version and
+# compatibility version in the shared library. But
+# of course the Tcl version of this is only used for Tcl.
+# LIB_SUFFIX - Specifies everything that comes after the "libfoo"
+# in a static or shared library name, using the $VERSION variable
# to put the version in the right place. This is used
# by platforms that need non-standard library names.
# Examples: ${VERSION}.so.1.1 on NetBSD, since it needs
# to have a version after the .so, and ${VERSION}.a
-# on AIX, since the Tcl shared library needs to have
+# on AIX, since a shared library needs to have
# a .a extension whereas shared objects for loadable
# extensions have a .so extension. Defaults to
# ${VERSION}${SHLIB_SUFFIX}.
@@ -504,13 +721,8 @@ AC_DEFUN(SC_ENABLE_SYMBOLS, [
# Flags used when running the compiler in debug mode
# CFLAGS_OPTIMIZE -
# Flags used when running the compiler in optimize mode
-#
# EXTRA_CFLAGS
#
-# Subst's the following vars:
-# DL_LIBS
-# CFLAGS_DEBUG
-# CFLAGS_OPTIMIZE
#--------------------------------------------------------------------
AC_DEFUN(SC_CONFIG_CFLAGS, [
@@ -567,15 +779,6 @@ AC_DEFUN(SC_CONFIG_CFLAGS, [
fi
fi
- AC_MSG_CHECKING([if gcc is being used])
- if test "$CC" = "gcc" -o `$CC -v 2>&1 | grep -c gcc` != "0" ; then
- using_gcc="yes"
- else
- using_gcc="no"
- fi
-
- AC_MSG_RESULT([$using_gcc ($CC)])
-
# Step 2: check for existence of -ldl library. This is needed because
# Linux can use either -ldl or -ldld for dynamic loading.
@@ -584,7 +787,6 @@ AC_DEFUN(SC_CONFIG_CFLAGS, [
# Step 3: set configuration options based on system name and version.
do64bit_ok=no
- fullSrcDir=`cd $srcdir; pwd`
EXTRA_CFLAGS=""
TCL_EXPORT_FILE_SUFFIX=""
UNSHARED_LIB_SUFFIX=""
@@ -593,7 +795,7 @@ AC_DEFUN(SC_CONFIG_CFLAGS, [
TCL_LIB_VERSIONS_OK=ok
CFLAGS_DEBUG=-g
CFLAGS_OPTIMIZE=-O
- if test "$using_gcc" = "yes" ; then
+ if test "$GCC" = "yes" ; then
CFLAGS_WARNING="-Wall -Wconversion -Wno-implicit-int"
else
CFLAGS_WARNING=""
@@ -605,45 +807,107 @@ dnl FIXME: Replace AC_CHECK_PROG with AC_CHECK_TOOL once cross compiling is fixe
dnl AC_CHECK_TOOL(AR, ar, :)
AC_CHECK_PROG(AR, ar, ar)
STLIB_LD='${AR} cr'
+ LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH"
+ PLAT_OBJS=""
case $system in
- AIX-4.[[2-9]])
- if test "${TCL_THREADS}" = "1" -a "$using_gcc" = "no" ; then
+ AIX-5.*)
+ if test "${TCL_THREADS}" = "1" -a "$GCC" != "yes" ; then
# AIX requires the _r compiler when gcc isn't being used
if test "${CC}" != "cc_r" ; then
CC=${CC}_r
fi
AC_MSG_RESULT(Using $CC for compiling with threads)
fi
+ LIBS="$LIBS -lc"
+ # AIX-5 uses ELF style dynamic libraries
SHLIB_CFLAGS=""
- SHLIB_LD="$fullSrcDir/ldAix /bin/ld -bhalt:4 -bM:SRE -bE:lib.exp -H512 -T512 -bnoentry"
+ SHLIB_LD="/usr/ccs/bin/ld -G -z text"
+
+ # Note: need the LIBS below, otherwise Tk won't find Tcl's
+ # symbols when dynamically loaded into tclsh.
+
SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
- DL_LIBS="-ldl"
+ # AIX-5 has dl* in libc.so
+ DL_LIBS=""
LDFLAGS=""
- LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
- TCL_NEEDS_EXP_FILE=1
- TCL_EXPORT_FILE_SUFFIX='${VERSION}\$\{DBGX\}.exp'
+
+ if test "$GCC" = "yes" ; then
+ CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}'
+ else
+ CC_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}'
+ fi
+ LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}'
+ LD_LIBRARY_PATH_VAR="LIBPATH"
+
+ # Check to enable 64-bit flags for compiler/linker
+ if test "$do64bit" = "yes" ; then
+ if test "$GCC" = "yes" ; then
+ AC_MSG_WARN("64bit mode not supported with GCC on $system")
+ else
+ do64bit_ok=yes
+ EXTRA_CFLAGS="-q64"
+ LDFLAGS="-q64"
+ fi
+ fi
;;
AIX-*)
- if test "${TCL_THREADS}" = "1" -a "$using_gcc" = "no" ; then
+ if test "${TCL_THREADS}" = "1" -a "$GCC" != "yes" ; then
# AIX requires the _r compiler when gcc isn't being used
if test "${CC}" != "cc_r" ; then
CC=${CC}_r
fi
AC_MSG_RESULT(Using $CC for compiling with threads)
fi
+ LIBS="$LIBS -lc"
SHLIB_CFLAGS=""
- SHLIB_LD="$fullSrcDir/ldAix /bin/ld -bhalt:4 -bM:SRE -bE:lib.exp -H512 -T512 -bnoentry"
+ SHLIB_LD="${TCL_SRC_DIR}/unix/ldAix /bin/ld -bhalt:4 -bM:SRE -bE:lib.exp -H512 -T512 -bnoentry"
SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
- LIBOBJS="$LIBOBJS tclLoadAix.o"
- DL_LIBS="-lld"
+ DL_LIBS="-ldl"
LDFLAGS=""
- LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ CC_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
+ LD_LIBRARY_PATH_VAR="LIBPATH"
TCL_NEEDS_EXP_FILE=1
TCL_EXPORT_FILE_SUFFIX='${VERSION}\$\{DBGX\}.exp'
+
+ # AIX v<=4.1 has some different flags than 4.2+
+ if test "$system" = "AIX-4.1" -o "`uname -v`" -lt "4" ; then
+ LIBOBJS="$LIBOBJS tclLoadAix.o"
+ DL_LIBS="-lld"
+ fi
+
+ # On AIX <=v4 systems, libbsd.a has to be linked in to support
+ # non-blocking file IO. This library has to be linked in after
+ # the MATH_LIBS or it breaks the pow() function. The way to
+ # insure proper sequencing, is to add it to the tail of MATH_LIBS.
+ # This library also supplies gettimeofday.
+ #
+ # AIX does not have a timezone field in struct tm. When the AIX
+ # bsd library is used, the timezone global and the gettimeofday
+ # methods are to be avoided for timezone deduction instead, we
+ # deduce the timezone by comparing the localtime result on a
+ # known GMT value.
+
+ AC_CHECK_LIB(bsd, gettimeofday, libbsd=yes, libbsd=no)
+ if test $libbsd = yes; then
+ MATH_LIBS="$MATH_LIBS -lbsd"
+ AC_DEFINE(USE_DELTA_FOR_TZ)
+ fi
+
+ # Check to enable 64-bit flags for compiler/linker
+ if test "$do64bit" = "yes" ; then
+ if test "$GCC" = "yes" ; then
+ AC_MSG_WARN("64bit mode not supported with GCC on $system")
+ else
+ do64bit_ok=yes
+ EXTRA_CFLAGS="-q64"
+ LDFLAGS="-q64"
+ fi
+ fi
;;
BSD/OS-2.1*|BSD/OS-3*)
SHLIB_CFLAGS=""
@@ -653,6 +917,7 @@ dnl AC_CHECK_TOOL(AR, ar, :)
DL_OBJS="tclLoadDl.o"
DL_LIBS="-ldl"
LDFLAGS=""
+ CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
;;
BSD/OS-4.*)
@@ -663,6 +928,7 @@ dnl AC_CHECK_TOOL(AR, ar, :)
DL_OBJS="tclLoadDl.o"
DL_LIBS="-ldl"
LDFLAGS="-export-dynamic"
+ CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
;;
dgux*)
@@ -673,9 +939,54 @@ dnl AC_CHECK_TOOL(AR, ar, :)
DL_OBJS="tclLoadDl.o"
DL_LIBS="-ldl"
LDFLAGS=""
+ CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
;;
- HP-UX-*.08.*|HP-UX-*.09.*|HP-UX-*.10.*|HP-UX-*.11.*)
+ HP-UX-*.11.*)
+ # Use updated header definitions where possible
+ AC_DEFINE(_XOPEN_SOURCE_EXTENDED)
+
+ SHLIB_SUFFIX=".sl"
+ AC_CHECK_LIB(dld, shl_load, tcl_ok=yes, tcl_ok=no)
+ if test "$tcl_ok" = yes; then
+ SHLIB_CFLAGS="+z"
+ SHLIB_LD="ld -b"
+ SHLIB_LD_LIBS='${LIBS}'
+ DL_OBJS="tclLoadShl.o"
+ DL_LIBS="-ldld"
+ LDFLAGS="-Wl,-E"
+ CC_SEARCH_FLAGS='-Wl,+s,+b,${LIB_RUNTIME_DIR}:.'
+ LD_SEARCH_FLAGS='+s +b ${LIB_RUNTIME_DIR}:.'
+ LD_LIBRARY_PATH_VAR="SHLIB_PATH"
+ fi
+
+ # Users may want PA-RISC 1.1/2.0 portable code - needs HP cc
+ #EXTRA_CFLAGS="+DAportable"
+
+ # Check to enable 64-bit flags for compiler/linker
+ if test "$do64bit" = "yes" ; then
+ if test "$GCC" = "yes" ; then
+ hpux_arch='`gcc -dumpmachine`'
+ case $hpux_arch in
+ hppa64*)
+ # 64-bit gcc in use. Fix flags for GNU ld.
+ do64bit_ok=yes
+ SHLIB_LD="gcc -shared"
+ SHLIB_LD_LIBS=""
+ LD_SEARCH_FLAGS=''
+ ;;
+ *)
+ AC_MSG_WARN("64bit mode not supported with GCC on $system")
+ ;;
+ esac
+ else
+ do64bit_ok=yes
+ EXTRA_CFLAGS="+DA2.0W"
+ LDFLAGS="+DA2.0W $LDFLAGS"
+ fi
+ fi
+ ;;
+ HP-UX-*.08.*|HP-UX-*.09.*|HP-UX-*.10.*)
SHLIB_SUFFIX=".sl"
AC_CHECK_LIB(dld, shl_load, tcl_ok=yes, tcl_ok=no)
if test "$tcl_ok" = yes; then
@@ -685,7 +996,9 @@ dnl AC_CHECK_TOOL(AR, ar, :)
DL_OBJS="tclLoadShl.o"
DL_LIBS="-ldld"
LDFLAGS="-Wl,-E"
- LD_SEARCH_FLAGS='-Wl,+s,+b,${LIB_RUNTIME_DIR}:.'
+ CC_SEARCH_FLAGS='-Wl,+s,+b,${LIB_RUNTIME_DIR}:.'
+ LD_SEARCH_FLAGS='+s +b ${LIB_RUNTIME_DIR}:.'
+ LD_LIBRARY_PATH_VAR="SHLIB_PATH"
fi
;;
IRIX-4.*)
@@ -696,18 +1009,32 @@ dnl AC_CHECK_TOOL(AR, ar, :)
DL_OBJS="tclLoadAout.o"
DL_LIBS=""
LDFLAGS="-Wl,-D,08000000"
- LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ CC_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
SHARED_LIB_SUFFIX='${VERSION}\$\{DBGX\}.a'
;;
- IRIX-5.*|IRIX-6.*|IRIX64-6.5*)
+ IRIX-5.*)
+ SHLIB_CFLAGS=""
+ SHLIB_LD="ld -shared -rdata_shared"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS=""
+ CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}'
+ EXTRA_CFLAGS=""
+ LDFLAGS=""
+ ;;
+ IRIX-6.*|IRIX64-6.5*)
SHLIB_CFLAGS=""
SHLIB_LD="ld -n32 -shared -rdata_shared"
SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
- LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
- if test "$using_gcc" = "yes" ; then
+ CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}'
+ if test "$GCC" = "yes" ; then
EXTRA_CFLAGS="-mabi=n32"
LDFLAGS="-mabi=n32"
else
@@ -725,13 +1052,28 @@ dnl AC_CHECK_TOOL(AR, ar, :)
;;
IRIX64-6.*)
SHLIB_CFLAGS=""
- SHLIB_LD="ld -32 -shared -rdata_shared"
+ SHLIB_LD="ld -n32 -shared -rdata_shared"
SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
LDFLAGS=""
- LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}'
+
+ # Check to enable 64-bit flags for compiler/linker
+
+ if test "$do64bit" = "yes" ; then
+ if test "$GCC" = "yes" ; then
+ AC_MSG_WARN([64bit mode not supported by gcc])
+ else
+ do64bit_ok=yes
+ SHLIB_LD="ld -64 -shared -rdata_shared"
+ EXTRA_CFLAGS="-64"
+ LDFLAGS="-64"
+ fi
+ fi
+
;;
Linux*)
SHLIB_CFLAGS="-fPIC"
@@ -749,13 +1091,52 @@ dnl AC_CHECK_TOOL(AR, ar, :)
DL_OBJS="tclLoadDl.o"
DL_LIBS="-ldl"
LDFLAGS="-rdynamic"
- LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
else
AC_CHECK_HEADER(dld.h, [
SHLIB_LD="ld -shared"
DL_OBJS="tclLoadDld.o"
DL_LIBS="-ldld"
LDFLAGS=""
+ CC_SEARCH_FLAGS=""
+ LD_SEARCH_FLAGS=""])
+ fi
+ if test "`uname -m`" = "alpha" ; then
+ EXTRA_CFLAGS="-mieee"
+ fi
+
+ # The combo of gcc + glibc has a bug related
+ # to inlining of functions like strtod(). The
+ # -fno-builtin flag should address this problem
+ # but it does not work. The -fno-inline flag
+ # is kind of overkill but it works.
+ # Disable inlining only when one of the
+ # files in compat/*.c is being linked in.
+ if test x"${LIBOBJS}" != x ; then
+ EXTRA_CFLAGS="${EXTRA_CFLAGS} -fno-inline"
+ fi
+
+ ;;
+ GNU*)
+ SHLIB_CFLAGS="-fPIC"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+
+ if test "$have_dl" = yes; then
+ SHLIB_LD="${CC} -shared"
+ DL_OBJS=""
+ DL_LIBS="-ldl"
+ LDFLAGS="-rdynamic"
+ CC_SEARCH_FLAGS=""
+ LD_SEARCH_FLAGS=""
+ else
+ AC_CHECK_HEADER(dld.h, [
+ SHLIB_LD="ld -shared"
+ DL_OBJS=""
+ DL_LIBS="-ldld"
+ LDFLAGS=""
+ CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""])
fi
if test "`uname -m`" = "alpha" ; then
@@ -770,6 +1151,7 @@ dnl AC_CHECK_TOOL(AR, ar, :)
DL_OBJS="tclLoadDl.o"
DL_LIBS="-ldl"
LDFLAGS=""
+ CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
;;
MP-RAS-*)
@@ -780,6 +1162,7 @@ dnl AC_CHECK_TOOL(AR, ar, :)
DL_OBJS="tclLoadDl.o"
DL_LIBS="-ldl"
LDFLAGS="-Wl,-Bexport"
+ CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
;;
NetBSD-*|FreeBSD-[[1-2]].*|OpenBSD-*)
@@ -793,7 +1176,8 @@ dnl AC_CHECK_TOOL(AR, ar, :)
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
LDFLAGS=""
- LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}'
AC_MSG_CHECKING(for ELF)
AC_EGREP_CPP(yes, [
#ifdef __ELF__
@@ -813,7 +1197,8 @@ dnl AC_CHECK_TOOL(AR, ar, :)
DL_OBJS="tclLoadAout.o"
DL_LIBS=""
LDFLAGS=""
- LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ CC_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.a'
])
@@ -826,12 +1211,47 @@ dnl AC_CHECK_TOOL(AR, ar, :)
# FreeBSD 3.* and greater have ELF.
SHLIB_CFLAGS="-fPIC"
SHLIB_LD="ld -Bshareable -x"
- SHLIB_LD_LIBS=""
+ SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
LDFLAGS="-export-dynamic"
+ CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}'
+ if test "${TCL_THREADS}" = "1" ; then
+ # The -pthread needs to go in the CFLAGS, not LIBS
+ LIBS=`echo $LIBS | sed s/-pthread//`
+ EXTRA_CFLAGS="-pthread"
+ LDFLAGS="$LDFLAGS -pthread"
+ fi
+ case $system in
+ FreeBSD-3.*)
+ # FreeBSD-3 doesn't handle version numbers with dots.
+ UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.a'
+ SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.so'
+ TCL_LIB_VERSIONS_OK=nodots
+ ;;
+ esac
+ ;;
+ Rhapsody-*|Darwin-*)
+ SHLIB_CFLAGS="-fno-common"
+ SHLIB_LD="cc -dynamiclib \${LDFLAGS}"
+ TCL_SHLIB_LD_EXTRAS="-compatibility_version ${TCL_VERSION} -current_version \${VERSION} -install_name \${DYLIB_INSTALL_DIR}/\${TCL_LIB_FILE} -prebind -seg1addr 0xa000000"
+ TK_SHLIB_LD_EXTRAS="-compatibility_version ${TK_VERSION} -current_version \${VERSION} -install_name \${DYLIB_INSTALL_DIR}/\${TK_LIB_FILE} -prebind -seg1addr 0xb000000"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".dylib"
+ DL_OBJS="tclLoadDyld.o"
+ PLAT_OBJS="tclMacOSXBundle.o"
+ DL_LIBS=""
+ LDFLAGS="-prebind"
+ CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
+ CFLAGS_OPTIMIZE="-Os"
+ LD_LIBRARY_PATH_VAR="DYLD_LIBRARY_PATH"
+ # for compatibility with autoconf vers 2.13 :
+ HACK=""
+ EXTRA_CFLAGS="-DMA${HACK}C_OSX_TCL -DHAVE_CFBUNDLE -DTCL_DEFAULT_ENCODING=\\\"utf-8\\\""
+ LIBS="$LIBS -framework CoreFoundation"
;;
NEXTSTEP-*)
SHLIB_CFLAGS=""
@@ -841,6 +1261,7 @@ dnl AC_CHECK_TOOL(AR, ar, :)
DL_OBJS="tclLoadNext.o"
DL_LIBS=""
LDFLAGS=""
+ CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
;;
OS/390-*)
@@ -857,45 +1278,71 @@ dnl AC_CHECK_TOOL(AR, ar, :)
DL_OBJS="tclLoadOSF.o"
DL_LIBS=""
LDFLAGS=""
+ CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
;;
OSF1-1.*)
# OSF/1 1.3 from OSF using ELF, and derivatives, including AD2
SHLIB_CFLAGS="-fPIC"
- SHLIB_LD="ld -shared"
+ if test "$SHARED_BUILD" = "1" ; then
+ SHLIB_LD="ld -shared"
+ else
+ SHLIB_LD="ld -non_shared"
+ fi
SHLIB_LD_LIBS=""
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
LDFLAGS=""
+ CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
;;
OSF1-V*)
# Digital OSF/1
SHLIB_CFLAGS=""
- SHLIB_LD='ld -shared -expect_unresolved "*"'
+ if test "$SHARED_BUILD" = "1" ; then
+ SHLIB_LD='ld -shared -expect_unresolved "*"'
+ else
+ SHLIB_LD='ld -non_shared -expect_unresolved "*"'
+ fi
SHLIB_LD_LIBS=""
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
LDFLAGS=""
- LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
- if test "$using_gcc" = "no" ; then
+ CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}'
+ if test "$GCC" != "yes" ; then
EXTRA_CFLAGS="-DHAVE_TZSET -std1"
fi
# see pthread_intro(3) for pthread support on osf1, k.furukawa
if test "${TCL_THREADS}" = "1" ; then
+ EXTRA_CFLAGS="${EXTRA_CFLAGS} -DHAVE_PTHREAD_ATTR_SETSTACKSIZE"
EXTRA_CFLAGS="${EXTRA_CFLAGS} -DTCL_THREAD_STACK_MIN=PTHREAD_STACK_MIN*64"
- if test "$using_gcc" = "no" ; then
+ LIBS=`echo $LIBS | sed s/-lpthreads//`
+ if test "$GCC" = "yes" ; then
+ LIBS="$LIBS -lpthread -lmach -lexc"
+ else
EXTRA_CFLAGS="${EXTRA_CFLAGS} -pthread"
LDFLAGS="-pthread"
- else
- LIBS=`echo $LIBS | sed s/-lpthreads//`
- LIBS="$LIBS -lpthread -lmach -lexc"
fi
fi
;;
+ QNX-6*)
+ # QNX RTP
+ # This may work for all QNX, but it was only reported for v6.
+ SHLIB_CFLAGS="-fPIC"
+ SHLIB_LD="ld -Bshareable -x"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ # dlopen is in -lc on QNX
+ DL_LIBS=""
+ LDFLAGS=""
+ CC_SEARCH_FLAGS=""
+ LD_SEARCH_FLAGS=""
+ ;;
RISCos-*)
SHLIB_CFLAGS="-G 0"
SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r -G 0"
@@ -904,13 +1351,14 @@ dnl AC_CHECK_TOOL(AR, ar, :)
DL_OBJS="tclLoadAout.o"
DL_LIBS=""
LDFLAGS="-Wl,-D,08000000"
- LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ CC_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
;;
SCO_SV-3.2*)
# Note, dlopen is available only on SCO 3.2.5 and greater. However,
# this test works, since "uname -s" was non-standard in 3.2.4 and
# below.
- if test "$using_gcc" = "yes" ; then
+ if test "$GCC" = "yes" ; then
SHLIB_CFLAGS="-fPIC -melf"
LDFLAGS="-melf -Wl,-Bexport"
else
@@ -922,7 +1370,7 @@ dnl AC_CHECK_TOOL(AR, ar, :)
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
- LDFLAGS="-belf -Wl,-Bexport"
+ CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
;;
SINIX*5.4*)
@@ -933,6 +1381,7 @@ dnl AC_CHECK_TOOL(AR, ar, :)
DL_OBJS="tclLoadDl.o"
DL_LIBS="-ldl"
LDFLAGS=""
+ CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
;;
SunOS-4*)
@@ -943,7 +1392,8 @@ dnl AC_CHECK_TOOL(AR, ar, :)
DL_OBJS="tclLoadDl.o"
DL_LIBS="-ldl"
LDFLAGS=""
- LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ CC_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
# SunOS can't handle version numbers with dots in them in library
# specs, like -ltcl7.5, so use -ltcl75 instead. Also, it
@@ -955,8 +1405,14 @@ dnl AC_CHECK_TOOL(AR, ar, :)
TCL_LIB_VERSIONS_OK=nodots
;;
SunOS-5.[[0-6]]*)
+
+ # Note: If _REENTRANT isn't defined, then Solaris
+ # won't define thread-safe library routines.
+
+ AC_DEFINE(_REENTRANT)
+ AC_DEFINE(_POSIX_PTHREAD_SEMANTICS)
+
SHLIB_CFLAGS="-KPIC"
- SHLIB_LD="/usr/ccs/bin/ld -G -z text"
# Note: need the LIBS below, otherwise Tk won't find Tcl's
# symbols when dynamically loaded into tclsh.
@@ -966,18 +1422,34 @@ dnl AC_CHECK_TOOL(AR, ar, :)
DL_OBJS="tclLoadDl.o"
DL_LIBS="-ldl"
LDFLAGS=""
- LD_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}'
+ if test "$GCC" = "yes" ; then
+ SHLIB_LD="$CC -shared"
+ CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}'
+ LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
+ else
+ SHLIB_LD="/usr/ccs/bin/ld -G -z text"
+ CC_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}'
+ LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
+ fi
;;
SunOS-5*)
+
+ # Note: If _REENTRANT isn't defined, then Solaris
+ # won't define thread-safe library routines.
+
+ AC_DEFINE(_REENTRANT)
+ AC_DEFINE(_POSIX_PTHREAD_SEMANTICS)
+
SHLIB_CFLAGS="-KPIC"
- SHLIB_LD="/usr/ccs/bin/ld -G -z text"
LDFLAGS=""
- do64bit_ok=no
+ # Check to enable 64-bit flags for compiler/linker
if test "$do64bit" = "yes" ; then
arch=`isainfo`
if test "$arch" = "sparcv9 sparc" ; then
- if test "$using_gcc" = "no" ; then
+ if test "$GCC" = "yes" ; then
+ AC_MSG_WARN("64bit mode not supported with GCC on $system")
+ else
do64bit_ok=yes
if test "$do64bitVIS" = "yes" ; then
EXTRA_CFLAGS="-xarch=v9a"
@@ -986,8 +1458,6 @@ dnl AC_CHECK_TOOL(AR, ar, :)
EXTRA_CFLAGS="-xarch=v9"
LDFLAGS="-xarch=v9"
fi
- else
- AC_MSG_WARN("64bit mode not supported with GCC on $system")
fi
else
AC_MSG_WARN("64bit mode only supported sparcv9 system")
@@ -1001,9 +1471,13 @@ dnl AC_CHECK_TOOL(AR, ar, :)
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS="-ldl"
- if test "$using_gcc" = "yes" ; then
- LD_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}'
+ if test "$GCC" = "yes" ; then
+ SHLIB_LD="$CC -shared"
+ CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}'
+ LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
else
+ SHLIB_LD="/usr/ccs/bin/ld -G -z text"
+ CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}'
LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}'
fi
;;
@@ -1015,8 +1489,9 @@ dnl AC_CHECK_TOOL(AR, ar, :)
DL_OBJS="tclLoadAout.o"
DL_LIBS=""
LDFLAGS="-Wl,-D,08000000"
- LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
- if test "$using_gcc" = "no" ; then
+ CC_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
+ if test "$GCC" != "yes" ; then
EXTRA_CFLAGS="-DHAVE_TZSET -std1"
fi
;;
@@ -1040,6 +1515,7 @@ dnl AC_CHECK_TOOL(AR, ar, :)
else
LDFLAGS=""
fi
+ CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
;;
esac
@@ -1144,6 +1620,7 @@ dnl AC_CHECK_TOOL(AR, ar, :)
DL_OBJS="tclLoadNone.o"
DL_LIBS=""
LDFLAGS=""
+ CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
BUILD_DLTEST=""
fi
@@ -1153,7 +1630,7 @@ dnl AC_CHECK_TOOL(AR, ar, :)
# standard manufacturer compiler.
if test "$DL_OBJS" != "tclLoadNone.o" ; then
- if test "$using_gcc" = "yes" ; then
+ if test "$GCC" = "yes" ; then
case $system in
AIX-*)
;;
@@ -1163,6 +1640,8 @@ dnl AC_CHECK_TOOL(AR, ar, :)
;;
NetBSD-*|FreeBSD-*|OpenBSD-*)
;;
+ Rhapsody-*|Darwin-*)
+ ;;
RISCos-*)
;;
SCO_SV-3.2*)
@@ -1183,15 +1662,79 @@ dnl AC_CHECK_TOOL(AR, ar, :)
UNSHARED_LIB_SUFFIX='${VERSION}\$\{DBGX\}.a'
fi
-# CYGNUS LOCAL
- TCL_LIB_SUFFIX=.a
- AC_SUBST(TCL_LIB_SUFFIX)
-# END CYGNUS LOCAL
+ AC_REQUIRE([AC_PROG_RANLIB])
+
+ if test "${SHARED_BUILD}" = "1" && test "${SHLIB_SUFFIX}" != "" ; then
+ LIB_SUFFIX=${SHARED_LIB_SUFFIX}
+ MAKE_LIB='${SHLIB_LD} -o [$]@ ${SHLIB_LD_FLAGS} ${OBJS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}'
+ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) $(LIB_INSTALL_DIR)/$(LIB_FILE)'
+ else
+ LIB_SUFFIX=${UNSHARED_LIB_SUFFIX}
+
+ if test "$RANLIB" = "" ; then
+ MAKE_LIB='$(STLIB_LD) [$]@ ${OBJS}'
+ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) $(LIB_INSTALL_DIR)/$(LIB_FILE)'
+ else
+ MAKE_LIB='${STLIB_LD} [$]@ ${OBJS} ; ${RANLIB} [$]@'
+ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) $(LIB_INSTALL_DIR)/$(LIB_FILE) ; (cd $(LIB_INSTALL_DIR) ; $(RANLIB) $(LIB_FILE))'
+ fi
+
+dnl Not at all clear what this was doing in Tcl's configure.in
+dnl or why it was needed was needed. In any event, this sort of
+dnl things needs to be done in the big loop above.
+dnl REMOVE THIS BLOCK LATER! (mdejong)
+dnl case $system in
+dnl BSD/OS*)
+dnl ;;
+dnl AIX-[[1-4]].*)
+dnl ;;
+dnl *)
+dnl SHLIB_LD_LIBS=""
+dnl ;;
+dnl esac
+ fi
+
+
+ # Stub lib does not depend on shared/static configuration
+ if test "$RANLIB" = "" ; then
+ MAKE_STUB_LIB='${STLIB_LD} [$]@ ${STUB_LIB_OBJS}'
+ INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) $(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)'
+ else
+ MAKE_STUB_LIB='${STLIB_LD} [$]@ ${STUB_LIB_OBJS} ; ${RANLIB} [$]@'
+ INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) $(LIB_INSTALL_DIR)/$(STUB_LIB_FILE) ; (cd $(LIB_INSTALL_DIR) ; $(RANLIB) $(STUB_LIB_FILE))'
+ fi
+
AC_SUBST(DL_LIBS)
+
+ AC_SUBST(DL_OBJS)
+ AC_SUBST(PLAT_OBJS)
+ AC_SUBST(CFLAGS)
AC_SUBST(CFLAGS_DEBUG)
AC_SUBST(CFLAGS_OPTIMIZE)
AC_SUBST(CFLAGS_WARNING)
+ AC_SUBST(EXTRA_CFLAGS)
+
+ AC_SUBST(LDFLAGS)
+ AC_SUBST(LDFLAGS_DEBUG)
+ AC_SUBST(LDFLAGS_OPTIMIZE)
+ AC_SUBST(CC_SEARCH_FLAGS)
+ AC_SUBST(LD_SEARCH_FLAGS)
+
+ AC_SUBST(STLIB_LD)
+ AC_SUBST(SHLIB_LD)
+ AC_SUBST(TCL_SHLIB_LD_EXTRAS)
+ AC_SUBST(TK_SHLIB_LD_EXTRAS)
+ AC_SUBST(SHLIB_LD_FLAGS)
+ AC_SUBST(SHLIB_LD_LIBS)
+ AC_SUBST(SHLIB_CFLAGS)
+ AC_SUBST(SHLIB_SUFFIX)
+
+ AC_SUBST(MAKE_LIB)
+ AC_SUBST(MAKE_STUB_LIB)
+ AC_SUBST(INSTALL_LIB)
+ AC_SUBST(INSTALL_STUB_LIB)
+ AC_SUBST(RANLIB)
])
#--------------------------------------------------------------------
@@ -1199,7 +1742,9 @@ dnl AC_CHECK_TOOL(AR, ar, :)
#
# Determine which interface to use to talk to the serial port.
# Note that #include lines must begin in leftmost column for
-# some compilers to recognize them as preprocessor directives.
+# some compilers to recognize them as preprocessor directives,
+# and some build environments have stdin not pointing at a
+# pseudo-terminal (usually /dev/null instead.)
#
# Arguments:
# none
@@ -1207,6 +1752,7 @@ dnl AC_CHECK_TOOL(AR, ar, :)
# Results:
#
# Defines only one of the following vars:
+# HAVE_SYS_MODEM_H
# USE_TERMIOS
# USE_TERMIO
# USE_SGTTY
@@ -1214,13 +1760,13 @@ dnl AC_CHECK_TOOL(AR, ar, :)
#--------------------------------------------------------------------
AC_DEFUN(SC_SERIAL_PORT, [
+ AC_CHECK_HEADERS(sys/modem.h)
AC_MSG_CHECKING([termios vs. termio vs. sgtty])
-
+ AC_CACHE_VAL(tcl_cv_api_serial, [
AC_TRY_RUN([
#include <termios.h>
-main()
-{
+int main() {
struct termios t;
if (tcgetattr(0, &t) == 0) {
cfsetospeed(&t, 0);
@@ -1228,32 +1774,25 @@ main()
return 0;
}
return 1;
-}], tk_ok=termios, tk_ok=no, tk_ok=no)
-
- if test $tk_ok = termios; then
- AC_DEFINE(USE_TERMIOS)
- else
+}], tcl_cv_api_serial=termios, tcl_cv_api_serial=no, tcl_cv_api_serial=no)
+ if test $tcl_cv_api_serial = no ; then
AC_TRY_RUN([
#include <termio.h>
-main()
-{
+int main() {
struct termio t;
if (ioctl(0, TCGETA, &t) == 0) {
t.c_cflag |= CBAUD | PARENB | PARODD | CSIZE | CSTOPB;
return 0;
}
return 1;
- }], tk_ok=termio, tk_ok=no, tk_ok=no)
-
- if test $tk_ok = termio; then
- AC_DEFINE(USE_TERMIO)
- else
+}], tcl_cv_api_serial=termio, tcl_cv_api_serial=no, tcl_cv_api_serial=no)
+ fi
+ if test $tcl_cv_api_serial = no ; then
AC_TRY_RUN([
#include <sgtty.h>
-main()
-{
+int main() {
struct sgttyb t;
if (ioctl(0, TIOCGETP, &t) == 0) {
t.sg_ospeed = 0;
@@ -1261,13 +1800,61 @@ main()
return 0;
}
return 1;
-}], tk_ok=sgtty, tk_ok=none, tk_ok=none)
- if test $tk_ok = sgtty; then
- AC_DEFINE(USE_SGTTY)
+}], tcl_cv_api_serial=sgtty, tcl_cv_api_serial=no, tcl_cv_api_serial=no)
fi
+ if test $tcl_cv_api_serial = no ; then
+ AC_TRY_RUN([
+#include <termios.h>
+#include <errno.h>
+
+int main() {
+ struct termios t;
+ if (tcgetattr(0, &t) == 0
+ || errno == ENOTTY || errno == ENXIO || errno == EINVAL) {
+ cfsetospeed(&t, 0);
+ t.c_cflag |= PARENB | PARODD | CSIZE | CSTOPB;
+ return 0;
+ }
+ return 1;
+}], tcl_cv_api_serial=termios, tcl_cv_api_serial=no, tcl_cv_api_serial=no)
fi
+ if test $tcl_cv_api_serial = no; then
+ AC_TRY_RUN([
+#include <termio.h>
+#include <errno.h>
+
+int main() {
+ struct termio t;
+ if (ioctl(0, TCGETA, &t) == 0
+ || errno == ENOTTY || errno == ENXIO || errno == EINVAL) {
+ t.c_cflag |= CBAUD | PARENB | PARODD | CSIZE | CSTOPB;
+ return 0;
+ }
+ return 1;
+ }], tcl_cv_api_serial=termio, tcl_cv_api_serial=no, tcl_cv_api_serial=no)
fi
- AC_MSG_RESULT($tk_ok)
+ if test $tcl_cv_api_serial = no; then
+ AC_TRY_RUN([
+#include <sgtty.h>
+#include <errno.h>
+
+int main() {
+ struct sgttyb t;
+ if (ioctl(0, TIOCGETP, &t) == 0
+ || errno == ENOTTY || errno == ENXIO || errno == EINVAL) {
+ t.sg_ospeed = 0;
+ t.sg_flags |= ODDP | EVENP | RAW;
+ return 0;
+ }
+ return 1;
+}], tcl_cv_api_serial=sgtty, tcl_cv_api_serial=none, tcl_cv_api_serial=none)
+ fi])
+ case $tcl_cv_api_serial in
+ termios) AC_DEFINE(USE_TERMIOS);;
+ termio) AC_DEFINE(USE_TERMIO);;
+ sgtty) AC_DEFINE(USE_SGTTY);;
+ esac
+ AC_MSG_RESULT($tcl_cv_api_serial)
])
#--------------------------------------------------------------------
@@ -1302,7 +1889,6 @@ main()
#--------------------------------------------------------------------
AC_DEFUN(SC_MISSING_POSIX_HEADERS, [
-
AC_MSG_CHECKING(dirent.h)
AC_TRY_LINK([#include <sys/types.h>
#include <dirent.h>], [
@@ -1330,10 +1916,10 @@ closedir(d);
fi
AC_MSG_RESULT($tcl_ok)
- AC_CHECK_HEADER(errno.h, , AC_DEFINE(NO_ERRNO_H))
- AC_CHECK_HEADER(float.h, , AC_DEFINE(NO_FLOAT_H))
- AC_CHECK_HEADER(values.h, , AC_DEFINE(NO_VALUES_H))
- AC_CHECK_HEADER(limits.h, , AC_DEFINE(NO_LIMITS_H))
+ AC_CHECK_HEADER(errno.h, , [AC_DEFINE(NO_ERRNO_H)])
+ AC_CHECK_HEADER(float.h, , [AC_DEFINE(NO_FLOAT_H)])
+ AC_CHECK_HEADER(values.h, , [AC_DEFINE(NO_VALUES_H)])
+ AC_CHECK_HEADER(limits.h, , [AC_DEFINE(NO_LIMITS_H)])
AC_CHECK_HEADER(stdlib.h, tcl_ok=1, tcl_ok=0)
AC_EGREP_HEADER(strtol, stdlib.h, , tcl_ok=0)
AC_EGREP_HEADER(strtoul, stdlib.h, , tcl_ok=0)
@@ -1352,8 +1938,8 @@ closedir(d);
AC_DEFINE(NO_STRING_H)
fi
- AC_CHECK_HEADER(sys/wait.h, , AC_DEFINE(NO_SYS_WAIT_H))
- AC_CHECK_HEADER(dlfcn.h, , AC_DEFINE(NO_DLFCN_H))
+ AC_CHECK_HEADER(sys/wait.h, , [AC_DEFINE(NO_SYS_WAIT_H)])
+ AC_CHECK_HEADER(dlfcn.h, , [AC_DEFINE(NO_DLFCN_H)])
# OS/390 lacks sys/param.h (and doesn't need it, by chance).
@@ -1396,28 +1982,27 @@ AC_DEFUN(SC_PATH_X, [
fi
if test "$no_x" = "yes" -o "$not_really_there" = "yes"; then
AC_MSG_CHECKING(for X11 header files)
- XINCLUDES="# no special path needed"
- AC_TRY_CPP([#include <X11/Intrinsic.h>], , XINCLUDES="nope")
- if test "$XINCLUDES" = nope; then
+ found_xincludes="no"
+ AC_TRY_CPP([#include <X11/Intrinsic.h>], found_xincludes="yes", found_xincludes="no")
+ if test "$found_xincludes" = "no"; then
dirs="/usr/unsupported/include /usr/local/include /usr/X386/include /usr/X11R6/include /usr/X11R5/include /usr/include/X11R5 /usr/include/X11R4 /usr/openwin/include /usr/X11/include /usr/sww/include"
for i in $dirs ; do
if test -r $i/X11/Intrinsic.h; then
AC_MSG_RESULT($i)
XINCLUDES=" -I$i"
+ found_xincludes="yes"
break
fi
done
fi
else
if test "$x_includes" != ""; then
- XINCLUDES=-I$x_includes
- else
- XINCLUDES="# no special path needed"
+ XINCLUDES="-I$x_includes"
+ found_xincludes="yes"
fi
fi
- if test "$XINCLUDES" = nope; then
+ if test found_xincludes = "no"; then
AC_MSG_RESULT(couldn't find any!)
- XINCLUDES="# no include files found"
fi
if test "$no_x" = yes; then
@@ -1515,68 +2100,6 @@ AC_DEFUN(SC_BLOCKING_STYLE, [
])
#--------------------------------------------------------------------
-# SC_HAVE_VFORK
-#
-# Check to see whether the system provides a vfork kernel call.
-# If not, then use fork instead. Also, check for a problem with
-# vforks and signals that can cause core dumps if a vforked child
-# resets a signal handler. If the problem exists, then use fork
-# instead of vfork.
-#
-# Arguments:
-# none
-#
-# Results:
-#
-# Defines some of the following vars:
-# vfork (=fork)
-#
-#--------------------------------------------------------------------
-
-AC_DEFUN(SC_HAVE_VFORK, [
- AC_TYPE_SIGNAL()
- AC_CHECK_FUNC(vfork, tcl_ok=1, tcl_ok=0)
- if test "$tcl_ok" = 1; then
- AC_MSG_CHECKING([vfork/signal bug]);
- AC_TRY_RUN([
-#include <stdio.h>
-#include <signal.h>
-#include <sys/wait.h>
-int gotSignal = 0;
-sigProc(sig)
- int sig;
-{
- gotSignal = 1;
-}
-main()
-{
- int pid, sts;
- (void) signal(SIGCHLD, sigProc);
- pid = vfork();
- if (pid < 0) {
- exit(1);
- } else if (pid == 0) {
- (void) signal(SIGCHLD, SIG_DFL);
- _exit(0);
- } else {
- (void) wait(&sts);
- }
- exit((gotSignal) ? 0 : 1);
-}], tcl_ok=1, tcl_ok=0, tcl_ok=0)
-
- if test "$tcl_ok" = 1; then
- AC_MSG_RESULT(ok)
- else
- AC_MSG_RESULT([buggy, using fork instead])
- fi
- fi
- rm -f core
- if test "$tcl_ok" = 0; then
- AC_DEFINE(vfork, fork)
- fi
-])
-
-#--------------------------------------------------------------------
# SC_TIME_HANLDER
#
# Checks how the system deals with time.h, what time structures
@@ -1600,73 +2123,54 @@ AC_DEFUN(SC_TIME_HANDLER, [
AC_HEADER_TIME
AC_STRUCT_TIMEZONE
+ AC_CHECK_FUNCS(gmtime_r localtime_r)
+
AC_MSG_CHECKING([tm_tzadj in struct tm])
- AC_TRY_COMPILE([#include <time.h>], [struct tm tm; tm.tm_tzadj;],
- [AC_DEFINE(HAVE_TM_TZADJ)
- AC_MSG_RESULT(yes)],
- AC_MSG_RESULT(no))
+ AC_CACHE_VAL(tcl_cv_member_tm_tzadj,
+ AC_TRY_COMPILE([#include <time.h>], [struct tm tm; tm.tm_tzadj;],
+ tcl_cv_member_tm_tzadj=yes, tcl_cv_member_tm_tzadj=no))
+ AC_MSG_RESULT($tcl_cv_member_tm_tzadj)
+ if test $tcl_cv_member_tm_tzadj = yes ; then
+ AC_DEFINE(HAVE_TM_TZADJ)
+ fi
AC_MSG_CHECKING([tm_gmtoff in struct tm])
- AC_TRY_COMPILE([#include <time.h>], [struct tm tm; tm.tm_gmtoff;],
- [AC_DEFINE(HAVE_TM_GMTOFF)
- AC_MSG_RESULT(yes)],
- AC_MSG_RESULT(no))
+ AC_CACHE_VAL(tcl_cv_member_tm_gmtoff,
+ AC_TRY_COMPILE([#include <time.h>], [struct tm tm; tm.tm_gmtoff;],
+ tcl_cv_member_tm_gmtoff=yes, tcl_cv_member_tm_gmtoff=no))
+ AC_MSG_RESULT($tcl_cv_member_tm_gmtoff)
+ if test $tcl_cv_member_tm_gmtoff = yes ; then
+ AC_DEFINE(HAVE_TM_GMTOFF)
+ fi
#
# Its important to include time.h in this check, as some systems
# (like convex) have timezone functions, etc.
#
- have_timezone=no
AC_MSG_CHECKING([long timezone variable])
- AC_TRY_COMPILE([#include <time.h>],
+ AC_CACHE_VAL(tcl_cv_var_timezone,
+ AC_TRY_COMPILE([#include <time.h>],
[extern long timezone;
timezone += 1;
exit (0);],
- [have_timezone=yes
+ tcl_cv_timezone_long=yes, tcl_cv_timezone_long=no))
+ AC_MSG_RESULT($tcl_cv_timezone_long)
+ if test $tcl_cv_timezone_long = yes ; then
+ AC_DEFINE(HAVE_TIMEZONE_VAR)
+ else
+ #
+ # On some systems (eg IRIX 6.2), timezone is a time_t and not a long.
+ #
+ AC_MSG_CHECKING([time_t timezone variable])
+ AC_CACHE_VAL(tcl_cv_timezone_time,
+ AC_TRY_COMPILE([#include <time.h>],
+ [extern time_t timezone;
+ timezone += 1;
+ exit (0);],
+ tcl_cv_timezone_time=yes, tcl_cv_timezone_time=no))
+ AC_MSG_RESULT($tcl_cv_timezone_time)
+ if test $tcl_cv_timezone_time = yes ; then
AC_DEFINE(HAVE_TIMEZONE_VAR)
- AC_MSG_RESULT(yes)],
- AC_MSG_RESULT(no))
-
- #
- # On some systems (eg IRIX 6.2), timezone is a time_t and not a long.
- #
- if test "$have_timezone" = no; then
- AC_MSG_CHECKING([time_t timezone variable])
- AC_TRY_COMPILE([#include <time.h>],
- [extern time_t timezone;
- timezone += 1;
- exit (0);],
- [AC_DEFINE(HAVE_TIMEZONE_VAR)
- AC_MSG_RESULT(yes)],
- AC_MSG_RESULT(no))
- fi
-
- #
- # On some systems (eg Solaris 2.5.1), timezone is not declared in
- # time.h unless you jump through hoops. Instead of that, we just
- # declare it ourselves when necessary.
- #
- if test "$have_timezone" = yes; then
- AC_MSG_CHECKING(for timezone declaration)
- changequote(<<,>>)
- tzrx='^[ ]*extern.*timezone'
- changequote([,])
- AC_EGREP_HEADER($tzrx, time.h, [
- AC_DEFINE(HAVE_TIMEZONE_DECL)
- AC_MSG_RESULT(found)], AC_MSG_RESULT(missing))
- fi
-
- #
- # AIX does not have a timezone field in struct tm. When the AIX bsd
- # library is used, the timezone global and the gettimeofday methods are
- # to be avoided for timezone deduction instead, we deduce the timezone
- # by comparing the localtime result on a known GMT value.
- #
-
- if test "`uname -s`" = "AIX" ; then
- AC_CHECK_LIB(bsd, gettimeofday, libbsd=yes)
- if test $libbsd = yes; then
- AC_DEFINE(USE_DELTA_FOR_TZ)
fi
fi
])
@@ -1695,24 +2199,28 @@ AC_DEFUN(SC_BUGGY_STRTOD, [
AC_CHECK_FUNC(strtod, tcl_strtod=1, tcl_strtod=0)
if test "$tcl_strtod" = 1; then
AC_MSG_CHECKING([for Solaris2.4/Tru64 strtod bugs])
- AC_TRY_RUN([
- extern double strtod();
- int main()
- {
- char *string = "NaN", *spaceString = " ";
- char *term;
- double value;
- value = strtod(string, &term);
- if ((term != string) && (term[-1] == 0)) {
- exit(1);
- }
- value = strtod(spaceString, &term);
- if (term == (spaceString+1)) {
- exit(1);
- }
- exit(0);
- }], tcl_ok=1, tcl_ok=0, tcl_ok=0)
- if test "$tcl_ok" = 1; then
+ AC_CACHE_VAL(tcl_cv_strtod_buggy,[
+ AC_TRY_RUN([
+ extern double strtod();
+ int main() {
+ char *infString="Inf", *nanString="NaN", *spaceString=" ";
+ char *term;
+ double value;
+ value = strtod(infString, &term);
+ if ((term != infString) && (term[-1] == 0)) {
+ exit(1);
+ }
+ value = strtod(nanString, &term);
+ if ((term != nanString) && (term[-1] == 0)) {
+ exit(1);
+ }
+ value = strtod(spaceString, &term);
+ if (term == (spaceString+1)) {
+ exit(1);
+ }
+ exit(0);
+ }], tcl_cv_strtod_buggy=1, tcl_cv_strtod_buggy=0, tcl_cv_strtod_buggy=0)])
+ if test "$tcl_cv_strtod_buggy" = 1; then
AC_MSG_RESULT(ok)
else
AC_MSG_RESULT(buggy)
@@ -1761,29 +2269,12 @@ AC_DEFUN(SC_TCL_LINK_LIBS, [
AC_CHECK_LIB(ieee, main, [MATH_LIBS="-lieee $MATH_LIBS"])
#--------------------------------------------------------------------
- # On AIX systems, libbsd.a has to be linked in to support
- # non-blocking file IO. This library has to be linked in after
- # the MATH_LIBS or it breaks the pow() function. The way to
- # insure proper sequencing, is to add it to the tail of MATH_LIBS.
- # This library also supplies gettimeofday.
- #--------------------------------------------------------------------
-
- libbsd=no
- if test "`uname -s`" = "AIX" ; then
- AC_CHECK_LIB(bsd, gettimeofday, libbsd=yes)
- if test $libbsd = yes; then
- MATH_LIBS="$MATH_LIBS -lbsd"
- fi
- fi
-
-
- #--------------------------------------------------------------------
# Interactive UNIX requires -linet instead of -lsocket, plus it
# needs net/errno.h to define the socket-related error codes.
#--------------------------------------------------------------------
AC_CHECK_LIB(inet, main, [LIBS="$LIBS -linet"])
- AC_CHECK_HEADER(net/errno.h, AC_DEFINE(HAVE_NET_ERRNO_H))
+ AC_CHECK_HEADER(net/errno.h, [AC_DEFINE(HAVE_NET_ERRNO_H)])
#--------------------------------------------------------------------
# Check for the existence of the -lsocket and -lnsl libraries.
@@ -1803,38 +2294,19 @@ AC_DEFUN(SC_TCL_LINK_LIBS, [
# if -lsocket doesn't work by itself.
#--------------------------------------------------------------------
- # CYGNUS LOCAL: Store any socket library(ies) in the cache, and don't
- # mess up the cache values of the functions we check for.
- AC_CACHE_CHECK([for socket libraries], tcl_cv_lib_sockets,
- [tcl_cv_lib_sockets=
- tcl_checkBoth=0
- unset ac_cv_func_connect
- AC_CHECK_FUNC(connect, tcl_checkSocket=0, tcl_checkSocket=1)
- if test "$tcl_checkSocket" = 1; then
- unset ac_cv_func_connect
- AC_CHECK_LIB(socket, main, tcl_cv_lib_sockets="-lsocket",
- tcl_checkBoth=1)
- fi
- if test "$tcl_checkBoth" = 1; then
- tcl_oldLibs=$LIBS
- LIBS="$LIBS -lsocket -lnsl"
- unset ac_cv_func_accept
- AC_CHECK_FUNC(accept,
- [tcl_checkNsl=0
- tcl_cv_lib_sockets="-lsocket -lnsl"])
- unset ac_cv_func_accept
- LIBS=$tcl_oldLibs
- fi
- unset ac_cv_func_gethostbyname
- tcl_oldLibs=$LIBS
- LIBS="$LIBS $tcl_cv_lib_sockets"
- AC_CHECK_FUNC(gethostbyname, ,
- [AC_CHECK_LIB(nsl, main,
- [tcl_cv_lib_sockets="$tcl_cv_lib_sockets -lnsl"])])
- unset ac_cv_func_gethostbyname
- LIBS=$tcl_oldLIBS
- ])
- test -z "$tcl_cv_lib_sockets" || LIBS="$LIBS $tcl_cv_lib_sockets"
+ tcl_checkBoth=0
+ AC_CHECK_FUNC(connect, tcl_checkSocket=0, tcl_checkSocket=1)
+ if test "$tcl_checkSocket" = 1; then
+ AC_CHECK_FUNC(setsockopt, , [AC_CHECK_LIB(socket, setsockopt,
+ LIBS="$LIBS -lsocket", tcl_checkBoth=1)])
+ fi
+ if test "$tcl_checkBoth" = 1; then
+ tk_oldLibs=$LIBS
+ LIBS="$LIBS -lsocket -lnsl"
+ AC_CHECK_FUNC(accept, tcl_checkNsl=0, [LIBS=$tk_oldLibs])
+ fi
+ AC_CHECK_FUNC(gethostbyname, , [AC_CHECK_LIB(nsl, gethostbyname,
+ [LIBS="$LIBS -lnsl"])])
# Don't perform the eval of the libraries here because DL_LIBS
# won't be set until we call SC_CONFIG_CFLAGS
@@ -1844,39 +2316,109 @@ AC_DEFUN(SC_TCL_LINK_LIBS, [
AC_SUBST(MATH_LIBS)
])
-dnl CYGNUS LOCAL: This gets the right posix flag for gcc
-
-AC_DEFUN(CY_AC_TCL_LYNX_POSIX,
-[AC_REQUIRE([AC_PROG_CC])AC_REQUIRE([AC_PROG_CPP])
-AC_MSG_CHECKING([to see if this is LynxOS])
-AC_CACHE_VAL(ac_cv_os_lynx,
-[AC_EGREP_CPP(yes,
-[/*
- * The old Lynx "cc" only defines "Lynx", but the newer one uses "__Lynx__"
- */
-#if defined(__Lynx__) || defined(Lynx)
-yes
-#endif
-], ac_cv_os_lynx=yes, ac_cv_os_lynx=no)])
-#
-if test "$ac_cv_os_lynx" = "yes" ; then
- AC_MSG_RESULT(yes)
- AC_DEFINE(LYNX)
- AC_MSG_CHECKING([whether -mposix or -X is available])
- AC_CACHE_VAL(ac_cv_c_posix_flag,
- [AC_TRY_COMPILE(,[
- /*
- * This flag varies depending on how old the compiler is.
- * -X is for the old "cc" and "gcc" (based on 1.42).
- * -mposix is for the new gcc (at least 2.5.8).
- */
- #if defined(__GNUC__) && __GNUC__ >= 2
- choke me
- #endif
- ], ac_cv_c_posix_flag=" -mposix", ac_cv_c_posix_flag=" -X")])
- CC="$CC $ac_cv_c_posix_flag"
- AC_MSG_RESULT($ac_cv_c_posix_flag)
- else
- AC_MSG_RESULT(no)
-fi
-])
+#--------------------------------------------------------------------
+# SC_TCL_EARLY_FLAGS
+#
+# Check for what flags are needed to be passed so the correct OS
+# features are available.
+#
+# Arguments:
+# None
+#
+# Results:
+#
+# Might define the following vars:
+# _ISOC99_SOURCE
+# _LARGEFILE64_SOURCE
+#
+#--------------------------------------------------------------------
+
+AC_DEFUN(SC_TCL_EARLY_FLAG,[
+ AC_CACHE_VAL([tcl_cv_flag_]translit($1,[A-Z],[a-z]),
+ AC_TRY_COMPILE([$2], $3, [tcl_cv_flag_]translit($1,[A-Z],[a-z])=no,
+ AC_TRY_COMPILE([[#define ]$1[ 1
+]$2], $3,
+ [tcl_cv_flag_]translit($1,[A-Z],[a-z])=yes,
+ [tcl_cv_flag_]translit($1,[A-Z],[a-z])=no)))
+ if test ["x${tcl_cv_flag_]translit($1,[A-Z],[a-z])[}" = "xyes"] ; then
+ AC_DEFINE($1)
+ tcl_flags="$tcl_flags $1"
+ fi])
+
+AC_DEFUN(SC_TCL_EARLY_FLAGS,[
+ AC_MSG_CHECKING([for required early compiler flags])
+ tcl_flags=""
+ SC_TCL_EARLY_FLAG(_ISOC99_SOURCE,[#include <stdlib.h>],
+ [char *p = (char *)strtoll; char *q = (char *)strtoull;])
+ SC_TCL_EARLY_FLAG(_LARGEFILE64_SOURCE,[#include <sys/stat.h>],
+ [struct stat64 buf; int i = stat64("/", &buf);])
+ if test "x${tcl_flags}" = "x" ; then
+ AC_MSG_RESULT(none)
+ else
+ AC_MSG_RESULT(${tcl_flags})
+ fi])
+
+#--------------------------------------------------------------------
+# SC_TCL_64BIT_FLAGS
+#
+# Check for what is defined in the way of 64-bit features.
+#
+# Arguments:
+# None
+#
+# Results:
+#
+# Might define the following vars:
+# TCL_WIDE_INT_IS_LONG
+# TCL_WIDE_INT_TYPE
+# HAVE_STRUCT_DIRENT64
+# HAVE_STRUCT_STAT64
+# HAVE_TYPE_OFF64_T
+#
+#--------------------------------------------------------------------
+
+AC_DEFUN(SC_TCL_64BIT_FLAGS, [
+ AC_MSG_CHECKING([for 64-bit integer type])
+ AC_CACHE_VAL(tcl_cv_type_64bit,[
+ AC_TRY_COMPILE(,[__int64 value = (__int64) 0;],
+ tcl_cv_type_64bit=__int64,tcl_cv_type_64bit=none
+ AC_TRY_RUN([#include <unistd.h>
+ int main() {exit(!(sizeof(long long) > sizeof(long)));}
+ ], tcl_cv_type_64bit="long long"))])
+ if test "${tcl_cv_type_64bit}" = none ; then
+ AC_MSG_RESULT(using long)
+ else
+ AC_DEFINE_UNQUOTED(TCL_WIDE_INT_TYPE,${tcl_cv_type_64bit})
+ AC_MSG_RESULT(${tcl_cv_type_64bit})
+
+ # Now check for auxiliary declarations
+ AC_MSG_CHECKING([for struct dirent64])
+ AC_CACHE_VAL(tcl_cv_struct_dirent64,[
+ AC_TRY_COMPILE([#include <sys/types.h>
+#include <sys/dirent.h>],[struct dirent64 p;],
+ tcl_cv_struct_dirent64=yes,tcl_cv_struct_dirent64=no)])
+ if test "x${tcl_cv_struct_dirent64}" = "xyes" ; then
+ AC_DEFINE(HAVE_STRUCT_DIRENT64)
+ fi
+ AC_MSG_RESULT(${tcl_cv_struct_dirent64})
+
+ AC_MSG_CHECKING([for struct stat64])
+ AC_CACHE_VAL(tcl_cv_struct_stat64,[
+ AC_TRY_COMPILE([#include <sys/stat.h>],[struct stat64 p;
+],
+ tcl_cv_struct_stat64=yes,tcl_cv_struct_stat64=no)])
+ if test "x${tcl_cv_struct_stat64}" = "xyes" ; then
+ AC_DEFINE(HAVE_STRUCT_STAT64)
+ fi
+ AC_MSG_RESULT(${tcl_cv_struct_stat64})
+
+ AC_MSG_CHECKING([for off64_t])
+ AC_CACHE_VAL(tcl_cv_type_off64_t,[
+ AC_TRY_COMPILE([#include <sys/types.h>],[off64_t offset;
+],
+ tcl_cv_type_off64_t=yes,tcl_cv_type_off64_t=no)])
+ if test "x${tcl_cv_type_off64_t}" = "xyes" ; then
+ AC_DEFINE(HAVE_TYPE_OFF64_T)
+ fi
+ AC_MSG_RESULT(${tcl_cv_type_off64_t})
+ fi])
diff --git a/tcl/unix/tcl.spec b/tcl/unix/tcl.spec
index d2ce7dff7b7..1bfd3bc02cc 100644
--- a/tcl/unix/tcl.spec
+++ b/tcl/unix/tcl.spec
@@ -1,7 +1,7 @@
# $Id$
# This file is the basis for a binary Tcl RPM for Linux.
-%define version 8.3.2
+%define version 8.4.0
%define directory /usr/local
Summary: Tcl scripting language development environment
@@ -10,9 +10,9 @@ Version: %{version}
Release: 1
Copyright: BSD
Group: Development/Languages
-Source: ftp://ftp.scriptics.com/pub/tcl/tcl8_3/tcl%{version}.tar.gz
-URL: http://dev.scriptics.com/
-Packager: Scriptics Corporation
+Source: http://prdownloads.sourceforge.net/tcl/tcl%{version}-src.tar.gz
+URL: http://www.tcl.tk/
+Packager: Carina
Buildroot: /var/tmp/%{name}%{version}
%description
diff --git a/tcl/unix/tclAppInit.c b/tcl/unix/tclAppInit.c
index dac0d66aa2e..047b6744137 100644
--- a/tcl/unix/tclAppInit.c
+++ b/tcl/unix/tclAppInit.c
@@ -16,15 +16,6 @@
#include "tcl.h"
-/*
- * The following variable is a special hack that is needed in order for
- * Sun shared libraries to be used for Tcl.
- */
-
-extern int matherr();
-int *tclDummyMathPtr = (int *) matherr;
-
-
#ifdef TCL_TEST
#include "tclInt.h"
@@ -177,8 +168,10 @@ Tcl_AppInit(interp)
* then no user-specific startup file will be run under any conditions.
*/
+#ifdef DJGPP
+ Tcl_SetVar(interp, "tcl_rcFileName", "~/tclsh.rc", TCL_GLOBAL_ONLY);
+#else
Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY);
+#endif
return TCL_OK;
}
-
-
diff --git a/tcl/unix/tclConfig.sh.in b/tcl/unix/tclConfig.sh.in
index 05e0949dc37..27326e94a30 100644
--- a/tcl/unix/tclConfig.sh.in
+++ b/tcl/unix/tclConfig.sh.in
@@ -23,10 +23,6 @@ TCL_CC='@CC@'
# -D flags for use with the C compiler.
TCL_DEFS='@DEFS@'
-# Extensions written in gcc need -fwritable-strings. Use TCL_CFLAGS for
-# any other flags required for extensions.
-TCL_CFLAGS='@CFLAGS@'
-
# If TCL was built with debugging symbols, generated libraries contain
# this string at the end of the library name (before the extension).
TCL_DBGX=@TCL_DBGX@
@@ -45,9 +41,6 @@ TCL_SHARED_BUILD=@TCL_SHARED_BUILD@
# The name of the Tcl library (may be either a .a file or a shared library):
TCL_LIB_FILE='@TCL_LIB_FILE@'
-# The fullpath of the Tcl library (used for dependency checking)
-TCL_LIB_FULL_PATH='@TCL_LIB_FULL_PATH@'
-
# Flag to indicate whether shared libraries need export files.
TCL_NEEDS_EXP_FILE=@TCL_NEEDS_EXP_FILE@
@@ -80,7 +73,7 @@ TCL_EXTRA_CFLAGS='@EXTRA_CFLAGS@'
# Base command to use for combining object files into a shared library:
TCL_SHLIB_LD='@SHLIB_LD@'
-# Base command to use for combining object files into a shared library:
+# Base command to use for combining object files into a static library:
TCL_STLIB_LD='@STLIB_LD@'
# Either '$LIBS' (if dependent libraries should be included when linking
@@ -91,10 +84,6 @@ TCL_SHLIB_LD_LIBS='@SHLIB_LD_LIBS@'
# Suffix to use for the name of a shared library.
TCL_SHLIB_SUFFIX='@SHLIB_SUFFIX@'
-# Suffix to use in the name of an unshared library.
-# FIXME: Comments in tcl.m4 about this var are incorrect!
-TCL_LIB_SUFFIX='@TCL_LIB_SUFFIX@'
-
# Library file(s) to include in tclsh and other base applications
# in order to provide facilities needed by DLOBJ above.
TCL_DL_LIBS='@DL_LIBS@'
@@ -107,7 +96,8 @@ TCL_LD_FLAGS='@LDFLAGS@'
# run-time dynamic linker where to look for shared libraries such as
# libtcl.so. Used when linking applications. Only works if there
# is a variable "LIB_RUNTIME_DIR" defined in the Makefile.
-TCL_LD_SEARCH_FLAGS='@TCL_LD_SEARCH_FLAGS@'
+TCL_CC_SEARCH_FLAGS='@CC_SEARCH_FLAGS@'
+TCL_LD_SEARCH_FLAGS='@LD_SEARCH_FLAGS@'
# Additional object files linked with Tcl to provide compatibility
# with standard facilities from ANSI C or POSIX.
@@ -127,6 +117,10 @@ TCL_BUILD_LIB_SPEC='@TCL_BUILD_LIB_SPEC@'
# installed directory.
TCL_LIB_SPEC='@TCL_LIB_SPEC@'
+# String to pass to the compiler so that an extension can
+# find installed Tcl headers.
+TCL_INCLUDE_SPEC='@TCL_INCLUDE_SPEC@'
+
# Indicates whether a version numbers should be used in -l switches
# ("ok" means it's safe to use switches like -ltcl7.5; "nodots" means
# use switches like -ltcl75). SunOS and FreeBSD require "nodots", for
@@ -182,5 +176,5 @@ TCL_BUILD_STUB_LIB_PATH='@TCL_BUILD_STUB_LIB_PATH@'
# Path to the Tcl stub library in the install directory.
TCL_STUB_LIB_PATH='@TCL_STUB_LIB_PATH@'
-# Vendor prefix to be added to lib names
-TCL_VENDOR_PREFIX=@VENDORPREFIX@
+# Flag, 1: we built Tcl with threads enables, 0 we didn't
+TCL_THREADS=@TCL_THREADS@
diff --git a/tcl/unix/tclLoadAix.c b/tcl/unix/tclLoadAix.c
index c46424132a4..0757f84f5c8 100644
--- a/tcl/unix/tclLoadAix.c
+++ b/tcl/unix/tclLoadAix.c
@@ -547,4 +547,3 @@ static void * findMain(void)
return ret;
}
-
diff --git a/tcl/unix/tclLoadAout.c b/tcl/unix/tclLoadAout.c
index 5e5f1f75dfb..d24e8a7ad20 100644
--- a/tcl/unix/tclLoadAout.c
+++ b/tcl/unix/tclLoadAout.c
@@ -22,6 +22,11 @@
#ifdef HAVE_EXEC_AOUT_H
# include <sys/exec_aout.h>
#endif
+#ifdef HAVE_UNISTD_H
+# include <unistd.h>
+#else
+# include "../compat/unistd.h"
+#endif
/*
* Some systems describe the a.out header in sys/exec.h, and some in
@@ -84,7 +89,7 @@ static char * SymbolTableFile = NULL;
* Type of the dictionary function that begins each load module.
*/
-typedef Tcl_PackageInitProc * (* DictFn) _ANSI_ARGS_ ((char * symbol));
+typedef Tcl_PackageInitProc * (* DictFn) _ANSI_ARGS_ ((CONST char * symbol));
/*
* Prototypes for procedures referenced only in this file:
@@ -97,17 +102,14 @@ static void UnlinkSymbolTable _ANSI_ARGS_((void));
/*
*----------------------------------------------------------------------
*
- * TclpLoadFile --
+ * TclpDlopen --
*
* Dynamically loads a binary code file into memory and returns
- * the addresses of two procedures within that file, if they
- * are defined.
+ * a handle to the new code.
*
* Results:
* A standard Tcl completion code. If an error occurs, an error
- * message is left in the interp's result. *proc1Ptr and *proc2Ptr
- * are filled in with the addresses of the symbols given by
- * *sym1 and *sym2, or NULL if those symbols can't be found.
+ * message is left in the interp's result.
*
* Side effects:
* New code suddenly appears in memory.
@@ -136,18 +138,17 @@ static void UnlinkSymbolTable _ANSI_ARGS_((void));
*/
int
-TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
+TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr)
Tcl_Interp *interp; /* Used for error reporting. */
- char *fileName; /* Name of the file containing the desired
+ Tcl_Obj *pathPtr; /* Name of the file containing the desired
* code (UTF-8). */
- 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
+ Tcl_LoadHandle *loadHandle; /* Filled with token for dynamically loaded
* file which will be passed back to
- * TclpUnloadFile() to unload the file. */
+ * (*unloadProcPtr)() to unload the file. */
+ Tcl_FSUnloadFileProc **unloadProcPtr;
+ /* Filled with address of Tcl_FSUnloadFileProc
+ * function which should be used for
+ * this file. */
{
char * inputSymbolTable; /* Name of the file containing the
* symbol table from the last link. */
@@ -162,12 +163,9 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
struct exec relocatedHead; /* Header of the relocated text */
unsigned long relocatedSize; /* Size of the relocated text */
char * startAddress; /* Starting address of the module */
- DictFn dictionary; /* Dictionary function in the load module */
int status; /* Status return from Tcl_ calls */
char * p;
- *clientDataPtr = NULL;
-
/* Find the file that contains the symbols for the run-time link. */
if (SymbolTableFile != NULL) {
@@ -189,13 +187,13 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
Tcl_DStringAppend (&linkCommandBuf, " -G 0 ", -1);
#endif
Tcl_DStringAppend (&linkCommandBuf, " -u TclLoadDictionary_", -1);
- TclGuessPackageName(fileName, &linkCommandBuf);
+ TclGuessPackageName(Tcl_GetString(pathPtr), &linkCommandBuf);
Tcl_DStringAppend (&linkCommandBuf, " -A ", -1);
Tcl_DStringAppend (&linkCommandBuf, inputSymbolTable, -1);
Tcl_DStringAppend (&linkCommandBuf, " -N -T XXXXXXXX ", -1);
- Tcl_DStringAppend (&linkCommandBuf, fileName, -1);
+ Tcl_DStringAppend (&linkCommandBuf, Tcl_GetString(pathPtr), -1);
Tcl_DStringAppend (&linkCommandBuf, " ", -1);
- if (FindLibraries (interp, fileName, &linkCommandBuf) != TCL_OK) {
+ if (FindLibraries (interp, Tcl_GetString(pathPtr), &linkCommandBuf) != TCL_OK) {
Tcl_DStringFree (&linkCommandBuf);
return TCL_ERROR;
}
@@ -258,7 +256,14 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
(void) brk (startAddress + relocatedSize);
- /* Seek to the start of the module's text */
+ /*
+ * Seek to the start of the module's text.
+ *
+ * Note that this does not really work with large files (i.e. where
+ * lseek64 exists and is different to lseek), but anyone trying to
+ * dynamically load a binary that is larger than what can fit in
+ * addressable memory is in trouble anyway...
+ */
#if defined(__mips) || defined(mips)
status = lseek (relocatedFd,
@@ -300,16 +305,38 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
SymbolTableFile = ckalloc (strlen (relocatedFileName) + 1);
strcpy (SymbolTableFile, relocatedFileName);
- /* Look up the entry points in the load module's dictionary. */
-
- dictionary = (DictFn) startAddress;
- *proc1Ptr = dictionary (sym1);
- *proc2Ptr = dictionary (sym2);
-
+ *loadHandle = startAddress;
return TCL_OK;
}
/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+{
+ /* Look up the entry point in the load module's dictionary. */
+ DictFn dictionary = (DictFn) loadHandle;
+ return (Tcl_PackageInitProc*) dictionary(sym1);
+}
+
+
+/*
*------------------------------------------------------------------------
*
* FindLibraries --
@@ -331,7 +358,7 @@ FindLibraries (interp, fileName, buf)
Tcl_DString * buf; /* Buffer where the -l an -L flags */
{
FILE * f; /* The load module */
- int c; /* Byte from the load module */
+ int c = 0; /* Byte from the load module */
char * p;
Tcl_DString ds;
CONST char *native;
@@ -434,9 +461,9 @@ UnlinkSymbolTable ()
*/
void
-TclpUnloadFile(clientData)
- ClientData clientData; /* ClientData returned by a previous call
- * to TclpLoadFile(). The clientData is
+TclpUnloadFile(loadHandle)
+ Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call
+ * to TclpDlopen(). The loadHandle is
* a token that represents the loaded
* file. */
{
@@ -464,15 +491,15 @@ TclpUnloadFile(clientData)
int
TclGuessPackageName(fileName, bufPtr)
- char *fileName; /* Name of file containing package (already
+ 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. */
{
- char *p, *q, *r;
- int srcOff, dstOff;
+ CONST char *p, *q;
+ char *r;
- if (q = strrchr(fileName,'/')) {
+ if ((q = strrchr(fileName,'/'))) {
q++;
} else {
q = fileName;
@@ -505,5 +532,3 @@ TclGuessPackageName(fileName, bufPtr)
return 1;
}
-
-
diff --git a/tcl/unix/tclLoadDl.c b/tcl/unix/tclLoadDl.c
index a03e8c3ef5c..be93fc693dc 100644
--- a/tcl/unix/tclLoadDl.c
+++ b/tcl/unix/tclLoadDl.c
@@ -38,17 +38,14 @@
/*
*---------------------------------------------------------------------------
*
- * TclpLoadFile --
+ * TclpDlopen --
*
* Dynamically loads a binary code file into memory and returns
- * the addresses of two procedures within that file, if they
- * are defined.
+ * a handle to the new code.
*
* Results:
* A standard Tcl completion code. If an error occurs, an error
- * message is left in the interp's result. *proc1Ptr and *proc2Ptr
- * are filled in with the addresses of the symbols given by
- * *sym1 and *sym2, or NULL if those symbols can't be found.
+ * message is left in the interp's result.
*
* Side effects:
* New code suddenly appears in memory.
@@ -57,68 +54,81 @@
*/
int
-TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
+TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr)
Tcl_Interp *interp; /* Used for error reporting. */
- char *fileName; /* Name of the file containing the desired
- * code. */
- 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
+ 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
- * TclpUnloadFile() to unload the file. */
+ * (*unloadProcPtr)() to unload the file. */
+ Tcl_FSUnloadFileProc **unloadProcPtr;
+ /* Filled with address of Tcl_FSUnloadFileProc
+ * function which should be used for
+ * this file. */
{
VOID *handle;
- Tcl_DString newName, ds;
- char *native;
+ CONST char *native;
- native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
+ native = Tcl_FSGetNativePath(pathPtr);
handle = dlopen(native, RTLD_NOW | RTLD_GLOBAL); /* INTL: Native. */
- Tcl_DStringFree(&ds);
-
- *clientDataPtr = (ClientData) handle;
if (handle == NULL) {
- Tcl_AppendResult(interp, "couldn't load file \"", fileName,
- "\": ", dlerror(), (char *) NULL);
+ Tcl_AppendResult(interp, "couldn't load file \"",
+ Tcl_GetString(pathPtr),
+ "\": ", dlerror(), (char *) NULL);
return TCL_ERROR;
}
+ *unloadProcPtr = &TclpUnloadFile;
+ *loadHandle = (Tcl_LoadHandle)handle;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+{
+ CONST char *native;
+ Tcl_DString newName, ds;
+ VOID *handle = (VOID*)loadHandle;
+ Tcl_PackageInitProc *proc;
/*
* Some platforms still add an underscore to the beginning of symbol
* names. If we can't find a name without an underscore, try again
* with the underscore.
*/
- native = Tcl_UtfToExternalDString(NULL, sym1, -1, &ds);
- *proc1Ptr = (Tcl_PackageInitProc *) dlsym(handle, /* INTL: Native. */
+ native = Tcl_UtfToExternalDString(NULL, symbol, -1, &ds);
+ proc = (Tcl_PackageInitProc *) dlsym(handle, /* INTL: Native. */
native);
- if (*proc1Ptr == NULL) {
+ if (proc == NULL) {
Tcl_DStringInit(&newName);
Tcl_DStringAppend(&newName, "_", 1);
native = Tcl_DStringAppend(&newName, native, -1);
- *proc1Ptr = (Tcl_PackageInitProc *) dlsym(handle, /* INTL: Native. */
+ proc = (Tcl_PackageInitProc *) dlsym(handle, /* INTL: Native. */
native);
Tcl_DStringFree(&newName);
}
Tcl_DStringFree(&ds);
- native = Tcl_UtfToExternalDString(NULL, sym2, -1, &ds);
- *proc2Ptr = (Tcl_PackageInitProc *) dlsym(handle, /* INTL: Native. */
- native);
- if (*proc2Ptr == NULL) {
- Tcl_DStringInit(&newName);
- Tcl_DStringAppend(&newName, "_", 1);
- native = Tcl_DStringAppend(&newName, native, -1);
- *proc2Ptr = (Tcl_PackageInitProc *) dlsym(handle, /* INTL: Native. */
- native);
- Tcl_DStringFree(&newName);
- }
- Tcl_DStringFree(&ds);
-
- return TCL_OK;
+ return proc;
}
/*
@@ -140,15 +150,15 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
*/
void
-TclpUnloadFile(clientData)
- ClientData clientData; /* ClientData returned by a previous call
- * to TclpLoadFile(). The clientData is
+TclpUnloadFile(loadHandle)
+ Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call
+ * to TclpDlopen(). The loadHandle is
* a token that represents the loaded
* file. */
{
VOID *handle;
- handle = (VOID *) clientData;
+ handle = (VOID *) loadHandle;
dlclose(handle);
}
@@ -174,11 +184,10 @@ TclpUnloadFile(clientData)
int
TclGuessPackageName(fileName, bufPtr)
- char *fileName; /* Name of file containing package (already
+ 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. */
{
return 0;
}
-
diff --git a/tcl/unix/tclLoadDld.c b/tcl/unix/tclLoadDld.c
index ebb5d6bced2..92479b4b360 100644
--- a/tcl/unix/tclLoadDld.c
+++ b/tcl/unix/tclLoadDld.c
@@ -30,17 +30,14 @@
/*
*----------------------------------------------------------------------
*
- * TclpLoadFile --
+ * TclpDlopen --
*
* Dynamically loads a binary code file into memory and returns
- * the addresses of two procedures within that file, if they
- * are defined.
+ * a handle to the new code.
*
* Results:
* A standard Tcl completion code. If an error occurs, an error
- * message is left in the interp's result. *proc1Ptr and *proc2Ptr
- * are filled in with the addresses of the symbols given by
- * *sym1 and *sym2, or NULL if those symbols can't be found.
+ * message is left in the interp's result.
*
* Side effects:
* New code suddenly appears in memory.
@@ -49,25 +46,25 @@
*/
int
-TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
+TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr)
Tcl_Interp *interp; /* Used for error reporting. */
- char *fileName; /* Name of the file containing the desired
- * code. */
- 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
+ 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
- * TclpUnloadFile() to unload the file. */
+ * (*unloadProcPtr)() to unload the file. */
+ Tcl_FSUnloadFileProc **unloadProcPtr;
+ /* Filled with address of Tcl_FSUnloadFileProc
+ * function which should be used for
+ * this file. */
{
static int firstTime = 1;
int returnCode;
-
+ char *fileName = Tcl_GetString(pathPtr);
+
/*
* The dld package needs to know the pathname to the tcl binary.
- * If that's not know, return an error.
+ * If that's not known, return an error.
*/
if (firstTime) {
@@ -87,21 +84,45 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
firstTime = 0;
}
- if ((returnCode = dld_link(fileName)) != 0) {
- Tcl_AppendResult(interp, "couldn't load file \"", fileName,
- "\": ", dld_strerror(returnCode), (char *) NULL);
+ if ((returnCode = dld_link(Tcl_GetString(pathPtr))) != 0) {
+ Tcl_AppendResult(interp, "couldn't load file \"",
+ Tcl_GetString(pathPtr),
+ "\": ", dld_strerror(returnCode), (char *) NULL);
return TCL_ERROR;
}
- *proc1Ptr = (Tcl_PackageInitProc *) dld_get_func(sym1);
- *proc2Ptr = (Tcl_PackageInitProc *) dld_get_func(sym2);
- *clientDataPtr = strcpy(
+ *loadHandle = strcpy(
(char *) ckalloc((unsigned) (strlen(fileName) + 1)), fileName);
+ *unloadProcPtr = &TclpUnloadFile;
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
+ * 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 (Tcl_PackageInitProc *) dld_get_func(symbol);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclpUnloadFile --
*
* Unloads a dynamically loaded binary code file from memory.
@@ -118,15 +139,15 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
*/
void
-TclpUnloadFile(clientData)
- ClientData clientData; /* ClientData returned by a previous call
- * to TclpLoadFile(). The clientData is
+TclpUnloadFile(loadHandle)
+ Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call
+ * to TclpDlopen(). The loadHandle is
* a token that represents the loaded
* file. */
{
char *fileName;
- handle = (char *) clientData;
+ handle = (char *) loadHandle;
dld_unlink_by_file(handle, 0);
ckfree(handle);
}
@@ -153,11 +174,10 @@ TclpUnloadFile(clientData)
int
TclGuessPackageName(fileName, bufPtr)
- char *fileName; /* Name of file containing package (already
+ 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. */
{
return 0;
}
-
diff --git a/tcl/unix/tclLoadDyld.c b/tcl/unix/tclLoadDyld.c
index 6b029f91294..a709fc88023 100644
--- a/tcl/unix/tclLoadDyld.c
+++ b/tcl/unix/tclLoadDyld.c
@@ -2,10 +2,9 @@
* tclLoadDyld.c --
*
* This procedure provides a version of the TclLoadFile that
- * works with NeXT/Apple's dyld dynamic loading. This file
+ * works with Apple's dyld dynamic loading. This file
* provided by Wilfredo Sanchez (wsanchez@apple.com).
- * The works on Mac OS X and Mac OS X Server.
- * It should work with OpenStep, but it's not been tried.
+ * This works on Mac OS X.
*
* Copyright (c) 1995 Apple Computer, Inc.
*
@@ -16,22 +15,30 @@
*/
#include "tclInt.h"
+#include "tclPort.h"
#include <mach-o/dyld.h>
+typedef struct Tcl_DyldModuleHandle {
+ struct Tcl_DyldModuleHandle *nextModuleHandle;
+ NSModule module;
+} Tcl_DyldModuleHandle;
+
+typedef struct Tcl_DyldLoadHandle {
+ const struct mach_header *dyld_lib;
+ Tcl_DyldModuleHandle *firstModuleHandle;
+} Tcl_DyldLoadHandle;
+
/*
*----------------------------------------------------------------------
*
- * TclpLoadFile --
+ * TclpDlopen --
*
- * Dynamically loads a binary code file into memory and returns
- * the addresses of two procedures within that file, if they
- * are defined.
+ * Dynamically loads a binary code file into memory and returns
+ * a handle to the new code.
*
* Results:
* A standard Tcl completion code. If an error occurs, an error
- * message is left in the interpreter's result. *proc1Ptr and *proc2Ptr
- * are filled in with the addresses of the symbols given by
- * *sym1 and *sym2, or NULL if those symbols can't be found.
+ * message is left in the interpreter's result.
*
* Side effects:
* New code suddenly appears in memory.
@@ -40,75 +47,94 @@
*/
int
-TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
+TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr)
Tcl_Interp *interp; /* Used for error reporting. */
- char *fileName; /* Name of the file containing the desired
- * code. */
- 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
+ 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
- * TclpUnloadFile() to unload the file. */
+ * (*unloadProcPtr)() to unload the file. */
+ Tcl_FSUnloadFileProc **unloadProcPtr;
+ /* Filled with address of Tcl_FSUnloadFileProc
+ * function which should be used for
+ * this file. */
{
- NSObjectFileImageReturnCode err;
- NSObjectFileImage image;
- NSModule module;
- NSSymbol symbol;
- char *name;
+ Tcl_DyldLoadHandle *dyldLoadHandle;
+ const struct mach_header *dyld_lib;
+ CONST char *native;
- err = NSCreateObjectFileImageFromFile(fileName, &image);
- if (err != NSObjectFileImageSuccess) {
- switch (err) {
- case NSObjectFileImageFailure:
- Tcl_SetResult(interp, "dyld: general failure", TCL_STATIC);
- break;
- case NSObjectFileImageInappropriateFile:
- Tcl_SetResult(interp, "dyld: inappropriate Mach-O file",
- TCL_STATIC);
- break;
- case NSObjectFileImageArch:
- Tcl_SetResult(interp,
- "dyld: inappropriate Mach-O architecture", TCL_STATIC);
- break;
- case NSObjectFileImageFormat:
- Tcl_SetResult(interp, "dyld: invalid Mach-O file format",
- TCL_STATIC);
- break;
- case NSObjectFileImageAccess:
- Tcl_SetResult(interp, "dyld: permission denied", TCL_STATIC);
- break;
- default:
- Tcl_SetResult(interp, "dyld: unknown failure", TCL_STATIC);
- break;
- }
- return TCL_ERROR;
+ native = Tcl_FSGetNativePath(pathPtr);
+ dyld_lib = NSAddImage(native,
+ NSADDIMAGE_OPTION_WITH_SEARCHING |
+ NSADDIMAGE_OPTION_RETURN_ON_ERROR);
+
+ if (!dyld_lib) {
+ NSLinkEditErrors editError;
+ char *name, *msg;
+ NSLinkEditError(&editError, &errno, &name, &msg);
+ Tcl_AppendResult(interp, msg, (char *) NULL);
+ return TCL_ERROR;
}
+ dyldLoadHandle = (Tcl_DyldLoadHandle *) ckalloc(sizeof(Tcl_DyldLoadHandle));
+ if (!dyldLoadHandle) return TCL_ERROR;
+ dyldLoadHandle->dyld_lib = dyld_lib;
+ dyldLoadHandle->firstModuleHandle = NULL;
+ *loadHandle = (Tcl_LoadHandle) dyldLoadHandle;
+ *unloadProcPtr = &TclpUnloadFile;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+{
+ NSSymbol nsSymbol;
+ CONST char *native;
+ Tcl_DString newName, ds;
+ Tcl_PackageInitProc* proc = NULL;
+ Tcl_DyldLoadHandle *dyldLoadHandle = (Tcl_DyldLoadHandle *) loadHandle;
+ /*
+ * dyld adds an underscore to the beginning of symbol names.
+ */
- module = NSLinkModule(image, fileName, TRUE);
-
- if (module == NULL) {
- Tcl_SetResult(interp, "dyld: falied to link module", TCL_STATIC);
- return TCL_ERROR;
+ native = Tcl_UtfToExternalDString(NULL, symbol, -1, &ds);
+ Tcl_DStringInit(&newName);
+ Tcl_DStringAppend(&newName, "_", 1);
+ native = Tcl_DStringAppend(&newName, native, -1);
+ nsSymbol = NSLookupSymbolInImage(dyldLoadHandle->dyld_lib, native,
+ NSLOOKUPSYMBOLINIMAGE_OPTION_BIND_NOW |
+ NSLOOKUPSYMBOLINIMAGE_OPTION_RETURN_ON_ERROR);
+ if(nsSymbol) {
+ Tcl_DyldModuleHandle *dyldModuleHandle;
+ proc = NSAddressOfSymbol(nsSymbol);
+ dyldModuleHandle = (Tcl_DyldModuleHandle *) ckalloc(sizeof(Tcl_DyldModuleHandle));
+ if (dyldModuleHandle) {
+ dyldModuleHandle->module = NSModuleForSymbol(nsSymbol);
+ dyldModuleHandle->nextModuleHandle = dyldLoadHandle->firstModuleHandle;
+ dyldLoadHandle->firstModuleHandle = dyldModuleHandle;
+ }
}
-
- name = (char*)malloc(sizeof(char)*(strlen(sym1)+2));
- sprintf(name, "_%s", sym1);
- symbol = NSLookupAndBindSymbol(name);
- free(name);
- *proc1Ptr = NSAddressOfSymbol(symbol);
-
- name = (char*)malloc(sizeof(char)*(strlen(sym2)+2));
- sprintf(name, "_%s", sym2);
- symbol = NSLookupAndBindSymbol(name);
- free(name);
- *proc2Ptr = NSAddressOfSymbol(symbol);
-
- *clientDataPtr = module;
-
- return TCL_OK;
+ Tcl_DStringFree(&newName);
+ Tcl_DStringFree(&ds);
+
+ return proc;
}
/*
@@ -131,13 +157,23 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
*/
void
-TclpUnloadFile(clientData)
- ClientData clientData; /* ClientData returned by a previous call
- * to TclpLoadFile(). The clientData is
+TclpUnloadFile(loadHandle)
+ Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call
+ * to TclpDlopen(). The loadHandle is
* a token that represents the loaded
* file. */
{
- NSUnLinkModule(clientData, FALSE);
+ Tcl_DyldLoadHandle *dyldLoadHandle = (Tcl_DyldLoadHandle *) loadHandle;
+ Tcl_DyldModuleHandle *dyldModuleHandle = dyldLoadHandle->firstModuleHandle;
+ void *ptr;
+
+ while (dyldModuleHandle) {
+ NSUnLinkModule(dyldModuleHandle->module, NSUNLINKMODULE_OPTION_NONE);
+ ptr = dyldModuleHandle;
+ dyldModuleHandle = dyldModuleHandle->nextModuleHandle;
+ ckfree(ptr);
+ }
+ ckfree(dyldLoadHandle);
}
/*
@@ -162,7 +198,7 @@ TclpUnloadFile(clientData)
int
TclGuessPackageName(fileName, bufPtr)
- char *fileName; /* Name of file containing package (already
+ 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. */
diff --git a/tcl/unix/tclLoadNext.c b/tcl/unix/tclLoadNext.c
index 41069413a56..db3c7154d52 100644
--- a/tcl/unix/tclLoadNext.c
+++ b/tcl/unix/tclLoadNext.c
@@ -20,17 +20,14 @@
/*
*----------------------------------------------------------------------
*
- * TclpLoadFile --
+ * TclpDlopen --
*
* Dynamically loads a binary code file into memory and returns
- * the addresses of two procedures within that file, if they
- * are defined.
+ * a handle to the new code.
*
* Results:
* A standard Tcl completion code. If an error occurs, an error
- * message is left in the interp's result. *proc1Ptr and *proc2Ptr
- * are filled in with the addresses of the symbols given by
- * *sym1 and *sym2, or NULL if those symbols can't be found.
+ * message is left in the interp's result.
*
* Side effects:
* New code suddenly appears in memory.
@@ -39,25 +36,25 @@
*/
int
-TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
+TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr)
Tcl_Interp *interp; /* Used for error reporting. */
- char *fileName; /* Name of the file containing the desired
- * code. */
- 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
+ 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
- * TclpUnloadFile() to unload the file. */
+ * (*unloadProcPtr)() to unload the file. */
+ Tcl_FSUnloadFileProc **unloadProcPtr;
+ /* Filled with address of Tcl_FSUnloadFileProc
+ * function which should be used for
+ * this file. */
{
struct mach_header *header;
char *data;
int len, maxlen;
char *files[]={fileName,NULL};
NXStream *errorStream=NXOpenMemory(0,0,NX_READWRITE);
-
+ char *fileName = Tcl_GetString(pathPtr);
+
if(!rld_load(errorStream,&header,files,NULL)) {
NXGetMemoryBuffer(errorStream,&data,&len,&maxlen);
Tcl_AppendResult(interp,"couldn't load file \"",fileName,"\": ",data,NULL);
@@ -66,27 +63,45 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
}
NXCloseMemory(errorStream,NX_FREEBUFFER);
- *proc1Ptr=NULL;
- if(sym1) {
- char sym[strlen(sym1)+2];
- sym[0]='_'; sym[1]=0; strcat(sym,sym1);
- rld_lookup(NULL,sym,(unsigned long *)proc1Ptr);
- }
-
- *proc2Ptr=NULL;
- if(sym2) {
- char sym[strlen(sym2)+2];
- sym[0]='_'; sym[1]=0; strcat(sym,sym2);
- rld_lookup(NULL,sym,(unsigned long *)proc2Ptr);
- }
- *clientDataPtr = NULL;
-
+ *loadHandle = (Tcl_LoadHandle)1; /* A dummy non-NULL value */
+ *unloadProcPtr = &TclpUnloadFile;
+
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
+ * 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;
+{
+ Tcl_PackageInitProc *proc=NULL;
+ if(symbol) {
+ char sym[strlen(symbol)+2];
+ sym[0]='_'; sym[1]=0; strcat(sym,symbol);
+ rld_lookup(NULL,sym,(unsigned long *)&proc);
+ }
+ return proc;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclpUnloadFile --
*
* Unloads a dynamically loaded binary code file from memory.
@@ -103,9 +118,9 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
*/
void
-TclpUnloadFile(clientData)
- ClientData clientData; /* ClientData returned by a previous call
- * to TclpLoadFile(). The clientData is
+TclpUnloadFile(loadHandle)
+ Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call
+ * to TclpDlopen(). The loadHandle is
* a token that represents the loaded
* file. */
{
@@ -133,11 +148,10 @@ TclpUnloadFile(clientData)
int
TclGuessPackageName(fileName, bufPtr)
- char *fileName; /* Name of file containing package (already
+ 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. */
{
return 0;
}
-
diff --git a/tcl/unix/tclLoadOSF.c b/tcl/unix/tclLoadOSF.c
index f4bc7551a80..5a4f5913c9b 100644
--- a/tcl/unix/tclLoadOSF.c
+++ b/tcl/unix/tclLoadOSF.c
@@ -41,17 +41,14 @@
/*
*----------------------------------------------------------------------
*
- * TclpLoadFile --
+ * TclpDlopen --
*
* Dynamically loads a binary code file into memory and returns
- * the addresses of two procedures within that file, if they
- * are defined.
+ * a handle to the new code.
*
* Results:
* A standard Tcl completion code. If an error occurs, an error
- * message is left in the interp's result. *proc1Ptr and *proc2Ptr
- * are filled in with the addresses of the symbols given by
- * *sym1 and *sym2, or NULL if those symbols can't be found.
+ * message is left in the interp's result.
*
* Side effects:
* New code suddenly appears in memory.
@@ -60,22 +57,22 @@
*/
int
-TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
+TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr)
Tcl_Interp *interp; /* Used for error reporting. */
- char *fileName; /* Name of the file containing the desired
- * code. */
- 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
+ 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
- * TclpUnloadFile() to unload the file. */
+ * (*unloadProcPtr)() to unload the file. */
+ Tcl_FSUnloadFileProc **unloadProcPtr;
+ /* Filled with address of Tcl_FSUnloadFileProc
+ * function which should be used for
+ * this file. */
{
ldr_module_t lm;
char *pkg;
-
+ char *fileName = Tcl_GetString(pathPtr);
+
lm = (Tcl_PackageInitProc *) load(fileName, LDR_NOFLAGS);
if (lm == LDR_NULL_MODULE) {
Tcl_AppendResult(interp, "couldn't load file \"", fileName,
@@ -93,18 +90,43 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
* I build loadable modules with a makefile rule like
* ld ... -export $@: -o $@ $(OBJS)
*/
- if ((pkg = strrchr(fileName, '/')) == NULL)
- pkg = fileName;
- else
+ if ((pkg = strrchr(fileName, '/')) == NULL) {
+ pkg = fileName;
+ } else {
pkg++;
- *proc1Ptr = ldr_lookup_package(pkg, sym1);
- *proc2Ptr = ldr_lookup_package(pkg, sym2);
+ }
+ *loadHandle = pkg;
+ *unloadProcPtr = &TclpUnloadFile;
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
+ * 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 ldr_lookup_package((char *)loadHandle, symbol);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclpUnloadFile --
*
* Unloads a dynamically loaded binary code file from memory.
@@ -121,9 +143,9 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
*/
void
-TclpUnloadFile(clientData)
- ClientData clientData; /* ClientData returned by a previous call
- * to TclpLoadFile(). The clientData is
+TclpUnloadFile(loadHandle)
+ Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call
+ * to TclpDlopen(). The loadHandle is
* a token that represents the loaded
* file. */
{
@@ -151,11 +173,10 @@ TclpUnloadFile(clientData)
int
TclGuessPackageName(fileName, bufPtr)
- char *fileName; /* Name of file containing package (already
+ 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. */
{
return 0;
}
-
diff --git a/tcl/unix/tclLoadShl.c b/tcl/unix/tclLoadShl.c
index 620367bd21f..423999d6d68 100644
--- a/tcl/unix/tclLoadShl.c
+++ b/tcl/unix/tclLoadShl.c
@@ -23,22 +23,19 @@
# undef EXTERN
#endif
-#include "tcl.h"
+#include "tclInt.h"
/*
*----------------------------------------------------------------------
*
- * TclpLoadFile --
+ * TclpDlopen --
*
* Dynamically loads a binary code file into memory and returns
- * the addresses of two procedures within that file, if they
- * are defined.
+ * a handle to the new code.
*
* Results:
* A standard Tcl completion code. If an error occurs, an error
- * message is left in the interp's result. *proc1Ptr and *proc2Ptr
- * are filled in with the addresses of the symbols given by
- * *sym1 and *sym2, or NULL if those symbols can't be found.
+ * message is left in the interp's result.
*
* Side effects:
* New code suddenly appears in memory.
@@ -47,22 +44,21 @@
*/
int
-TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
+TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr)
Tcl_Interp *interp; /* Used for error reporting. */
- char *fileName; /* Name of the file containing the desired
- * code. */
- 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
+ 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
- * TclpUnloadFile() to unload the file. */
+ * (*unloadProcPtr)() to unload the file. */
+ Tcl_FSUnloadFileProc **unloadProcPtr;
+ /* Filled with address of Tcl_FSUnloadFileProc
+ * function which should be used for
+ * this file. */
{
shl_t handle;
- Tcl_DString newName;
-
+ char *fileName = Tcl_GetString(pathPtr);
+
/*
* The flags below used to be BIND_IMMEDIATE; they were changed at
* the suggestion of Wolfgang Kechel (wolfgang@prs.de): "This
@@ -73,43 +69,61 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
* when they are build."
*/
- handle = shl_load(fileName, BIND_DEFERRED|BIND_VERBOSE, 0L);
+ handle = shl_load(fileName,
+ BIND_DEFERRED|BIND_VERBOSE|DYNAMIC_PATH,
+ 0L);
if (handle == NULL) {
Tcl_AppendResult(interp, "couldn't load file \"", fileName,
"\": ", Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
- *clientDataPtr = (ClientData) handle;
-
+ *loadHandle = (Tcl_LoadHandle) handle;
+ *unloadProcPtr = &TclpUnloadFile;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+{
+ Tcl_DString newName;
+ Tcl_PackageInitProc *proc=NULL;
+ shl_t handle = (shl_t)loadHandle;
/*
* Some versions of the HP system software still use "_" at the
* beginning of exported symbols while others don't; try both
* forms of each name.
*/
- if (shl_findsym(&handle, sym1, (short) TYPE_PROCEDURE, (void *) proc1Ptr)
+ if (shl_findsym(&handle, symbol, (short) TYPE_PROCEDURE, (void *) &proc)
!= 0) {
Tcl_DStringInit(&newName);
Tcl_DStringAppend(&newName, "_", 1);
- Tcl_DStringAppend(&newName, sym1, -1);
+ Tcl_DStringAppend(&newName, symbol, -1);
if (shl_findsym(&handle, Tcl_DStringValue(&newName),
- (short) TYPE_PROCEDURE, (void *) proc1Ptr) != 0) {
- *proc1Ptr = NULL;
+ (short) TYPE_PROCEDURE, (void *) &proc) != 0) {
+ proc = NULL;
}
Tcl_DStringFree(&newName);
}
- if (shl_findsym(&handle, sym2, (short) TYPE_PROCEDURE, (void *) proc2Ptr)
- != 0) {
- Tcl_DStringInit(&newName);
- Tcl_DStringAppend(&newName, "_", 1);
- Tcl_DStringAppend(&newName, sym2, -1);
- if (shl_findsym(&handle, Tcl_DStringValue(&newName),
- (short) TYPE_PROCEDURE, (void *) proc2Ptr) != 0) {
- *proc2Ptr = NULL;
- }
- Tcl_DStringFree(&newName);
- }
- return TCL_OK;
+ return proc;
}
/*
@@ -131,15 +145,15 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
*/
void
-TclpUnloadFile(clientData)
- ClientData clientData; /* ClientData returned by a previous call
- * to TclpLoadFile(). The clientData is
+TclpUnloadFile(loadHandle)
+ Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call
+ * to TclpDlopen(). The loadHandle is
* a token that represents the loaded
* file. */
{
shl_t handle;
- handle = (shl_t) clientData;
+ handle = (shl_t) loadHandle;
shl_unload(handle);
}
@@ -165,11 +179,10 @@ TclpUnloadFile(clientData)
int
TclGuessPackageName(fileName, bufPtr)
- char *fileName; /* Name of file containing package (already
+ 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. */
{
return 0;
}
-
diff --git a/tcl/unix/tclUnixChan.c b/tcl/unix/tclUnixChan.c
index 4558fa41d83..d357a08dd70 100644
--- a/tcl/unix/tclUnixChan.c
+++ b/tcl/unix/tclUnixChan.c
@@ -13,11 +13,11 @@
* RCS: @(#) $Id$
*/
-#include "tclInt.h" /* Internal definitions for Tcl. */
-#include "tclPort.h" /* Portability features for Tcl. */
+#include "tclInt.h" /* Internal definitions for Tcl. */
+#include "tclPort.h" /* Portability features for Tcl. */
/*
- * sys/ioctl.h has already been included by tclPort.h. Including termios.h
+ * sys/ioctl.h has already been included by tclPort.h. Including termios.h
* or termio.h causes a bunch of warning messages because some duplicate
* (but not contradictory) #defines exist in termios.h and/or termio.h
*/
@@ -45,16 +45,65 @@
#ifdef USE_TERMIOS
# include <termios.h>
+# ifdef HAVE_SYS_IOCTL_H
+# include <sys/ioctl.h>
+# endif /* HAVE_SYS_IOCTL_H */
+# ifdef HAVE_SYS_MODEM_H
+# include <sys/modem.h>
+# endif /* HAVE_SYS_MODEM_H */
# define IOSTATE struct termios
# define GETIOSTATE(fd, statePtr) tcgetattr((fd), (statePtr))
# define SETIOSTATE(fd, statePtr) tcsetattr((fd), TCSADRAIN, (statePtr))
+# define GETCONTROL(fd, intPtr) ioctl((fd), TIOCMGET, (intPtr))
+# define SETCONTROL(fd, intPtr) ioctl((fd), TIOCMSET, (intPtr))
+ /*
+ * TIP #35 introduced a different on exit flush/close behavior that
+ * doesn't work correctly with standard channels on all systems.
+ * The problem is tcflush throws away waiting channel data. This may
+ * be necessary for true serial channels that may block, but isn't
+ * correct in the standard case. This might be replaced with tcdrain
+ * instead, but that can block. For now, we revert to making this do
+ * nothing, and TtyOutputProc being the same old FileOutputProc.
+ * -- hobbs [Bug #525783]
+ */
+# define BAD_TIP35_FLUSH 0
+# if BAD_TIP35_FLUSH
+# define TTYFLUSH(fd) tcflush((fd), TCIOFLUSH);
+# else
+# define TTYFLUSH(fd)
+# endif /* BAD_TIP35_FLUSH */
+# ifdef FIONREAD
+# define GETREADQUEUE(fd, int) ioctl((fd), FIONREAD, &(int))
+# elif defined(FIORDCHK)
+# define GETREADQUEUE(fd, int) int = ioctl((fd), FIORDCHK, NULL)
+# endif /* FIONREAD */
+# ifdef TIOCOUTQ
+# define GETWRITEQUEUE(fd, int) ioctl((fd), TIOCOUTQ, &(int))
+# endif /* TIOCOUTQ */
+# if defined(TIOCSBRK) && defined(TIOCCBRK)
+/*
+ * Can't use ?: operator below because that messes up types on either
+ * Linux or Solaris (the two are mutually exclusive!)
+ */
+# define SETBREAK(fd, flag) \
+ if (flag) { \
+ ioctl((fd), TIOCSBRK, NULL); \
+ } else { \
+ ioctl((fd), TIOCCBRK, NULL); \
+ }
+# endif /* TIOCSBRK&TIOCCBRK */
+# if !defined(CRTSCTS) && defined(CNEW_RTSCTS)
+# define CRTSCTS CNEW_RTSCTS
+# endif /* !CRTSCTS&CNEW_RTSCTS */
#else /* !USE_TERMIOS */
+
#ifdef USE_TERMIO
# include <termio.h>
# define IOSTATE struct termio
# define GETIOSTATE(fd, statePtr) ioctl((fd), TCGETA, (statePtr))
# define SETIOSTATE(fd, statePtr) ioctl((fd), TCSETAW, (statePtr))
#else /* !USE_TERMIO */
+
#ifdef USE_SGTTY
# include <sgtty.h>
# define IOSTATE struct sgttyb
@@ -63,6 +112,7 @@
#else /* !USE_SGTTY */
# undef SUPPORTS_TTY
#endif /* !USE_SGTTY */
+
#endif /* !USE_TERMIO */
#endif /* !USE_TERMIOS */
@@ -76,8 +126,10 @@ typedef struct FileState {
int validMask; /* OR'ed combination of TCL_READABLE,
* TCL_WRITABLE, or TCL_EXCEPTION: indicates
* which operations are valid on the file. */
+#ifdef DEPRECATED
struct FileState *nextPtr; /* Pointer to next file in list of all
* file channels. */
+#endif /* DEPRECATED */
} FileState;
#ifdef SUPPORTS_TTY
@@ -89,7 +141,9 @@ typedef struct FileState {
typedef struct TtyState {
FileState fs; /* Per-instance state of the file
- * descriptor. Must be the first field. */
+ * descriptor. Must be the first field. */
+ int stateUpdated; /* Flag to say if the state has been
+ * modified and needs resetting. */
IOSTATE savedState; /* Initial state of device. Used to reset
* state when device closed. */
} TtyState;
@@ -98,7 +152,7 @@ typedef struct TtyState {
* The following structure is used to set or get the serial port
* attributes in a platform-independant manner.
*/
-
+
typedef struct TtyAttrs {
int baud;
int parity;
@@ -108,16 +162,24 @@ typedef struct TtyAttrs {
#endif /* !SUPPORTS_TTY */
+#define UNSUPPORTED_OPTION(detail) \
+ if (interp) { \
+ Tcl_AppendResult(interp, (detail), \
+ " not supported for this platform", (char *) NULL); \
+ }
+
+#ifdef DEPRECATED
typedef struct ThreadSpecificData {
/*
* List of all file channels currently open. This is per thread and is
* used to match up fd's to channels, which rarely occurs.
*/
-
+
FileState *firstFilePtr;
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
+#endif /* DEPRECATED */
/*
* This structure describes per-instance state of a tcp based channel.
@@ -148,14 +210,14 @@ typedef struct TcpState {
* the connection request will fail.
*/
-#ifndef SOMAXCONN
-#define SOMAXCONN 100
-#endif
+#ifndef SOMAXCONN
+# define SOMAXCONN 100
+#endif /* SOMAXCONN */
-#if (SOMAXCONN < 100)
-#undef SOMAXCONN
-#define SOMAXCONN 100
-#endif
+#if (SOMAXCONN < 100)
+# undef SOMAXCONN
+# define SOMAXCONN 100
+#endif /* SOMAXCONN < 100 */
/*
* The following defines how much buffer space the kernel should maintain
@@ -169,78 +231,89 @@ typedef struct TcpState {
*/
static TcpState * CreateSocket _ANSI_ARGS_((Tcl_Interp *interp,
- int port, char *host, int server,
- char *myaddr, int myport, int async));
+ int port, CONST char *host, int server,
+ CONST char *myaddr, int myport, int async));
static int CreateSocketAddress _ANSI_ARGS_(
(struct sockaddr_in *sockaddrPtr,
- char *host, int port));
+ CONST char *host, int port));
static int FileBlockModeProc _ANSI_ARGS_((
- ClientData instanceData, int mode));
+ ClientData instanceData, int mode));
static int FileCloseProc _ANSI_ARGS_((ClientData instanceData,
Tcl_Interp *interp));
static int FileGetHandleProc _ANSI_ARGS_((ClientData instanceData,
- int direction, ClientData *handlePtr));
+ int direction, ClientData *handlePtr));
static int FileInputProc _ANSI_ARGS_((ClientData instanceData,
- char *buf, int toRead, int *errorCode));
+ char *buf, int toRead, int *errorCode));
static int FileOutputProc _ANSI_ARGS_((
- ClientData instanceData, char *buf, int toWrite,
- int *errorCode));
+ ClientData instanceData, CONST char *buf,
+ int toWrite, int *errorCode));
static int FileSeekProc _ANSI_ARGS_((ClientData instanceData,
long offset, int mode, int *errorCode));
+static Tcl_WideInt FileWideSeekProc _ANSI_ARGS_((ClientData instanceData,
+ Tcl_WideInt offset, int mode, int *errorCode));
static void FileWatchProc _ANSI_ARGS_((ClientData instanceData,
- int mask));
+ int mask));
static void TcpAccept _ANSI_ARGS_((ClientData data, int mask));
static int TcpBlockModeProc _ANSI_ARGS_((ClientData data,
- int mode));
+ int mode));
static int TcpCloseProc _ANSI_ARGS_((ClientData instanceData,
Tcl_Interp *interp));
static int TcpGetHandleProc _ANSI_ARGS_((ClientData instanceData,
- int direction, ClientData *handlePtr));
+ int direction, ClientData *handlePtr));
static int TcpGetOptionProc _ANSI_ARGS_((ClientData instanceData,
- Tcl_Interp *interp, char *optionName,
+ Tcl_Interp *interp, CONST char *optionName,
Tcl_DString *dsPtr));
static int TcpInputProc _ANSI_ARGS_((ClientData instanceData,
- char *buf, int toRead, int *errorCode));
+ char *buf, int toRead, int *errorCode));
static int TcpOutputProc _ANSI_ARGS_((ClientData instanceData,
- char *buf, int toWrite, int *errorCode));
+ CONST char *buf, int toWrite, int *errorCode));
static void TcpWatchProc _ANSI_ARGS_((ClientData instanceData,
- int mask));
+ int mask));
#ifdef SUPPORTS_TTY
static int TtyCloseProc _ANSI_ARGS_((ClientData instanceData,
Tcl_Interp *interp));
static void TtyGetAttributes _ANSI_ARGS_((int fd,
TtyAttrs *ttyPtr));
static int TtyGetOptionProc _ANSI_ARGS_((ClientData instanceData,
- Tcl_Interp *interp, char *optionName,
+ Tcl_Interp *interp, CONST char *optionName,
Tcl_DString *dsPtr));
-static FileState * TtyInit _ANSI_ARGS_((int fd));
+static FileState * TtyInit _ANSI_ARGS_((int fd, int initialize));
+#if BAD_TIP35_FLUSH
+static int TtyOutputProc _ANSI_ARGS_((ClientData instanceData,
+ CONST char *buf, int toWrite, int *errorCode));
+#endif /* BAD_TIP35_FLUSH */
static int TtyParseMode _ANSI_ARGS_((Tcl_Interp *interp,
CONST char *mode, int *speedPtr, int *parityPtr,
int *dataPtr, int *stopPtr));
static void TtySetAttributes _ANSI_ARGS_((int fd,
TtyAttrs *ttyPtr));
static int TtySetOptionProc _ANSI_ARGS_((ClientData instanceData,
- Tcl_Interp *interp, char *optionName,
- char *value));
+ Tcl_Interp *interp, CONST char *optionName,
+ CONST char *value));
#endif /* SUPPORTS_TTY */
static int WaitForConnect _ANSI_ARGS_((TcpState *statePtr,
- int *errorCodePtr));
+ int *errorCodePtr));
/*
* This structure describes the channel type structure for file based IO:
*/
static Tcl_ChannelType fileChannelType = {
- "file", /* Type name. */
- FileBlockModeProc, /* Set blocking/nonblocking mode.*/
- FileCloseProc, /* Close proc. */
- FileInputProc, /* Input proc. */
- FileOutputProc, /* Output proc. */
- FileSeekProc, /* Seek proc. */
- NULL, /* Set option proc. */
- NULL, /* Get option proc. */
- FileWatchProc, /* Initialize notifier. */
- FileGetHandleProc, /* Get OS handles out of channel. */
+ "file", /* Type name. */
+ TCL_CHANNEL_VERSION_3, /* v3 channel */
+ FileCloseProc, /* Close proc. */
+ FileInputProc, /* Input proc. */
+ FileOutputProc, /* Output proc. */
+ FileSeekProc, /* Seek proc. */
+ NULL, /* Set option proc. */
+ NULL, /* Get option proc. */
+ FileWatchProc, /* Initialize notifier. */
+ FileGetHandleProc, /* Get OS handles out of channel. */
+ NULL, /* close2proc. */
+ FileBlockModeProc, /* Set blocking or non-blocking mode.*/
+ NULL, /* flush proc. */
+ NULL, /* handler proc. */
+ FileWideSeekProc, /* wide seek proc. */
};
#ifdef SUPPORTS_TTY
@@ -250,16 +323,24 @@ static Tcl_ChannelType fileChannelType = {
*/
static Tcl_ChannelType ttyChannelType = {
- "tty", /* Type name. */
- FileBlockModeProc, /* Set blocking/nonblocking mode.*/
- TtyCloseProc, /* Close proc. */
- FileInputProc, /* Input proc. */
- FileOutputProc, /* Output proc. */
- NULL, /* Seek proc. */
- TtySetOptionProc, /* Set option proc. */
- TtyGetOptionProc, /* Get option proc. */
- FileWatchProc, /* Initialize notifier. */
- FileGetHandleProc, /* Get OS handles out of channel. */
+ "tty", /* Type name. */
+ TCL_CHANNEL_VERSION_2, /* v2 channel */
+ TtyCloseProc, /* Close proc. */
+ FileInputProc, /* Input proc. */
+#if BAD_TIP35_FLUSH
+ TtyOutputProc, /* Output proc. */
+#else /* !BAD_TIP35_FLUSH */
+ FileOutputProc, /* Output proc. */
+#endif /* BAD_TIP35_FLUSH */
+ NULL, /* Seek proc. */
+ TtySetOptionProc, /* Set option proc. */
+ TtyGetOptionProc, /* Get option proc. */
+ FileWatchProc, /* Initialize notifier. */
+ FileGetHandleProc, /* Get OS handles out of channel. */
+ NULL, /* close2proc. */
+ FileBlockModeProc, /* Set blocking or non-blocking mode.*/
+ NULL, /* flush proc. */
+ NULL, /* handler proc. */
};
#endif /* SUPPORTS_TTY */
@@ -269,16 +350,20 @@ static Tcl_ChannelType ttyChannelType = {
*/
static Tcl_ChannelType tcpChannelType = {
- "tcp", /* Type name. */
- TcpBlockModeProc, /* Set blocking/nonblocking mode.*/
- TcpCloseProc, /* Close proc. */
- TcpInputProc, /* Input proc. */
- TcpOutputProc, /* Output proc. */
- NULL, /* Seek proc. */
- NULL, /* Set option proc. */
- TcpGetOptionProc, /* Get option proc. */
- TcpWatchProc, /* Initialize notifier. */
- TcpGetHandleProc, /* Get OS handles out of channel. */
+ "tcp", /* Type name. */
+ TCL_CHANNEL_VERSION_2, /* v2 channel */
+ TcpCloseProc, /* Close proc. */
+ TcpInputProc, /* Input proc. */
+ TcpOutputProc, /* Output proc. */
+ NULL, /* Seek proc. */
+ NULL, /* Set option proc. */
+ TcpGetOptionProc, /* Get option proc. */
+ TcpWatchProc, /* Initialize notifier. */
+ TcpGetHandleProc, /* Get OS handles out of channel. */
+ NULL, /* close2proc. */
+ TcpBlockModeProc, /* Set blocking or non-blocking mode.*/
+ NULL, /* flush proc. */
+ NULL, /* handler proc. */
};
@@ -304,8 +389,8 @@ static int
FileBlockModeProc(instanceData, mode)
ClientData instanceData; /* File state. */
int mode; /* The mode to set. Can be one of
- * TCL_MODE_BLOCKING or
- * TCL_MODE_NONBLOCKING. */
+ * TCL_MODE_BLOCKING or
+ * TCL_MODE_NONBLOCKING. */
{
FileState *fsPtr = (FileState *) instanceData;
int curStatus;
@@ -321,7 +406,7 @@ FileBlockModeProc(instanceData, mode)
return errno;
}
curStatus = fcntl(fsPtr->fd, F_GETFL);
-#else
+#else /* USE_FIONBIO */
if (mode == TCL_MODE_BLOCKING) {
curStatus = 0;
} else {
@@ -330,7 +415,7 @@ FileBlockModeProc(instanceData, mode)
if (ioctl(fsPtr->fd, (int) FIONBIO, &curStatus) < 0) {
return errno;
}
-#endif
+#endif /* !USE_FIONBIO */
return 0;
}
@@ -357,15 +442,15 @@ FileInputProc(instanceData, buf, toRead, errorCodePtr)
ClientData instanceData; /* File state. */
char *buf; /* Where to store data read. */
int toRead; /* How much space is available
- * in the buffer? */
+ * in the buffer? */
int *errorCodePtr; /* Where to store error code. */
{
FileState *fsPtr = (FileState *) instanceData;
int bytesRead; /* How many bytes were actually
- * read from the input device? */
+ * read from the input device? */
*errorCodePtr = 0;
-
+
/*
* Assume there is always enough input available. This will block
* appropriately, and read will unblock as soon as a short read is
@@ -375,7 +460,7 @@ FileInputProc(instanceData, buf, toRead, errorCodePtr)
bytesRead = read(fsPtr->fd, buf, (size_t) toRead);
if (bytesRead > -1) {
- return bytesRead;
+ return bytesRead;
}
*errorCodePtr = errno;
return -1;
@@ -391,7 +476,7 @@ FileInputProc(instanceData, buf, toRead, errorCodePtr)
*
* Results:
* The number of bytes written is returned or -1 on error. An
- * output argument contains a POSIX error code if an error occurred,
+ * output argument contains a POSIX error code if an error occurred,
* or zero.
*
* Side effects:
@@ -403,7 +488,7 @@ FileInputProc(instanceData, buf, toRead, errorCodePtr)
static int
FileOutputProc(instanceData, buf, toWrite, errorCodePtr)
ClientData instanceData; /* File state. */
- char *buf; /* The data buffer. */
+ CONST char *buf; /* The data buffer. */
int toWrite; /* How many bytes to write? */
int *errorCodePtr; /* Where to store error code. */
{
@@ -411,9 +496,20 @@ FileOutputProc(instanceData, buf, toWrite, errorCodePtr)
int written;
*errorCodePtr = 0;
+
+ if (toWrite == 0) {
+ /*
+ * SF Tcl Bug 465765.
+ * Do not try to write nothing into a file. STREAM based
+ * implementations will considers this as EOF (if there is a
+ * pipe behind the file).
+ */
+
+ return 0;
+ }
written = write(fsPtr->fd, buf, (size_t) toWrite);
if (written > -1) {
- return written;
+ return written;
}
*errorCodePtr = errno;
return -1;
@@ -442,10 +538,11 @@ FileCloseProc(instanceData, interp)
Tcl_Interp *interp; /* For error reporting - unused. */
{
FileState *fsPtr = (FileState *) instanceData;
- FileState **nextPtrPtr;
int errorCode = 0;
+#ifdef DEPRECATED
+ FileState **nextPtrPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
+#endif /* DEPRECATED */
Tcl_DeleteFileHandler(fsPtr->fd);
/*
@@ -458,6 +555,7 @@ FileCloseProc(instanceData, interp)
errorCode = errno;
}
}
+#ifdef DEPRECATED
for (nextPtrPtr = &(tsdPtr->firstFilePtr); (*nextPtrPtr) != NULL;
nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
if ((*nextPtrPtr) == fsPtr) {
@@ -465,6 +563,7 @@ FileCloseProc(instanceData, interp)
break;
}
}
+#endif /* DEPRECATED */
ckfree((char *) fsPtr);
return errorCode;
}
@@ -491,18 +590,75 @@ FileCloseProc(instanceData, interp)
static int
FileSeekProc(instanceData, offset, mode, errorCodePtr)
- ClientData instanceData; /* File state. */
- long offset; /* Offset to seek to. */
- int mode; /* Relative to where
- * should we seek? Can be
- * one of SEEK_START,
- * SEEK_SET or SEEK_END. */
- int *errorCodePtr; /* To store error code. */
+ ClientData instanceData; /* File state. */
+ long offset; /* Offset to seek to. */
+ int mode; /* Relative to where should we seek? Can be
+ * one of SEEK_START, SEEK_SET or SEEK_END. */
+ int *errorCodePtr; /* To store error code. */
+{
+ FileState *fsPtr = (FileState *) instanceData;
+ Tcl_WideInt oldLoc, newLoc;
+
+ /*
+ * Save our current place in case we need to roll-back the seek.
+ */
+ oldLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) 0, SEEK_CUR);
+ if (oldLoc == Tcl_LongAsWide(-1)) {
+ /*
+ * Bad things are happening. Error out...
+ */
+ *errorCodePtr = errno;
+ return -1;
+ }
+
+ newLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) offset, mode);
+
+ /*
+ * Check for expressability in our return type, and roll-back otherwise.
+ */
+ if (newLoc > Tcl_LongAsWide(INT_MAX)) {
+ *errorCodePtr = EOVERFLOW;
+ TclOSseek(fsPtr->fd, (Tcl_SeekOffset) oldLoc, SEEK_SET);
+ return -1;
+ } else {
+ *errorCodePtr = (newLoc == Tcl_LongAsWide(-1)) ? errno : 0;
+ }
+ return (int) Tcl_WideAsLong(newLoc);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileWideSeekProc --
+ *
+ * This procedure is called by the generic IO level to move the
+ * access point in a file based channel, with offsets expressed
+ * as wide integers.
+ *
+ * Results:
+ * -1 if failed, the new position if successful. An output
+ * argument contains the POSIX error code if an error occurred,
+ * or zero.
+ *
+ * Side effects:
+ * Moves the location at which the channel will be accessed in
+ * future operations.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_WideInt
+FileWideSeekProc(instanceData, offset, mode, errorCodePtr)
+ ClientData instanceData; /* File state. */
+ Tcl_WideInt offset; /* Offset to seek to. */
+ int mode; /* Relative to where should we seek? Can be
+ * one of SEEK_START, SEEK_CUR or SEEK_END. */
+ int *errorCodePtr; /* To store error code. */
{
FileState *fsPtr = (FileState *) instanceData;
- int newLoc;
+ Tcl_WideInt newLoc;
- newLoc = lseek(fsPtr->fd, (off_t) offset, mode);
+ newLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) offset, mode);
*errorCodePtr = (newLoc == -1) ? errno : 0;
return newLoc;
@@ -529,8 +685,8 @@ static void
FileWatchProc(instanceData, mask)
ClientData instanceData; /* The file state. */
int mask; /* Events of interest; an OR-ed
- * combination of TCL_READABLE,
- * TCL_WRITABLE and TCL_EXCEPTION. */
+ * combination of TCL_READABLE,
+ * TCL_WRITABLE and TCL_EXCEPTION. */
{
FileState *fsPtr = (FileState *) instanceData;
@@ -598,26 +754,116 @@ FileGetHandleProc(instanceData, direction, handlePtr)
* 0 if successful, errno if failed.
*
* Side effects:
- * Restores the settings and closes the device of the channel.
+ * Closes the device of the channel.
*
*----------------------------------------------------------------------
*/
-
static int
TtyCloseProc(instanceData, interp)
ClientData instanceData; /* Tty state. */
Tcl_Interp *interp; /* For error reporting - unused. */
{
- TtyState *ttyPtr;
-
- ttyPtr = (TtyState *) instanceData;
- SETIOSTATE(ttyPtr->fs.fd, &ttyPtr->savedState);
+#if BAD_TIP35_FLUSH
+ TtyState *ttyPtr = (TtyState *) instanceData;
+#endif /* BAD_TIP35_FLUSH */
+#ifdef TTYFLUSH
+ TTYFLUSH(ttyPtr->fs.fd);
+#endif /* TTYFLUSH */
+#if 0
+ /*
+ * TIP#35 agreed to remove the unsave so that TCL could be used as a
+ * simple stty.
+ * It would be cleaner to remove all the stuff related to
+ * TtyState.stateUpdated
+ * TtyState.savedState
+ * Then the structure TtyState would be the same as FileState.
+ * IMO this cleanup could better be done for the final 8.4 release
+ * after nobody complained about the missing unsave. -- schroedter
+ */
+ if (ttyPtr->stateUpdated) {
+ SETIOSTATE(ttyPtr->fs.fd, &ttyPtr->savedState);
+ }
+#endif
return FileCloseProc(instanceData, interp);
}
/*
*----------------------------------------------------------------------
*
+ * TtyOutputProc--
+ *
+ * This procedure is invoked from the generic IO level to write
+ * output to a TTY channel.
+ *
+ * Results:
+ * The number of bytes written is returned or -1 on error. An
+ * output argument contains a POSIX error code if an error occurred,
+ * or zero.
+ *
+ * Side effects:
+ * Writes output on the output device of the channel
+ * if the channel is not designated to be closed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#if BAD_TIP35_FLUSH
+static int
+TtyOutputProc(instanceData, buf, toWrite, errorCodePtr)
+ ClientData instanceData; /* File state. */
+ CONST char *buf; /* The data buffer. */
+ int toWrite; /* How many bytes to write? */
+ int *errorCodePtr; /* Where to store error code. */
+{
+ if (TclInExit()) {
+ /*
+ * Do not write data during Tcl exit.
+ * Serial port may block preventing Tcl from exit.
+ */
+ return toWrite;
+ } else {
+ return FileOutputProc(instanceData, buf, toWrite, errorCodePtr);
+ }
+}
+#endif /* BAD_TIP35_FLUSH */
+
+#ifdef USE_TERMIOS
+/*
+ *----------------------------------------------------------------------
+ *
+ * TtyModemStatusStr --
+ *
+ * Converts a RS232 modem status list of readable flags
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+TtyModemStatusStr(status, dsPtr)
+ int status; /* RS232 modem status */
+ Tcl_DString *dsPtr; /* Where to store string */
+{
+#ifdef TIOCM_CTS
+ Tcl_DStringAppendElement(dsPtr, "CTS");
+ Tcl_DStringAppendElement(dsPtr, (status & TIOCM_CTS) ? "1" : "0");
+#endif /* TIOCM_CTS */
+#ifdef TIOCM_DSR
+ Tcl_DStringAppendElement(dsPtr, "DSR");
+ Tcl_DStringAppendElement(dsPtr, (status & TIOCM_DSR) ? "1" : "0");
+#endif /* TIOCM_DSR */
+#ifdef TIOCM_RNG
+ Tcl_DStringAppendElement(dsPtr, "RING");
+ Tcl_DStringAppendElement(dsPtr, (status & TIOCM_RNG) ? "1" : "0");
+#endif /* TIOCM_RNG */
+#ifdef TIOCM_CD
+ Tcl_DStringAppendElement(dsPtr, "DCD");
+ Tcl_DStringAppendElement(dsPtr, (status & TIOCM_CD) ? "1" : "0");
+#endif /* TIOCM_CD */
+}
+#endif /* USE_TERMIOS */
+
+/*
+ *----------------------------------------------------------------------
+ *
* TtySetOptionProc --
*
* Sets an option on a channel.
@@ -628,7 +874,7 @@ TtyCloseProc(instanceData, interp)
*
* Side effects:
* May modify an option on a device.
- * Sets Error message if needed (by calling Tcl_BadChannelOption).
+ * Sets Error message if needed (by calling Tcl_BadChannelOption).
*
*----------------------------------------------------------------------
*/
@@ -637,15 +883,25 @@ static int
TtySetOptionProc(instanceData, interp, optionName, value)
ClientData instanceData; /* File state. */
Tcl_Interp *interp; /* For error reporting - can be NULL. */
- char *optionName; /* Which option to set? */
- char *value; /* New value for option. */
+ CONST char *optionName; /* Which option to set? */
+ CONST char *value; /* New value for option. */
{
FileState *fsPtr = (FileState *) instanceData;
- unsigned int len;
+ unsigned int len, vlen;
TtyAttrs tty;
+#ifdef USE_TERMIOS
+ int flag, control, argc;
+ CONST char **argv;
+ IOSTATE iostate;
+#endif /* USE_TERMIOS */
len = strlen(optionName);
- if ((len > 1) && (strncmp(optionName, "-mode", len) == 0)) {
+ vlen = strlen(value);
+
+ /*
+ * Option -mode baud,parity,databits,stopbits
+ */
+ if ((len > 2) && (strncmp(optionName, "-mode", len) == 0)) {
if (TtyParseMode(interp, value, &tty.baud, &tty.parity, &tty.data,
&tty.stop) != TCL_OK) {
return TCL_ERROR;
@@ -655,10 +911,161 @@ TtySetOptionProc(instanceData, interp, optionName, value)
*/
TtySetAttributes(fsPtr->fd, &tty);
+ ((TtyState *) fsPtr)->stateUpdated = 1;
+ return TCL_OK;
+ }
+
+#ifdef USE_TERMIOS
+
+ /*
+ * Option -handshake none|xonxoff|rtscts|dtrdsr
+ */
+ if ((len > 1) && (strncmp(optionName, "-handshake", len) == 0)) {
+ /*
+ * Reset all handshake options
+ * DTR and RTS are ON by default
+ */
+ GETIOSTATE(fsPtr->fd, &iostate);
+ iostate.c_iflag &= ~(IXON | IXOFF | IXANY);
+#ifdef CRTSCTS
+ iostate.c_cflag &= ~CRTSCTS;
+#endif /* CRTSCTS */
+ if (strncasecmp(value, "NONE", vlen) == 0) {
+ /* leave all handshake options disabled */
+ } else if (strncasecmp(value, "XONXOFF", vlen) == 0) {
+ iostate.c_iflag |= (IXON | IXOFF | IXANY);
+ } else if (strncasecmp(value, "RTSCTS", vlen) == 0) {
+#ifdef CRTSCTS
+ iostate.c_cflag |= CRTSCTS;
+#else /* !CRTSTS */
+ UNSUPPORTED_OPTION("-handshake RTSCTS");
+ return TCL_ERROR;
+#endif /* CRTSCTS */
+ } else if (strncasecmp(value, "DTRDSR", vlen) == 0) {
+ UNSUPPORTED_OPTION("-handshake DTRDSR");
+ return TCL_ERROR;
+ } else {
+ if (interp) {
+ Tcl_AppendResult(interp, "bad value for -handshake: ",
+ "must be one of xonxoff, rtscts, dtrdsr or none",
+ (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+ SETIOSTATE(fsPtr->fd, &iostate);
+ return TCL_OK;
+ }
+
+ /*
+ * Option -xchar {\x11 \x13}
+ */
+ if ((len > 1) && (strncmp(optionName, "-xchar", len) == 0)) {
+ GETIOSTATE(fsPtr->fd, &iostate);
+ if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ if (argc == 2) {
+ iostate.c_cc[VSTART] = argv[0][0];
+ iostate.c_cc[VSTOP] = argv[1][0];
+ } else {
+ if (interp) {
+ Tcl_AppendResult(interp,
+ "bad value for -xchar: should be a list of two elements",
+ (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+ SETIOSTATE(fsPtr->fd, &iostate);
+ return TCL_OK;
+ }
+
+ /*
+ * Option -timeout msec
+ */
+ if ((len > 2) && (strncmp(optionName, "-timeout", len) == 0)) {
+ int msec;
+
+ GETIOSTATE(fsPtr->fd, &iostate);
+ if (Tcl_GetInt(interp, value, &msec) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ iostate.c_cc[VMIN] = 0;
+ iostate.c_cc[VTIME] = (msec == 0) ? 0 : (msec < 100) ? 1 : (msec+50)/100;
+ SETIOSTATE(fsPtr->fd, &iostate);
+ return TCL_OK;
+ }
+
+ /*
+ * Option -ttycontrol {DTR 1 RTS 0 BREAK 0}
+ */
+ if ((len > 4) && (strncmp(optionName, "-ttycontrol", len) == 0)) {
+ if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ if ((argc % 2) == 1) {
+ if (interp) {
+ Tcl_AppendResult(interp,
+ "bad value for -ttycontrol: should be a list of",
+ "signal,value pairs", (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ GETCONTROL(fsPtr->fd, &control);
+ while (argc > 1) {
+ if (Tcl_GetBoolean(interp, argv[1], &flag) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ if (strncasecmp(argv[0], "DTR", strlen(argv[0])) == 0) {
+#ifdef TIOCM_DTR
+ if (flag) {
+ control |= TIOCM_DTR;
+ } else {
+ control &= ~TIOCM_DTR;
+ }
+#else /* !TIOCM_DTR */
+ UNSUPPORTED_OPTION("-ttycontrol DTR");
+ return TCL_ERROR;
+#endif /* TIOCM_DTR */
+ } else if (strncasecmp(argv[0], "RTS", strlen(argv[0])) == 0) {
+#ifdef TIOCM_RTS
+ if (flag) {
+ control |= TIOCM_RTS;
+ } else {
+ control &= ~TIOCM_RTS;
+ }
+#else /* !TIOCM_RTS*/
+ UNSUPPORTED_OPTION("-ttycontrol RTS");
+ return TCL_ERROR;
+#endif /* TIOCM_RTS*/
+ } else if (strncasecmp(argv[0], "BREAK", strlen(argv[0])) == 0) {
+#ifdef SETBREAK
+ SETBREAK(fsPtr->fd, flag);
+#else /* !SETBREAK */
+ UNSUPPORTED_OPTION("-ttycontrol BREAK");
+ return TCL_ERROR;
+#endif /* SETBREAK */
+ } else {
+ if (interp) {
+ Tcl_AppendResult(interp,
+ "bad signal for -ttycontrol: must be ",
+ "DTR, RTS or BREAK", (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+ argc -= 2, argv += 2;
+ } /* while (argc > 1) */
+
+ SETCONTROL(fsPtr->fd, &control);
return TCL_OK;
- } else {
- return Tcl_BadChannelOption(interp, optionName, "mode");
}
+
+ return Tcl_BadChannelOption(interp, optionName,
+ "mode handshake timeout ttycontrol xchar ");
+
+#else /* !USE_TERMIOS */
+ return Tcl_BadChannelOption(interp, optionName, "mode");
+#endif /* USE_TERMIOS */
}
/*
@@ -678,7 +1085,7 @@ TtySetOptionProc(instanceData, interp, optionName, value)
* Side effects:
* The string returned by this function is in static storage and
* may be reused at any time subsequent to the call.
- * Sets Error message if needed (by calling Tcl_BadChannelOption).
+ * Sets Error message if needed (by calling Tcl_BadChannelOption).
*
*----------------------------------------------------------------------
*/
@@ -687,28 +1094,98 @@ static int
TtyGetOptionProc(instanceData, interp, optionName, dsPtr)
ClientData instanceData; /* File state. */
Tcl_Interp *interp; /* For error reporting - can be NULL. */
- char *optionName; /* Option to get. */
+ CONST char *optionName; /* Option to get. */
Tcl_DString *dsPtr; /* Where to store value(s). */
{
FileState *fsPtr = (FileState *) instanceData;
unsigned int len;
char buf[3 * TCL_INTEGER_SPACE + 16];
TtyAttrs tty;
+ int valid = 0; /* flag if valid option parsed */
if (optionName == NULL) {
- Tcl_DStringAppendElement(dsPtr, "-mode");
len = 0;
} else {
len = strlen(optionName);
}
- if ((len == 0) ||
- ((len > 1) && (strncmp(optionName, "-mode", len) == 0))) {
+ if (len == 0) {
+ Tcl_DStringAppendElement(dsPtr, "-mode");
+ }
+ if (len==0 || (len>2 && strncmp(optionName, "-mode", len)==0)) {
+ valid = 1;
TtyGetAttributes(fsPtr->fd, &tty);
sprintf(buf, "%d,%c,%d,%d", tty.baud, tty.parity, tty.data, tty.stop);
Tcl_DStringAppendElement(dsPtr, buf);
+ }
+
+#ifdef USE_TERMIOS
+ /*
+ * get option -xchar
+ */
+ if (len == 0) {
+ Tcl_DStringAppendElement(dsPtr, "-xchar");
+ Tcl_DStringStartSublist(dsPtr);
+ }
+ if (len==0 || (len>1 && strncmp(optionName, "-xchar", len)==0)) {
+ IOSTATE iostate;
+ valid = 1;
+
+ GETIOSTATE(fsPtr->fd, &iostate);
+ sprintf(buf, "%c", iostate.c_cc[VSTART]);
+ Tcl_DStringAppendElement(dsPtr, buf);
+ sprintf(buf, "%c", iostate.c_cc[VSTOP]);
+ Tcl_DStringAppendElement(dsPtr, buf);
+ }
+ if (len == 0) {
+ Tcl_DStringEndSublist(dsPtr);
+ }
+
+ /*
+ * get option -queue
+ * option is readonly and returned by [fconfigure chan -queue]
+ * but not returned by unnamed [fconfigure chan]
+ */
+ if ((len > 1) && (strncmp(optionName, "-queue", len) == 0)) {
+ int inQueue=0, outQueue=0;
+ int inBuffered, outBuffered;
+ valid = 1;
+#ifdef GETREADQUEUE
+ GETREADQUEUE(fsPtr->fd, inQueue);
+#endif /* GETREADQUEUE */
+#ifdef GETWRITEQUEUE
+ GETWRITEQUEUE(fsPtr->fd, outQueue);
+#endif /* GETWRITEQUEUE */
+ inBuffered = Tcl_InputBuffered(fsPtr->channel);
+ outBuffered = Tcl_OutputBuffered(fsPtr->channel);
+
+ sprintf(buf, "%d", inBuffered+inQueue);
+ Tcl_DStringAppendElement(dsPtr, buf);
+ sprintf(buf, "%d", outBuffered+outQueue);
+ Tcl_DStringAppendElement(dsPtr, buf);
+ }
+
+ /*
+ * get option -ttystatus
+ * option is readonly and returned by [fconfigure chan -ttystatus]
+ * but not returned by unnamed [fconfigure chan]
+ */
+ if ((len > 4) && (strncmp(optionName, "-ttystatus", len) == 0)) {
+ int status;
+ valid = 1;
+ GETCONTROL(fsPtr->fd, &status);
+ TtyModemStatusStr(status, dsPtr);
+ }
+#endif /* USE_TERMIOS */
+
+ if (valid) {
return TCL_OK;
} else {
- return Tcl_BadChannelOption(interp, optionName, "mode");
+ return Tcl_BadChannelOption(interp, optionName,
+#ifdef USE_TERMIOS
+ "mode queue ttystatus xchar");
+#else /* !USE_TERMIOS */
+ "mode");
+#endif /* USE_TERMIOS */
}
}
@@ -716,13 +1193,13 @@ TtyGetOptionProc(instanceData, interp, optionName, dsPtr)
#ifdef B4800
# if (B4800 == 4800)
# define DIRECT_BAUD
-# endif
-#endif
+# endif /* B4800 == 4800 */
+#endif /* B4800 */
#ifdef DIRECT_BAUD
# define TtyGetSpeed(baud) ((unsigned) (baud))
# define TtyGetBaud(speed) ((int) (speed))
-#else
+#else /* !DIRECT_BAUD */
static struct {int baud; unsigned long speed;} speeds[] = {
#ifdef B0
@@ -838,10 +1315,10 @@ TtyGetSpeed(baud)
int baud; /* The baud rate to look up. */
{
int bestIdx, bestDiff, i, diff;
-
+
bestIdx = 0;
bestDiff = 1000000;
-
+
/*
* If the baud rate does not correspond to one of the known mask values,
* choose the mask value whose baud rate is closest to the specified
@@ -883,7 +1360,7 @@ TtyGetBaud(speed)
unsigned long speed; /* Speed mask value to look up. */
{
int i;
-
+
for (i = 0; speeds[i].baud >= 0; i++) {
if (speeds[i].speed == speed) {
return speeds[i].baud;
@@ -892,7 +1369,7 @@ TtyGetBaud(speed)
return 0;
}
-#endif /* !DIRECT_BAUD */
+#endif /* !DIRECT_BAUD */
/*
@@ -910,7 +1387,7 @@ TtyGetBaud(speed)
*
*---------------------------------------------------------------------------
*/
-
+
static void
TtyGetAttributes(fd, ttyPtr)
int fd; /* Open file descriptor for serial port to
@@ -925,27 +1402,27 @@ TtyGetAttributes(fd, ttyPtr)
#ifdef USE_TERMIOS
baud = TtyGetBaud(cfgetospeed(&iostate));
-
+
parity = 'n';
#ifdef PAREXT
switch ((int) (iostate.c_cflag & (PARENB | PARODD | PAREXT))) {
case PARENB : parity = 'e'; break;
- case PARENB | PARODD : parity = 'o'; break;
+ case PARENB | PARODD : parity = 'o'; break;
case PARENB | PAREXT : parity = 's'; break;
- case PARENB | PARODD | PAREXT : parity = 'm'; break;
+ case PARENB | PARODD | PAREXT : parity = 'm'; break;
}
-#else /* !PAREXT */
+#else /* !PAREXT */
switch ((int) (iostate.c_cflag & (PARENB | PARODD))) {
case PARENB : parity = 'e'; break;
- case PARENB | PARODD : parity = 'o'; break;
+ case PARENB | PARODD : parity = 'o'; break;
}
-#endif /* !PAREXT */
+#endif /* !PAREXT */
data = iostate.c_cflag & CSIZE;
data = (data == CS5) ? 5 : (data == CS6) ? 6 : (data == CS7) ? 7 : 8;
stop = (iostate.c_cflag & CSTOPB) ? 2 : 1;
-#endif /* USE_TERMIOS */
+#endif /* USE_TERMIOS */
#ifdef USE_TERMIO
baud = TtyGetBaud(iostate.c_cflag & CBAUD);
@@ -953,16 +1430,16 @@ TtyGetAttributes(fd, ttyPtr)
parity = 'n';
switch (iostate.c_cflag & (PARENB | PARODD | PAREXT)) {
case PARENB : parity = 'e'; break;
- case PARENB | PARODD : parity = 'o'; break;
+ case PARENB | PARODD : parity = 'o'; break;
case PARENB | PAREXT : parity = 's'; break;
- case PARENB | PARODD | PAREXT : parity = 'm'; break;
+ case PARENB | PARODD | PAREXT : parity = 'm'; break;
}
data = iostate.c_cflag & CSIZE;
data = (data == CS5) ? 5 : (data == CS6) ? 6 : (data == CS7) ? 7 : 8;
stop = (iostate.c_cflag & CSTOPB) ? 2 : 1;
-#endif /* USE_TERMIO */
+#endif /* USE_TERMIO */
#ifdef USE_SGTTY
baud = TtyGetBaud(iostate.sg_ospeed);
@@ -977,7 +1454,7 @@ TtyGetAttributes(fd, ttyPtr)
data = (iostate.sg_flags & (EVENP | ODDP)) ? 7 : 8;
stop = 1;
-#endif /* USE_SGTTY */
+#endif /* USE_SGTTY */
ttyPtr->baud = baud;
ttyPtr->parity = parity;
@@ -1000,7 +1477,7 @@ TtyGetAttributes(fd, ttyPtr)
*
*---------------------------------------------------------------------------
*/
-
+
static void
TtySetAttributes(fd, ttyPtr)
int fd; /* Open file descriptor for serial port to
@@ -1026,7 +1503,7 @@ TtySetAttributes(fd, ttyPtr)
if ((parity == 'm') || (parity == 's')) {
flag |= PAREXT;
}
-#endif
+#endif /* PAREXT */
if ((parity == 'm') || (parity == 'o')) {
flag |= PARODD;
}
@@ -1109,7 +1586,7 @@ TtySetAttributes(fd, ttyPtr)
*
*---------------------------------------------------------------------------
*/
-
+
static int
TtyParseMode(interp, mode, speedPtr, parityPtr, dataPtr, stopPtr)
Tcl_Interp *interp; /* If non-NULL, interp for error return. */
@@ -1142,7 +1619,7 @@ TtyParseMode(interp, mode, speedPtr, parityPtr, dataPtr, stopPtr)
strchr("noems", parity) == NULL
#else
strchr("noe", parity) == NULL
-#endif
+#endif /* PAREXT|USE_TERMIO */
) {
if (interp != NULL) {
Tcl_AppendResult(interp, bad,
@@ -1150,7 +1627,7 @@ TtyParseMode(interp, mode, speedPtr, parityPtr, dataPtr, stopPtr)
" parity: should be n, o, e, m, or s",
#else
" parity: should be n, o, or e",
-#endif
+#endif /* PAREXT|USE_TERMIO */
NULL);
}
return TCL_ERROR;
@@ -1180,54 +1657,70 @@ TtyParseMode(interp, mode, speedPtr, parityPtr, dataPtr, stopPtr)
* Given file descriptor that refers to a serial port,
* initialize the serial port to a set of sane values so that
* Tcl can talk to a device located on the serial port.
+ * Note that no initialization happens if the initialize flag
+ * is not set; this is necessary for the correct handling of
+ * UNIX console TTYs at startup.
*
* Results:
- * None.
+ * A pointer to a FileState suitable for use with Tcl_CreateChannel
+ * and the ttyChannelType structure.
*
* Side effects:
* Serial device initialized to non-blocking raw mode, similar to
- * sockets. All other modes can be simulated on top of this in Tcl.
+ * sockets (if initialize flag is non-zero.) All other modes can
+ * be simulated on top of this in Tcl.
*
*---------------------------------------------------------------------------
*/
static FileState *
-TtyInit(fd)
+TtyInit(fd, initialize)
int fd; /* Open file descriptor for serial port to
* be initialized. */
+ int initialize;
{
- IOSTATE iostate;
TtyState *ttyPtr;
ttyPtr = (TtyState *) ckalloc((unsigned) sizeof(TtyState));
GETIOSTATE(fd, &ttyPtr->savedState);
-
- iostate = ttyPtr->savedState;
-
-#ifdef USE_TERMIOS
- iostate.c_iflag = IGNBRK;
- iostate.c_oflag = 0;
- iostate.c_lflag = 0;
- iostate.c_cflag |= CREAD;
- iostate.c_cc[VMIN] = 1;
- iostate.c_cc[VTIME] = 0;
-#endif /* USE_TERMIOS */
-
-#ifdef USE_TERMIO
- iostate.c_iflag = IGNBRK;
- iostate.c_oflag = 0;
- iostate.c_lflag = 0;
- iostate.c_cflag |= CREAD;
- iostate.c_cc[VMIN] = 1;
- iostate.c_cc[VTIME] = 0;
-#endif /* USE_TERMIO */
+ ttyPtr->stateUpdated = 0;
+ if (initialize) {
+ IOSTATE iostate = ttyPtr->savedState;
+
+#if defined(USE_TERMIOS) || defined(USE_TERMIO)
+ if (iostate.c_iflag != IGNBRK ||
+ iostate.c_oflag != 0 ||
+ iostate.c_lflag != 0 ||
+ iostate.c_cflag & CREAD ||
+ iostate.c_cc[VMIN] != 1 ||
+ iostate.c_cc[VTIME] != 0) {
+ ttyPtr->stateUpdated = 1;
+ }
+ iostate.c_iflag = IGNBRK;
+ iostate.c_oflag = 0;
+ iostate.c_lflag = 0;
+ iostate.c_cflag |= CREAD;
+ iostate.c_cc[VMIN] = 1;
+ iostate.c_cc[VTIME] = 0;
+#endif /* USE_TERMIOS|USE_TERMIO */
#ifdef USE_SGTTY
- iostate.sg_flags &= (EVENP | ODDP);
- iostate.sg_flags |= RAW;
+ if ((iostate.sg_flags & (EVENP | ODDP)) ||
+ !(iostate.sg_flags & RAW)) {
+ ttyPtr->stateUpdated = 1;
+ }
+ iostate.sg_flags &= (EVENP | ODDP);
+ iostate.sg_flags |= RAW;
#endif /* USE_SGTTY */
- SETIOSTATE(fd, &iostate);
+ /*
+ * Only update if we're changing anything to avoid possible
+ * blocking.
+ */
+ if (ttyPtr->stateUpdated) {
+ SETIOSTATE(fd, &iostate);
+ }
+ }
return &ttyPtr->fs;
}
@@ -1253,28 +1746,27 @@ TtyInit(fd)
*/
Tcl_Channel
-TclpOpenFileChannel(interp, fileName, modeString, permissions)
+TclpOpenFileChannel(interp, pathPtr, mode, permissions)
Tcl_Interp *interp; /* Interpreter for error reporting;
- * can be NULL. */
- char *fileName; /* Name of file to open. */
- char *modeString; /* A list of POSIX open modes or
- * a string such as "rw". */
+ * 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? */
+ * file, with what modes to create
+ * it? */
{
- int fd, seekFlag, mode, channelPermissions;
+ int fd, channelPermissions;
FileState *fsPtr;
- char *native, *translation;
+ CONST char *native, *translation;
char channelName[16 + TCL_INTEGER_SPACE];
- Tcl_DString ds, buffer;
Tcl_ChannelType *channelTypePtr;
+#ifdef SUPPORTS_TTY
+ int ctl_tty;
+#endif /* SUPPORTS_TTY */
+#ifdef DEPRECATED
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+#endif /* DEPRECATED */
- mode = TclGetOpenMode(interp, modeString, &seekFlag);
- if (mode == -1) {
- return NULL;
- }
switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
case O_RDONLY:
channelPermissions = TCL_READABLE;
@@ -1286,41 +1778,42 @@ TclpOpenFileChannel(interp, fileName, modeString, permissions)
channelPermissions = (TCL_READABLE | TCL_WRITABLE);
break;
default:
- /*
- * This may occurr if modeString was "", for example.
- */
+ /*
+ * This may occurr if modeString was "", for example.
+ */
panic("TclpOpenFileChannel: invalid mode value");
return NULL;
}
- native = Tcl_TranslateFileName(interp, fileName, &buffer);
+ native = Tcl_FSGetNativePath(pathPtr);
if (native == NULL) {
return NULL;
}
- native = Tcl_UtfToExternalDString(NULL, native, -1, &ds);
- fd = open(native, mode, permissions); /* INTL: Native. */
- Tcl_DStringFree(&ds);
- Tcl_DStringFree(&buffer);
+ fd = TclOSopen(native, mode, permissions);
+#ifdef SUPPORTS_TTY
+ ctl_tty = (strcmp (native, "/dev/tty") == 0);
+#endif /* SUPPORTS_TTY */
if (fd < 0) {
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp, "couldn't open \"", fileName, "\": ",
- Tcl_PosixError(interp), (char *) NULL);
- }
- return NULL;
+ if (interp != (Tcl_Interp *) NULL) {
+ Tcl_AppendResult(interp, "couldn't open \"",
+ Tcl_GetString(pathPtr), "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
+ }
+ return NULL;
}
/*
* Set close-on-exec flag on the fd so that child processes will not
* inherit this fd.
*/
-
+
fcntl(fd, F_SETFD, FD_CLOEXEC);
-
+
sprintf(channelName, "file%d", fd);
-
+
#ifdef SUPPORTS_TTY
- if (isatty(fd)) {
+ if (!ctl_tty && isatty(fd)) {
/*
* Initialize the serial port to a set of sane parameters.
* Especially important if the remote device is set to echo and
@@ -1328,10 +1821,10 @@ TclpOpenFileChannel(interp, fileName, modeString, permissions)
* were sent to the serial port, the remote device would echo it,
* then the serial driver would echo it back to the device, etc.
*/
-
+
translation = "auto crlf";
channelTypePtr = &ttyChannelType;
- fsPtr = TtyInit(fd);
+ fsPtr = TtyInit(fd, 1);
} else
#endif /* SUPPORTS_TTY */
{
@@ -1340,25 +1833,16 @@ TclpOpenFileChannel(interp, fileName, modeString, permissions)
fsPtr = (FileState *) ckalloc((unsigned) sizeof(FileState));
}
+#ifdef DEPRECATED
fsPtr->nextPtr = tsdPtr->firstFilePtr;
tsdPtr->firstFilePtr = fsPtr;
+#endif /* DEPRECATED */
fsPtr->validMask = channelPermissions | TCL_EXCEPTION;
fsPtr->fd = fd;
-
+
fsPtr->channel = Tcl_CreateChannel(channelTypePtr, channelName,
(ClientData) fsPtr, channelPermissions);
- if (seekFlag) {
- if (Tcl_Seek(fsPtr->channel, 0, SEEK_END) < 0) {
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp, "couldn't seek to end of file on \"",
- channelName, "\": ", Tcl_PosixError(interp), NULL);
- }
- Tcl_Close(NULL, fsPtr->channel);
- return NULL;
- }
- }
-
if (translation != NULL) {
/*
* Gotcha. Most modems need a "\r" at the end of the command
@@ -1367,7 +1851,7 @@ TclpOpenFileChannel(interp, fileName, modeString, permissions)
* command. So, by default, newlines are translated to "\r\n" on
* output to avoid "bug" reports that the serial port isn't working.
*/
-
+
if (Tcl_SetChannelOption(interp, fsPtr->channel, "-translation",
translation) != TCL_OK) {
Tcl_Close(NULL, fsPtr->channel);
@@ -1398,40 +1882,65 @@ Tcl_Channel
Tcl_MakeFileChannel(handle, mode)
ClientData handle; /* OS level handle. */
int mode; /* ORed combination of TCL_READABLE and
- * TCL_WRITABLE to indicate file mode. */
+ * TCL_WRITABLE to indicate file mode. */
{
FileState *fsPtr;
char channelName[16 + TCL_INTEGER_SPACE];
int fd = (int) handle;
+ Tcl_ChannelType *channelTypePtr;
+#ifdef DEPRECATED
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+#endif /* DEPRECATED */
+ int socketType = 0;
+ socklen_t argLength = sizeof(int);
if (mode == 0) {
- return NULL;
+ return NULL;
}
- sprintf(channelName, "file%d", fd);
/*
* Look to see if a channel with this fd and the same mode already exists.
* If the fd is used, but the mode doesn't match, return NULL.
*/
-
+
+#ifdef DEPRECATED
for (fsPtr = tsdPtr->firstFilePtr; fsPtr != NULL; fsPtr = fsPtr->nextPtr) {
if (fsPtr->fd == fd) {
return ((mode|TCL_EXCEPTION) == fsPtr->validMask) ?
fsPtr->channel : NULL;
}
}
+#endif /* DEPRECATED */
- fsPtr = (FileState *) ckalloc((unsigned) sizeof(FileState));
+#ifdef SUPPORTS_TTY
+ if (isatty(fd)) {
+ fsPtr = TtyInit(fd, 0);
+ channelTypePtr = &ttyChannelType;
+ sprintf(channelName, "serial%d", fd);
+ } else
+#endif /* SUPPORTS_TTY */
+ if (getsockopt(fd, SOL_SOCKET, SO_TYPE, (VOID *)&socketType,
+ &argLength) == 0 && socketType == SOCK_STREAM) {
+ /*
+ * The mode parameter gets lost here, unfortunately.
+ */
+ return Tcl_MakeTcpClientChannel((ClientData) fd);
+ } else {
+ channelTypePtr = &fileChannelType;
+ fsPtr = (FileState *) ckalloc((unsigned) sizeof(FileState));
+ sprintf(channelName, "file%d", fd);
+ }
+
+#ifdef DEPRECATED
fsPtr->nextPtr = tsdPtr->firstFilePtr;
tsdPtr->firstFilePtr = fsPtr;
-
+#endif /* DEPRECATED */
fsPtr->fd = fd;
fsPtr->validMask = mode | TCL_EXCEPTION;
- fsPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName,
- (ClientData) fsPtr, mode);
-
+ fsPtr->channel = Tcl_CreateChannel(channelTypePtr, channelName,
+ (ClientData) fsPtr, mode);
+
return fsPtr->channel;
}
@@ -1457,41 +1966,39 @@ static int
TcpBlockModeProc(instanceData, mode)
ClientData instanceData; /* Socket state. */
int mode; /* The mode to set. Can be one of
- * TCL_MODE_BLOCKING or
- * TCL_MODE_NONBLOCKING. */
+ * TCL_MODE_BLOCKING or
+ * TCL_MODE_NONBLOCKING. */
{
TcpState *statePtr = (TcpState *) instanceData;
int setting;
-
-#ifndef USE_FIONBIO
+
+#ifndef USE_FIONBIO
setting = fcntl(statePtr->fd, F_GETFL);
if (mode == TCL_MODE_BLOCKING) {
- statePtr->flags &= (~(TCP_ASYNC_SOCKET));
- setting &= (~(O_NONBLOCK));
+ statePtr->flags &= (~(TCP_ASYNC_SOCKET));
+ setting &= (~(O_NONBLOCK));
} else {
- statePtr->flags |= TCP_ASYNC_SOCKET;
- setting |= O_NONBLOCK;
+ statePtr->flags |= TCP_ASYNC_SOCKET;
+ setting |= O_NONBLOCK;
}
if (fcntl(statePtr->fd, F_SETFL, setting) < 0) {
- return errno;
+ return errno;
}
-#endif
-
-#ifdef USE_FIONBIO
+#else /* USE_FIONBIO */
if (mode == TCL_MODE_BLOCKING) {
- statePtr->flags &= (~(TCP_ASYNC_SOCKET));
- setting = 0;
- if (ioctl(statePtr->fd, (int) FIONBIO, &setting) == -1) {
- return errno;
- }
+ statePtr->flags &= (~(TCP_ASYNC_SOCKET));
+ setting = 0;
+ if (ioctl(statePtr->fd, (int) FIONBIO, &setting) == -1) {
+ return errno;
+ }
} else {
- statePtr->flags |= TCP_ASYNC_SOCKET;
- setting = 1;
- if (ioctl(statePtr->fd, (int) FIONBIO, &setting) == -1) {
- return errno;
- }
+ statePtr->flags |= TCP_ASYNC_SOCKET;
+ setting = 1;
+ if (ioctl(statePtr->fd, (int) FIONBIO, &setting) == -1) {
+ return errno;
+ }
}
-#endif
+#endif /* !USE_FIONBIO */
return 0;
}
@@ -1526,37 +2033,35 @@ WaitForConnect(statePtr, errorCodePtr)
* If an asynchronous connect is in progress, attempt to wait for it
* to complete before reading.
*/
-
+
if (statePtr->flags & TCP_ASYNC_CONNECT) {
- if (statePtr->flags & TCP_ASYNC_SOCKET) {
- timeOut = 0;
- } else {
- timeOut = -1;
- }
- errno = 0;
- state = TclUnixWaitForFile(statePtr->fd,
+ if (statePtr->flags & TCP_ASYNC_SOCKET) {
+ timeOut = 0;
+ } else {
+ timeOut = -1;
+ }
+ errno = 0;
+ state = TclUnixWaitForFile(statePtr->fd,
TCL_WRITABLE | TCL_EXCEPTION, timeOut);
- if (!(statePtr->flags & TCP_ASYNC_SOCKET)) {
-#ifndef USE_FIONBIO
- flags = fcntl(statePtr->fd, F_GETFL);
- flags &= (~(O_NONBLOCK));
- (void) fcntl(statePtr->fd, F_SETFL, flags);
-#endif
-
-#ifdef USE_FIONBIO
- flags = 0;
- (void) ioctl(statePtr->fd, FIONBIO, &flags);
-#endif
- }
- if (state & TCL_EXCEPTION) {
- return -1;
- }
- if (state & TCL_WRITABLE) {
- statePtr->flags &= (~(TCP_ASYNC_CONNECT));
- } else if (timeOut == 0) {
- *errorCodePtr = errno = EWOULDBLOCK;
- return -1;
- }
+ if (!(statePtr->flags & TCP_ASYNC_SOCKET)) {
+#ifndef USE_FIONBIO
+ flags = fcntl(statePtr->fd, F_GETFL);
+ flags &= (~(O_NONBLOCK));
+ (void) fcntl(statePtr->fd, F_SETFL, flags);
+#else /* USE_FIONBIO */
+ flags = 0;
+ (void) ioctl(statePtr->fd, FIONBIO, &flags);
+#endif /* !USE_FIONBIO */
+ }
+ if (state & TCL_EXCEPTION) {
+ return -1;
+ }
+ if (state & TCL_WRITABLE) {
+ statePtr->flags &= (~(TCP_ASYNC_CONNECT));
+ } else if (timeOut == 0) {
+ *errorCodePtr = errno = EWOULDBLOCK;
+ return -1;
+ }
}
return 0;
}
@@ -1589,7 +2094,7 @@ TcpInputProc(instanceData, buf, bufSize, errorCodePtr)
ClientData instanceData; /* Socket state. */
char *buf; /* Where to store data read. */
int bufSize; /* How much space is available
- * in the buffer? */
+ * in the buffer? */
int *errorCodePtr; /* Where to store error code. */
{
TcpState *statePtr = (TcpState *) instanceData;
@@ -1598,19 +2103,18 @@ TcpInputProc(instanceData, buf, bufSize, errorCodePtr)
*errorCodePtr = 0;
state = WaitForConnect(statePtr, errorCodePtr);
if (state != 0) {
- return -1;
+ return -1;
}
bytesRead = recv(statePtr->fd, buf, (size_t) bufSize, 0);
if (bytesRead > -1) {
- return bytesRead;
+ return bytesRead;
}
if (errno == ECONNRESET) {
+ /*
+ * Turn ECONNRESET into a soft EOF condition.
+ */
- /*
- * Turn ECONNRESET into a soft EOF condition.
- */
-
- return 0;
+ return 0;
}
*errorCodePtr = errno;
return -1;
@@ -1640,7 +2144,7 @@ TcpInputProc(instanceData, buf, bufSize, errorCodePtr)
static int
TcpOutputProc(instanceData, buf, toWrite, errorCodePtr)
ClientData instanceData; /* Socket state. */
- char *buf; /* The data buffer. */
+ CONST char *buf; /* The data buffer. */
int toWrite; /* How many bytes to write? */
int *errorCodePtr; /* Where to store error code. */
{
@@ -1651,11 +2155,11 @@ TcpOutputProc(instanceData, buf, toWrite, errorCodePtr)
*errorCodePtr = 0;
state = WaitForConnect(statePtr, errorCodePtr);
if (state != 0) {
- return -1;
+ return -1;
}
written = send(statePtr->fd, buf, (size_t) toWrite, 0);
if (written > -1) {
- return written;
+ return written;
}
*errorCodePtr = errno;
return -1;
@@ -1719,7 +2223,7 @@ TcpCloseProc(instanceData, interp)
*
* Results:
* A standard Tcl result. The value of the specified option or a
- * list of all options and their values is returned in the
+ * list of all options and their values is returned in the
* supplied DString. Sets Error message if needed.
*
* Side effects:
@@ -1730,33 +2234,32 @@ TcpCloseProc(instanceData, interp)
static int
TcpGetOptionProc(instanceData, interp, optionName, dsPtr)
- ClientData instanceData; /* Socket state. */
- Tcl_Interp *interp; /* For error reporting - can be NULL. */
- char *optionName; /* Name of the option to
+ ClientData instanceData; /* Socket state. */
+ Tcl_Interp *interp; /* For error reporting - can be NULL. */
+ CONST char *optionName; /* Name of the option to
* retrieve the value for, or
* NULL to get all options and
* their values. */
- Tcl_DString *dsPtr; /* Where to store the computed
+ Tcl_DString *dsPtr; /* Where to store the computed
* value; initialized by caller. */
{
TcpState *statePtr = (TcpState *) instanceData;
struct sockaddr_in sockname;
struct sockaddr_in peername;
struct hostent *hostEntPtr;
- int size = sizeof(struct sockaddr_in);
+ socklen_t size = sizeof(struct sockaddr_in);
size_t len = 0;
char buf[TCL_INTEGER_SPACE];
if (optionName != (char *) NULL) {
- len = strlen(optionName);
+ len = strlen(optionName);
}
if ((len > 1) && (optionName[1] == 'e') &&
(strncmp(optionName, "-error", len) == 0)) {
- int optlen;
+ socklen_t optlen = sizeof(int);
int err, ret;
-
- optlen = sizeof(int);
+
ret = getsockopt(statePtr->fd, SOL_SOCKET, SO_ERROR,
(char *)&err, &optlen);
if (ret < 0) {
@@ -1765,96 +2268,94 @@ TcpGetOptionProc(instanceData, interp, optionName, dsPtr)
if (err != 0) {
Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(err), -1);
}
- return TCL_OK;
+ return TCL_OK;
}
if ((len == 0) ||
- ((len > 1) && (optionName[1] == 'p') &&
- (strncmp(optionName, "-peername", len) == 0))) {
- if (getpeername(statePtr->fd, (struct sockaddr *) &peername,
+ ((len > 1) && (optionName[1] == 'p') &&
+ (strncmp(optionName, "-peername", len) == 0))) {
+ if (getpeername(statePtr->fd, (struct sockaddr *) &peername,
&size) >= 0) {
- if (len == 0) {
- Tcl_DStringAppendElement(dsPtr, "-peername");
- Tcl_DStringStartSublist(dsPtr);
- }
- Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr));
- hostEntPtr = gethostbyaddr( /* INTL: Native. */
+ if (len == 0) {
+ Tcl_DStringAppendElement(dsPtr, "-peername");
+ Tcl_DStringStartSublist(dsPtr);
+ }
+ Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr));
+ hostEntPtr = gethostbyaddr( /* INTL: Native. */
(char *) &peername.sin_addr,
sizeof(peername.sin_addr), AF_INET);
- if (hostEntPtr != NULL) {
+ if (hostEntPtr != NULL) {
Tcl_DString ds;
Tcl_ExternalToUtfDString(NULL, hostEntPtr->h_name, -1, &ds);
- Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds));
- } else {
- Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr));
- }
- TclFormatInt(buf, ntohs(peername.sin_port));
- Tcl_DStringAppendElement(dsPtr, buf);
- if (len == 0) {
- Tcl_DStringEndSublist(dsPtr);
- } else {
- return TCL_OK;
- }
- } else {
- /*
- * getpeername failed - but if we were asked for all the options
- * (len==0), don't flag an error at that point because it could
- * be an fconfigure request on a server socket. (which have
- * no peer). same must be done on win&mac.
- */
-
- if (len) {
- if (interp) {
- Tcl_AppendResult(interp, "can't get peername: ",
- Tcl_PosixError(interp),
- (char *) NULL);
- }
- return TCL_ERROR;
- }
- }
+ Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds));
+ } else {
+ Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr));
+ }
+ TclFormatInt(buf, ntohs(peername.sin_port));
+ Tcl_DStringAppendElement(dsPtr, buf);
+ if (len == 0) {
+ Tcl_DStringEndSublist(dsPtr);
+ } else {
+ return TCL_OK;
+ }
+ } else {
+ /*
+ * getpeername failed - but if we were asked for all the options
+ * (len==0), don't flag an error at that point because it could
+ * be an fconfigure request on a server socket. (which have
+ * no peer). same must be done on win&mac.
+ */
+
+ if (len) {
+ if (interp) {
+ Tcl_AppendResult(interp, "can't get peername: ",
+ Tcl_PosixError(interp), (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+ }
}
if ((len == 0) ||
- ((len > 1) && (optionName[1] == 's') &&
- (strncmp(optionName, "-sockname", len) == 0))) {
- if (getsockname(statePtr->fd, (struct sockaddr *) &sockname, &size)
- >= 0) {
- if (len == 0) {
- Tcl_DStringAppendElement(dsPtr, "-sockname");
- Tcl_DStringStartSublist(dsPtr);
- }
- Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr));
- hostEntPtr = gethostbyaddr( /* INTL: Native. */
+ ((len > 1) && (optionName[1] == 's') &&
+ (strncmp(optionName, "-sockname", len) == 0))) {
+ if (getsockname(statePtr->fd, (struct sockaddr *) &sockname,
+ &size) >= 0) {
+ if (len == 0) {
+ Tcl_DStringAppendElement(dsPtr, "-sockname");
+ Tcl_DStringStartSublist(dsPtr);
+ }
+ Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr));
+ hostEntPtr = gethostbyaddr( /* INTL: Native. */
(char *) &sockname.sin_addr,
- sizeof(sockname.sin_addr), AF_INET);
- if (hostEntPtr != (struct hostent *) NULL) {
+ sizeof(sockname.sin_addr), AF_INET);
+ if (hostEntPtr != (struct hostent *) NULL) {
Tcl_DString ds;
Tcl_ExternalToUtfDString(NULL, hostEntPtr->h_name, -1, &ds);
- Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds));
- } else {
- Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr));
- }
- TclFormatInt(buf, ntohs(sockname.sin_port));
- Tcl_DStringAppendElement(dsPtr, buf);
- if (len == 0) {
- Tcl_DStringEndSublist(dsPtr);
- } else {
- return TCL_OK;
- }
- } else {
+ Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds));
+ } else {
+ Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr));
+ }
+ TclFormatInt(buf, ntohs(sockname.sin_port));
+ Tcl_DStringAppendElement(dsPtr, buf);
+ if (len == 0) {
+ Tcl_DStringEndSublist(dsPtr);
+ } else {
+ return TCL_OK;
+ }
+ } else {
if (interp) {
Tcl_AppendResult(interp, "can't get sockname: ",
- Tcl_PosixError(interp),
- (char *) NULL);
+ Tcl_PosixError(interp), (char *) NULL);
}
return TCL_ERROR;
}
}
if (len > 0) {
- return Tcl_BadChannelOption(interp, optionName, "peername sockname");
+ return Tcl_BadChannelOption(interp, optionName, "peername sockname");
}
return TCL_OK;
@@ -1881,8 +2382,8 @@ static void
TcpWatchProc(instanceData, mask)
ClientData instanceData; /* The socket state. */
int mask; /* Events of interest; an OR-ed
- * combination of TCL_READABLE,
- * TCL_WRITABLE and TCL_EXCEPTION. */
+ * combination of TCL_READABLE,
+ * TCL_WRITABLE and TCL_EXCEPTION. */
{
TcpState *statePtr = (TcpState *) instanceData;
@@ -1956,15 +2457,15 @@ static TcpState *
CreateSocket(interp, port, host, server, myaddr, myport, async)
Tcl_Interp *interp; /* For error reporting; can be NULL. */
int port; /* Port number to open. */
- char *host; /* Name of host on which to open port.
+ CONST char *host; /* Name of host on which to open port.
* NULL implies INADDR_ANY */
int server; /* 1 if socket should be a server socket,
* else 0 for a client socket. */
- char *myaddr; /* Optional client-side address */
+ CONST char *myaddr; /* Optional client-side address */
int myport; /* Optional client-side port */
int async; /* If nonzero and creating a client socket,
- * attempt to do an async connect. Otherwise
- * do a synchronous connect or bind. */
+ * attempt to do an async connect. Otherwise
+ * do a synchronous connect or bind. */
{
int status, sock, asyncConnect, curState, origState;
struct sockaddr_in sockaddr; /* socket address */
@@ -1992,7 +2493,7 @@ CreateSocket(interp, port, host, server, myaddr, myport, async)
*/
fcntl(sock, F_SETFD, FD_CLOEXEC);
-
+
/*
* Set kernel space buffering
*/
@@ -2002,17 +2503,16 @@ CreateSocket(interp, port, host, server, myaddr, myport, async)
asyncConnect = 0;
status = 0;
if (server) {
-
/*
* Set up to reuse server addresses automatically and bind to the
* specified port.
*/
-
+
status = 1;
(void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR, (char *) &status,
sizeof(status));
status = bind(sock, (struct sockaddr *) &sockaddr,
- sizeof(struct sockaddr));
+ sizeof(struct sockaddr));
if (status != -1) {
status = listen(sock, SOMAXCONN);
}
@@ -2020,7 +2520,7 @@ CreateSocket(interp, port, host, server, myaddr, myport, async)
if (myaddr != NULL || myport != 0) {
curState = 1;
(void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR,
- (char *) &curState, sizeof(curState));
+ (char *) &curState, sizeof(curState));
status = bind(sock, (struct sockaddr *) &mysockaddr,
sizeof(struct sockaddr));
if (status < 0) {
@@ -2035,28 +2535,26 @@ CreateSocket(interp, port, host, server, myaddr, myport, async)
* being informed when the connect completes.
*/
- if (async) {
-#ifndef USE_FIONBIO
- origState = fcntl(sock, F_GETFL);
- curState = origState | O_NONBLOCK;
- status = fcntl(sock, F_SETFL, curState);
-#endif
-
-#ifdef USE_FIONBIO
- curState = 1;
- status = ioctl(sock, FIONBIO, &curState);
-#endif
- } else {
- status = 0;
- }
- if (status > -1) {
- status = connect(sock, (struct sockaddr *) &sockaddr,
- sizeof(sockaddr));
- if (status < 0) {
- if (errno == EINPROGRESS) {
- asyncConnect = 1;
- status = 0;
- }
+ if (async) {
+#ifndef USE_FIONBIO
+ origState = fcntl(sock, F_GETFL);
+ curState = origState | O_NONBLOCK;
+ status = fcntl(sock, F_SETFL, curState);
+#else /* USE_FIONBIO */
+ curState = 1;
+ status = ioctl(sock, FIONBIO, &curState);
+#endif /* !USE_FIONBIO */
+ } else {
+ status = 0;
+ }
+ if (status > -1) {
+ status = connect(sock, (struct sockaddr *) &sockaddr,
+ sizeof(sockaddr));
+ if (status < 0) {
+ if (errno == EINPROGRESS) {
+ asyncConnect = 1;
+ status = 0;
+ }
} else {
/*
* Here we are if the connect succeeds. In case of an
@@ -2070,27 +2568,25 @@ CreateSocket(interp, port, host, server, myaddr, myport, async)
origState = fcntl(sock, F_GETFL);
curState = origState & ~(O_NONBLOCK);
status = fcntl(sock, F_SETFL, curState);
-#endif
-
-#ifdef USE_FIONBIO
+#else /* USE_FIONBIO */
curState = 0;
status = ioctl(sock, FIONBIO, &curState);
-#endif
+#endif /* !USE_FIONBIO */
}
}
- }
+ }
}
bindError:
if (status < 0) {
- if (interp != NULL) {
- Tcl_AppendResult(interp, "couldn't open socket: ",
- Tcl_PosixError(interp), (char *) NULL);
- }
- if (sock != -1) {
- close(sock);
- }
- return NULL;
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "couldn't open socket: ",
+ Tcl_PosixError(interp), (char *) NULL);
+ }
+ if (sock != -1) {
+ close(sock);
+ }
+ return NULL;
}
/*
@@ -2100,7 +2596,7 @@ bindError:
statePtr = (TcpState *) ckalloc((unsigned) sizeof(TcpState));
statePtr->flags = 0;
if (asyncConnect) {
- statePtr->flags = TCP_ASYNC_CONNECT;
+ statePtr->flags = TCP_ASYNC_CONNECT;
}
statePtr->fd = sock;
@@ -2108,7 +2604,7 @@ bindError:
addressError:
if (sock != -1) {
- close(sock);
+ close(sock);
}
if (interp != NULL) {
Tcl_AppendResult(interp, "couldn't open socket: ",
@@ -2137,7 +2633,7 @@ addressError:
static int
CreateSocketAddress(sockaddrPtr, host, port)
struct sockaddr_in *sockaddrPtr; /* Socket address */
- char *host; /* Host. NULL implies INADDR_ANY */
+ CONST char *host; /* Host. NULL implies INADDR_ANY */
int port; /* Port number */
{
struct hostent *hostent; /* Host database entry */
@@ -2157,36 +2653,36 @@ CreateSocketAddress(sockaddrPtr, host, port)
} else {
native = Tcl_UtfToExternalDString(NULL, host, -1, &ds);
}
- addr.s_addr = inet_addr(native); /* INTL: Native. */
+ addr.s_addr = inet_addr(native); /* INTL: Native. */
/*
* This is 0xFFFFFFFF to ensure that it compares as a 32bit -1
* on either 32 or 64 bits systems.
*/
- if (addr.s_addr == 0xFFFFFFFF) {
- hostent = gethostbyname(native); /* INTL: Native. */
- if (hostent != NULL) {
- memcpy((VOID *) &addr,
- (VOID *) hostent->h_addr_list[0],
- (size_t) hostent->h_length);
- } else {
+ if (addr.s_addr == 0xFFFFFFFF) {
+ hostent = gethostbyname(native); /* INTL: Native. */
+ if (hostent != NULL) {
+ memcpy((VOID *) &addr,
+ (VOID *) hostent->h_addr_list[0],
+ (size_t) hostent->h_length);
+ } else {
#ifdef EHOSTUNREACH
- errno = EHOSTUNREACH;
-#else
+ errno = EHOSTUNREACH;
+#else /* !EHOSTUNREACH */
#ifdef ENXIO
- errno = ENXIO;
-#endif
-#endif
+ errno = ENXIO;
+#endif /* ENXIO */
+#endif /* EHOSTUNREACH */
if (native != NULL) {
Tcl_DStringFree(&ds);
}
- return 0; /* error */
- }
- }
+ return 0; /* error */
+ }
+ }
if (native != NULL) {
Tcl_DStringFree(&ds);
}
}
-
+
/*
* NOTE: On 64 bit machines the assignment below is rumored to not
* do the right thing. Please report errors related to this if you
@@ -2206,7 +2702,7 @@ CreateSocketAddress(sockaddrPtr, host, port)
* Opens a TCP client socket and creates a channel around it.
*
* Results:
- * The channel or NULL if failed. An error message is returned
+ * The channel or NULL if failed. An error message is returned
* in the interpreter on failure.
*
* Side effects:
@@ -2219,12 +2715,12 @@ Tcl_Channel
Tcl_OpenTcpClient(interp, port, host, myaddr, myport, async)
Tcl_Interp *interp; /* For error reporting; can be NULL. */
int port; /* Port number to open. */
- char *host; /* Host on which to open port. */
- char *myaddr; /* Client-side address */
+ CONST char *host; /* Host on which to open port. */
+ CONST char *myaddr; /* Client-side address */
int myport; /* Client-side port */
int async; /* If nonzero, attempt to do an
- * asynchronous connect. Otherwise
- * we do a blocking connect. */
+ * asynchronous connect. Otherwise
+ * we do a blocking connect. */
{
TcpState *statePtr;
char channelName[16 + TCL_INTEGER_SPACE];
@@ -2244,11 +2740,11 @@ Tcl_OpenTcpClient(interp, port, host, myaddr, myport, async)
sprintf(channelName, "sock%d", statePtr->fd);
statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
- (ClientData) statePtr, (TCL_READABLE | TCL_WRITABLE));
+ (ClientData) statePtr, (TCL_READABLE | TCL_WRITABLE));
if (Tcl_SetChannelOption(interp, statePtr->channel, "-translation",
"auto crlf") == TCL_ERROR) {
- Tcl_Close((Tcl_Interp *) NULL, statePtr->channel);
- return NULL;
+ Tcl_Close((Tcl_Interp *) NULL, statePtr->channel);
+ return NULL;
}
return statePtr->channel;
}
@@ -2278,17 +2774,18 @@ Tcl_MakeTcpClientChannel(sock)
statePtr = (TcpState *) ckalloc((unsigned) sizeof(TcpState));
statePtr->fd = (int) sock;
+ statePtr->flags = 0;
statePtr->acceptProc = NULL;
statePtr->acceptProcData = (ClientData) NULL;
sprintf(channelName, "sock%d", statePtr->fd);
-
+
statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
- (ClientData) statePtr, (TCL_READABLE | TCL_WRITABLE));
+ (ClientData) statePtr, (TCL_READABLE | TCL_WRITABLE));
if (Tcl_SetChannelOption((Tcl_Interp *) NULL, statePtr->channel,
"-translation", "auto crlf") == TCL_ERROR) {
- Tcl_Close((Tcl_Interp *) NULL, statePtr->channel);
- return NULL;
+ Tcl_Close((Tcl_Interp *) NULL, statePtr->channel);
+ return NULL;
}
return statePtr->channel;
}
@@ -2314,11 +2811,11 @@ Tcl_MakeTcpClientChannel(sock)
Tcl_Channel
Tcl_OpenTcpServer(interp, port, myHost, acceptProc, acceptProcData)
Tcl_Interp *interp; /* For error reporting - may be
- * NULL. */
+ * NULL. */
int port; /* Port number to open. */
- char *myHost; /* Name of local host. */
+ CONST char *myHost; /* Name of local host. */
Tcl_TcpAcceptProc *acceptProc; /* Callback for accepting connections
- * from new clients. */
+ * from new clients. */
ClientData acceptProcData; /* Data for the callback. */
{
TcpState *statePtr;
@@ -2342,10 +2839,10 @@ Tcl_OpenTcpServer(interp, port, myHost, acceptProc, acceptProcData)
*/
Tcl_CreateFileHandler(statePtr->fd, TCL_READABLE, TcpAccept,
- (ClientData) statePtr);
+ (ClientData) statePtr);
sprintf(channelName, "sock%d", statePtr->fd);
statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
- (ClientData) statePtr, 0);
+ (ClientData) statePtr, 0);
return statePtr->channel;
}
@@ -2353,7 +2850,7 @@ Tcl_OpenTcpServer(interp, port, myHost, acceptProc, acceptProcData)
*----------------------------------------------------------------------
*
* TcpAccept --
- * Accept a TCP socket connection. This is called by the event loop.
+ * Accept a TCP socket connection. This is called by the event loop.
*
* Results:
* None.
@@ -2375,7 +2872,7 @@ TcpAccept(data, mask)
int newsock; /* The new client socket */
TcpState *newSockState; /* State for new socket. */
struct sockaddr_in addr; /* The remote address */
- int len; /* For accept interface */
+ socklen_t len; /* For accept interface */
char channelName[16 + TCL_INTEGER_SPACE];
sockState = (TcpState *) data;
@@ -2383,7 +2880,7 @@ TcpAccept(data, mask)
len = sizeof(struct sockaddr_in);
newsock = accept(sockState->fd, (struct sockaddr *) &addr, &len);
if (newsock < 0) {
- return;
+ return;
}
/*
@@ -2392,14 +2889,14 @@ TcpAccept(data, mask)
*/
(void) fcntl(newsock, F_SETFD, FD_CLOEXEC);
-
+
newSockState = (TcpState *) ckalloc((unsigned) sizeof(TcpState));
newSockState->flags = 0;
newSockState->fd = newsock;
newSockState->acceptProc = NULL;
newSockState->acceptProcData = NULL;
-
+
sprintf(channelName, "sock%d", newsock);
newSockState->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
(ClientData) newSockState, (TCL_READABLE | TCL_WRITABLE));
@@ -2441,39 +2938,48 @@ TclpGetDefaultStdChannel(type)
int mode = 0; /* compiler warning (used before set). */
char *bufMode = NULL;
+ /*
+ * Some #def's to make the code a little clearer!
+ */
+#define ZERO_OFFSET ((Tcl_SeekOffset) 0)
+#define ERROR_OFFSET ((Tcl_SeekOffset) -1)
+
switch (type) {
- case TCL_STDIN:
- if ((lseek(0, (off_t) 0, SEEK_CUR) == -1) &&
- (errno == EBADF)) {
- return (Tcl_Channel) NULL;
- }
+ case TCL_STDIN:
+ if ((TclOSseek(0, ZERO_OFFSET, SEEK_CUR) == ERROR_OFFSET)
+ && (errno == EBADF)) {
+ return (Tcl_Channel) NULL;
+ }
fd = 0;
mode = TCL_READABLE;
- bufMode = "line";
- break;
- case TCL_STDOUT:
- if ((lseek(1, (off_t) 0, SEEK_CUR) == -1) &&
- (errno == EBADF)) {
- return (Tcl_Channel) NULL;
- }
+ bufMode = "line";
+ break;
+ case TCL_STDOUT:
+ if ((TclOSseek(1, ZERO_OFFSET, SEEK_CUR) == ERROR_OFFSET)
+ && (errno == EBADF)) {
+ return (Tcl_Channel) NULL;
+ }
fd = 1;
mode = TCL_WRITABLE;
- bufMode = "line";
- break;
- case TCL_STDERR:
- if ((lseek(2, (off_t) 0, SEEK_CUR) == -1) &&
- (errno == EBADF)) {
- return (Tcl_Channel) NULL;
- }
+ bufMode = "line";
+ break;
+ case TCL_STDERR:
+ if ((TclOSseek(2, ZERO_OFFSET, SEEK_CUR) == ERROR_OFFSET)
+ && (errno == EBADF)) {
+ return (Tcl_Channel) NULL;
+ }
fd = 2;
mode = TCL_WRITABLE;
bufMode = "none";
- break;
+ break;
default:
panic("TclGetDefaultStdChannel: Unexpected channel type");
break;
}
+#undef ZERO_OFFSET
+#undef ERROR_OFFSET
+
channel = Tcl_MakeFileChannel((ClientData) fd, mode);
if (channel == NULL) {
return NULL;
@@ -2483,7 +2989,11 @@ TclpGetDefaultStdChannel(type)
* Set up the normal channel options for stdio handles.
*/
- Tcl_SetChannelOption(NULL, channel, "-translation", "auto");
+ if (Tcl_GetChannelType(channel) == &fileChannelType) {
+ Tcl_SetChannelOption(NULL, channel, "-translation", "auto");
+ } else {
+ Tcl_SetChannelOption(NULL, channel, "-translation", "auto crlf");
+ }
Tcl_SetChannelOption(NULL, channel, "-buffering", bufMode);
return channel;
}
@@ -2513,14 +3023,14 @@ TclpGetDefaultStdChannel(type)
int
Tcl_GetOpenFile(interp, string, forWriting, checkUsage, filePtr)
Tcl_Interp *interp; /* Interpreter in which to find file. */
- char *string; /* String that identifies file. */
+ CONST char *string; /* String that identifies file. */
int forWriting; /* 1 means the file is going to be used
* for writing, 0 means for reading. */
int checkUsage; /* 1 means verify that the file was opened
* in a mode that allows the access specified
* by "forWriting". Ignored, we always
- * check that the channel is open for the
- * requested mode. */
+ * check that the channel is open for the
+ * requested mode. */
ClientData *filePtr; /* Store pointer to FILE structure here. */
{
Tcl_Channel chan;
@@ -2529,19 +3039,19 @@ Tcl_GetOpenFile(interp, string, forWriting, checkUsage, filePtr)
ClientData data;
int fd;
FILE *f;
-
+
chan = Tcl_GetChannel(interp, string, &chanMode);
if (chan == (Tcl_Channel) NULL) {
- return TCL_ERROR;
+ return TCL_ERROR;
}
if ((forWriting) && ((chanMode & TCL_WRITABLE) == 0)) {
- Tcl_AppendResult(interp,
- "\"", string, "\" wasn't opened for writing", (char *) NULL);
- return TCL_ERROR;
+ Tcl_AppendResult(interp,
+ "\"", string, "\" wasn't opened for writing", (char *) NULL);
+ return TCL_ERROR;
} else if ((!(forWriting)) && ((chanMode & TCL_READABLE) == 0)) {
- Tcl_AppendResult(interp,
- "\"", string, "\" wasn't opened for reading", (char *) NULL);
- return TCL_ERROR;
+ Tcl_AppendResult(interp,
+ "\"", string, "\" wasn't opened for reading", (char *) NULL);
+ return TCL_ERROR;
}
/*
@@ -2554,10 +3064,10 @@ Tcl_GetOpenFile(interp, string, forWriting, checkUsage, filePtr)
if ((chanTypePtr == &fileChannelType)
#ifdef SUPPORTS_TTY
|| (chanTypePtr == &ttyChannelType)
-#endif /* SUPPORTS_TTY */
+#endif /* SUPPORTS_TTY */
|| (chanTypePtr == &tcpChannelType)
|| (strcmp(chanTypePtr->typeName, "pipe") == 0)) {
- if (Tcl_GetChannelHandle(chan,
+ if (Tcl_GetChannelHandle(chan,
(forWriting ? TCL_WRITABLE : TCL_READABLE),
(ClientData*) &data) == TCL_OK) {
fd = (int) data;
@@ -2567,7 +3077,7 @@ Tcl_GetOpenFile(interp, string, forWriting, checkUsage, filePtr)
* truncate an existing file if the file is being opened
* for writing....
*/
-
+
f = fdopen(fd, (forWriting ? "w" : "r"));
if (f == NULL) {
Tcl_AppendResult(interp, "cannot get a FILE * for \"", string,
@@ -2580,8 +3090,8 @@ Tcl_GetOpenFile(interp, string, forWriting, checkUsage, filePtr)
}
Tcl_AppendResult(interp, "\"", string,
- "\" cannot be used to get a FILE *", (char *) NULL);
- return TCL_ERROR;
+ "\" cannot be used to get a FILE *", (char *) NULL);
+ return TCL_ERROR;
}
/*
@@ -2634,7 +3144,7 @@ TclUnixWaitForFile(fd, mask, timeout)
*/
if (timeout > 0) {
- TclpGetTime(&now);
+ Tcl_GetTime(&now);
abortTime.sec = now.sec + timeout/1000;
abortTime.usec = now.usec + (timeout%1000)*1000;
if (abortTime.usec >= 1000000) {
@@ -2660,7 +3170,7 @@ TclUnixWaitForFile(fd, mask, timeout)
memset((VOID *) readyMasks, 0, 3*MASK_SIZE*sizeof(fd_mask));
index = fd/(NBBY*sizeof(fd_mask));
bit = 1 << (fd%(NBBY*sizeof(fd_mask)));
-
+
/*
* Loop in a mini-event loop of our own, waiting for either the
* file to become ready or a timeout to occur.
@@ -2679,7 +3189,7 @@ TclUnixWaitForFile(fd, mask, timeout)
blockTime.tv_usec = 0;
}
}
-
+
/*
* Set the appropriate bit in the ready masks for the fd.
*/
@@ -2724,7 +3234,7 @@ TclUnixWaitForFile(fd, mask, timeout)
* The select returned early, so we need to recompute the timeout.
*/
- TclpGetTime(&now);
+ Tcl_GetTime(&now);
if ((abortTime.sec < now.sec)
|| ((abortTime.sec == now.sec)
&& (abortTime.usec <= now.usec))) {
@@ -2733,5 +3243,3 @@ TclUnixWaitForFile(fd, mask, timeout)
}
return result;
}
-
-
diff --git a/tcl/unix/tclUnixEvent.c b/tcl/unix/tclUnixEvent.c
index 02bd91d7190..34a41da5c66 100644
--- a/tcl/unix/tclUnixEvent.c
+++ b/tcl/unix/tclUnixEvent.c
@@ -44,7 +44,7 @@ Tcl_Sleep(ms)
* early, go back to sleep again.
*/
- TclpGetTime(&before);
+ Tcl_GetTime(&before);
after = before;
after.sec += ms/1000;
after.usec += (ms%1000)*1000;
@@ -71,7 +71,6 @@ Tcl_Sleep(ms)
}
(void) select(0, (SELECT_MASK *) 0, (SELECT_MASK *) 0,
(SELECT_MASK *) 0, &delay);
- TclpGetTime(&before);
+ Tcl_GetTime(&before);
}
}
-
diff --git a/tcl/unix/tclUnixFCmd.c b/tcl/unix/tclUnixFCmd.c
index 3b1b02ce0af..9340233610a 100644
--- a/tcl/unix/tclUnixFCmd.c
+++ b/tcl/unix/tclUnixFCmd.c
@@ -71,23 +71,23 @@
*/
static int GetGroupAttribute _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, CONST char *fileName,
+ int objIndex, Tcl_Obj *fileName,
Tcl_Obj **attributePtrPtr));
static int GetOwnerAttribute _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, CONST char *fileName,
+ int objIndex, Tcl_Obj *fileName,
Tcl_Obj **attributePtrPtr));
static int GetPermissionsAttribute _ANSI_ARGS_((
Tcl_Interp *interp, int objIndex,
- CONST char *fileName, Tcl_Obj **attributePtrPtr));
+ Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr));
static int SetGroupAttribute _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, CONST char *fileName,
+ int objIndex, Tcl_Obj *fileName,
Tcl_Obj *attributePtr));
static int SetOwnerAttribute _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, CONST char *fileName,
+ int objIndex, Tcl_Obj *fileName,
Tcl_Obj *attributePtr));
static int SetPermissionsAttribute _ANSI_ARGS_((
Tcl_Interp *interp, int objIndex,
- CONST char *fileName, Tcl_Obj *attributePtr));
+ Tcl_Obj *fileName, Tcl_Obj *attributePtr));
static int GetModeFromPermString _ANSI_ARGS_((
Tcl_Interp *interp, char *modeStringPtr,
mode_t *modePtr));
@@ -97,7 +97,7 @@ static int GetModeFromPermString _ANSI_ARGS_((
*/
typedef int (TraversalProc) _ANSI_ARGS_((Tcl_DString *srcPtr,
- Tcl_DString *dstPtr, CONST struct stat *statBufPtr, int type,
+ Tcl_DString *dstPtr, CONST Tcl_StatBuf *statBufPtr, int type,
Tcl_DString *errorPtr));
/*
@@ -110,7 +110,7 @@ enum {
UNIX_PERMISSIONS_ATTRIBUTE
};
-char *tclpFileAttrStrings[] = {
+CONST char *tclpFileAttrStrings[] = {
"-group",
"-owner",
"-permissions",
@@ -128,32 +128,55 @@ CONST TclFileAttrProcs tclpFileAttrProcs[] = {
*/
static int CopyFile _ANSI_ARGS_((CONST char *src,
- CONST char *dst, CONST struct stat *statBufPtr));
+ CONST char *dst, CONST Tcl_StatBuf *statBufPtr));
static int CopyFileAtts _ANSI_ARGS_((CONST char *src,
- CONST char *dst, CONST struct stat *statBufPtr));
-static int DoCopyFile _ANSI_ARGS_((Tcl_DString *srcPtr,
- Tcl_DString *dstPtr));
-static int DoCreateDirectory _ANSI_ARGS_((Tcl_DString *pathPtr));
-static int DoDeleteFile _ANSI_ARGS_((Tcl_DString *pathPtr));
+ CONST char *dst, CONST Tcl_StatBuf *statBufPtr));
+static int DoCopyFile _ANSI_ARGS_((CONST char *srcPtr,
+ CONST char *dstPtr));
+static int DoCreateDirectory _ANSI_ARGS_((CONST char *pathPtr));
+static int DoDeleteFile _ANSI_ARGS_((CONST char *path));
static int DoRemoveDirectory _ANSI_ARGS_((Tcl_DString *pathPtr,
int recursive, Tcl_DString *errorPtr));
static int DoRenameFile _ANSI_ARGS_((CONST char *src,
CONST char *dst));
static int TraversalCopy _ANSI_ARGS_((Tcl_DString *srcPtr,
- Tcl_DString *dstPtr, CONST struct stat *statBufPtr,
+ Tcl_DString *dstPtr, CONST Tcl_StatBuf *statBufPtr,
int type, Tcl_DString *errorPtr));
static int TraversalDelete _ANSI_ARGS_((Tcl_DString *srcPtr,
- Tcl_DString *dstPtr, CONST struct stat *statBufPtr,
+ Tcl_DString *dstPtr, CONST Tcl_StatBuf *statBufPtr,
int type, Tcl_DString *errorPtr));
static int TraverseUnixTree _ANSI_ARGS_((
TraversalProc *traversalProc,
Tcl_DString *sourcePtr, Tcl_DString *destPtr,
Tcl_DString *errorPtr));
+
+#ifdef PURIFY
+/*
+ * realpath and purify don't mix happily. It has been noted that realpath
+ * should not be used with purify because of bogus warnings, but just
+ * memset'ing the resolved path will squelch those. This assumes we are
+ * passing the standard MAXPATHLEN size resolved arg.
+ */
+static char * Realpath _ANSI_ARGS_((CONST char *path,
+ char *resolved));
+
+char *
+Realpath(path, resolved)
+ CONST char *path;
+ char *resolved;
+{
+ memset(resolved, 0, MAXPATHLEN);
+ return realpath(path, resolved);
+}
+#else
+#define Realpath realpath
+#endif
+
/*
*---------------------------------------------------------------------------
*
- * TclpRenameFile, DoRenameFile --
+ * TclpObjRenameFile, DoRenameFile --
*
* Changes the name of an existing file or directory, from src to dst.
* If src and dst refer to the same file or directory, does nothing
@@ -185,23 +208,13 @@ static int TraverseUnixTree _ANSI_ARGS_((
*---------------------------------------------------------------------------
*/
-int
-TclpRenameFile(src, dst)
- CONST char *src; /* Pathname of file or dir to be renamed
- * (UTF-8). */
- CONST char *dst; /* New pathname of file or directory
- * (UTF-8). */
+int
+TclpObjRenameFile(srcPathPtr, destPathPtr)
+ Tcl_Obj *srcPathPtr;
+ Tcl_Obj *destPathPtr;
{
- int result;
- Tcl_DString srcString, dstString;
-
- Tcl_UtfToExternalDString(NULL, src, -1, &srcString);
- Tcl_UtfToExternalDString(NULL, dst, -1, &dstString);
- result = DoRenameFile(Tcl_DStringValue(&srcString),
- Tcl_DStringValue(&dstString));
- Tcl_DStringFree(&srcString);
- Tcl_DStringFree(&dstString);
- return result;
+ return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr),
+ Tcl_FSGetNativePath(destPathPtr));
}
static int
@@ -239,15 +252,15 @@ DoRenameFile(src, dst)
if (errno == EINVAL) {
char srcPath[MAXPATHLEN], dstPath[MAXPATHLEN];
DIR *dirPtr;
- struct dirent *dirEntPtr;
+ Tcl_DirEntry *dirEntPtr;
- if ((realpath((char *) src, srcPath) != NULL) /* INTL: Native. */
- && (realpath((char *) dst, dstPath) != NULL) /* INTL: Native. */
+ if ((Realpath((char *) src, srcPath) != NULL) /* INTL: Native. */
+ && (Realpath((char *) dst, dstPath) != NULL) /* INTL: Native. */
&& (strncmp(srcPath, dstPath, strlen(srcPath)) != 0)) {
dirPtr = opendir(dst); /* INTL: Native. */
if (dirPtr != NULL) {
while (1) {
- dirEntPtr = readdir(dirPtr); /* INTL: Native. */
+ dirEntPtr = TclOSreaddir(dirPtr); /* INTL: Native. */
if (dirEntPtr == NULL) {
break;
}
@@ -283,12 +296,11 @@ DoRenameFile(src, dst)
return TCL_ERROR;
}
-
/*
*---------------------------------------------------------------------------
*
- * TclpCopyFile, DoCopyFile --
+ * TclpObjCopyFile, DoCopyFile --
*
* Copy a single file (not a directory). If dst already exists and
* is not a directory, it is removed.
@@ -313,37 +325,26 @@ DoRenameFile(src, dst)
*/
int
-TclpCopyFile(src, dst)
- CONST char *src; /* Pathname of file to be copied (UTF-8). */
- CONST char *dst; /* Pathname of file to copy to (UTF-8). */
+TclpObjCopyFile(srcPathPtr, destPathPtr)
+ Tcl_Obj *srcPathPtr;
+ Tcl_Obj *destPathPtr;
{
- int result;
- Tcl_DString srcString, dstString;
-
- Tcl_UtfToExternalDString(NULL, src, -1, &srcString);
- Tcl_UtfToExternalDString(NULL, dst, -1, &dstString);
- result = DoCopyFile(&srcString, &dstString);
- Tcl_DStringFree(&srcString);
- Tcl_DStringFree(&dstString);
- return result;
+ return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr),
+ Tcl_FSGetNativePath(destPathPtr));
}
static int
-DoCopyFile(srcPtr, dstPtr)
- Tcl_DString *srcPtr; /* Pathname of file to be copied (native). */
- Tcl_DString *dstPtr; /* Pathname of file to copy to (native). */
+DoCopyFile(src, dst)
+ CONST char *src; /* Pathname of file to be copied (native). */
+ CONST char *dst; /* Pathname of file to copy to (native). */
{
- struct stat srcStatBuf, dstStatBuf;
- CONST char *src, *dst;
-
- src = Tcl_DStringValue(srcPtr);
- dst = Tcl_DStringValue(dstPtr);
+ Tcl_StatBuf srcStatBuf, dstStatBuf;
/*
* Have to do a stat() to determine the filetype.
*/
- if (lstat(src, &srcStatBuf) != 0) { /* INTL: Native. */
+ if (TclOSlstat(src, &srcStatBuf) != 0) { /* INTL: Native. */
return TCL_ERROR;
}
if (S_ISDIR(srcStatBuf.st_mode)) {
@@ -356,7 +357,7 @@ DoCopyFile(srcPtr, dstPtr)
* exists, so we remove it first
*/
- if (lstat(dst, &dstStatBuf) == 0) { /* INTL: Native. */
+ if (TclOSlstat(dst, &dstStatBuf) == 0) { /* INTL: Native. */
if (S_ISDIR(dstStatBuf.st_mode)) {
errno = EISDIR;
return TCL_ERROR;
@@ -369,6 +370,7 @@ DoCopyFile(srcPtr, dstPtr)
}
switch ((int) (srcStatBuf.st_mode & S_IFMT)) {
+#ifndef DJGPP
case S_IFLNK: {
char link[MAXPATHLEN];
int length;
@@ -383,6 +385,7 @@ DoCopyFile(srcPtr, dstPtr)
}
break;
}
+#endif
case S_IFBLK:
case S_IFCHR: {
if (mknod(dst, srcStatBuf.st_mode, /* INTL: Native. */
@@ -426,7 +429,7 @@ CopyFile(src, dst, statBufPtr)
CONST char *src; /* Pathname of file to copy (native). */
CONST char *dst; /* Pathname of file to create/overwrite
* (native). */
- CONST struct stat *statBufPtr;
+ CONST Tcl_StatBuf *statBufPtr;
/* Used to determine mode and blocksize. */
{
int srcFd;
@@ -435,11 +438,11 @@ CopyFile(src, dst, statBufPtr)
char *buffer; /* Data buffer for copy */
size_t nread;
- if ((srcFd = open(src, O_RDONLY, 0)) < 0) { /* INTL: Native. */
+ if ((srcFd = TclOSopen(src, O_RDONLY, 0)) < 0) { /* INTL: Native. */
return TCL_ERROR;
}
- dstFd = open(dst, O_CREAT | O_TRUNC | O_WRONLY, /* INTL: Native. */
+ dstFd = TclOSopen(dst, O_CREAT|O_TRUNC|O_WRONLY, /* INTL: Native. */
statBufPtr->st_mode);
if (dstFd < 0) {
close(srcFd);
@@ -497,7 +500,7 @@ CopyFile(src, dst, statBufPtr)
/*
*---------------------------------------------------------------------------
*
- * TclpDeleteFile, DoDeleteFile --
+ * TclpObjDeleteFile, DoDeleteFile --
*
* Removes a single file (not a directory).
*
@@ -516,26 +519,17 @@ CopyFile(src, dst, statBufPtr)
*---------------------------------------------------------------------------
*/
-int
-TclpDeleteFile(path)
- CONST char *path; /* Pathname of file to be removed (UTF-8). */
+int
+TclpObjDeleteFile(pathPtr)
+ Tcl_Obj *pathPtr;
{
- int result;
- Tcl_DString pathString;
-
- Tcl_UtfToExternalDString(NULL, path, -1, &pathString);
- result = DoDeleteFile(&pathString);
- Tcl_DStringFree(&pathString);
- return result;
+ return DoDeleteFile(Tcl_FSGetNativePath(pathPtr));
}
static int
-DoDeleteFile(pathPtr)
- Tcl_DString *pathPtr; /* Pathname of file to be removed (native). */
+DoDeleteFile(path)
+ CONST char *path; /* Pathname of file to be removed (native). */
{
- CONST char *path;
-
- path = Tcl_DStringValue(pathPtr);
if (unlink(path) != 0) { /* INTL: Native. */
return TCL_ERROR;
}
@@ -568,27 +562,18 @@ DoDeleteFile(pathPtr)
*---------------------------------------------------------------------------
*/
-int
-TclpCreateDirectory(path)
- CONST char *path; /* Pathname of directory to create (UTF-8). */
+int
+TclpObjCreateDirectory(pathPtr)
+ Tcl_Obj *pathPtr;
{
- int result;
- Tcl_DString pathString;
-
- Tcl_UtfToExternalDString(NULL, path, -1, &pathString);
- result = DoCreateDirectory(&pathString);
- Tcl_DStringFree(&pathString);
- return result;
+ return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr));
}
static int
-DoCreateDirectory(pathPtr)
- Tcl_DString *pathPtr; /* Pathname of directory to create (native). */
+DoCreateDirectory(path)
+ CONST char *path; /* Pathname of directory to create (native). */
{
mode_t mode;
- CONST char *path;
-
- path = Tcl_DStringValue(pathPtr);
mode = umask(0);
umask(mode);
@@ -608,7 +593,7 @@ DoCreateDirectory(pathPtr)
/*
*---------------------------------------------------------------------------
*
- * TclpCopyDirectory --
+ * TclpObjCopyDirectory --
*
* Recursively copies a directory. The target directory dst must
* not already exist. Note that this function does not merge two
@@ -619,8 +604,8 @@ DoCreateDirectory(pathPtr)
* If the directory was successfully copied, returns TCL_OK.
* Otherwise the return value is TCL_ERROR, errno is set to indicate
* the error, and the pathname of the file that caused the error
- * is stored in errorPtr. See TclpCreateDirectory and TclpCopyFile
- * for a description of possible values for errno.
+ * is stored in errorPtr. See TclpObjCreateDirectory and
+ * TclpObjCopyFile for a description of possible values for errno.
*
* Side effects:
* An exact copy of the directory hierarchy src will be created
@@ -631,27 +616,36 @@ DoCreateDirectory(pathPtr)
*---------------------------------------------------------------------------
*/
-int
-TclpCopyDirectory(src, dst, errorPtr)
- CONST char *src; /* Pathname of directory to be copied
- * (UTF-8). */
- CONST char *dst; /* Pathname of target directory (UTF-8). */
- Tcl_DString *errorPtr; /* If non-NULL, uninitialized or free
- * DString filled with UTF-8 name of file
- * causing error. */
+int
+TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr)
+ Tcl_Obj *srcPathPtr;
+ Tcl_Obj *destPathPtr;
+ Tcl_Obj **errorPtr;
{
+ Tcl_DString ds;
Tcl_DString srcString, dstString;
- int result;
+ int ret;
- Tcl_UtfToExternalDString(NULL, src, -1, &srcString);
- Tcl_UtfToExternalDString(NULL, dst, -1, &dstString);
+ Tcl_UtfToExternalDString(NULL,
+ Tcl_FSGetTranslatedStringPath(NULL,srcPathPtr),
+ -1, &srcString);
+ Tcl_UtfToExternalDString(NULL,
+ Tcl_FSGetTranslatedStringPath(NULL,destPathPtr),
+ -1, &dstString);
- result = TraverseUnixTree(TraversalCopy, &srcString, &dstString, errorPtr);
+ ret = TraverseUnixTree(TraversalCopy, &srcString, &dstString, &ds);
Tcl_DStringFree(&srcString);
Tcl_DStringFree(&dstString);
- return result;
+
+ if (ret != TCL_OK) {
+ *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
+ Tcl_DStringFree(&ds);
+ Tcl_IncrRefCount(*errorPtr);
+ }
+ return ret;
}
+
/*
*---------------------------------------------------------------------------
@@ -679,25 +673,27 @@ TclpCopyDirectory(src, dst, errorPtr)
*---------------------------------------------------------------------------
*/
-int
-TclpRemoveDirectory(path, recursive, errorPtr)
- CONST char *path; /* 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_DString *errorPtr; /* If non-NULL, uninitialized or free
- * DString filled with UTF-8 name of file
- * causing error. */
+int
+TclpObjRemoveDirectory(pathPtr, recursive, errorPtr)
+ Tcl_Obj *pathPtr;
+ int recursive;
+ Tcl_Obj **errorPtr;
{
- int result;
+ Tcl_DString ds;
Tcl_DString pathString;
+ int ret;
- Tcl_UtfToExternalDString(NULL, path, -1, &pathString);
- result = DoRemoveDirectory(&pathString, recursive, errorPtr);
+ Tcl_UtfToExternalDString(NULL, Tcl_FSGetTranslatedStringPath(NULL, pathPtr),
+ -1, &pathString);
+ ret = DoRemoveDirectory(&pathString, recursive, &ds);
Tcl_DStringFree(&pathString);
- return result;
+ if (ret != TCL_OK) {
+ *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
+ Tcl_DStringFree(&ds);
+ Tcl_IncrRefCount(*errorPtr);
+ }
+ return ret;
}
static int
@@ -712,19 +708,37 @@ DoRemoveDirectory(pathPtr, recursive, errorPtr)
* causing error. */
{
CONST char *path;
-
+ mode_t oldPerm = 0;
+ int result;
+
path = Tcl_DStringValue(pathPtr);
+
+ if (recursive != 0) {
+ /* We should try to change permissions so this can be deleted */
+ Tcl_StatBuf statBuf;
+ int newPerm;
+
+ if (TclOSstat(path, &statBuf) == 0) {
+ oldPerm = (mode_t) (statBuf.st_mode & 0x00007FFF);
+ }
+
+ newPerm = oldPerm | (64+128+256);
+ chmod(path, (mode_t) newPerm);
+ }
+
if (rmdir(path) == 0) { /* INTL: Native. */
return TCL_OK;
}
if (errno == ENOTEMPTY) {
errno = EEXIST;
}
+
+ result = TCL_OK;
if ((errno != EEXIST) || (recursive == 0)) {
if (errorPtr != NULL) {
Tcl_ExternalToUtfDString(NULL, path, -1, errorPtr);
}
- return TCL_ERROR;
+ result = TCL_ERROR;
}
/*
@@ -732,7 +746,15 @@ DoRemoveDirectory(pathPtr, recursive, errorPtr)
* specified, so we recursively remove all the files in the directory.
*/
- return TraverseUnixTree(TraversalDelete, pathPtr, NULL, errorPtr);
+ if (result == TCL_OK) {
+ result = TraverseUnixTree(TraversalDelete, pathPtr, NULL, errorPtr);
+ }
+
+ if ((result != TCL_OK) && (recursive != 0)) {
+ /* Try to restore permissions */
+ chmod(path, oldPerm);
+ }
+ return result;
}
/*
@@ -769,11 +791,11 @@ TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr)
* DString filled with UTF-8 name of file
* causing error. */
{
- struct stat statBuf;
+ Tcl_StatBuf statBuf;
CONST char *source, *errfile;
int result, sourceLen;
int targetLen;
- struct dirent *dirEntPtr;
+ Tcl_DirEntry *dirEntPtr;
DIR *dirPtr;
errfile = NULL;
@@ -781,7 +803,7 @@ TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr)
targetLen = 0; /* lint. */
source = Tcl_DStringValue(sourcePtr);
- if (lstat(source, &statBuf) != 0) { /* INTL: Native. */
+ if (TclOSlstat(source, &statBuf) != 0) { /* INTL: Native. */
errfile = source;
goto end;
}
@@ -816,8 +838,8 @@ TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr)
Tcl_DStringAppend(targetPtr, "/", 1);
targetLen = Tcl_DStringLength(targetPtr);
}
-
- while ((dirEntPtr = readdir(dirPtr)) != NULL) { /* INTL: Native. */
+
+ while ((dirEntPtr = TclOSreaddir(dirPtr)) != NULL) { /* INTL: Native. */
if ((strcmp(dirEntPtr->d_name, ".") == 0)
|| (strcmp(dirEntPtr->d_name, "..") == 0)) {
continue;
@@ -882,8 +904,8 @@ TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr)
*
* TraversalCopy
*
- * Called from TraverseUnixTree in order to execute a recursive copy of a
- * directory.
+ * Called from TraverseUnixTree in order to execute a recursive copy
+ * of a directory.
*
* Results:
* Standard Tcl result.
@@ -899,7 +921,7 @@ static int
TraversalCopy(srcPtr, dstPtr, statBufPtr, type, errorPtr)
Tcl_DString *srcPtr; /* Source pathname to copy (native). */
Tcl_DString *dstPtr; /* Destination pathname of copy (native). */
- CONST struct stat *statBufPtr;
+ CONST Tcl_StatBuf *statBufPtr;
/* Stat info for file specified by srcPtr. */
int type; /* Reason for call - see TraverseUnixTree(). */
Tcl_DString *errorPtr; /* If non-NULL, uninitialized or free
@@ -908,13 +930,14 @@ TraversalCopy(srcPtr, dstPtr, statBufPtr, type, errorPtr)
{
switch (type) {
case DOTREE_F:
- if (DoCopyFile(srcPtr, dstPtr) == TCL_OK) {
+ if (DoCopyFile(Tcl_DStringValue(srcPtr),
+ Tcl_DStringValue(dstPtr)) == TCL_OK) {
return TCL_OK;
}
break;
case DOTREE_PRED:
- if (DoCreateDirectory(dstPtr) == TCL_OK) {
+ if (DoCreateDirectory(Tcl_DStringValue(dstPtr)) == TCL_OK) {
return TCL_OK;
}
break;
@@ -963,7 +986,7 @@ static int
TraversalDelete(srcPtr, ignore, statBufPtr, type, errorPtr)
Tcl_DString *srcPtr; /* Source pathname (native). */
Tcl_DString *ignore; /* Destination pathname (not used). */
- CONST struct stat *statBufPtr;
+ CONST Tcl_StatBuf *statBufPtr;
/* Stat info for file specified by srcPtr. */
int type; /* Reason for call - see TraverseUnixTree(). */
Tcl_DString *errorPtr; /* If non-NULL, uninitialized or free
@@ -972,7 +995,7 @@ TraversalDelete(srcPtr, ignore, statBufPtr, type, errorPtr)
{
switch (type) {
case DOTREE_F: {
- if (DoDeleteFile(srcPtr) == 0) {
+ if (DoDeleteFile(Tcl_DStringValue(srcPtr)) == 0) {
return TCL_OK;
}
break;
@@ -1017,7 +1040,7 @@ static int
CopyFileAtts(src, dst, statBufPtr)
CONST char *src; /* Path name of source file (native). */
CONST char *dst; /* Path name of target file (native). */
- CONST struct stat *statBufPtr;
+ CONST Tcl_StatBuf *statBufPtr;
/* Stat info for source file */
{
struct utimbuf tval;
@@ -1073,24 +1096,25 @@ static int
GetGroupAttribute(interp, objIndex, fileName, attributePtrPtr)
Tcl_Interp *interp; /* The interp we are using for errors. */
int objIndex; /* The index of the attribute. */
- CONST char *fileName; /* The name of the file (UTF-8). */
+ Tcl_Obj *fileName; /* The name of the file (UTF-8). */
Tcl_Obj **attributePtrPtr; /* A pointer to return the object with. */
{
- struct stat statBuf;
+ Tcl_StatBuf statBuf;
struct group *groupPtr;
int result;
- result = TclStat(fileName, &statBuf);
+ result = TclpObjStat(fileName, &statBuf);
if (result != 0) {
- Tcl_AppendResult(interp, "could not read \"", fileName, "\": ",
+ Tcl_AppendResult(interp, "could not read \"",
+ Tcl_GetString(fileName), "\": ",
Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
groupPtr = getgrgid(statBuf.st_gid); /* INTL: Native. */
if (groupPtr == NULL) {
- *attributePtrPtr = Tcl_NewIntObj(statBuf.st_gid);
+ *attributePtrPtr = Tcl_NewIntObj((int) statBuf.st_gid);
} else {
Tcl_DString ds;
CONST char *utf;
@@ -1124,24 +1148,25 @@ static int
GetOwnerAttribute(interp, objIndex, fileName, attributePtrPtr)
Tcl_Interp *interp; /* The interp we are using for errors. */
int objIndex; /* The index of the attribute. */
- CONST char *fileName; /* The name of the file (UTF-8). */
+ Tcl_Obj *fileName; /* The name of the file (UTF-8). */
Tcl_Obj **attributePtrPtr; /* A pointer to return the object with. */
{
- struct stat statBuf;
+ Tcl_StatBuf statBuf;
struct passwd *pwPtr;
int result;
- result = TclStat(fileName, &statBuf);
+ result = TclpObjStat(fileName, &statBuf);
if (result != 0) {
- Tcl_AppendResult(interp, "could not read \"", fileName, "\": ",
+ Tcl_AppendResult(interp, "could not read \"",
+ Tcl_GetString(fileName), "\": ",
Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
pwPtr = getpwuid(statBuf.st_uid); /* INTL: Native. */
if (pwPtr == NULL) {
- *attributePtrPtr = Tcl_NewIntObj(statBuf.st_uid);
+ *attributePtrPtr = Tcl_NewIntObj((int) statBuf.st_uid);
} else {
Tcl_DString ds;
CONST char *utf;
@@ -1175,22 +1200,23 @@ static int
GetPermissionsAttribute(interp, objIndex, fileName, attributePtrPtr)
Tcl_Interp *interp; /* The interp we are using for errors. */
int objIndex; /* The index of the attribute. */
- CONST char *fileName; /* The name of the file (UTF-8). */
+ Tcl_Obj *fileName; /* The name of the file (UTF-8). */
Tcl_Obj **attributePtrPtr; /* A pointer to return the object with. */
{
- struct stat statBuf;
+ Tcl_StatBuf statBuf;
char returnString[7];
int result;
- result = TclStat(fileName, &statBuf);
+ result = TclpObjStat(fileName, &statBuf);
if (result != 0) {
- Tcl_AppendResult(interp, "could not read \"", fileName, "\": ",
+ Tcl_AppendResult(interp, "could not read \"",
+ Tcl_GetString(fileName), "\": ",
Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
- sprintf(returnString, "%0#5lo", (statBuf.st_mode & 0x00007FFF));
+ sprintf(returnString, "%0#5lo", (long) (statBuf.st_mode & 0x00007FFF));
*attributePtrPtr = Tcl_NewStringObj(returnString, -1);
@@ -1217,15 +1243,15 @@ static int
SetGroupAttribute(interp, objIndex, fileName, attributePtr)
Tcl_Interp *interp; /* The interp for error reporting. */
int objIndex; /* The index of the attribute. */
- CONST char *fileName; /* The name of the file (UTF-8). */
+ Tcl_Obj *fileName; /* The name of the file (UTF-8). */
Tcl_Obj *attributePtr; /* New group for file. */
{
long gid;
int result;
- Tcl_DString ds;
CONST char *native;
if (Tcl_GetLongFromObj(NULL, attributePtr, &gid) != TCL_OK) {
+ Tcl_DString ds;
struct group *groupPtr;
CONST char *string;
int length;
@@ -1239,21 +1265,22 @@ SetGroupAttribute(interp, objIndex, fileName, attributePtr)
if (groupPtr == NULL) {
endgrent();
Tcl_AppendResult(interp, "could not set group for file \"",
- fileName, "\": group \"", string, "\" does not exist",
+ Tcl_GetString(fileName), "\": group \"",
+ string, "\" does not exist",
(char *) NULL);
return TCL_ERROR;
}
gid = groupPtr->gr_gid;
}
- native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
+ native = Tcl_FSGetNativePath(fileName);
result = chown(native, (uid_t) -1, (gid_t) gid); /* INTL: Native. */
- Tcl_DStringFree(&ds);
endgrent();
if (result != 0) {
Tcl_AppendResult(interp, "could not set group for file \"",
- fileName, "\": ", Tcl_PosixError(interp), (char *) NULL);
+ Tcl_GetString(fileName), "\": ", Tcl_PosixError(interp),
+ (char *) NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -1279,15 +1306,15 @@ static int
SetOwnerAttribute(interp, objIndex, fileName, attributePtr)
Tcl_Interp *interp; /* The interp for error reporting. */
int objIndex; /* The index of the attribute. */
- CONST char *fileName; /* The name of the file (UTF-8). */
+ Tcl_Obj *fileName; /* The name of the file (UTF-8). */
Tcl_Obj *attributePtr; /* New owner for file. */
{
long uid;
int result;
- Tcl_DString ds;
CONST char *native;
if (Tcl_GetLongFromObj(NULL, attributePtr, &uid) != TCL_OK) {
+ Tcl_DString ds;
struct passwd *pwPtr;
CONST char *string;
int length;
@@ -1300,20 +1327,21 @@ SetOwnerAttribute(interp, objIndex, fileName, attributePtr)
if (pwPtr == NULL) {
Tcl_AppendResult(interp, "could not set owner for file \"",
- fileName, "\": user \"", string, "\" does not exist",
+ Tcl_GetString(fileName), "\": user \"",
+ string, "\" does not exist",
(char *) NULL);
return TCL_ERROR;
}
uid = pwPtr->pw_uid;
}
- native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
+ native = Tcl_FSGetNativePath(fileName);
result = chown(native, (uid_t) uid, (gid_t) -1); /* INTL: Native. */
- Tcl_DStringFree(&ds);
if (result != 0) {
- Tcl_AppendResult(interp, "could not set owner for file \"", fileName,
- "\": ", Tcl_PosixError(interp), (char *) NULL);
+ Tcl_AppendResult(interp, "could not set owner for file \"",
+ Tcl_GetString(fileName), "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -1339,14 +1367,13 @@ static int
SetPermissionsAttribute(interp, objIndex, fileName, attributePtr)
Tcl_Interp *interp; /* The interp we are using for errors. */
int objIndex; /* The index of the attribute. */
- CONST char *fileName; /* The name of the file (UTF-8). */
+ Tcl_Obj *fileName; /* The name of the file (UTF-8). */
Tcl_Obj *attributePtr; /* The attribute to set. */
{
long mode;
mode_t newMode;
int result;
CONST char *native;
- Tcl_DString ds;
/*
* First try if the string is a number
@@ -1354,7 +1381,7 @@ SetPermissionsAttribute(interp, objIndex, fileName, attributePtr)
if (Tcl_GetLongFromObj(NULL, attributePtr, &mode) == TCL_OK) {
newMode = (mode_t) (mode & 0x00007FFF);
} else {
- struct stat buf;
+ Tcl_StatBuf buf;
char *modeStringPtr = Tcl_GetString(attributePtr);
/*
@@ -1363,9 +1390,10 @@ SetPermissionsAttribute(interp, objIndex, fileName, attributePtr)
* We get the current mode of the file, in order to allow for
* ug+-=rwx style chmod strings.
*/
- result = TclStat(fileName, &buf);
+ result = TclpObjStat(fileName, &buf);
if (result != 0) {
- Tcl_AppendResult(interp, "could not read \"", fileName, "\": ",
+ Tcl_AppendResult(interp, "could not read \"",
+ Tcl_GetString(fileName), "\": ",
Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
@@ -1379,12 +1407,12 @@ SetPermissionsAttribute(interp, objIndex, fileName, attributePtr)
}
}
- native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
+ native = Tcl_FSGetNativePath(fileName);
result = chmod(native, newMode); /* INTL: Native. */
- Tcl_DStringFree(&ds);
if (result != 0) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "could not set permissions for file \"", fileName, "\": ",
+ "could not set permissions for file \"",
+ Tcl_GetString(fileName), "\": ",
Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
@@ -1394,14 +1422,12 @@ SetPermissionsAttribute(interp, objIndex, fileName, attributePtr)
/*
*---------------------------------------------------------------------------
*
- * TclpListVolumes --
+ * TclpObjListVolumes --
*
* Lists the currently mounted volumes, which on UNIX is just /.
*
* Results:
- * A standard Tcl result. Will always be TCL_OK, since there is no way
- * that this command can fail. Also, the interpreter's result is set to
- * the list of volumes.
+ * The list of volumes.
*
* Side effects:
* None.
@@ -1409,16 +1435,13 @@ SetPermissionsAttribute(interp, objIndex, fileName, attributePtr)
*---------------------------------------------------------------------------
*/
-int
-TclpListVolumes(interp)
- Tcl_Interp *interp; /* Interpreter to which to pass
- * the volume list. */
+Tcl_Obj*
+TclpObjListVolumes(void)
{
- Tcl_Obj *resultPtr;
-
- resultPtr = Tcl_GetObjResult(interp);
- Tcl_SetStringObj(resultPtr, "/", 1);
- return TCL_OK;
+ Tcl_Obj *resultPtr = Tcl_NewStringObj("/",1);
+
+ Tcl_IncrRefCount(resultPtr);
+ return resultPtr;
}
/*
@@ -1609,5 +1632,117 @@ GetModeFromPermString(interp, modeStringPtr, modePtr)
}
return TCL_OK;
}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpObjNormalizePath --
+ *
+ * This function scans through a path specification and replaces
+ * it, in place, with a normalized version. A normalized version
+ * is one in which all symlinks in the path are replaced with
+ * their expanded form (except a symlink at the very end of the
+ * path).
+ *
+ * Results:
+ * The new 'nextCheckpoint' value, giving as far as we could
+ * understand in the path.
+ *
+ * Side effects:
+ * The pathPtr string, is modified.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
+ Tcl_Interp *interp;
+ Tcl_Obj *pathPtr;
+ int nextCheckpoint;
+{
+ char *currentPathEndPosition;
+ int pathLen;
+ char cur;
+ char *path = Tcl_GetStringFromObj(pathPtr, &pathLen);
+#ifndef NO_REALPATH
+ char normPath[MAXPATHLEN];
+ Tcl_DString ds;
+ CONST char *nativePath;
+#endif
+ currentPathEndPosition = path + nextCheckpoint;
+
+ while (1) {
+ cur = *currentPathEndPosition;
+ if ((cur == '/') && (path != currentPathEndPosition)) {
+ /* Reached directory separator */
+ Tcl_DString ds;
+ CONST char *nativePath;
+ int accessOk;
+
+ nativePath = Tcl_UtfToExternalDString(NULL, path,
+ currentPathEndPosition - path, &ds);
+ accessOk = access(nativePath, F_OK);
+ Tcl_DStringFree(&ds);
+ if (accessOk != 0) {
+ /* File doesn't exist */
+ break;
+ }
+ /* Update the acceptable point */
+ nextCheckpoint = currentPathEndPosition - path;
+ } else if (cur == 0) {
+ /* Reached end of string */
+ break;
+ }
+ currentPathEndPosition++;
+ }
+ /*
+ * We should really now convert this to a canonical path. We do
+ * that with 'realpath' if we have it available. Otherwise we could
+ * step through every single path component, checking whether it is a
+ * symlink, but that would be a lot of work, and most modern OSes
+ * have 'realpath'.
+ */
+#ifndef NO_REALPATH
+ /*
+ * If we only had '/foo' or '/' then we never increment nextCheckpoint
+ * and we don't need or want to go through 'Realpath'. Also, on some
+ * platforms, passing an empty string to 'Realpath' will give us the
+ * normalized pwd, which is not what we want at all!
+ */
+ if (nextCheckpoint == 0) return 0;
+
+ nativePath = Tcl_UtfToExternalDString(NULL, path, nextCheckpoint, &ds);
+ if (Realpath(nativePath, normPath) != NULL) {
+ /*
+ * Free up the native path and put in its place the
+ * converted, normalized path.
+ */
+ Tcl_DStringFree(&ds);
+ Tcl_ExternalToUtfDString(NULL, normPath, (int) strlen(normPath), &ds);
+
+ if (path[nextCheckpoint] != '\0') {
+ /* not at end, append remaining path */
+ int normLen = Tcl_DStringLength(&ds);
+ Tcl_DStringAppend(&ds, path + nextCheckpoint,
+ pathLen - nextCheckpoint);
+ /*
+ * We recognise up to and including the directory
+ * separator.
+ */
+ nextCheckpoint = normLen + 1;
+ } else {
+ /* We recognise the whole string */
+ nextCheckpoint = Tcl_DStringLength(&ds);
+ }
+ /*
+ * Overwrite with the normalized path.
+ */
+ Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds));
+ }
+ Tcl_DStringFree(&ds);
+#endif /* !NO_REALPATH */
+ return nextCheckpoint;
+}
diff --git a/tcl/unix/tclUnixFile.c b/tcl/unix/tclUnixFile.c
index 3354644c87a..64e158625e0 100644
--- a/tcl/unix/tclUnixFile.c
+++ b/tcl/unix/tclUnixFile.c
@@ -15,6 +15,8 @@
#include "tclInt.h"
#include "tclPort.h"
+static int NativeMatchType(CONST char* nativeName, Tcl_GlobTypeData *types);
+
/*
*---------------------------------------------------------------------------
@@ -46,7 +48,7 @@ TclpFindExecutable(argv0)
* (native). */
{
CONST char *name, *p;
- struct stat statBuf;
+ Tcl_StatBuf statBuf;
int length;
Tcl_DString buffer, nameString;
@@ -116,8 +118,8 @@ TclpFindExecutable(argv0)
* strings directly.
*/
- if ((access(name, X_OK) == 0) /* INTL: Native. */
- && (stat(name, &statBuf) == 0) /* INTL: Native. */
+ if ((access(name, X_OK) == 0) /* INTL: Native. */
+ && (TclOSstat(name, &statBuf) == 0) /* INTL: Native. */
&& S_ISREG(statBuf.st_mode)) {
goto gotName;
}
@@ -135,8 +137,12 @@ TclpFindExecutable(argv0)
* If the name starts with "/" then just copy it to tclExecutableName.
*/
- gotName:
+gotName:
+#ifdef DJGPP
+ if (name[1] == ':') {
+#else
if (name[0] == '/') {
+#endif
Tcl_ExternalToUtfDString(NULL, name, -1, &nameString);
tclNativeExecutableName = (char *)
ckalloc((unsigned) (Tcl_DStringLength(&nameString) + 1));
@@ -168,7 +174,7 @@ TclpFindExecutable(argv0)
Tcl_DStringValue(&nameString));
Tcl_DStringFree(&nameString);
- done:
+done:
Tcl_DStringFree(&buffer);
return tclNativeExecutableName;
}
@@ -176,264 +182,281 @@ TclpFindExecutable(argv0)
/*
*----------------------------------------------------------------------
*
- * TclpMatchFilesTypes --
+ * TclpMatchInDirectory --
*
* This routine is used by the globbing code to search a
* directory for all files which match a given pattern.
*
* Results:
- * If the tail argument is NULL, then the matching files are
- * added to the the interp's result. Otherwise, TclDoGlob is called
- * recursively for each matching subdirectory. The return value
- * is a standard Tcl result indicating whether an error occurred
- * in globbing.
+ * The return value is a standard Tcl result indicating whether an
+ * error occurred in globbing. Errors are left in interp, good
+ * results are lappended to resultPtr (which must be a valid object)
*
* Side effects:
* None.
*
- *----------------------------------------------------------------------
- */
+ *---------------------------------------------------------------------- */
int
-TclpMatchFilesTypes(interp, separators, dirPtr, pattern, tail, types)
- Tcl_Interp *interp; /* Interpreter to receive results. */
- char *separators; /* Directory separators to pass to TclDoGlob */
- Tcl_DString *dirPtr; /* Contains path to directory to search. */
- char *pattern; /* Pattern to match against. */
- char *tail; /* Pointer to end of pattern. Tail must
- * point to a location in pattern and must
- * not be static. */
- GlobTypeData *types; /* Object containing list of acceptable types.
- * May be NULL. */
+TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
+ Tcl_Interp *interp; /* Interpreter to receive errors. */
+ Tcl_Obj *resultPtr; /* List object to lappend 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. */
{
- char *native, *fname, *dirName, *patternEnd = tail;
- char savedChar = 0; /* lint. */
- DIR *d;
- Tcl_DString ds;
- struct stat statBuf;
- int matchHidden;
- int result = TCL_OK;
- int baseLength = Tcl_DStringLength(dirPtr);
- Tcl_Obj *resultPtr;
+ CONST char *native;
+ Tcl_Obj *fileNamePtr;
- /*
- * Make sure that the directory part of the name really is a
- * directory. If the directory name is "", use the name "."
- * instead, because some UNIX systems don't treat "" like "."
- * automatically. Keep the "" for use in generating file names,
- * otherwise "glob foo.c" would return "./foo.c".
- */
-
- if (Tcl_DStringLength(dirPtr) == 0) {
- dirName = ".";
- } else {
- dirName = Tcl_DStringValue(dirPtr);
+ fileNamePtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
+ if (fileNamePtr == NULL) {
+ return TCL_ERROR;
}
-
- if ((TclpStat(dirName, &statBuf) != 0) /* INTL: UTF-8. */
- || !S_ISDIR(statBuf.st_mode)) {
+
+ if (pattern == NULL || (*pattern == '\0')) {
+ /* Match a file directly */
+ CONST char *native = (CONST char*) Tcl_FSGetNativePath(pathPtr);
+ if (NativeMatchType(native, types)) {
+ Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
+ }
return TCL_OK;
- }
-
- /*
- * Check to see if the pattern needs to compare with hidden files.
- */
-
- if ((pattern[0] == '.')
- || ((pattern[0] == '\\') && (pattern[1] == '.'))) {
- matchHidden = 1;
} else {
- matchHidden = 0;
- }
-
- /*
- * Now open the directory for reading and iterate over the contents.
- */
-
- native = Tcl_UtfToExternalDString(NULL, dirName, -1, &ds);
- d = opendir(native); /* INTL: Native. */
- Tcl_DStringFree(&ds);
- if (d == NULL) {
- Tcl_ResetResult(interp);
-
+ CONST char *fname, *dirName;
+ DIR *d;
+ Tcl_DString ds;
+ Tcl_StatBuf statBuf;
+ int matchHidden;
+ int nativeDirLen;
+ int result = TCL_OK;
+ Tcl_DString dsOrig;
+ int baseLength;
+
+ Tcl_DStringInit(&dsOrig);
+ Tcl_DStringAppend(&dsOrig, Tcl_GetString(fileNamePtr), -1);
+ baseLength = Tcl_DStringLength(&dsOrig);
+
/*
- * Strip off a trailing '/' if necessary, before reporting the error.
+ * Make sure that the directory part of the name really is a
+ * directory. If the directory name is "", use the name "."
+ * instead, because some UNIX systems don't treat "" like "."
+ * automatically. Keep the "" for use in generating file names,
+ * otherwise "glob foo.c" would return "./foo.c".
*/
- if (baseLength > 0) {
- savedChar = (Tcl_DStringValue(dirPtr))[baseLength-1];
- if (savedChar == '/') {
- (Tcl_DStringValue(dirPtr))[baseLength-1] = '\0';
+ if (baseLength == 0) {
+ dirName = ".";
+ } else {
+ dirName = Tcl_DStringValue(&dsOrig);
+ /* Make sure we have a trailing directory delimiter */
+ if (dirName[baseLength-1] != '/') {
+ dirName = Tcl_DStringAppend(&dsOrig, "/", 1);
+ baseLength++;
}
}
- Tcl_AppendResult(interp, "couldn't read directory \"",
- Tcl_DStringValue(dirPtr), "\": ",
- Tcl_PosixError(interp), (char *) NULL);
- if (baseLength > 0) {
- (Tcl_DStringValue(dirPtr))[baseLength-1] = savedChar;
+
+ /*
+ * Check to see if the pattern needs to compare with hidden files.
+ */
+
+ if ((pattern[0] == '.')
+ || ((pattern[0] == '\\') && (pattern[1] == '.'))) {
+ matchHidden = 1;
+ } else {
+ matchHidden = 0;
}
- return TCL_ERROR;
- }
- /*
- * Clean up the end of the pattern and the tail pointer. Leave
- * the tail pointing to the first character after the path separator
- * following the pattern, or NULL. Also, ensure that the pattern
- * is null-terminated.
- */
+ /*
+ * Now open the directory for reading and iterate over the contents.
+ */
- if (*tail == '\\') {
- tail++;
- }
- if (*tail == '\0') {
- tail = NULL;
- } else {
- tail++;
- }
- savedChar = *patternEnd;
- *patternEnd = '\0';
+ native = Tcl_UtfToExternalDString(NULL, dirName, -1, &ds);
- resultPtr = Tcl_GetObjResult(interp);
- while (1) {
- char *utf;
- struct dirent *entryPtr;
-
- entryPtr = readdir(d); /* INTL: Native. */
- if (entryPtr == NULL) {
- break;
+ if ((TclOSstat(native, &statBuf) != 0) /* INTL: Native. */
+ || !S_ISDIR(statBuf.st_mode)) {
+ Tcl_DStringFree(&dsOrig);
+ Tcl_DStringFree(&ds);
+ return TCL_OK;
}
- if (types != NULL && (types->perm & TCL_GLOB_PERM_HIDDEN)) {
- /*
- * We explicitly asked for hidden files, so turn around
- * and ignore any file which isn't hidden.
- */
- if (*entryPtr->d_name != '.') {
- continue;
- }
- } else if (!matchHidden && (*entryPtr->d_name == '.')) {
+ d = opendir(native); /* INTL: Native. */
+ if (d == NULL) {
+ char savedChar = '\0';
+ Tcl_ResetResult(interp);
+ Tcl_DStringFree(&ds);
+
/*
- * Don't match names starting with "." unless the "." is
- * present in the pattern.
+ * Strip off a trailing '/' if necessary, before reporting the error.
*/
- continue;
+
+ if (baseLength > 0) {
+ savedChar = (Tcl_DStringValue(&dsOrig))[baseLength-1];
+ if (savedChar == '/') {
+ (Tcl_DStringValue(&dsOrig))[baseLength-1] = '\0';
+ }
+ }
+ Tcl_AppendResult(interp, "couldn't read directory \"",
+ Tcl_DStringValue(&dsOrig), "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
+ if (baseLength > 0) {
+ (Tcl_DStringValue(&dsOrig))[baseLength-1] = savedChar;
+ }
+ Tcl_DStringFree(&dsOrig);
+ return TCL_ERROR;
}
- /*
- * Now check to see if the file matches. If there are more
- * characters to be processed, then ensure matching files are
- * directories before calling TclDoGlob. Otherwise, just add
- * the file to the result.
- */
+ nativeDirLen = Tcl_DStringLength(&ds);
+
+ while (1) {
+ Tcl_DString utfDs;
+ CONST char *utf;
+ Tcl_DirEntry *entryPtr;
+
+ entryPtr = TclOSreaddir(d); /* INTL: Native. */
+ if (entryPtr == NULL) {
+ break;
+ }
+ if (types != NULL && (types->perm & TCL_GLOB_PERM_HIDDEN)) {
+ /*
+ * We explicitly asked for hidden files, so turn around
+ * and ignore any file which isn't hidden.
+ */
+ if (*entryPtr->d_name != '.') {
+ continue;
+ }
+ } else if (!matchHidden && (*entryPtr->d_name == '.')) {
+ /*
+ * Don't match names starting with "." unless the "." is
+ * present in the pattern.
+ */
+ continue;
+ }
- utf = Tcl_ExternalToUtfDString(NULL, entryPtr->d_name, -1, &ds);
- if (Tcl_StringMatch(utf, pattern) != 0) {
- Tcl_DStringSetLength(dirPtr, baseLength);
- Tcl_DStringAppend(dirPtr, utf, -1);
- fname = Tcl_DStringValue(dirPtr);
- if (tail == NULL) {
+ /*
+ * Now check to see if the file matches, according to both type
+ * and pattern. If so, add the file to the result.
+ */
+
+ utf = Tcl_ExternalToUtfDString(NULL, entryPtr->d_name, -1, &utfDs);
+ if (Tcl_StringMatch(utf, pattern) != 0) {
int typeOk = 1;
- if (types != NULL) {
- if (types->perm != 0) {
- struct stat buf;
- if (TclpStat(fname, &buf) != 0) {
- panic("stat failed on known file");
- }
- /*
- * readonly means that there are NO write permissions
- * (even for user), but execute is OK for anybody
- */
- if (
- ((types->perm & TCL_GLOB_PERM_RONLY) &&
- (buf.st_mode & (S_IWOTH|S_IWGRP|S_IWUSR))) ||
- ((types->perm & TCL_GLOB_PERM_R) &&
- (TclpAccess(fname, R_OK) != 0)) ||
- ((types->perm & TCL_GLOB_PERM_W) &&
- (TclpAccess(fname, W_OK) != 0)) ||
- ((types->perm & TCL_GLOB_PERM_X) &&
- (TclpAccess(fname, X_OK) != 0))
- ) {
- typeOk = 0;
- }
- }
- if (typeOk && (types->type != 0)) {
- struct stat buf;
- /*
- * We must match at least one flag to be listed
- */
- typeOk = 0;
- if (TclpLstat(fname, &buf) >= 0) {
- /*
- * In order bcdpfls as in 'find -t'
- */
- if (
- ((types->type & TCL_GLOB_TYPE_BLOCK) &&
- S_ISBLK(buf.st_mode)) ||
- ((types->type & TCL_GLOB_TYPE_CHAR) &&
- S_ISCHR(buf.st_mode)) ||
- ((types->type & TCL_GLOB_TYPE_DIR) &&
- S_ISDIR(buf.st_mode)) ||
- ((types->type & TCL_GLOB_TYPE_PIPE) &&
- S_ISFIFO(buf.st_mode)) ||
- ((types->type & TCL_GLOB_TYPE_FILE) &&
- S_ISREG(buf.st_mode))
-#ifdef S_ISLNK
- || ((types->type & TCL_GLOB_TYPE_LINK) &&
- S_ISLNK(buf.st_mode))
-#endif
-#ifdef S_ISSOCK
- || ((types->type & TCL_GLOB_TYPE_SOCK) &&
- S_ISSOCK(buf.st_mode))
-#endif
- ) {
- typeOk = 1;
- }
- } else {
- /* Posix error occurred */
- }
- }
+ Tcl_DStringSetLength(&dsOrig, baseLength);
+ Tcl_DStringAppend(&dsOrig, utf, -1);
+ fname = Tcl_DStringValue(&dsOrig);
+ if (types != NULL) {
+ char *nativeEntry;
+ Tcl_DStringSetLength(&ds, nativeDirLen);
+ nativeEntry = Tcl_DStringAppend(&ds, entryPtr->d_name, -1);
+ typeOk = NativeMatchType(nativeEntry, types);
}
if (typeOk) {
Tcl_ListObjAppendElement(interp, resultPtr,
- Tcl_NewStringObj(fname,
- Tcl_DStringLength(dirPtr)));
- }
- } else if ((TclpStat(fname, &statBuf) == 0)
- && S_ISDIR(statBuf.st_mode)) {
- Tcl_DStringAppend(dirPtr, "/", 1);
- result = TclDoGlob(interp, separators, dirPtr, tail, types);
- if (result != TCL_OK) {
- Tcl_DStringFree(&ds);
- break;
+ Tcl_NewStringObj(fname, Tcl_DStringLength(&dsOrig)));
}
}
+ Tcl_DStringFree(&utfDs);
}
+
+ closedir(d);
Tcl_DStringFree(&ds);
+ Tcl_DStringFree(&dsOrig);
+ return result;
}
- *patternEnd = savedChar;
-
- closedir(d);
- return result;
}
-
-/*
- * TclpMatchFiles --
- *
- * This function is now obsolete. Call the above function
- * 'TclpMatchFilesTypes' instead.
- */
-int
-TclpMatchFiles(interp, separators, dirPtr, pattern, tail)
- Tcl_Interp *interp; /* Interpreter to receive results. */
- char *separators; /* Directory separators to pass to TclDoGlob */
- Tcl_DString *dirPtr; /* Contains path to directory to search. */
- char *pattern; /* Pattern to match against. */
- char *tail; /* Pointer to end of pattern. Tail must
- * point to a location in pattern and must
- * not be static. */
+static int
+NativeMatchType(
+ CONST char* nativeEntry, /* Native path to check */
+ Tcl_GlobTypeData *types) /* Type description to match against */
{
- return TclpMatchFilesTypes(interp,separators,dirPtr,pattern,tail,NULL);
+ Tcl_StatBuf buf;
+ if (types == NULL) {
+ /*
+ * Simply check for the file's existence, but do it
+ * with lstat, in case it is a link to a file which
+ * doesn't exist (since that case would not show up
+ * if we used 'access' or 'stat')
+ */
+ if (TclOSlstat(nativeEntry, &buf) != 0) {
+ return 0;
+ }
+ } else {
+ if (types->perm != 0) {
+ if (TclOSstat(nativeEntry, &buf) != 0) {
+ /*
+ * Either the file has disappeared between the
+ * 'readdir' call and the 'stat' call, or
+ * the file is a link to a file which doesn't
+ * exist (which we could ascertain with
+ * lstat), or there is some other strange
+ * problem. In all these cases, we define this
+ * to mean the file does not match any defined
+ * permission, and therefore it is not
+ * added to the list of files to return.
+ */
+ return 0;
+ }
+
+ /*
+ * readonly means that there are NO write permissions
+ * (even for user), but execute is OK for anybody
+ */
+ if (((types->perm & TCL_GLOB_PERM_RONLY) &&
+ (buf.st_mode & (S_IWOTH|S_IWGRP|S_IWUSR))) ||
+ ((types->perm & TCL_GLOB_PERM_R) &&
+ (access(nativeEntry, R_OK) != 0)) ||
+ ((types->perm & TCL_GLOB_PERM_W) &&
+ (access(nativeEntry, W_OK) != 0)) ||
+ ((types->perm & TCL_GLOB_PERM_X) &&
+ (access(nativeEntry, X_OK) != 0))
+ ) {
+ return 0;
+ }
+ }
+ if (types->type != 0) {
+ if (types->perm == 0) {
+ /* We haven't yet done a stat on the file */
+ if (TclOSstat(nativeEntry, &buf) != 0) {
+ /* Posix error occurred */
+ return 0;
+ }
+ }
+ /*
+ * In order bcdpfls as in 'find -t'
+ */
+ if (
+ ((types->type & TCL_GLOB_TYPE_BLOCK) &&
+ S_ISBLK(buf.st_mode)) ||
+ ((types->type & TCL_GLOB_TYPE_CHAR) &&
+ S_ISCHR(buf.st_mode)) ||
+ ((types->type & TCL_GLOB_TYPE_DIR) &&
+ S_ISDIR(buf.st_mode)) ||
+ ((types->type & TCL_GLOB_TYPE_PIPE) &&
+ S_ISFIFO(buf.st_mode)) ||
+ ((types->type & TCL_GLOB_TYPE_FILE) &&
+ S_ISREG(buf.st_mode))
+#ifdef S_ISSOCK
+ || ((types->type & TCL_GLOB_TYPE_SOCK) &&
+ S_ISSOCK(buf.st_mode))
+#endif /* S_ISSOCK */
+ ) {
+ /* Do nothing -- this file is ok */
+ } else {
+#ifdef S_ISLNK
+ if (types->type & TCL_GLOB_TYPE_LINK) {
+ if (TclOSlstat(nativeEntry, &buf) == 0) {
+ if (S_ISLNK(buf.st_mode)) {
+ return 1;
+ }
+ }
+ }
+#endif /* S_ISLNK */
+ return 0;
+ }
+ }
+ }
+ return 1;
}
/*
@@ -465,7 +488,7 @@ TclpGetUserHome(name, bufferPtr)
{
struct passwd *pwPtr;
Tcl_DString ds;
- char *native;
+ CONST char *native;
native = Tcl_UtfToExternalDString(NULL, name, -1, &ds);
pwPtr = getpwnam(native); /* INTL: Native. */
@@ -483,7 +506,7 @@ TclpGetUserHome(name, bufferPtr)
/*
*---------------------------------------------------------------------------
*
- * TclpAccess --
+ * TclpObjAccess --
*
* This function replaces the library version of access().
*
@@ -496,26 +519,23 @@ TclpGetUserHome(name, bufferPtr)
*---------------------------------------------------------------------------
*/
-int
-TclpAccess(path, mode)
- CONST char *path; /* Path of file to access (UTF-8). */
- int mode; /* Permission setting. */
+int
+TclpObjAccess(pathPtr, mode)
+ Tcl_Obj *pathPtr; /* Path of file to access */
+ int mode; /* Permission setting. */
{
- int result;
- Tcl_DString ds;
- char *native;
-
- native = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
- result = access(native, mode); /* INTL: Native. */
- Tcl_DStringFree(&ds);
-
- return result;
+ CONST char *path = Tcl_FSGetNativePath(pathPtr);
+ if (path == NULL) {
+ return -1;
+ } else {
+ return access(path, mode);
+ }
}
/*
*---------------------------------------------------------------------------
*
- * TclpChdir --
+ * TclpObjChdir --
*
* This function replaces the library version of chdir().
*
@@ -528,25 +548,22 @@ TclpAccess(path, mode)
*---------------------------------------------------------------------------
*/
-int
-TclpChdir(dirName)
- CONST char *dirName; /* Path to new working directory (UTF-8). */
+int
+TclpObjChdir(pathPtr)
+ Tcl_Obj *pathPtr; /* Path to new working directory */
{
- int result;
- Tcl_DString ds;
- char *native;
-
- native = Tcl_UtfToExternalDString(NULL, dirName, -1, &ds);
- result = chdir(native); /* INTL: Native. */
- Tcl_DStringFree(&ds);
-
- return result;
+ CONST char *path = Tcl_FSGetNativePath(pathPtr);
+ if (path == NULL) {
+ return -1;
+ } else {
+ return chdir(path);
+ }
}
/*
*----------------------------------------------------------------------
*
- * TclpLstat --
+ * TclpObjLstat --
*
* This function replaces the library version of lstat().
*
@@ -559,26 +576,18 @@ TclpChdir(dirName)
*----------------------------------------------------------------------
*/
-int
-TclpLstat(path, bufPtr)
- CONST char *path; /* Path of file to stat (UTF-8). */
- struct stat *bufPtr; /* Filled with results of stat call. */
+int
+TclpObjLstat(pathPtr, bufPtr)
+ Tcl_Obj *pathPtr; /* Path of file to stat */
+ Tcl_StatBuf *bufPtr; /* Filled with results of stat call. */
{
- int result;
- Tcl_DString ds;
- char *native;
-
- native = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
- result = lstat(native, bufPtr); /* INTL: Native. */
- Tcl_DStringFree(&ds);
-
- return result;
+ return TclOSlstat(Tcl_FSGetNativePath(pathPtr), bufPtr);
}
/*
*---------------------------------------------------------------------------
*
- * TclpGetCwd --
+ * TclpObjGetCwd --
*
* This function replaces the library version of getcwd().
*
@@ -596,7 +605,23 @@ TclpLstat(path, bufPtr)
*----------------------------------------------------------------------
*/
-char *
+Tcl_Obj*
+TclpObjGetCwd(interp)
+ Tcl_Interp *interp;
+{
+ Tcl_DString ds;
+ if (TclpGetCwd(interp, &ds) != NULL) {
+ Tcl_Obj *cwdPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
+ Tcl_IncrRefCount(cwdPtr);
+ Tcl_DStringFree(&ds);
+ return cwdPtr;
+ } else {
+ return NULL;
+ }
+}
+
+/* Older string based version */
+CONST char *
TclpGetCwd(interp, bufferPtr)
Tcl_Interp *interp; /* If non-NULL, used for error reporting. */
Tcl_DString *bufferPtr; /* Uninitialized or free DString filled
@@ -645,9 +670,10 @@ TclpReadlink(path, linkPtr)
Tcl_DString *linkPtr; /* Uninitialized or free DString filled
* with contents of link (UTF-8). */
{
+#ifndef DJGPP
char link[MAXPATHLEN];
int length;
- char *native;
+ CONST char *native;
Tcl_DString ds;
native = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
@@ -660,12 +686,15 @@ TclpReadlink(path, linkPtr)
Tcl_ExternalToUtfDString(NULL, link, length, linkPtr);
return Tcl_DStringValue(linkPtr);
+#else
+ return NULL;
+#endif
}
/*
*----------------------------------------------------------------------
*
- * TclpStat --
+ * TclpObjStat --
*
* This function replaces the library version of stat().
*
@@ -678,20 +707,109 @@ TclpReadlink(path, linkPtr)
*----------------------------------------------------------------------
*/
-int
-TclpStat(path, bufPtr)
- CONST char *path; /* Path of file to stat (in UTF-8). */
- struct stat *bufPtr; /* Filled with results of stat call. */
+int
+TclpObjStat(pathPtr, bufPtr)
+ Tcl_Obj *pathPtr; /* Path of file to stat */
+ Tcl_StatBuf *bufPtr; /* Filled with results of stat call. */
{
- int result;
- Tcl_DString ds;
- char *native;
-
- native = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
- result = stat(native, bufPtr); /* INTL: Native. */
- Tcl_DStringFree(&ds);
+ CONST char *path = Tcl_FSGetNativePath(pathPtr);
+ if (path == NULL) {
+ return -1;
+ } else {
+ return TclOSstat(path, bufPtr);
+ }
+}
+
+
+#ifdef S_IFLNK
+
+Tcl_Obj*
+TclpObjLink(pathPtr, toPtr, linkAction)
+ Tcl_Obj *pathPtr;
+ Tcl_Obj *toPtr;
+ int linkAction;
+{
+ if (toPtr != NULL) {
+ CONST char *src = Tcl_FSGetNativePath(pathPtr);
+ CONST char *target = Tcl_FSGetNativePath(toPtr);
+
+ if (src == NULL || target == NULL) {
+ return NULL;
+ }
+ if (access(src, F_OK) != -1) {
+ /* src exists */
+ errno = EEXIST;
+ return NULL;
+ }
+ if (access(target, F_OK) == -1) {
+ /* target doesn't exist */
+ errno = ENOENT;
+ return NULL;
+ }
+ /*
+ * Check symbolic link flag first, since we prefer to
+ * create these.
+ */
+ if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {
+ if (symlink(target, src) != 0) return NULL;
+ } else if (linkAction & TCL_CREATE_HARD_LINK) {
+ if (link(target, src) != 0) return NULL;
+ } else {
+ errno = ENODEV;
+ return NULL;
+ }
+ return toPtr;
+ } else {
+ Tcl_Obj* linkPtr = NULL;
+
+ char link[MAXPATHLEN];
+ int length;
+ Tcl_DString ds;
- return result;
+ if (Tcl_FSGetTranslatedPath(NULL, pathPtr) == NULL) {
+ return NULL;
+ }
+ length = readlink(Tcl_FSGetNativePath(pathPtr), link, sizeof(link));
+ if (length < 0) {
+ return NULL;
+ }
+
+ Tcl_ExternalToUtfDString(NULL, link, length, &ds);
+ linkPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds));
+ Tcl_DStringFree(&ds);
+ if (linkPtr != NULL) {
+ Tcl_IncrRefCount(linkPtr);
+ }
+ return linkPtr;
+ }
}
+#endif
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpFilesystemPathType --
+ *
+ * This function is part of the native filesystem support, and
+ * returns the path type of the given path. Right now it simply
+ * returns NULL. In the future it could return specific path
+ * types, like 'nfs', 'samba', 'FAT32', etc.
+ *
+ * Results:
+ * NULL at present.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+Tcl_Obj*
+TclpFilesystemPathType(pathObjPtr)
+ Tcl_Obj* pathObjPtr;
+{
+ /* All native paths are of the same type */
+ return NULL;
+}
diff --git a/tcl/unix/tclUnixInit.c b/tcl/unix/tclUnixInit.c
index e1d89af4e05..047941d97fc 100644
--- a/tcl/unix/tclUnixInit.c
+++ b/tcl/unix/tclUnixInit.c
@@ -10,9 +10,15 @@
* RCS: @(#) $Id$
*/
+#if defined(HAVE_CFBUNDLE)
+#include <CoreFoundation/CoreFoundation.h>
+#endif
#include "tclInt.h"
#include "tclPort.h"
#include <locale.h>
+#ifdef HAVE_LANGINFO
+#include <langinfo.h>
+#endif
#if defined(__FreeBSD__)
# include <floatingpoint.h>
#endif
@@ -29,6 +35,20 @@
*/
#include "tclInitScript.h"
+/* Used to store the encoding used for binary files */
+static Tcl_Encoding binaryEncoding = NULL;
+/* Has the basic library path encoding issue been fixed */
+static int libraryPathEncodingFixed = 0;
+
+/*
+ * Tcl tries to use standard and homebrew methods to guess the right
+ * encoding on the platform. However, there is always a final fallback,
+ * and this value is it. Make sure it is a real Tcl encoding.
+ */
+
+#ifndef TCL_DEFAULT_ENCODING
+#define TCL_DEFAULT_ENCODING "iso8859-1"
+#endif
/*
* Default directory in which to look for Tcl library scripts. The
@@ -47,7 +67,10 @@ static char pkgPath[sizeof(TCL_PACKAGE_PATH)+200] = TCL_PACKAGE_PATH;
/*
* The following table is used to map from Unix locale strings to
- * encoding files.
+ * encoding files. If HAVE_LANGINFO is defined, then this is a fallback
+ * table when the result from nl_langinfo isn't a recognized encoding.
+ * Otherwise this is the first list checked for a mapping from env
+ * encoding to Tcl encoding name.
*/
typedef struct LocaleTable {
@@ -56,8 +79,32 @@ typedef struct LocaleTable {
} LocaleTable;
static CONST LocaleTable localeTable[] = {
+#ifdef HAVE_LANGINFO
+ {"gb2312-1980", "gb2312"},
+#ifdef __hpux
+ {"SJIS", "shiftjis"},
+ {"eucjp", "euc-jp"},
+ {"euckr", "euc-kr"},
+ {"euctw", "euc-cn"},
+ {"greek8", "cp869"},
+ {"iso88591", "iso8859-1"},
+ {"iso88592", "iso8859-2"},
+ {"iso88595", "iso8859-5"},
+ {"iso88596", "iso8859-6"},
+ {"iso88597", "iso8859-7"},
+ {"iso88598", "iso8859-8"},
+ {"iso88599", "iso8859-9"},
+ {"iso885915", "iso8859-15"},
+ {"roman8", "iso8859-1"},
+ {"tis620", "tis-620"},
+ {"turkish8", "cp857"},
+ {"utf8", "utf-8"},
+#endif /* __hpux */
+#endif /* HAVE_LANGINFO */
+
{"ja_JP.SJIS", "shiftjis"},
{"ja_JP.EUC", "euc-jp"},
+ {"ja_JP.eucJP", "euc-jp"},
{"ja_JP.JIS", "iso2022-jp"},
{"ja_JP.mscode", "shiftjis"},
{"ja_JP.ujis", "euc-jp"},
@@ -92,6 +139,11 @@ static CONST LocaleTable localeTable[] = {
{NULL, NULL}
};
+
+#ifdef HAVE_CFBUNDLE
+static int Tcl_MacOSXGetLibraryPath(Tcl_Interp *interp, int maxPathLen, char *tclLibPath);
+#endif /* HAVE_CFBUNDLE */
+
/*
*---------------------------------------------------------------------------
@@ -192,10 +244,10 @@ CONST char *path; /* Path to the executable in native
{
#define LIBRARY_SIZE 32
Tcl_Obj *pathPtr, *objPtr;
- char *str;
+ CONST char *str;
Tcl_DString buffer, ds;
int pathc;
- char **pathv;
+ CONST char **pathv;
char installLib[LIBRARY_SIZE], developLib[LIBRARY_SIZE];
Tcl_DStringInit(&ds);
@@ -207,12 +259,9 @@ CONST char *path; /* Path to the executable in native
* is installed. The developLib computes the path as though the
* executable is run from a develpment directory.
*/
-
- /* CYGNUS LOCAL */
- sprintf(installLib, "share/tcl%s", TCL_VERSION);
- /* END CYGNUS LOCAL */
- sprintf(developLib, "tcl%s/library",
- ((TCL_RELEASE_LEVEL < 2) ? TCL_PATCH_LEVEL : TCL_VERSION));
+
+ sprintf(installLib, "lib/tcl%s", TCL_VERSION);
+ sprintf(developLib, "tcl%s/library", TCL_PATCH_LEVEL);
/*
* Look for the library relative to default encoding dir.
@@ -269,59 +318,77 @@ CONST char *path; /* Path to the executable in native
* This code looks in the following directories:
*
* <bindir>/../<installLib>
- * (e.g. /usr/local/bin/../lib/tcl8.2)
+ * (e.g. /usr/local/bin/../lib/tcl8.4)
* <bindir>/../../<installLib>
- * (e.g. /usr/local/TclPro/solaris-sparc/bin/../../lib/tcl8.2)
+ * (e.g. /usr/local/TclPro/solaris-sparc/bin/../../lib/tcl8.4)
* <bindir>/../library
- * (e.g. /usr/src/tcl8.2/unix/../library)
+ * (e.g. /usr/src/tcl8.4.0/unix/../library)
* <bindir>/../../library
- * (e.g. /usr/src/tcl8.2/unix/solaris-sparc/../../library)
+ * (e.g. /usr/src/tcl8.4.0/unix/solaris-sparc/../../library)
* <bindir>/../../<developLib>
- * (e.g. /usr/src/tcl8.2/unix/../../tcl8.2/library)
- * <bindir>/../../../<devlopLib>
- * (e.g. /usr/src/tcl8.2/unix/solaris-sparc/../../../tcl8.2/library)
+ * (e.g. /usr/src/tcl8.4.0/unix/../../tcl8.4.0/library)
+ * <bindir>/../../../<developLib>
+ * (e.g. /usr/src/tcl8.4.0/unix/solaris-sparc/../../../tcl8.4.0/library)
*/
+
+ /*
+ * The variable path holds an absolute path. Take care not to
+ * overwrite pathv[0] since that might produce a relative path.
+ */
+
if (path != NULL) {
Tcl_SplitPath(path, &pathc, &pathv);
- if (pathc > 1) {
+ if (pathc > 2) {
+ str = pathv[pathc - 2];
pathv[pathc - 2] = installLib;
path = Tcl_JoinPath(pathc - 1, pathv, &ds);
+ pathv[pathc - 2] = str;
objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
Tcl_DStringFree(&ds);
}
- if (pathc > 2) {
+ if (pathc > 3) {
+ str = pathv[pathc - 3];
pathv[pathc - 3] = installLib;
path = Tcl_JoinPath(pathc - 2, pathv, &ds);
+ pathv[pathc - 3] = str;
objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
Tcl_DStringFree(&ds);
}
- if (pathc > 1) {
+ if (pathc > 2) {
+ str = pathv[pathc - 2];
pathv[pathc - 2] = "library";
path = Tcl_JoinPath(pathc - 1, pathv, &ds);
+ pathv[pathc - 2] = str;
objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
Tcl_DStringFree(&ds);
}
- if (pathc > 2) {
+ if (pathc > 3) {
+ str = pathv[pathc - 3];
pathv[pathc - 3] = "library";
path = Tcl_JoinPath(pathc - 2, pathv, &ds);
+ pathv[pathc - 3] = str;
objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
Tcl_DStringFree(&ds);
}
- if (pathc > 1) {
+ if (pathc > 3) {
+ str = pathv[pathc - 3];
pathv[pathc - 3] = developLib;
path = Tcl_JoinPath(pathc - 2, pathv, &ds);
+ pathv[pathc - 3] = str;
objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
Tcl_DStringFree(&ds);
}
- if (pathc > 3) {
+ if (pathc > 4) {
+ str = pathv[pathc - 4];
pathv[pathc - 4] = developLib;
path = Tcl_JoinPath(pathc - 3, pathv, &ds);
+ pathv[pathc - 4] = str;
objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
Tcl_DStringFree(&ds);
@@ -335,11 +402,22 @@ CONST char *path; /* Path to the executable in native
* is different from the prtefix.
*/
- str = defaultLibraryDir;
+ {
+#ifdef HAVE_CFBUNDLE
+ char tclLibPath[1024];
+
+ if (Tcl_MacOSXGetLibraryPath(NULL, 1024, tclLibPath) == TCL_OK) {
+ str = tclLibPath;
+ } else
+#endif /* HAVE_CFBUNDLE */
+ {
+ str = defaultLibraryDir;
+ }
if (str[0] != '\0') {
objPtr = Tcl_NewStringObj(str, -1);
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
}
+ }
TclSetLibraryPath(pathPtr);
Tcl_DStringFree(&buffer);
@@ -353,13 +431,18 @@ CONST char *path; /* Path to the executable in native
* Based on the locale, determine the encoding of the operating
* system and the default encoding for newly opened files.
*
- * Called at process initialization time.
+ * Called at process initialization time, and part way through
+ * startup, we verify that the initial encodings were correctly
+ * setup. Depending on Tcl's environment, there may not have been
+ * enough information first time through (above).
*
* Results:
* None.
*
* Side effects:
- * The Tcl library path is converted from native encoding to UTF-8.
+ * The Tcl library path is converted from native encoding to UTF-8,
+ * on the first call, and the encodings may be changed on first or
+ * second call.
*
*---------------------------------------------------------------------------
*/
@@ -367,141 +450,223 @@ CONST char *path; /* Path to the executable in native
void
TclpSetInitialEncodings()
{
- CONST char *encoding;
- int i;
- Tcl_Obj *pathPtr;
- char *langEnv;
+ if (libraryPathEncodingFixed == 0) {
+ CONST char *encoding = NULL;
+ int i, setSysEncCode = TCL_ERROR;
+ Tcl_Obj *pathPtr;
- /*
- * Determine the current encoding from the LC_* or LANG environment
- * variables. We previously used setlocale() to determine the locale,
- * but this does not work on some systems (e.g. Linux/i386 RH 5.0).
- */
+ /*
+ * Determine the current encoding from the LC_* or LANG environment
+ * variables. We previously used setlocale() to determine the locale,
+ * but this does not work on some systems (e.g. Linux/i386 RH 5.0).
+ */
+#ifdef HAVE_LANGINFO
+ if (setlocale(LC_CTYPE, "") != NULL) {
+ Tcl_DString ds;
- langEnv = getenv("LC_ALL");
+ /*
+ * Use a DString so we can overwrite it in name compatability
+ * checks below.
+ */
- if (langEnv == NULL || langEnv[0] == '\0') {
- langEnv = getenv("LC_CTYPE");
- }
- if (langEnv == NULL || langEnv[0] == '\0') {
- langEnv = getenv("LANG");
- }
- if (langEnv == NULL || langEnv[0] == '\0') {
- langEnv = NULL;
- }
+ Tcl_DStringInit(&ds);
+ encoding = Tcl_DStringAppend(&ds, nl_langinfo(CODESET), -1);
- encoding = NULL;
- if (langEnv != NULL) {
- for (i = 0; localeTable[i].lang != NULL; i++) {
- if (strcmp(localeTable[i].lang, langEnv) == 0) {
- encoding = localeTable[i].encoding;
- break;
+ Tcl_UtfToLower(Tcl_DStringValue(&ds));
+#ifdef HAVE_LANGINFO_DEBUG
+ fprintf(stderr, "encoding '%s'", encoding);
+#endif
+ if (encoding[0] == 'i' && encoding[1] == 's' && encoding[2] == 'o'
+ && encoding[3] == '-') {
+ char *p, *q;
+ /* need to strip '-' from iso-* encoding */
+ for(p = Tcl_DStringValue(&ds)+3, q = Tcl_DStringValue(&ds)+4;
+ *p; *p++ = *q++);
+ } else if (encoding[0] == 'i' && encoding[1] == 'b'
+ && encoding[2] == 'm' && encoding[3] >= '0'
+ && encoding[3] <= '9') {
+ char *p, *q;
+ /* if langinfo reports "ibm*" we should use "cp*" */
+ p = Tcl_DStringValue(&ds);
+ *p++ = 'c'; *p++ = 'p';
+ for(q = p+1; *p ; *p++ = *q++);
+ } else if ((*encoding == '\0')
+ || !strcmp(encoding, "ansi_x3.4-1968")) {
+ /* Use iso8859-1 for empty or 'ansi_x3.4-1968' encoding */
+ encoding = "iso8859-1";
}
+#ifdef HAVE_LANGINFO_DEBUG
+ fprintf(stderr, " ?%s?", encoding);
+#endif
+ setSysEncCode = Tcl_SetSystemEncoding(NULL, encoding);
+ if (setSysEncCode != TCL_OK) {
+ /*
+ * If this doesn't return TCL_OK, the encoding returned by
+ * nl_langinfo or as we translated it wasn't accepted. Do
+ * this fallback check. If this fails, we will enter the
+ * old fallback below.
+ */
+
+ for (i = 0; localeTable[i].lang != NULL; i++) {
+ if (strcmp(localeTable[i].lang, encoding) == 0) {
+ setSysEncCode = Tcl_SetSystemEncoding(NULL,
+ localeTable[i].encoding);
+ break;
+ }
+ }
+ }
+#ifdef HAVE_LANGINFO_DEBUG
+ fprintf(stderr, " => '%s'\n", encoding);
+#endif
+ Tcl_DStringFree(&ds);
}
- /*
- * There was no mapping in the locale table. If there is an
- * encoding subfield, we can try to guess from that.
- */
+#ifdef HAVE_LANGINFO_DEBUG
+ else {
+ fprintf(stderr, "setlocale returned NULL\n");
+ }
+#endif
+#endif /* HAVE_LANGINFO */
- if (encoding == NULL) {
- char *p;
- for (p = langEnv; *p != '\0'; p++) {
- if (*p == '.') {
- p++;
- break;
- }
+ if (setSysEncCode != TCL_OK) {
+ /*
+ * Classic fallback check. This tries a homebrew algorithm to
+ * determine what encoding should be used based on env vars.
+ */
+ char *langEnv = getenv("LC_ALL");
+ encoding = NULL;
+
+ if (langEnv == NULL || langEnv[0] == '\0') {
+ langEnv = getenv("LC_CTYPE");
}
- if (*p != '\0') {
- Tcl_DString ds;
- Tcl_DStringInit(&ds);
- Tcl_DStringAppend(&ds, p, -1);
-
- encoding = Tcl_DStringValue(&ds);
- Tcl_UtfToLower(Tcl_DStringValue(&ds));
- if (Tcl_SetSystemEncoding(NULL, encoding) == TCL_OK) {
- Tcl_DStringFree(&ds);
- goto resetPath;
- }
- Tcl_DStringFree(&ds);
- encoding = NULL;
+ if (langEnv == NULL || langEnv[0] == '\0') {
+ langEnv = getenv("LANG");
+ }
+ if (langEnv == NULL || langEnv[0] == '\0') {
+ langEnv = NULL;
}
- }
- }
- if (encoding == NULL) {
- encoding = "iso8859-1";
- }
- Tcl_SetSystemEncoding(NULL, encoding);
+ if (langEnv != NULL) {
+ for (i = 0; localeTable[i].lang != NULL; i++) {
+ if (strcmp(localeTable[i].lang, langEnv) == 0) {
+ encoding = localeTable[i].encoding;
+ break;
+ }
+ }
+ /*
+ * There was no mapping in the locale table. If there is an
+ * encoding subfield, we can try to guess from that.
+ */
+
+ if (encoding == NULL) {
+ char *p;
+ for (p = langEnv; *p != '\0'; p++) {
+ if (*p == '.') {
+ p++;
+ break;
+ }
+ }
+ if (*p != '\0') {
+ Tcl_DString ds;
+ Tcl_DStringInit(&ds);
+ encoding = Tcl_DStringAppend(&ds, p, -1);
+
+ Tcl_UtfToLower(Tcl_DStringValue(&ds));
+ setSysEncCode = Tcl_SetSystemEncoding(NULL, encoding);
+ if (setSysEncCode != TCL_OK) {
+ encoding = NULL;
+ }
+ Tcl_DStringFree(&ds);
+ }
+ }
+#ifdef HAVE_LANGINFO_DEBUG
+ fprintf(stderr, "encoding fallback check '%s' => '%s'\n",
+ langEnv, encoding);
+#endif
+ }
+ if (setSysEncCode != TCL_OK) {
+ if (encoding == NULL) {
+ encoding = TCL_DEFAULT_ENCODING;
+ }
- resetPath:
- /*
- * Initialize the C library's locale subsystem. This is required
- * for input methods to work properly on X11. We only do this for
- * LC_CTYPE because that's the necessary one, and we don't want to
- * affect LC_TIME here. The side effect of setting the default locale
- * should be to load any locale specific modules that are needed by X.
- * [BUG: 5422 3345 4236 2522 2521].
- */
+ Tcl_SetSystemEncoding(NULL, encoding);
+ }
- setlocale(LC_CTYPE, "");
+ /*
+ * Initialize the C library's locale subsystem. This is required
+ * for input methods to work properly on X11. We only do this for
+ * LC_CTYPE because that's the necessary one, and we don't want to
+ * affect LC_TIME here. The side effect of setting the default
+ * locale should be to load any locale specific modules that are
+ * needed by X. [BUG: 5422 3345 4236 2522 2521].
+ * In HAVE_LANGINFO, this call is already done above.
+ */
+#ifndef HAVE_LANGINFO
+ setlocale(LC_CTYPE, "");
+#endif
+ }
- /*
- * In case the initial locale is not "C", ensure that the numeric
- * processing is done in "C" locale regardless. This is needed because
- * Tcl relies on routines like strtod, but should not have locale
- * dependent behavior.
- */
+ /*
+ * In case the initial locale is not "C", ensure that the numeric
+ * processing is done in "C" locale regardless. This is needed because
+ * Tcl relies on routines like strtod, but should not have locale
+ * dependent behavior.
+ */
- setlocale(LC_NUMERIC, "C");
+ setlocale(LC_NUMERIC, "C");
- /*
- * Until the system encoding was actually set, the library path was
- * actually in the native multi-byte encoding, and not really UTF-8
- * as advertised. We cheated as follows:
- *
- * 1. It was safe to allow the Tcl_SetSystemEncoding() call to
- * append the ASCII chars that make up the encoding's filename to
- * the names (in the native encoding) of directories in the library
- * path, since all Unix multi-byte encodings have ASCII in the
- * beginning.
- *
- * 2. To open the encoding file, the native bytes in the file name
- * were passed to the OS, without translating from UTF-8 to native,
- * because the name was already in the native encoding.
- *
- * Now that the system encoding was actually successfully set,
- * translate all the names in the library path to UTF-8. That way,
- * next time we search the library path, we'll translate the names
- * from UTF-8 to the system encoding which will be the native
- * encoding.
- */
+ /*
+ * Until the system encoding was actually set, the library path was
+ * actually in the native multi-byte encoding, and not really UTF-8
+ * as advertised. We cheated as follows:
+ *
+ * 1. It was safe to allow the Tcl_SetSystemEncoding() call to
+ * append the ASCII chars that make up the encoding's filename to
+ * the names (in the native encoding) of directories in the library
+ * path, since all Unix multi-byte encodings have ASCII in the
+ * beginning.
+ *
+ * 2. To open the encoding file, the native bytes in the file name
+ * were passed to the OS, without translating from UTF-8 to native,
+ * because the name was already in the native encoding.
+ *
+ * Now that the system encoding was actually successfully set,
+ * translate all the names in the library path to UTF-8. That way,
+ * next time we search the library path, we'll translate the names
+ * from UTF-8 to the system encoding which will be the native
+ * encoding.
+ */
- pathPtr = TclGetLibraryPath();
- if (pathPtr != NULL) {
- int objc;
- Tcl_Obj **objv;
-
- objc = 0;
- Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
- for (i = 0; i < objc; i++) {
- int length;
- char *string;
- Tcl_DString ds;
+ pathPtr = TclGetLibraryPath();
+ if (pathPtr != NULL) {
+ int objc;
+ Tcl_Obj **objv;
+
+ objc = 0;
+ Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
+ for (i = 0; i < objc; i++) {
+ int length;
+ char *string;
+ Tcl_DString ds;
- string = Tcl_GetStringFromObj(objv[i], &length);
- Tcl_ExternalToUtfDString(NULL, string, length, &ds);
- Tcl_SetStringObj(objv[i], Tcl_DStringValue(&ds),
- Tcl_DStringLength(&ds));
- Tcl_DStringFree(&ds);
+ string = Tcl_GetStringFromObj(objv[i], &length);
+ Tcl_ExternalToUtfDString(NULL, string, length, &ds);
+ Tcl_SetStringObj(objv[i], Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds));
+ Tcl_DStringFree(&ds);
+ }
}
- }
-
- /*
- * Keep the iso8859-1 encoding preloaded. The IO package uses it for
- * gets on a binary channel.
- */
- Tcl_GetEncoding(NULL, "iso8859-1");
+ libraryPathEncodingFixed = 1;
+ }
+
+ /* This is only ever called from the startup thread */
+ if (binaryEncoding == NULL) {
+ /*
+ * Keep the iso8859-1 encoding preloaded. The IO package uses
+ * it for gets on a binary channel.
+ */
+ binaryEncoding = Tcl_GetEncoding(NULL, "iso8859-1");
+ }
}
/*
@@ -531,16 +696,38 @@ TclpSetVariables(interp)
struct utsname name;
#endif
int unameOK;
- char *user;
+ CONST char *user;
Tcl_DString ds;
- Tcl_SetVar(interp, "tclDefaultLibrary", defaultLibraryDir, TCL_GLOBAL_ONLY);
- Tcl_SetVar(interp, "tcl_pkgPath", pkgPath, TCL_GLOBAL_ONLY);
+#ifdef HAVE_CFBUNDLE
+ char tclLibPath[1024];
+
+ if (Tcl_MacOSXGetLibraryPath(interp, 1024, tclLibPath) == TCL_OK) {
+ Tcl_SetVar(interp, "tclDefaultLibrary", tclLibPath,
+ TCL_GLOBAL_ONLY);
+ Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath,
+ TCL_GLOBAL_ONLY);
+ Tcl_SetVar(interp, "tcl_pkgPath", " ",
+ TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
+ Tcl_SetVar(interp, "tcl_pkgPath", pkgPath,
+ TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
+ } else
+#endif /* HAVE_CFBUNDLE */
+ {
+ Tcl_SetVar(interp, "tclDefaultLibrary", defaultLibraryDir,
+ TCL_GLOBAL_ONLY);
+ Tcl_SetVar(interp, "tcl_pkgPath", pkgPath, TCL_GLOBAL_ONLY);
+ }
+
+#ifdef DJGPP
+ Tcl_SetVar2(interp, "tcl_platform", "platform", "dos", TCL_GLOBAL_ONLY);
+#else
Tcl_SetVar2(interp, "tcl_platform", "platform", "unix", TCL_GLOBAL_ONLY);
+#endif
unameOK = 0;
#ifndef NO_UNAME
if (uname(&name) >= 0) {
- char *native;
+ CONST char *native;
unameOK = 1;
@@ -715,14 +902,14 @@ Tcl_SourceRCFile(interp)
Tcl_Interp *interp; /* Interpreter to source rc file into. */
{
Tcl_DString temp;
- char *fileName;
+ CONST char *fileName;
Tcl_Channel errChannel;
fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);
if (fileName != NULL) {
Tcl_Channel c;
- char *fullName;
+ CONST char *fullName;
Tcl_DStringInit(&temp);
fullName = Tcl_TranslateFileName(interp, fileName, &temp);
@@ -780,4 +967,33 @@ TclpCheckStackSpace()
return 1;
}
+
+#ifdef HAVE_CFBUNDLE
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_MacOSXGetLibraryPath --
+ *
+ * If we have a bundle structure for the Tcl installation,
+ * then check there first to see if we can find the libraries
+ * there.
+ *
+ * Results:
+ * TCL_OK if we have found the tcl library; TCL_ERROR otherwise.
+ *
+ * Side effects:
+ * Same as for Tcl_MacOSXOpenBundleResources.
+ *
+ *----------------------------------------------------------------------
+ */
+static int Tcl_MacOSXGetLibraryPath(Tcl_Interp *interp, int maxPathLen, char *tclLibPath)
+{
+ int foundInFramework = TCL_ERROR;
+ if (strcmp(defaultLibraryDir, "@TCL_IN_FRAMEWORK@") == 0) {
+ foundInFramework = Tcl_MacOSXOpenBundleResources(interp,
+ "com.tcltk.tcllibrary", 0, maxPathLen, tclLibPath);
+ }
+ return foundInFramework;
+}
+#endif /* HAVE_CFBUNDLE */
diff --git a/tcl/unix/tclUnixNotfy.c b/tcl/unix/tclUnixNotfy.c
index 38ca5f4d067..6d5de2a0440 100644
--- a/tcl/unix/tclUnixNotfy.c
+++ b/tcl/unix/tclUnixNotfy.c
@@ -973,7 +973,6 @@ NotifierThreadProc(clientData)
}
if (found || (tsdPtr->pollState & POLL_DONE)) {
tsdPtr->eventReady = 1;
- Tcl_ConditionNotify(&tsdPtr->waitCV);
if (tsdPtr->onList) {
/*
* Remove the ThreadSpecificData structure of this
@@ -994,6 +993,7 @@ NotifierThreadProc(clientData)
tsdPtr->onList = 0;
tsdPtr->pollState = 0;
}
+ Tcl_ConditionNotify(&tsdPtr->waitCV);
}
}
Tcl_MutexUnlock(&notifierMutex);
@@ -1031,5 +1031,3 @@ NotifierThreadProc(clientData)
Tcl_MutexUnlock(&notifierMutex);
}
#endif
-
-
diff --git a/tcl/unix/tclUnixPipe.c b/tcl/unix/tclUnixPipe.c
index 78254b49e68..d4edaf2afa4 100644
--- a/tcl/unix/tclUnixPipe.c
+++ b/tcl/unix/tclUnixPipe.c
@@ -55,7 +55,7 @@ static int PipeGetHandleProc _ANSI_ARGS_((ClientData instanceData,
static int PipeInputProc _ANSI_ARGS_((ClientData instanceData,
char *buf, int toRead, int *errorCode));
static int PipeOutputProc _ANSI_ARGS_((
- ClientData instanceData, char *buf, int toWrite,
+ ClientData instanceData, CONST char *buf, int toWrite,
int *errorCode));
static void PipeWatchProc _ANSI_ARGS_((ClientData instanceData, int mask));
static void RestoreSignals _ANSI_ARGS_((void));
@@ -67,16 +67,20 @@ static int SetupStdFile _ANSI_ARGS_((TclFile file, int type));
*/
static Tcl_ChannelType pipeChannelType = {
- "pipe", /* Type name. */
- PipeBlockModeProc, /* Set blocking/nonblocking mode.*/
- PipeCloseProc, /* Close proc. */
- PipeInputProc, /* Input proc. */
- PipeOutputProc, /* Output proc. */
- NULL, /* Seek proc. */
- NULL, /* Set option proc. */
- NULL, /* Get option proc. */
- PipeWatchProc, /* Initialize notifier. */
- PipeGetHandleProc, /* Get OS handles out of channel. */
+ "pipe", /* Type name. */
+ TCL_CHANNEL_VERSION_2, /* v2 channel */
+ PipeCloseProc, /* Close proc. */
+ PipeInputProc, /* Input proc. */
+ PipeOutputProc, /* Output proc. */
+ NULL, /* Seek proc. */
+ NULL, /* Set option proc. */
+ NULL, /* Get option proc. */
+ PipeWatchProc, /* Initialize notifier. */
+ PipeGetHandleProc, /* Get OS handles out of channel. */
+ NULL, /* close2proc. */
+ PipeBlockModeProc, /* Set blocking or non-blocking mode.*/
+ NULL, /* flush proc. */
+ NULL, /* handler proc. */
};
/*
@@ -132,11 +136,11 @@ TclpOpenFile(fname, mode)
int mode; /* In what mode to open the file? */
{
int fd;
- char *native;
+ CONST char *native;
Tcl_DString ds;
native = Tcl_UtfToExternalDString(NULL, fname, -1, &ds);
- fd = open(native, mode, 0666); /* INTL: Native. */
+ fd = TclOSopen(native, mode, 0666); /* INTL: Native. */
Tcl_DStringFree(&ds);
if (fd != -1) {
fcntl(fd, F_SETFD, FD_CLOEXEC);
@@ -147,7 +151,7 @@ TclpOpenFile(fname, mode)
*/
if (mode & O_WRONLY) {
- lseek(fd, (off_t) 0, SEEK_END);
+ TclOSseek(fd, (Tcl_SeekOffset) 0, SEEK_END);
}
/*
@@ -182,14 +186,21 @@ TclFile
TclpCreateTempFile(contents)
CONST char *contents; /* String to write into temp file, or NULL. */
{
- char fileName[L_tmpnam], *native;
+ char fileName[L_tmpnam + 9];
+ CONST char *native;
Tcl_DString dstring;
int fd;
- if (tmpnam(fileName) == NULL) { /* INTL: Native. */
- return NULL;
+ /*
+ * We should also check against making more then TMP_MAX of these.
+ */
+
+ strcpy(fileName, P_tmpdir); /* INTL: Native. */
+ if (fileName[strlen(fileName) - 1] != '/') {
+ strcat(fileName, "/"); /* INTL: Native. */
}
- fd = open(fileName, O_RDWR|O_CREAT|O_TRUNC, 0666); /* INTL: Native. */
+ strcat(fileName, "tclXXXXXX");
+ fd = mkstemp(fileName); /* INTL: Native. */
if (fd == -1) {
return NULL;
}
@@ -204,7 +215,7 @@ TclpCreateTempFile(contents)
return NULL;
}
Tcl_DStringFree(&dstring);
- lseek(fd, (off_t) 0, SEEK_SET);
+ TclOSseek(fd, (Tcl_SeekOffset) 0, SEEK_SET);
}
return MakeFile(fd);
}
@@ -212,6 +223,50 @@ TclpCreateTempFile(contents)
/*
*----------------------------------------------------------------------
*
+ * TclpTempFileName --
+ *
+ * This function returns unique filename.
+ *
+ * Results:
+ * Returns a valid Tcl_Obj* with refCount 0, or NULL on failure.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj*
+TclpTempFileName()
+{
+ char fileName[L_tmpnam + 9];
+ Tcl_Obj *result = NULL;
+ int fd;
+
+ /*
+ * We should also check against making more then TMP_MAX of these.
+ */
+
+ strcpy(fileName, P_tmpdir); /* INTL: Native. */
+ if (fileName[strlen(fileName) - 1] != '/') {
+ strcat(fileName, "/"); /* INTL: Native. */
+ }
+ strcat(fileName, "tclXXXXXX");
+ fd = mkstemp(fileName); /* INTL: Native. */
+ if (fd == -1) {
+ return NULL;
+ }
+ fcntl(fd, F_SETFD, FD_CLOEXEC);
+ unlink(fileName); /* INTL: Native. */
+
+ result = TclpNativeToNormalized((ClientData) fileName);
+ close (fd);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclpCreatePipe --
*
* Creates a pipe - simply calls the pipe() function.
@@ -313,7 +368,7 @@ TclpCreateProcess(interp, argc, argv, inputFile, outputFile, errorFile,
* Error messages from the child process
* itself are sent to errorFile. */
int argc; /* Number of arguments in following array. */
- char **argv; /* Array of argument strings in UTF-8.
+ CONST char **argv; /* Array of argument strings in UTF-8.
* argv[0] contains the name of the executable
* translated using Tcl_TranslateFileName
* call). Additional arguments have not been
@@ -369,7 +424,7 @@ TclpCreateProcess(interp, argc, argv, inputFile, outputFile, errorFile,
newArgv[i] = Tcl_UtfToExternalDString(NULL, argv[i], -1, &dsArray[i]);
}
- joinThisError = (errorFile == outputFile);
+ joinThisError = errorFile && (errorFile == outputFile);
pid = fork();
if (pid == 0) {
fd = GetFd(errPipeOut);
@@ -444,10 +499,12 @@ TclpCreateProcess(interp, argc, argv, inputFile, outputFile, errorFile,
if (pid != -1) {
/*
* Reap the child process now if an error occurred during its
- * startup.
+ * startup. We don't call this with WNOHANG because that can lead to
+ * defunct processes on an MP system. We shouldn't have to worry
+ * about hanging here, since this is the error case. [Bug: 6148]
*/
- Tcl_WaitPid((Tcl_Pid) pid, &status, WNOHANG);
+ Tcl_WaitPid((Tcl_Pid) pid, &status, 0);
}
if (errPipeIn) {
@@ -947,14 +1004,20 @@ PipeInputProc(instanceData, buf, toRead, errorCodePtr)
* appropriately, and read will unblock as soon as a short read is
* possible, if the channel is in blocking mode. If the channel is
* nonblocking, the read will never block.
+ * Some OSes can throw an interrupt error, for which we should
+ * immediately retry. [Bug #415131]
*/
- bytesRead = read(GetFd(psPtr->inFile), buf, (size_t) toRead);
- if (bytesRead > -1) {
- return bytesRead;
+ do {
+ bytesRead = read (GetFd(psPtr->inFile), buf, (size_t) toRead);
+ } while ((bytesRead < 0) && (errno == EINTR));
+
+ if (bytesRead < 0) {
+ *errorCodePtr = errno;
+ return -1;
+ } else {
+ return bytesRead;
}
- *errorCodePtr = errno;
- return -1;
}
/*
@@ -979,7 +1042,7 @@ PipeInputProc(instanceData, buf, toRead, errorCodePtr)
static int
PipeOutputProc(instanceData, buf, toWrite, errorCodePtr)
ClientData instanceData; /* Pipe state. */
- char *buf; /* The data buffer. */
+ CONST char *buf; /* The data buffer. */
int toWrite; /* How many bytes to write? */
int *errorCodePtr; /* Where to store error code. */
{
@@ -987,12 +1050,22 @@ PipeOutputProc(instanceData, buf, toWrite, errorCodePtr)
int written;
*errorCodePtr = 0;
- written = write(GetFd(psPtr->outFile), buf, (size_t) toWrite);
- if (written > -1) {
- return written;
+
+ /*
+ * Some OSes can throw an interrupt error, for which we should
+ * immediately retry. [Bug #415131]
+ */
+
+ do {
+ written = write(GetFd(psPtr->outFile), buf, (size_t) toWrite);
+ } while ((written < 0) && (errno == EINTR));
+
+ if (written < 0) {
+ *errorCodePtr = errno;
+ return -1;
+ } else {
+ return written;
}
- *errorCodePtr = errno;
- return -1;
}
/*
@@ -1170,5 +1243,3 @@ Tcl_PidObjCmd(dummy, interp, objc, objv)
}
return TCL_OK;
}
-
-
diff --git a/tcl/unix/tclUnixPort.h b/tcl/unix/tclUnixPort.h
index b84ef03f2a2..942261aa83e 100644
--- a/tcl/unix/tclUnixPort.h
+++ b/tcl/unix/tclUnixPort.h
@@ -56,6 +56,42 @@
# include <dirent.h>
#endif
#endif
+
+#ifdef HAVE_STRUCT_DIRENT64
+typedef struct dirent64 Tcl_DirEntry;
+# define TclOSreaddir readdir64
+# define TclOSreaddir_r readdir64_r
+#else
+typedef struct dirent Tcl_DirEntry;
+# define TclOSreaddir readdir
+# define TclOSreaddir_r readdir_r
+#endif
+
+#ifdef HAVE_TYPE_OFF64_T
+typedef off64_t Tcl_SeekOffset;
+# define TclOSseek lseek64
+# define TclOSopen open64
+#else
+typedef off_t Tcl_SeekOffset;
+# define TclOSseek lseek
+# define TclOSopen open
+#endif
+
+#ifdef HAVE_STRUCT_STAT64
+# define TclOSstat stat64
+# define TclOSlstat lstat64
+#else
+# define TclOSstat stat
+# define TclOSlstat lstat
+#endif
+
+#if !HAVE_STRTOLL && defined(TCL_WIDE_INT_TYPE) && !TCL_WIDE_INT_IS_LONG
+EXTERN Tcl_WideInt strtoll _ANSI_ARGS_((CONST char *string,
+ char **endPtr, int base));
+EXTERN Tcl_WideUInt strtoull _ANSI_ARGS_((CONST char *string,
+ char **endPtr, int base));
+#endif
+
#include <sys/file.h>
#ifdef HAVE_SYS_SELECT_H
# include <sys/select.h>
@@ -288,7 +324,10 @@ EXTERN int gettimeofday _ANSI_ARGS_((struct timeval *tp,
*/
#ifndef S_IFLNK
+# undef TclOSlstat
# define lstat stat
+# define lstat64 stat64
+# define TclOSlstat TclOSstat
#endif
/*
@@ -302,49 +341,49 @@ EXTERN int gettimeofday _ANSI_ARGS_((struct timeval *tp,
# else
# define S_ISREG(m) 0
# endif
-# endif
+#endif /* !S_ISREG */
#ifndef S_ISDIR
# ifdef S_IFDIR
# define S_ISDIR(m) (((m) & S_IFMT) == S_IFDIR)
# else
# define S_ISDIR(m) 0
# endif
-# endif
+#endif /* !S_ISDIR */
#ifndef S_ISCHR
# ifdef S_IFCHR
# define S_ISCHR(m) (((m) & S_IFMT) == S_IFCHR)
# else
# define S_ISCHR(m) 0
# endif
-# endif
+#endif /* !S_ISCHR */
#ifndef S_ISBLK
# ifdef S_IFBLK
# define S_ISBLK(m) (((m) & S_IFMT) == S_IFBLK)
# else
# define S_ISBLK(m) 0
# endif
-# endif
+#endif /* !S_ISBLK */
#ifndef S_ISFIFO
# ifdef S_IFIFO
# define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
# else
# define S_ISFIFO(m) 0
# endif
-# endif
+#endif /* !S_ISFIFO */
#ifndef S_ISLNK
# ifdef S_IFLNK
# define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
# else
# define S_ISLNK(m) 0
# endif
-# endif
+#endif /* !S_ISLNK */
#ifndef S_ISSOCK
# ifdef S_IFSOCK
# define S_ISSOCK(m) (((m) & S_IFMT) == S_IFSOCK)
# else
# define S_ISSOCK(m) 0
# endif
-# endif
+#endif /* !S_ISSOCK */
/*
* Make sure that MAXPATHLEN is defined.
@@ -373,16 +412,16 @@ EXTERN int gettimeofday _ANSI_ARGS_((struct timeval *tp,
#ifndef NO_FD_SET
# define SELECT_MASK fd_set
-#else
+#else /* NO_FD_SET */
# ifndef _AIX
typedef long fd_mask;
-# endif
+# endif /* !AIX */
# if defined(_IBMR2)
# define SELECT_MASK void
-# else
+# else /* !defined(_IBMR2) */
# define SELECT_MASK int
-# endif
-#endif
+# endif /* defined(_IBMR2) */
+#endif /* !NO_FD_SET */
/*
* Define "NBBY" (number of bits per byte) if it's not already defined.
@@ -402,13 +441,13 @@ EXTERN int gettimeofday _ANSI_ARGS_((struct timeval *tp,
# else
# define FD_SETSIZE 256
# endif
-#endif
+#endif /* FD_SETSIZE */
#if !defined(howmany)
# define howmany(x, y) (((x)+((y)-1))/(y))
-#endif
+#endif /* !defined(howmany) */
#ifndef NFDBITS
# define NFDBITS NBBY*sizeof(fd_mask)
-#endif
+#endif /* NFDBITS */
#define MASK_SIZE howmany(FD_SETSIZE, NFDBITS)
/*
@@ -420,6 +459,19 @@ EXTERN int gettimeofday _ANSI_ARGS_((struct timeval *tp,
extern int errno;
/*
+ * Not all systems declare all the errors that Tcl uses! Provide some
+ * work-arounds...
+ */
+
+#ifndef EOVERFLOW
+# ifdef EFBIG
+# define EOVERFLOW EFBIG
+# else /* !EFBIG */
+# define EOVERFLOW EINVAL
+# endif /* EFBIG */
+#endif /* EOVERFLOW */
+
+/*
* Variables provided by the C library:
*/
@@ -439,6 +491,12 @@ extern char **environ;
extern double strtod();
/*
+ * There is no platform-specific panic routine for Unix in the Tcl internals.
+ */
+
+#define TclpPanic ((Tcl_PanicProc *) NULL)
+
+/*
*---------------------------------------------------------------------------
* The following macros and declarations represent the interface between
* generic and unix-specific parts of Tcl. Some of the macros may override
@@ -450,14 +508,17 @@ extern double strtod();
* The default platform eol translation on Unix is TCL_TRANSLATE_LF.
*/
+#ifdef DJGPP
+#define TCL_PLATFORM_TRANSLATION TCL_TRANSLATE_CRLF
+#else
#define TCL_PLATFORM_TRANSLATION TCL_TRANSLATE_LF
+#endif
/*
* The following macros have trivial definitions, allowing generic code to
* address platform-specific issues.
*/
-#define TclpAsyncMark(async)
#define TclpGetPid(pid) ((unsigned long) (pid))
#define TclpReleaseFile(file) /* Nothing. */
@@ -479,15 +540,6 @@ extern double strtod();
#define TclpExit exit
-#ifdef TclpStat
-#undef TclpStat
-#endif
-
-EXTERN int TclpLstat _ANSI_ARGS_((CONST char *path,
- struct stat *buf));
-EXTERN int TclpStat _ANSI_ARGS_((CONST char *path,
- struct stat *buf));
-
/*
* Platform specific mutex definition used by memory allocators.
* These mutexes are statically allocated and explicitly initialized.
@@ -501,6 +553,16 @@ typedef pthread_mutex_t TclpMutex;
EXTERN void TclpMutexInit _ANSI_ARGS_((TclpMutex *mPtr));
EXTERN void TclpMutexLock _ANSI_ARGS_((TclpMutex *mPtr));
EXTERN void TclpMutexUnlock _ANSI_ARGS_((TclpMutex *mPtr));
+EXTERN Tcl_DirEntry * TclpReaddir(DIR *);
+EXTERN struct tm * TclpLocaltime(time_t *);
+EXTERN struct tm * TclpGmtime(time_t *);
+EXTERN char * TclpInetNtoa(struct in_addr);
+#define readdir(x) TclpReaddir(x)
+#define localtime(x) TclpLocaltime(x)
+#define gmtime(x) TclpGmtime(x)
+#define inet_ntoa(x) TclpInetNtoa(x)
+#undef TclOSreaddir
+#define TclOSreaddir(x) TclpReaddir(x)
#else
typedef int TclpMutex;
#define TclpMutexInit(a)
@@ -512,4 +574,3 @@ typedef int TclpMutex;
#include "tclIntPlatDecls.h"
#endif /* _TCLUNIXPORT */
-
diff --git a/tcl/unix/tclUnixSock.c b/tcl/unix/tclUnixSock.c
index 0b63f84f6b7..f995b055876 100644
--- a/tcl/unix/tclUnixSock.c
+++ b/tcl/unix/tclUnixSock.c
@@ -62,7 +62,7 @@ TCL_DECLARE_MUTEX(hostMutex)
*----------------------------------------------------------------------
*/
-char *
+CONST char *
Tcl_GetHostName()
{
#ifndef NO_UNAME
@@ -84,6 +84,21 @@ Tcl_GetHostName()
(VOID *) memset((VOID *) &u, (int) 0, sizeof(struct utsname));
if (uname(&u) > -1) { /* INTL: Native. */
hp = gethostbyname(u.nodename); /* INTL: Native. */
+ if (hp == NULL) {
+ /*
+ * Sometimes the nodename is fully qualified, but gets truncated
+ * as it exceeds SYS_NMLN. See if we can just get the immediate
+ * nodename and get a proper answer that way.
+ */
+ char *dot = strchr(u.nodename, '.');
+ if (dot != NULL) {
+ char *node = ckalloc((unsigned) (dot - u.nodename + 1));
+ memcpy(node, u.nodename, (size_t) (dot - u.nodename));
+ node[dot - u.nodename] = '\0';
+ hp = gethostbyname(node);
+ ckfree(node);
+ }
+ }
if (hp != NULL) {
native = hp->h_name;
} else {
@@ -133,4 +148,3 @@ TclpHasSockets(interp)
{
return TCL_OK;
}
-
diff --git a/tcl/unix/tclUnixTest.c b/tcl/unix/tclUnixTest.c
index 6680dc91769..a964cf13f9b 100644
--- a/tcl/unix/tclUnixTest.c
+++ b/tcl/unix/tclUnixTest.c
@@ -66,22 +66,22 @@ static char *gotsig = "0";
static void TestFileHandlerProc _ANSI_ARGS_((ClientData clientData,
int mask));
static int TestfilehandlerCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestfilewaitCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestfindexecutableCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestgetopenfileCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestgetdefencdirCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestsetdefencdirCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
int TclplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp));
static int TestalarmCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestgotsigCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static void AlarmHandler _ANSI_ARGS_(());
/*
@@ -147,7 +147,7 @@ TestfilehandlerCmd(clientData, interp, argc, argv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
Pipe *pipePtr;
int i, mask, timeout;
@@ -299,7 +299,7 @@ TestfilehandlerCmd(clientData, interp, argc, argv)
} else if (strcmp(argv[1], "wait") == 0) {
if (argc != 5) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"",
- argv[0], " wait index readable/writable timeout\"",
+ argv[0], " wait index readable|writable timeout\"",
(char *) NULL);
return TCL_ERROR;
}
@@ -374,7 +374,7 @@ TestfilewaitCmd(clientData, interp, argc, argv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
int mask, result, timeout;
Tcl_Channel channel;
@@ -443,7 +443,7 @@ TestfindexecutableCmd(clientData, interp, argc, argv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
char *oldName;
char *oldNativeName;
@@ -497,7 +497,7 @@ TestgetopenfileCmd(clientData, interp, argc, argv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
ClientData filePtr;
@@ -542,7 +542,7 @@ TestsetdefencdirCmd(clientData, interp, argc, argv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
if (argc != 2) {
Tcl_AppendResult(interp,
@@ -586,7 +586,7 @@ TestgetdefencdirCmd(clientData, interp, argc, argv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
if (argc != 1) {
Tcl_AppendResult(interp,
@@ -623,7 +623,7 @@ TestalarmCmd(clientData, interp, argc, argv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
#ifdef SA_RESTART
unsigned int sec;
@@ -700,10 +700,9 @@ TestgotsigCmd(clientData, interp, argc, argv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
Tcl_AppendResult(interp, gotsig, (char *) NULL);
gotsig = "0";
return TCL_OK;
}
-
diff --git a/tcl/unix/tclUnixThrd.c b/tcl/unix/tclUnixThrd.c
index 2e8e8a4faff..1dd2d998c80 100644
--- a/tcl/unix/tclUnixThrd.c
+++ b/tcl/unix/tclUnixThrd.c
@@ -13,12 +13,24 @@
*/
#include "tclInt.h"
+#include "tclPort.h"
#ifdef TCL_THREADS
-#include "tclPort.h"
#include "pthread.h"
+typedef struct ThreadSpecificData {
+ char nabuf[16];
+ struct tm gtbuf;
+ struct tm ltbuf;
+ struct {
+ Tcl_DirEntry ent;
+ char name[PATH_MAX+1];
+ } rdbuf;
+} ThreadSpecificData;
+
+static Tcl_ThreadDataKey dataKey;
+
/*
* masterLock is used to serialize creation of mutexes, condition
* variables, and thread local storage.
@@ -53,8 +65,6 @@ static pthread_mutex_t *allocLockPtr = &allocLock;
#endif /* TCL_THREADS */
-
-
/*
*----------------------------------------------------------------------
*
@@ -133,6 +143,40 @@ Tcl_CreateThread(idPtr, proc, clientData, stackSize, flags)
#endif /* TCL_THREADS */
}
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_JoinThread --
+ *
+ * This procedure waits upon the exit of the specified thread.
+ *
+ * Results:
+ * TCL_OK if the wait was successful, TCL_ERROR else.
+ *
+ * Side effects:
+ * The result area is set to the exit code of the thread we
+ * waited upon.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_JoinThread(id, state)
+ Tcl_ThreadId id; /* Id of the thread to wait upon */
+ int* state; /* Reference to the storage the result
+ * of the thread we wait upon will be
+ * written into. */
+{
+#ifdef TCL_THREADS
+ int result;
+
+ result = pthread_join ((pthread_t) id, (VOID**) state);
+ return (result == 0) ? TCL_OK : TCL_ERROR;
+#else
+ return TCL_ERROR;
+#endif
+}
+
#ifdef TCL_THREADS
/*
*----------------------------------------------------------------------
@@ -649,8 +693,17 @@ Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
if (timePtr == NULL) {
pthread_cond_wait(pcondPtr, pmutexPtr);
} else {
- ptime.tv_sec = timePtr->sec + TclpGetSeconds();
- ptime.tv_nsec = 1000 * timePtr->usec;
+ Tcl_Time now;
+
+ /*
+ * Make sure to take into account the microsecond component of the
+ * current time, including possible overflow situations. [Bug #411603]
+ */
+
+ Tcl_GetTime(&now);
+ ptime.tv_sec = timePtr->sec + now.sec +
+ (timePtr->usec + now.usec) / 1000000;
+ ptime.tv_nsec = 1000 * ((timePtr->usec + now.usec) % 1000000);
pthread_cond_timedwait(pcondPtr, pmutexPtr, &ptime);
}
}
@@ -719,8 +772,180 @@ TclpFinalizeCondition(condPtr)
*condPtr = NULL;
}
}
+#endif /* TCL_THREADS */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpReaddir, TclpLocaltime, TclpGmtime, TclpInetNtoa --
+ *
+ * These procedures replace core C versions to be used in a
+ * threaded environment.
+ *
+ * Results:
+ * See documentation of C functions.
+ *
+ * Side effects:
+ * See documentation of C functions.
+ *
+ *----------------------------------------------------------------------
+ */
+#if defined(TCL_THREADS) && !defined(HAVE_READDIR_R)
+TCL_DECLARE_MUTEX( rdMutex )
+#undef readdir
+#endif
+Tcl_DirEntry *
+TclpReaddir(DIR * dir)
+{
+ Tcl_DirEntry *ent;
+#ifdef TCL_THREADS
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-#endif /* TCL_THREADS */
+#ifdef HAVE_READDIR_R
+ ent = &tsdPtr->rdbuf.ent;
+ if (TclOSreaddir_r(dir, ent, &ent) != 0) {
+ ent = NULL;
+ }
+
+#else /* !HAVE_READDIR_R */
+
+ Tcl_MutexLock(&rdMutex);
+# ifdef HAVE_STRUCT_DIRENT64
+ ent = readdir64(dir);
+# else /* !HAVE_STRUCT_DIRENT64 */
+ ent = readdir(dir);
+# endif /* HAVE_STRUCT_DIRENT64 */
+ if (ent != NULL) {
+ memcpy((VOID *) &tsdPtr->rdbuf.ent, (VOID *) ent,
+ sizeof(Tcl_DirEntry) + sizeof(char) * (PATH_MAX+1));
+ ent = &tsdPtr->rdbuf.ent;
+ }
+ Tcl_MutexUnlock(&rdMutex);
+#endif /* HAVE_READDIR_R */
+#else
+# ifdef HAVE_STRUCT_DIRENT64
+ ent = readdir64(dir);
+# else /* !HAVE_STRUCT_DIRENT64 */
+ ent = readdir(dir);
+# endif /* HAVE_STRUCT_DIRENT64 */
+#endif
+ return ent;
+}
+
+#if defined(TCL_THREADS) && (!defined(HAVE_GMTIME_R) || !defined(HAVE_LOCALTIME_R))
+TCL_DECLARE_MUTEX( tmMutex )
+#undef localtime
+#undef gmtime
+#endif
+
+struct tm *
+TclpLocaltime(time_t * clock)
+{
+#ifdef TCL_THREADS
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+#ifdef HAVE_LOCALTIME_R
+ return localtime_r(clock, &tsdPtr->ltbuf);
+#else
+ Tcl_MutexLock( &tmMutex );
+ memcpy( (VOID *) &tsdPtr->ltbuf, (VOID *) localtime( clock ), sizeof (struct tm) );
+ Tcl_MutexUnlock( &tmMutex );
+ return &tsdPtr->ltbuf;
+#endif
+#else
+ return localtime(clock);
+#endif
+}
+
+struct tm *
+TclpGmtime(time_t * clock)
+{
+#ifdef TCL_THREADS
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+#ifdef HAVE_GMTIME_R
+ return gmtime_r(clock, &tsdPtr->gtbuf);
+#else
+ Tcl_MutexLock( &tmMutex );
+ memcpy( (VOID *) &tsdPtr->gtbuf, (VOID *) gmtime( clock ), sizeof (struct tm) );
+ Tcl_MutexUnlock( &tmMutex );
+ return &tsdPtr->gtbuf;
+#endif
+#else
+ return gmtime(clock);
+#endif
+}
+
+char *
+TclpInetNtoa(struct in_addr addr)
+{
+#ifdef TCL_THREADS
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ union {
+ unsigned long l;
+ unsigned char b[4];
+ } u;
+
+ u.l = (unsigned long) addr.s_addr;
+ sprintf(tsdPtr->nabuf, "%u.%u.%u.%u", u.b[0], u.b[1], u.b[2], u.b[3]);
+ return tsdPtr->nabuf;
+#else
+ return inet_ntoa(addr);
+#endif
+}
+
+#ifdef TCL_THREADS
+/*
+ * Additions by AOL for specialized thread memory allocator.
+ */
+#ifdef USE_THREAD_ALLOC
+static int initialized = 0;
+static pthread_key_t key;
+static pthread_once_t once = PTHREAD_ONCE_INIT;
+
+Tcl_Mutex *
+TclpNewAllocMutex(void)
+{
+ struct lock {
+ Tcl_Mutex tlock;
+ pthread_mutex_t plock;
+ } *lockPtr;
+
+ lockPtr = malloc(sizeof(struct lock));
+ if (lockPtr == NULL) {
+ panic("could not allocate lock");
+ }
+ lockPtr->tlock = (Tcl_Mutex) &lockPtr->plock;
+ pthread_mutex_init(&lockPtr->plock, NULL);
+ return &lockPtr->tlock;
+}
+
+static void
+InitKey(void)
+{
+ extern void TclFreeAllocCache(void *);
+
+ pthread_key_create(&key, TclFreeAllocCache);
+ initialized = 1;
+}
+
+void *
+TclpGetAllocCache(void)
+{
+ if (!initialized) {
+ pthread_once(&once, InitKey);
+ }
+ return pthread_getspecific(key);
+}
+
+void
+TclpSetAllocCache(void *arg)
+{
+ pthread_setspecific(key, arg);
+}
+
+#endif /* USE_THREAD_ALLOC */
+#endif /* TCL_THREADS */
diff --git a/tcl/unix/tclUnixTime.c b/tcl/unix/tclUnixTime.c
index e1bc43808a2..c978bd737b0 100644
--- a/tcl/unix/tclUnixTime.c
+++ b/tcl/unix/tclUnixTime.c
@@ -14,8 +14,33 @@
#include "tclInt.h"
#include "tclPort.h"
+#include <locale.h>
#define TM_YEAR_BASE 1900
#define IsLeapYear(x) ((x % 4 == 0) && (x % 100 != 0 || x % 400 == 0))
+
+/*
+ * TclpGetDate is coded to return a pointer to a 'struct tm'. For
+ * thread safety, this structure must be in thread-specific data.
+ * The 'tmKey' variable is the key to this buffer.
+ */
+
+static Tcl_ThreadDataKey tmKey;
+
+/*
+ * If we fall back on the thread-unsafe versions of gmtime and localtime,
+ * use this mutex to try to protect them.
+ */
+
+#if !defined(HAVE_GMTIME_R) || !defined(HAVE_LOCALTIME_R)
+TCL_DECLARE_MUTEX(tmMutex)
+#endif
+
+/*
+ * Forward declarations for procedures defined later in this file.
+ */
+
+static struct tm *ThreadSafeGMTime _ANSI_ARGS_(( CONST time_t* ));
+static struct tm *ThreadSafeLocalTime _ANSI_ARGS_(( CONST time_t* ));
/*
*-----------------------------------------------------------------------------
@@ -115,7 +140,7 @@ TclpGetTimeZone (currentTime)
#if defined(HAVE_TM_TZADJ)
# define TCL_GOT_TIMEZONE
time_t curTime = (time_t) currentTime;
- struct tm *timeDataPtr = localtime(&curTime);
+ struct tm *timeDataPtr = ThreadSafeLocalTime(&curTime);
int timeZone;
timeZone = timeDataPtr->tm_tzadj / 60;
@@ -129,7 +154,7 @@ TclpGetTimeZone (currentTime)
#if defined(HAVE_TM_GMTOFF) && !defined (TCL_GOT_TIMEZONE)
# define TCL_GOT_TIMEZONE
time_t curTime = (time_t) currentTime;
- struct tm *timeDataPtr = localtime(&curTime);
+ struct tm *timeDataPtr = ThreadSafeLocalTime(&curTime);
int timeZone;
timeZone = -(timeDataPtr->tm_gmtoff / 60);
@@ -152,7 +177,7 @@ TclpGetTimeZone (currentTime)
time_t tt;
struct tm *stm;
tt = 849268800L; /* 1996-11-29 12:00:00 GMT */
- stm = localtime(&tt); /* eg 1996-11-29 6:00:00 CST6CDT */
+ stm = ThreadSafeLocalTime(&tt); /* eg 1996-11-29 6:00:00 CST6CDT */
/* The calculation below assumes a max of +12 or -12 hours from GMT */
timeZone = (12 - stm->tm_hour)*60 + (0 - stm->tm_min);
return timeZone; /* eg +360 for CST6CDT */
@@ -216,7 +241,7 @@ TclpGetTimeZone (currentTime)
/*
*----------------------------------------------------------------------
*
- * TclpGetTime --
+ * Tcl_GetTime --
*
* Gets the current system time in seconds and microseconds
* since the beginning of the epoch: 00:00 UCT, January 1, 1970.
@@ -231,7 +256,7 @@ TclpGetTimeZone (currentTime)
*/
void
-TclpGetTime(timePtr)
+Tcl_GetTime(timePtr)
Tcl_Time *timePtr; /* Location to store time information. */
{
struct timeval tv;
@@ -268,9 +293,9 @@ TclpGetDate(time, useGMT)
CONST time_t *tp = (CONST time_t *)time;
if (useGMT) {
- return gmtime(tp);
+ return ThreadSafeGMTime(tp);
} else {
- return localtime(tp);
+ return ThreadSafeLocalTime(tp);
}
}
@@ -279,7 +304,8 @@ TclpGetDate(time, useGMT)
*
* TclpStrftime --
*
- * On Unix, we can safely call the native strftime implementation.
+ * On Unix, we can safely call the native strftime implementation,
+ * and also ignore the useGMT parameter.
*
* Results:
* The normal strftime result.
@@ -291,11 +317,12 @@ TclpGetDate(time, useGMT)
*/
size_t
-TclpStrftime(s, maxsize, format, t)
+TclpStrftime(s, maxsize, format, t, useGMT)
char *s;
size_t maxsize;
CONST char *format;
CONST struct tm *t;
+ int useGMT;
{
if (format[0] == '%' && format[1] == 'Q') {
/* Format as a stardate */
@@ -306,5 +333,86 @@ TclpStrftime(s, maxsize, format, t)
(((t->tm_hour * 60) + t->tm_min)/144));
return(strlen(s));
}
+ setlocale(LC_TIME, "");
return strftime(s, maxsize, format, t);
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ThreadSafeGMTime --
+ *
+ * Wrapper around the 'gmtime' library function to make it thread
+ * safe.
+ *
+ * Results:
+ * Returns a pointer to a 'struct tm' in thread-specific data.
+ *
+ * Side effects:
+ * Invokes gmtime or gmtime_r as appropriate.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static struct tm *
+ThreadSafeGMTime(timePtr)
+ 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 = (struct tm *)
+ Tcl_GetThreadData(&tmKey, sizeof(struct tm));
+#ifdef HAVE_GMTIME_R
+ gmtime_r(timePtr, tmPtr);
+#else
+ Tcl_MutexLock(&tmMutex);
+ memcpy((VOID *) tmPtr, (VOID *) gmtime(timePtr), sizeof(struct tm));
+ Tcl_MutexUnlock(&tmMutex);
+#endif
+ return tmPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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(timePtr)
+ 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 = (struct tm *)
+ Tcl_GetThreadData(&tmKey, sizeof(struct tm));
+#ifdef HAVE_LOCALTIME_R
+ localtime_r(timePtr, tmPtr);
+#else
+ Tcl_MutexLock(&tmMutex);
+ memcpy((VOID *) tmPtr, (VOID *) localtime(timePtr), sizeof(struct tm));
+ Tcl_MutexUnlock(&tmMutex);
+#endif
+ return tmPtr;
+}
diff --git a/tcl/unix/tclXtTest.c b/tcl/unix/tclXtTest.c
index 25e4bc32848..01e25b261a8 100644
--- a/tcl/unix/tclXtTest.c
+++ b/tcl/unix/tclXtTest.c
@@ -15,7 +15,7 @@
#include "tcl.h"
static int TesteventloopCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
extern void InitNotifier _ANSI_ARGS_((void));
@@ -75,7 +75,7 @@ TesteventloopCmd(clientData, interp, argc, argv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
static int *framePtr = NULL; /* Pointer to integer on stack frame of
* innermost invocation of the "wait"
@@ -118,4 +118,3 @@ TesteventloopCmd(clientData, interp, argc, argv)
}
return TCL_OK;
}
-
diff --git a/tcl/win/Makefile.in b/tcl/win/Makefile.in
index f43ed26fb00..f558be19590 100644
--- a/tcl/win/Makefile.in
+++ b/tcl/win/Makefile.in
@@ -36,10 +36,10 @@ mandir = @mandir@
# when installing files.
INSTALL_ROOT =
-# Directory from which applications will reference the libary of Tcl
+# Directory from which applications will reference the library of Tcl
# scripts (note: you can set the TCL_LIBRARY environment variable at
# run-time to override this value):
-TCL_LIBRARY = @datadir@/tcl$(VERSION)
+TCL_LIBRARY = $(prefix)/lib/tcl$(VERSION)
# Path to use at runtime to refer to LIB_INSTALL_DIR:
LIB_RUNTIME_DIR = $(libdir)
@@ -80,22 +80,18 @@ CFLAGS_WARNING = @CFLAGS_WARNING@
CFLAGS_DEBUG = @CFLAGS_DEBUG@
CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@
-# To enable compilation debugging reverse the comment characters on
-# one of the following lines.
-COMPILE_DEBUG_FLAGS =
-#COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG
-#COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS
-
-# The default switches for optimization or debugging
-LDFLAGS_DEBUG = @LDFLAGS_DEBUG@
-LDFLAGS_OPTIMIZE = @LDFLAGS_OPTIMIZE@
-
# To change the compiler switches, for example to change from optimization to
# debugging symbols, change the following line:
#CFLAGS = $(CFLAGS_DEBUG)
#CFLAGS = $(CFLAGS_OPTIMIZE)
#CFLAGS = $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE)
-CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@
+CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@ @MEM_DEBUG_FLAGS@
+
+# To enable compilation debugging reverse the comment characters on
+# one of the following lines.
+COMPILE_DEBUG_FLAGS =
+#COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG
+#COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS
# Special compiler flags to use when building man2tcl on Windows.
MAN2TCLFLAGS = @MAN2TCLFLAGS@
@@ -106,42 +102,45 @@ GENERIC_DIR = @srcdir@/../generic
WIN_DIR = @srcdir@
COMPAT_DIR = @srcdir@/../compat
-# This converts a POSIX path to a Windows native path
+# Converts a POSIX path to a Windows native path.
CYGPATH = @CYGPATH@
-GENERIC_DIR_NATIVE = $(shell $(CYGPATH) '$(GENERIC_DIR)')
-WIN_DIR_NATIVE = $(shell $(CYGPATH) '$(WIN_DIR)')
-ROOT_DIR_NATIVE = $(shell $(CYGPATH) '$(ROOT_DIR)')
+GENERIC_DIR_NATIVE = $(shell $(CYGPATH) '$(GENERIC_DIR)')
+WIN_DIR_NATIVE = $(shell $(CYGPATH) '$(WIN_DIR)')
+ROOT_DIR_NATIVE = $(shell $(CYGPATH) '$(ROOT_DIR)')
LIBRARY_DIR = $(shell echo '$(ROOT_DIR_NATIVE)/library' | sed 's/\\/\//g' )
-VENDORPREFIX = @VENDORPREFIX@
DLLSUFFIX = @DLLSUFFIX@
LIBSUFFIX = @LIBSUFFIX@
EXESUFFIX = @EXESUFFIX@
-LIBPREFIX = @LIBPREFIX@
TCL_STUB_LIB_FILE = @TCL_STUB_LIB_FILE@
TCL_DLL_FILE = @TCL_DLL_FILE@
TCL_LIB_FILE = @TCL_LIB_FILE@
-GNU_TCL_LIB_FILE = @GNU_TCL_LIB_FILE@
-MSVC_TCL_LIB_FILE = @MSVC_TCL_LIB_FILE@
-DDE_DLL_FILE = @DDE_DLL_FILE@
-DDE_LIB_FILE = @DDE_LIB_FILE@
-REG_DLL_FILE = @REG_DLL_FILE@
-REG_LIB_FILE = @REG_LIB_FILE@
-PIPE_DLL_FILE = @PIPE_DLL_FILE@
+DDE_DLL_FILE = tcldde$(DDEVER)${DLLSUFFIX}
+DDE_LIB_FILE = tcldde$(DDEVER)${LIBSUFFIX}
+REG_DLL_FILE = tclreg$(REGVER)${DLLSUFFIX}
+REG_LIB_FILE = tclreg$(REGVER)${LIBSUFFIX}
+PIPE_DLL_FILE = tclpip$(VER)${DLLSUFFIX}
SHARED_LIBRARIES = $(TCL_DLL_FILE) $(TCL_STUB_LIB_FILE) \
$(DDE_DLL_FILE) $(REG_DLL_FILE) $(PIPE_DLL_FILE)
STATIC_LIBRARIES = $(TCL_LIB_FILE) $(REG_LIB_FILE) $(DDE_LIB_FILE)
+# TCL_EXE is the name of a tclsh executable that is available *BEFORE*
+# running make for the first time. Certain build targets (make genstubs)
+# need it to be available on the PATH. This executable should *NOT* be
+# required just to do a normal build although it can be required to run
+# make dist.
+TCL_EXE = tclsh
+
TCLSH = tclsh$(VER)${EXESUFFIX}
TCLTEST = tcltest${EXEEXT}
CAT32 = cat32$(EXEEXT)
MAN2TCL = man2tcl$(EXEEXT)
-SET_MAKE=@SET_MAKE@
+@SET_MAKE@
# Setting the VPATH variable to a list of paths will cause the
# makefile to look into these paths when resolving .c to .obj
@@ -156,6 +155,8 @@ RC = @RC@
RES = @RES@
AC_FLAGS = @EXTRA_CFLAGS@ @DEFS@
CPPFLAGS = @CPPFLAGS@
+LDFLAGS_DEBUG = @LDFLAGS_DEBUG@
+LDFLAGS_OPTIMIZE = @LDFLAGS_OPTIMIZE@
LDFLAGS = @LDFLAGS@ @LDFLAGS_DEFAULT@
LDFLAGS_CONSOLE = @LDFLAGS_CONSOLE@
LDFLAGS_WINDOW = @LDFLAGS_WINDOW@
@@ -168,6 +169,10 @@ SHLIB_CFLAGS = @SHLIB_CFLAGS@
SHLIB_SUFFIX = @SHLIB_SUFFIX@
VER = @TCL_MAJOR_VERSION@@TCL_MINOR_VERSION@
DOTVER = @TCL_MAJOR_VERSION@.@TCL_MINOR_VERSION@
+DDEVER = @TCL_DDE_MAJOR_VERSION@@TCL_DDE_MINOR_VERSION@
+DDEDOTVER = @TCL_DDE_MAJOR_VERSION@.@TCL_DDE_MINOR_VERSION@
+REGVER = @TCL_REG_MAJOR_VERSION@@TCL_REG_MINOR_VERSION@
+REGDOTVER = @TCL_REG_MAJOR_VERSION@.@TCL_REG_MINOR_VERSION@
LIBS = @LIBS@
RMDIR = rm -rf
@@ -253,6 +258,8 @@ GENERIC_OBJS = \
tclStubInit.$(OBJEXT) \
tclStubLib.$(OBJEXT) \
tclThread.$(OBJEXT) \
+ tclThreadAlloc.$(OBJEXT) \
+ tclThreadJoin.$(OBJEXT) \
tclTimer.$(OBJEXT) \
tclUtf.$(OBJEXT) \
tclUtil.$(OBJEXT) \
@@ -276,7 +283,7 @@ WIN_OBJS = \
tclWinTime.$(OBJEXT)
COMPAT_OBJS = \
- strftime.$(OBJEXT)
+ strftime.$(OBJEXT) strtoll.$(OBJEXT) strtoull.$(OBJEXT)
PIPE_OBJS = stub16.$(OBJEXT)
@@ -310,13 +317,13 @@ winhelp: $(ROOT_DIR)/tools/man2help.tcl $(MAN2TCL)
$(MAN2TCL): $(ROOT_DIR)/tools/man2tcl.c
$(CC) $(CFLAGS_OPTIMIZE) $(MAN2TCLFLAGS) -o $(MAN2TCL) "$(ROOT_DIR_NATIVE)"/tools/man2tcl.c
-$(TCLSH): $(TCL_LIB_FILE) $(TCLSH_OBJS) tclsh.$(RES)
+$(TCLSH): $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(TCLSH_OBJS) tclsh.$(RES)
$(CC) $(CFLAGS) $(TCLSH_OBJS) $(TCL_LIB_FILE) $(LIBS) \
- tclsh.$(RES) $(CC_EXENAME)
+ tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
$(TCLTEST): $(TCL_LIB_FILE) $(TCLTEST_OBJS) $(CAT32) tclsh.$(RES)
$(CC) $(CFLAGS) $(TCLTEST_OBJS) $(TCL_LIB_FILE) $(LIBS) \
- tclsh.$(RES) $(CC_EXENAME)
+ tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
cat32.$(OBJEXT): cat.c
$(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME)
@@ -332,13 +339,11 @@ ${TCL_STUB_LIB_FILE}: ${STUB_OBJS}
@MAKE_LIB@ ${STUB_OBJS}
@POST_MAKE_LIB@
-${GNU_TCL_LIB_FILE}: ${TCL_DLL_FILE}
-
${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES)
@$(RM) ${TCL_DLL_FILE}
@MAKE_DLL@ ${TCL_OBJS} tcl.$(RES) $(SHLIB_LD_LIBS)
-${MSVC_TCL_LIB_FILE}: ${TCL_OBJS} ${TCL_DLL_FILE}
+${TCL_LIB_FILE}: ${TCL_OBJS}
@$(RM) ${TCL_LIB_FILE}
@MAKE_LIB@ ${TCL_OBJS}
@POST_MAKE_LIB@
@@ -353,7 +358,7 @@ ${DDE_LIB_FILE}: ${DDE_OBJS} ${TCL_LIB_FILE}
${REG_DLL_FILE}: ${REG_OBJS} ${TCL_STUB_LIB_FILE}
@$(RM) ${REG_DLL_FILE}
- @MAKE_DLL@ ${REG_OBJS} ${TCL_STUB_LIB_FILE} $(SHLIB_LD_LIBS)
+ @MAKE_DLL@ ${REG_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
${REG_LIB_FILE}: ${REG_OBJS} ${TCL_LIB_FILE}
@$(RM) ${REG_LIB_FILE}
@@ -364,7 +369,7 @@ ${REG_LIB_FILE}: ${REG_OBJS} ${TCL_LIB_FILE}
${PIPE_DLL_FILE}: ${PIPE_OBJS}
@$(RM) ${PIPE_DLL_FILE}
- @MAKE_EXE@ $(CFLAGS) ${PIPE_OBJS} $(LIBS)
+ @MAKE_EXE@ $(CFLAGS) ${PIPE_OBJS} $(LIBS) $(LDFLAGS_CONSOLE)
# Add the object extension to the implicit rules. By default .obj is not
# automatically added.
@@ -414,15 +419,21 @@ tclStubLib.${OBJEXT}: tclStubLib.c
$(CC) -c $(CC_SWITCHES) -DBUILD_tcl @DEPARG@ $(CC_OBJNAME)
.rc.$(RES):
- $(RC) @RC_OUT@ $@ @RC_TYPE@ @RC_INCLUDE@ "$(GENERIC_DIR_NATIVE)" @RC_INCLUDE@ "$(WIN_DIR_NATIVE)" @DEPARG@
+ $(RC) @RC_OUT@ $@ @RC_TYPE@ @RC_DEFINES@ @RC_INCLUDE@ "$(GENERIC_DIR_NATIVE)" @RC_INCLUDE@ "$(WIN_DIR_NATIVE)" @DEPARG@
install: all install-binaries install-libraries install-doc
-install-binaries:
- @$(MKDIR) -p "$(BIN_INSTALL_DIR)"
- @$(MKDIR) -p "$(LIB_INSTALL_DIR)"
- $(COPY) tclConfig.sh $(LIB_INSTALL_DIR)/tclConfig.sh
- @for i in dde1.1 reg1.0; \
+install-binaries: binaries
+ @for i in "$(LIB_INSTALL_DIR)" "$(BIN_INSTALL_DIR)" ; \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ $(MKDIR) $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
+ done;
+ @for i in dde1.2 reg1.0; \
do \
if [ ! -d $(LIB_INSTALL_DIR)/$$i ] ; then \
echo "Making directory $(LIB_INSTALL_DIR)/$$i"; \
@@ -433,37 +444,39 @@ install-binaries:
@for i in $(TCL_DLL_FILE) $(TCLSH) $(PIPE_DLL_FILE); \
do \
if [ -f $$i ]; then \
- echo "Installing $$i"; \
+ echo "Installing $$i to $(BIN_INSTALL_DIR)/"; \
$(COPY) $$i "$(BIN_INSTALL_DIR)"; \
fi; \
done
- @for i in $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE); \
+ @for i in tclConfig.sh $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE); \
do \
if [ -f $$i ]; then \
- echo "Installing $$i"; \
+ echo "Installing $$i to $(LIB_INSTALL_DIR)/"; \
$(COPY) $$i "$(LIB_INSTALL_DIR)"; \
fi; \
done
@if [ -f $(DDE_DLL_FILE) ]; then \
echo installing $(DDE_DLL_FILE); \
- $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde1.1; \
- $(COPY) $(ROOT_DIR)/library/dde1.1/pkgIndex.tcl $(LIB_INSTALL_DIR)/dde1.1; \
+ $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde1.2; \
+ $(COPY) $(ROOT_DIR)/library/dde/pkgIndex.tcl \
+ $(LIB_INSTALL_DIR)/dde1.2; \
fi
@if [ -f $(DDE_LIB_FILE) ]; then \
echo installing $(DDE_LIB_FILE); \
- $(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde1.1; \
+ $(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde1.2; \
fi
@if [ -f $(REG_DLL_FILE) ]; then \
echo installing $(REG_DLL_FILE); \
$(COPY) $(REG_DLL_FILE) $(LIB_INSTALL_DIR)/reg1.0; \
- $(COPY) $(ROOT_DIR)/library/reg1.0/pkgIndex.tcl $(LIB_INSTALL_DIR)/reg1.0; \
+ $(COPY) $(ROOT_DIR)/library/reg/pkgIndex.tcl \
+ $(LIB_INSTALL_DIR)/reg1.0; \
fi
@if [ -f $(REG_LIB_FILE) ]; then \
echo installing $(REG_LIB_FILE); \
$(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg1.0; \
fi
-install-libraries:
+install-libraries: libraries
@for i in $(prefix)/lib $(INCLUDE_INSTALL_DIR) \
$(SCRIPT_INSTALL_DIR); \
do \
@@ -473,7 +486,7 @@ install-libraries:
else true; \
fi; \
done;
- @for i in http1.0 http2.3 opt0.4 encoding msgcat1.0 tcltest1.0; \
+ @for i in http1.0 http2.4 opt0.4 encoding msgcat1.3 tcltest2.2; \
do \
if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \
echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
@@ -482,7 +495,8 @@ install-libraries:
fi; \
done;
@echo "Installing header files";
- @for i in "$(GENERIC_DIR)/tcl.h" "$(GENERIC_DIR)/tclDecls.h" ; \
+ @for i in "$(GENERIC_DIR)/tcl.h" "$(GENERIC_DIR)/tclDecls.h" \
+ "$(GENERIC_DIR)/tclPlatDecls.h" ; \
do \
$(COPY) "$$i" "$(INCLUDE_INSTALL_DIR)"; \
done;
@@ -491,20 +505,41 @@ install-libraries:
do \
$(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)"; \
done;
- @for i in http2.3 http1.0 opt0.4 msgcat1.0 tcltest1.0; \
+ @echo "Installing library http1.0 directory";
+ @for j in $(ROOT_DIR)/library/http1.0/*.tcl; \
+ do \
+ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \
+ done;
+ @echo "Installing library http2.4 directory";
+ @for j in $(ROOT_DIR)/library/http/*.tcl; \
do \
- echo "Installing library $$i directory"; \
- for j in $(ROOT_DIR)/library/$$i/*.tcl; \
- do \
- $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/$$i"; \
- done; \
+ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http2.4"; \
done;
- @echo "Installing encodings"
+ @echo "Installing library opt0.4 directory";
+ @for j in $(ROOT_DIR)/library/opt/*.tcl; \
+ do \
+ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
+ done;
+ @echo "Installing library msgcat1.3 directory";
+ @for j in $(ROOT_DIR)/library/msgcat/*.tcl; \
+ do \
+ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/msgcat1.3"; \
+ done;
+ @echo "Installing library tcltest2.2 directory";
+ @for j in $(ROOT_DIR)/library/tcltest/*.tcl; \
+ do \
+ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/tcltest2.2"; \
+ done;
+ @echo "Installing encodings";
@for i in $(ROOT_DIR)/library/encoding/*.enc ; do \
$(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)/encoding"; \
done;
-install-doc:
+install-doc: doc
+
+# Specifying TESTFLAGS on the command line is the standard way to pass
+# args to tcltest, ie:
+# % make test TESTFLAGS="-verbose bps -file fileName.test"
test: binaries $(TCLTEST)
TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
@@ -512,17 +547,26 @@ test: binaries $(TCLTEST)
| ./$(CAT32)
# Useful target to launch a built tcltest with the proper path,...
-runtest: tcltest
+runtest: binaries $(TCLTEST)
@TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
- ./tcltest
+ ./$(TCLTEST) $(TESTFLAGS) $(SCRIPT)
-depend:
+# This target can be used to run tclsh from the build directory
+# via `make shell SCRIPT=foo.tcl`
+shell: binaries
+ @TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
+ ./$(TCLSH) $(SCRIPT)
+
+# This target can be used to run tclsh inside either gdb or insight
+gdb: binaries
+ @echo "set env TCL_LIBRARY=$(LIBRARY_DIR)" > gdb.run
+ gdb ./tclsh --command=gdb.run
+ rm gdb.run
-Makefile: $(SRC_DIR)/Makefile.in config.status
- $(SHELL) config.status
+depend:
-config.status: $(WIN_DIR)/configure
- $(SHELL) config.status --recheck
+Makefile: $(SRC_DIR)/Makefile.in
+ ./config.status
cleanhelp:
$(RM) *.hlp *.cnt *.GID *.rtf man2tcl.exe
@@ -540,19 +584,14 @@ distclean: clean
# Regenerate the stubs files.
#
-# FIXME: We can't depend on TCLSH here since it is not yet built!
-
$(GENERIC_DIR)/tclStubInit.c: $(GENERIC_DIR)/tcl.decls \
$(GENERIC_DIR)/tclInt.decls
- @TCL_LIBRARY="$(ROOT_DIR_NATIVE)/library"; export TCL_LIBRARY; \
- $(TCLSH) "$(ROOT_DIR_NATIVE)\tools\genStubs.tcl" \
- "$(GENERIC_DIR_NATIVE)" \
- "$(GENERIC_DIR_NATIVE)\tcl.decls" \
- "$(GENERIC_DIR_NATIVE)\tclInt.decls"
+ @echo "Warning: tclStubInit.c may be out of date."
+ @echo "Developers may want to run \"make genstubs\" to regenerate."
+ @echo "This warning can be safely ignored, do not report as a bug!"
genstubs:
- @TCL_LIBRARY="$(ROOT_DIR_NATIVE)/library"; export TCL_LIBRARY; \
- $(TCLSH) "$(ROOT_DIR_NATIVE)\tools\genStubs.tcl" \
+ $(TCL_EXE) "$(ROOT_DIR_NATIVE)\tools\genStubs.tcl" \
"$(GENERIC_DIR_NATIVE)" \
"$(GENERIC_DIR_NATIVE)\tcl.decls" \
"$(GENERIC_DIR_NATIVE)\tclInt.decls"
diff --git a/tcl/win/README b/tcl/win/README
index f382774470a..d1c67d538ab 100644
--- a/tcl/win/README
+++ b/tcl/win/README
@@ -1,8 +1,4 @@
-Tcl 8.3 for Windows
-
-by Scott Stanton
-Scriptics Corporation
-scott.stanton@scriptics.com
+Tcl 8.4 for Windows
RCS: @(#) $Id$
@@ -14,24 +10,70 @@ version of Tcl. This directory also contains source files for Tcl
that are specific to Microsoft Windows.
The information in this file is maintained on the web at:
- http://dev.scriptics.com/doc/howto/compile.html#win
+ http://www.tcl.tk/doc/howto/compile.html#win
+
+The above URL includes a lengthy discussion of compiler macros necessary
+when compiling Tcl extensions that will be dynamically loaded.
2. Compiling Tcl
----------------
-In order to compile Tcl for Windows, you need the following items:
+In order to compile Tcl for Windows, you need the following:
+
+ Tcl 8.4 Source Distribution (plus any patches)
+
+ and
+
+ Visual C++ 5 or newer
+
+ or
+
+ Msys + Mingw 1.1
+
+ http://prdownloads.sourceforge.net/tcl/msys_mingw2.zip
+
+ This Msys + Mingw download is the minimal environment
+ needed to build Tcl/Tk under Windows. It includes a
+ shell environment and gcc. The release is designed to
+ make it as easy a possible to build Tcl/Tk. To install,
+ you just download the zip file and extract the files
+ into a directory. The README.TXT file describes how
+ to launch the msys shell, you then run the configure
+ script in the tcl/win directory.
+
+ or
+
+ Cygwin 1.1 or newer (See http://sources.redhat.com/cygwin)
- Tcl 8.3 Source Distribution (plus any patches)
+ Mingw 1.1 (http://prdownloads.sourceforge.net/mingw/MinGW-1.1.tar.gz)
- Visual C++ 2.x/4.x/5.x
+ Extract the contents of the archive file into /usr/local/mingw
+ and place /usr/local/mingw/bin at the front of your PATH env var
+ before running the configure script in the tcl/win directory.
-In practice, this release is built with Visual C++ 5.0
-In the "win" subdirectory of the source release, you will find
-"makefile.vc". This is the makefile Visual C++ compiler. You should
-update the paths at the top of the file to reflect your system
-configuration. Now you can use "make" (or "nmake" for VC++) to build
-the tcl libraries and the tclsh executable.
+In practice, this release is built with Visual C++ 6.0 and the TEA
+Makefile.
+
+If you are building with Visual C++, in the "win" subdirectory of the
+source release, you will find "makefile.vc". This is the makefile for
+the Visual C++ compiler and uses the stock NMAKE tool. Detailed
+directions for using it, are in the comments of "makefile.vc". A quick
+example would be:
+ C:\tcl_source\win\>nmake -f makefile.vc
+
+There is also a Developer Studio workspace and project file, too, if you
+would like to use them.
+
+If you are building with Msys or Cygwin, you can use the configure script
+that lives in the win subdirectory. The Msys or Cygwin based configure/build
+process works just like the UNIX one, so you will want to refer to
+../unix/README for available configure options. An error will be
+generated by the configure script if you try to compile Tcl with
+the Cygwin version of gcc instead of the Mingw version. Check your
+PATH if you get this error. Be aware that gcc will generate
+lots of compile time warnings when building Tcl. Warnings are
+not errors, so please don't file a bug report about them.
In order to use the binaries generated by these makefiles, you will
need to place the Tcl script library files someplace where Tcl can
@@ -39,24 +81,16 @@ find them. Tcl looks in one of following places for the library files:
1) The path specified in the environment variable "TCL_LIBRARY".
- 2) In the lib\tcl8.3 directory under the installation directory
- as specified in the registry:
+ 2) Relative to the directory containing the current .exe.
+ Tcl will look for a directory "..\lib\tcl8.4" relative to the
+ directory containing the currently running .exe.
- HKEY_LOCAL_MACHINE\SOFTWARE\Scriptics\Tcl\8.3
-
- 3) Relative to the directory containing the current .exe.
- Tcl will look for a directory "..\lib\tcl8.3" relative to the
- directory containing the currently running .exe.
-
-Note that in order to run tclsh83.exe, you must ensure that tcl83.dll
-and tclpip83.dll are on your path, in the system directory, or in the
-directory containing tclsh83.exe.
+Note that in order to run tclsh84.exe, you must ensure that tcl84.dll
+and tclpip84.dll are on your path, in the system directory, or in the
+directory containing tclsh84.exe.
Note: Tcl no longer provides support for Win32s.
-This page includes a lengthy discussion of compiler macros necessary
-when compiling Tcl extensions that will be dynamically loaded.
-
3. Test suite
-------------
@@ -64,11 +98,7 @@ This distribution contains an extensive test suite for Tcl. Some of
the tests are timing dependent and will fail from time to time. If a
test is failing consistently, please send us a bug report with as much
detail as you can manage. Please use the online database at
- http://dev.scriptics.com/ticket/
+ http://tcl.sourceforge.net/
In order to run the test suite, you build the "test" target using the
appropriate makefile for your compiler.
-
-
-
-
diff --git a/tcl/win/aclocal.m4 b/tcl/win/aclocal.m4
index 005783c4aae..bc7540da6cc 100644
--- a/tcl/win/aclocal.m4
+++ b/tcl/win/aclocal.m4
@@ -1,2 +1 @@
builtin(include,tcl.m4)
-builtin(include,../cygtcl.m4)
diff --git a/tcl/win/buildall.vc.bat b/tcl/win/buildall.vc.bat
new file mode 100644
index 00000000000..2e5d04ed7d1
--- /dev/null
+++ b/tcl/win/buildall.vc.bat
@@ -0,0 +1,36 @@
+@echo off
+
+:: This is an example batchfile for building everything. Please
+:: edit this (or make your own) for your needs and wants using
+:: the instructions for calling makefile.vc found in makefile.vc
+::
+:: RCS: @(#) $Id$
+
+echo Sit back and have a cup of coffee while this grinds through ;)
+echo You asked for *everything*, remember?
+echo.
+
+if "%MSVCDir%" == "" call C:\dev\devstudio60\vc98\bin\vcvars32.bat
+set INSTALLDIR=C:\progra~1\tcl
+
+nmake -nologo -f makefile.vc release winhelp OPTS=none
+if errorlevel 1 goto error
+nmake -nologo -f makefile.vc release OPTS=static
+if errorlevel 1 goto error
+nmake -nologo -f makefile.vc core dlls OPTS=static,msvcrt
+if errorlevel 1 goto error
+nmake -nologo -f makefile.vc core OPTS=static,threads
+if errorlevel 1 goto error
+nmake -nologo -f makefile.vc core dlls OPTS=static,msvcrt,threads
+if errorlevel 1 goto error
+nmake -nologo -f makefile.vc shell OPTS=threads
+if errorlevel 1 goto error
+goto end
+
+:error
+echo *** BOOM! ***
+
+:end
+echo done!
+pause
+
diff --git a/tcl/win/cat.c b/tcl/win/cat.c
index ea088e2df2a..ff57a0e569f 100644
--- a/tcl/win/cat.c
+++ b/tcl/win/cat.c
@@ -35,5 +35,3 @@ main()
return 0;
}
-
-
diff --git a/tcl/win/coffbase.txt b/tcl/win/coffbase.txt
new file mode 100644
index 00000000000..195bbfb3fcc
--- /dev/null
+++ b/tcl/win/coffbase.txt
@@ -0,0 +1,24 @@
+;
+; This file defines the virtual base addresses for Dynamic Link Libraries (DLL)
+; that are part of the Tcl system. The first token on a line is the key (or name
+; of the DLL) and the second token is the virtual base address, in hexidecimal.
+; The third token is the maximum size of the DLL image file, including symbols.
+;
+; Using a specified "prefered load address" should speed loading time by avoiding
+; relocations (NT supported only). It is assumed extension authors will contribute
+; their modules to this grand-master list. You can use the dumpbin utility with
+; the /headers option to get the "size of image" data (already in hex). If the
+; maximum size is too small a linker warning will occur. Modules can overlap when
+; they're mutually exclusive. This info is placed in the DLL's PE header by the
+; linker with the `-base:@$(TCLDIR)\win\coffbase.txt,<key>` option.
+;
+; RCS: @(#) $Id$
+
+tcl 0x10000000 0x00200000
+tcldde 0x10200000 0x00010000
+tclreg 0x10210000 0x00010000
+tk 0x10220000 0x00200000
+expect 0x10480000 0x00080000
+itcl 0x10500000 0x00080000
+itk 0x10580000 0x00080000
+
diff --git a/tcl/win/configure b/tcl/win/configure
index 89ae3c9debc..e1d77356b04 100755
--- a/tcl/win/configure
+++ b/tcl/win/configure
@@ -16,7 +16,11 @@ ac_help="$ac_help
ac_help="$ac_help
--enable-shared build and link with shared libraries [--enable-shared]"
ac_help="$ac_help
+ --enable-64bit enable 64bit support (where applicable)"
+ac_help="$ac_help
--enable-symbols build with debugging symbols [--disable-symbols]"
+ac_help="$ac_help
+ --enable-memdebug build with memory debugging [--disable-memdebug]"
# Initialize some variables set by options.
# The variables have the same names as the options, with
@@ -34,7 +38,6 @@ program_suffix=NONE
program_transform_name=s,x,x,
silent=
site=
-sitefile=
srcdir=
target=NONE
verbose=
@@ -149,7 +152,6 @@ Configuration:
--help print this message
--no-create do not create output files
--quiet, --silent do not print \`checking...' messages
- --site-file=FILE use FILE as the site file
--version print the version of autoconf that created configure
Directory and file names:
--prefix=PREFIX install architecture-independent files in PREFIX
@@ -320,11 +322,6 @@ EOF
-site=* | --site=* | --sit=*)
site="$ac_optarg" ;;
- -site-file | --site-file | --site-fil | --site-fi | --site-f)
- ac_prev=sitefile ;;
- -site-file=* | --site-file=* | --site-fil=* | --site-fi=* | --site-f=*)
- sitefile="$ac_optarg" ;;
-
-srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
ac_prev=srcdir ;;
-srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
@@ -490,16 +487,12 @@ fi
srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
# Prefer explicitly selected file to automatically selected ones.
-if test -z "$sitefile"; then
- if test -z "$CONFIG_SITE"; then
- if test "x$prefix" != xNONE; then
- CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
- else
- CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
- fi
+if test -z "$CONFIG_SITE"; then
+ if test "x$prefix" != xNONE; then
+ CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+ else
+ CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
fi
-else
- CONFIG_SITE="$sitefile"
fi
for ac_site_file in $CONFIG_SITE; do
if test -r "$ac_site_file"; then
@@ -539,27 +532,52 @@ fi
-TCL_VERSION=8.3
+
+TCL_VERSION=8.4
TCL_MAJOR_VERSION=8
-TCL_MINOR_VERSION=3
-TCL_PATCH_LEVEL=".2"
+TCL_MINOR_VERSION=4
+TCL_PATCH_LEVEL=".0"
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
+TCL_DDE_VERSION=1.2
+TCL_DDE_MAJOR_VERSION=1
+TCL_DDE_MINOR_VERSION=2
+TCL_DDE_PATCH_LEVEL=""
+DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION
+
+TCL_REG_VERSION=1.0
+TCL_REG_MAJOR_VERSION=1
+TCL_REG_MINOR_VERSION=0
+TCL_REG_PATCH_LEVEL=""
+REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION
+
+#------------------------------------------------------------------------
+# Handle the --prefix=... option
+#------------------------------------------------------------------------
+
if test "${prefix}" = "NONE"; then
prefix=/usr/local
fi
if test "${exec_prefix}" = "NONE"; then
exec_prefix=$prefix
fi
+# libdir must be a fully qualified path (not ${exec_prefix}/lib)
+eval libdir="$libdir"
#------------------------------------------------------------------------
# Standard compiler checks
#------------------------------------------------------------------------
+# If the user did not set CFLAGS, set it now to keep
+# the AC_PROG_CC macro from adding "-g -O2".
+if test "${CFLAGS+set}" != "set" ; then
+ CFLAGS=""
+fi
+
# Extract the first word of "gcc", so it can be a program name with args.
set dummy gcc; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:563: checking for $ac_word" >&5
+echo "configure:581: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@@ -589,7 +607,7 @@ if test -z "$CC"; then
# Extract the first word of "cc", so it can be a program name with args.
set dummy cc; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:593: checking for $ac_word" >&5
+echo "configure:611: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@@ -640,7 +658,7 @@ fi
# Extract the first word of "cl", so it can be a program name with args.
set dummy cl; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:644: checking for $ac_word" >&5
+echo "configure:662: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@@ -672,7 +690,7 @@ fi
fi
echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6
-echo "configure:676: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5
+echo "configure:694: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5
ac_ext=c
# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
@@ -683,12 +701,12 @@ cross_compiling=$ac_cv_prog_cc_cross
cat > conftest.$ac_ext << EOF
-#line 687 "configure"
+#line 705 "configure"
#include "confdefs.h"
main(){return(0);}
EOF
-if { (eval echo configure:692: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:710: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
ac_cv_prog_cc_works=yes
# If we can't run a trivial program, we are probably using a cross compiler.
if (./conftest; exit) 2>/dev/null; then
@@ -714,12 +732,12 @@ if test $ac_cv_prog_cc_works = no; then
{ echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; }
fi
echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6
-echo "configure:718: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5
+echo "configure:736: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5
echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6
cross_compiling=$ac_cv_prog_cc_cross
echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6
-echo "configure:723: checking whether we are using GNU C" >&5
+echo "configure:741: checking whether we are using GNU C" >&5
if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@@ -728,7 +746,7 @@ else
yes;
#endif
EOF
-if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:732: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
+if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:750: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
ac_cv_prog_gcc=yes
else
ac_cv_prog_gcc=no
@@ -747,7 +765,7 @@ ac_test_CFLAGS="${CFLAGS+set}"
ac_save_CFLAGS="$CFLAGS"
CFLAGS=
echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6
-echo "configure:751: checking whether ${CC-cc} accepts -g" >&5
+echo "configure:769: checking whether ${CC-cc} accepts -g" >&5
if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@@ -779,112 +797,18 @@ else
fi
-ac_aux_dir=
-for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do
- if test -f $ac_dir/install-sh; then
- ac_aux_dir=$ac_dir
- ac_install_sh="$ac_aux_dir/install-sh -c"
- break
- elif test -f $ac_dir/install.sh; then
- ac_aux_dir=$ac_dir
- ac_install_sh="$ac_aux_dir/install.sh -c"
- break
- fi
-done
-if test -z "$ac_aux_dir"; then
- { echo "configure: error: can not find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." 1>&2; exit 1; }
-fi
-ac_config_guess=$ac_aux_dir/config.guess
-ac_config_sub=$ac_aux_dir/config.sub
-ac_configure=$ac_aux_dir/configure # This should be Cygnus configure.
-
-
-# Make sure we can run config.sub.
-if ${CONFIG_SHELL-/bin/sh} $ac_config_sub sun4 >/dev/null 2>&1; then :
-else { echo "configure: error: can not run $ac_config_sub" 1>&2; exit 1; }
-fi
-
-echo $ac_n "checking host system type""... $ac_c" 1>&6
-echo "configure:809: checking host system type" >&5
-
-host_alias=$host
-case "$host_alias" in
-NONE)
- case $nonopt in
- NONE)
- if host_alias=`${CONFIG_SHELL-/bin/sh} $ac_config_guess`; then :
- else { echo "configure: error: can not guess host type; you must specify one" 1>&2; exit 1; }
- fi ;;
- *) host_alias=$nonopt ;;
- esac ;;
-esac
-
-host=`${CONFIG_SHELL-/bin/sh} $ac_config_sub $host_alias`
-host_cpu=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
-host_vendor=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
-host_os=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
-echo "$ac_t""$host" 1>&6
-
-echo $ac_n "checking build system type""... $ac_c" 1>&6
-echo "configure:830: checking build system type" >&5
-
-build_alias=$build
-case "$build_alias" in
-NONE)
- case $nonopt in
- NONE) build_alias=$host_alias ;;
- *) build_alias=$nonopt ;;
- esac ;;
-esac
-
-build=`${CONFIG_SHELL-/bin/sh} $ac_config_sub $build_alias`
-build_cpu=`echo $build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
-build_vendor=`echo $build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
-build_os=`echo $build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
-echo "$ac_t""$build" 1>&6
-
-if test $host != $build; then
- ac_tool_prefix=${host_alias}-
-else
- ac_tool_prefix=
-fi
-
-# Extract the first word of "${ac_tool_prefix}ar", so it can be a program name with args.
-set dummy ${ac_tool_prefix}ar; ac_word=$2
-echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:856: checking for $ac_word" >&5
-if eval "test \"`echo '$''{'ac_cv_prog_AR'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- if test -n "$AR"; then
- ac_cv_prog_AR="$AR" # Let the user override the test.
-else
- IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
- ac_dummy="$PATH"
- for ac_dir in $ac_dummy; do
- test -z "$ac_dir" && ac_dir=.
- if test -f $ac_dir/$ac_word; then
- ac_cv_prog_AR="${ac_tool_prefix}ar"
- break
- fi
- done
- IFS="$ac_save_ifs"
-fi
-fi
-AR="$ac_cv_prog_AR"
-if test -n "$AR"; then
- echo "$ac_t""$AR" 1>&6
-else
- echo "$ac_t""no" 1>&6
-fi
+# To properly support cross-compilation, one would
+# need to use these tool checks instead of
+# the ones below and reconfigure with
+# autoconf 2.50. You can also just set
+# the CC, AR, RANLIB, and RC environment
+# variables if you want to cross compile.
-
-if test -z "$ac_cv_prog_AR"; then
-if test -n "$ac_tool_prefix"; then
- # Extract the first word of "ar", so it can be a program name with args.
+if test "${GCC}" = "yes" ; then
+ # Extract the first word of "ar", so it can be a program name with args.
set dummy ar; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:888: checking for $ac_word" >&5
+echo "configure:812: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_AR'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@@ -901,7 +825,6 @@ else
fi
done
IFS="$ac_save_ifs"
- test -z "$ac_cv_prog_AR" && ac_cv_prog_AR=":"
fi
fi
AR="$ac_cv_prog_AR"
@@ -911,47 +834,10 @@ else
echo "$ac_t""no" 1>&6
fi
-else
- AR=":"
-fi
-fi
-
-# Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args.
-set dummy ${ac_tool_prefix}ranlib; ac_word=$2
-echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:923: checking for $ac_word" >&5
-if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- if test -n "$RANLIB"; then
- ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
-else
- IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
- ac_dummy="$PATH"
- for ac_dir in $ac_dummy; do
- test -z "$ac_dir" && ac_dir=.
- if test -f $ac_dir/$ac_word; then
- ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib"
- break
- fi
- done
- IFS="$ac_save_ifs"
-fi
-fi
-RANLIB="$ac_cv_prog_RANLIB"
-if test -n "$RANLIB"; then
- echo "$ac_t""$RANLIB" 1>&6
-else
- echo "$ac_t""no" 1>&6
-fi
-
-
-if test -z "$ac_cv_prog_RANLIB"; then
-if test -n "$ac_tool_prefix"; then
- # Extract the first word of "ranlib", so it can be a program name with args.
+ # Extract the first word of "ranlib", so it can be a program name with args.
set dummy ranlib; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:955: checking for $ac_word" >&5
+echo "configure:841: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@@ -968,7 +854,6 @@ else
fi
done
IFS="$ac_save_ifs"
- test -z "$ac_cv_prog_RANLIB" && ac_cv_prog_RANLIB=":"
fi
fi
RANLIB="$ac_cv_prog_RANLIB"
@@ -978,47 +863,10 @@ else
echo "$ac_t""no" 1>&6
fi
-else
- RANLIB=":"
-fi
-fi
-
-# Extract the first word of "${ac_tool_prefix}windres", so it can be a program name with args.
-set dummy ${ac_tool_prefix}windres; ac_word=$2
-echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:990: checking for $ac_word" >&5
-if eval "test \"`echo '$''{'ac_cv_prog_RC'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- if test -n "$RC"; then
- ac_cv_prog_RC="$RC" # Let the user override the test.
-else
- IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
- ac_dummy="$PATH"
- for ac_dir in $ac_dummy; do
- test -z "$ac_dir" && ac_dir=.
- if test -f $ac_dir/$ac_word; then
- ac_cv_prog_RC="${ac_tool_prefix}windres"
- break
- fi
- done
- IFS="$ac_save_ifs"
-fi
-fi
-RC="$ac_cv_prog_RC"
-if test -n "$RC"; then
- echo "$ac_t""$RC" 1>&6
-else
- echo "$ac_t""no" 1>&6
-fi
-
-
-if test -z "$ac_cv_prog_RC"; then
-if test -n "$ac_tool_prefix"; then
- # Extract the first word of "windres", so it can be a program name with args.
+ # Extract the first word of "windres", so it can be a program name with args.
set dummy windres; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:1022: checking for $ac_word" >&5
+echo "configure:870: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_RC'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@@ -1035,7 +883,6 @@ else
fi
done
IFS="$ac_save_ifs"
- test -z "$ac_cv_prog_RC" && ac_cv_prog_RC=":"
fi
fi
RC="$ac_cv_prog_RC"
@@ -1045,18 +892,14 @@ else
echo "$ac_t""no" 1>&6
fi
-else
- RC=":"
-fi
fi
-
#--------------------------------------------------------------------
# Checks to see if the make progeam sets the $MAKE variable.
#--------------------------------------------------------------------
echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6
-echo "configure:1060: checking whether ${MAKE-make} sets \${MAKE}" >&5
+echo "configure:903: checking whether ${MAKE-make} sets \${MAKE}" >&5
set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_prog_make_${ac_make}_set'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
@@ -1084,16 +927,16 @@ fi
#--------------------------------------------------------------------
-# These two macros perform additinal compiler test.
+# Perform additinal compiler tests.
#--------------------------------------------------------------------
echo $ac_n "checking for Cygwin environment""... $ac_c" 1>&6
-echo "configure:1092: checking for Cygwin environment" >&5
+echo "configure:935: checking for Cygwin environment" >&5
if eval "test \"`echo '$''{'ac_cv_cygwin'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1097 "configure"
+#line 940 "configure"
#include "confdefs.h"
int main() {
@@ -1104,7 +947,7 @@ int main() {
return __CYGWIN__;
; return 0; }
EOF
-if { (eval echo configure:1108: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:951: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
ac_cv_cygwin=yes
else
@@ -1121,18 +964,75 @@ echo "$ac_t""$ac_cv_cygwin" 1>&6
CYGWIN=
test "$ac_cv_cygwin" = yes && CYGWIN=yes
+if test "$ac_cv_cygwin" = "yes" ; then
+ { echo "configure: error: Compiling with the Cygwin version of gcc is not supported.
+ Use the Mingw version of gcc from www.mingw.org instead." 1>&2; exit 1; }
+fi
+
+
+echo $ac_n "checking for SEH support in compiler""... $ac_c" 1>&6
+echo "configure:975: checking for SEH support in compiler" >&5
+if eval "test \"`echo '$''{'tcl_cv_seh'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test "$cross_compiling" = yes; then
+ tcl_cv_seh=no
+else
+ cat > conftest.$ac_ext <<EOF
+#line 983 "configure"
+#include "confdefs.h"
+
+#define WIN32_LEAN_AND_MEAN
+#include <windows.h>
+#undef WIN32_LEAN_AND_MEAN
+
+int main(int argc, char** argv) {
+ int a, b = 0;
+ __try {
+ a = 666 / b;
+ }
+ __except (EXCEPTION_EXECUTE_HANDLER) {
+ return 0;
+ }
+ return 1;
+}
+
+EOF
+if { (eval echo configure:1002: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+then
+ tcl_cv_seh=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -fr conftest*
+ tcl_cv_seh=no
+fi
+rm -fr conftest*
+fi
+
+
+fi
+
+echo "$ac_t""$tcl_cv_seh" 1>&6
+if test "$tcl_cv_seh" = "no" ; then
+ cat >> confdefs.h <<\EOF
+#define HAVE_NO_SEH
+EOF
+
+fi
+
#--------------------------------------------------------------------
# Determines the correct binary file extension (.o, .obj, .exe etc.)
#--------------------------------------------------------------------
echo $ac_n "checking for object suffix""... $ac_c" 1>&6
-echo "configure:1130: checking for object suffix" >&5
+echo "configure:1030: checking for object suffix" >&5
if eval "test \"`echo '$''{'ac_cv_objext'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
rm -f conftest*
echo 'int i = 1;' > conftest.$ac_ext
-if { (eval echo configure:1136: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:1036: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
for ac_file in conftest.*; do
case $ac_file in
*.c) ;;
@@ -1150,19 +1050,19 @@ OBJEXT=$ac_cv_objext
ac_objext=$ac_cv_objext
echo $ac_n "checking for mingw32 environment""... $ac_c" 1>&6
-echo "configure:1154: checking for mingw32 environment" >&5
+echo "configure:1054: checking for mingw32 environment" >&5
if eval "test \"`echo '$''{'ac_cv_mingw32'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1159 "configure"
+#line 1059 "configure"
#include "confdefs.h"
int main() {
return __MINGW32__;
; return 0; }
EOF
-if { (eval echo configure:1166: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:1066: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
ac_cv_mingw32=yes
else
@@ -1181,7 +1081,7 @@ test "$ac_cv_mingw32" = yes && MINGW32=yes
echo $ac_n "checking for executable suffix""... $ac_c" 1>&6
-echo "configure:1185: checking for executable suffix" >&5
+echo "configure:1085: checking for executable suffix" >&5
if eval "test \"`echo '$''{'ac_cv_exeext'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@@ -1191,10 +1091,10 @@ else
rm -f conftest*
echo 'int main () { return 0; }' > conftest.$ac_ext
ac_cv_exeext=
- if { (eval echo configure:1195: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then
+ if { (eval echo configure:1095: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then
for file in conftest.*; do
case $file in
- *.c | *.o | *.obj | *.ilk | *.pdb) ;;
+ *.c | *.o | *.obj) ;;
*) ac_cv_exeext=`echo $file | sed -e s/conftest//` ;;
esac
done
@@ -1218,7 +1118,7 @@ ac_exeext=$EXEEXT
echo $ac_n "checking for building with threads""... $ac_c" 1>&6
-echo "configure:1222: checking for building with threads" >&5
+echo "configure:1122: checking for building with threads" >&5
# Check whether --enable-threads or --disable-threads was given.
if test "${enable_threads+set}" = set; then
enableval="$enable_threads"
@@ -1239,6 +1139,7 @@ EOF
TCL_THREADS=0
echo "$ac_t""no (default)" 1>&6
fi
+
#--------------------------------------------------------------------
@@ -1248,7 +1149,7 @@ EOF
echo $ac_n "checking how to build libraries""... $ac_c" 1>&6
-echo "configure:1252: checking how to build libraries" >&5
+echo "configure:1153: checking how to build libraries" >&5
# Check whether --enable-shared or --disable-shared was given.
if test "${enable_shared+set}" = set; then
enableval="$enable_shared"
@@ -1285,12 +1186,28 @@ EOF
#--------------------------------------------------------------------
- TCL_LIB_VERSIONS_OK=nodots
+
+ # Step 0: Enable 64 bit support?
+
+ echo $ac_n "checking if 64bit support is requested""... $ac_c" 1>&6
+echo "configure:1194: checking if 64bit support is requested" >&5
+ # Check whether --enable-64bit or --disable-64bit was given.
+if test "${enable_64bit+set}" = set; then
+ enableval="$enable_64bit"
+ do64bit=$enableval
+else
+ do64bit=no
+fi
+
+ echo "$ac_t""$do64bit" 1>&6
+
+ # Set some defaults (may get changed below)
+ EXTRA_CFLAGS=""
# Extract the first word of "cygpath", so it can be a program name with args.
set dummy cygpath; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:1294: checking for $ac_word" >&5
+echo "configure:1211: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_CYGPATH'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@@ -1318,67 +1235,42 @@ else
fi
- # Check for a bug in gcc's windres that causes the
- # compile to fail when a Windows native path is
- # passed into windres. The mingw toolchain requires
- # Windows native paths while Cygwin should work
- # with both. Avoid the bug by passing a POSIX
- # path when using the Cygwin toolchain.
-
- if test "$GCC" = "yes" && test "$CYGPATH" != "echo" ; then
- conftest=/tmp/conftest.rc
- echo "STRINGTABLE BEGIN" > $conftest
- echo "101 \"name\"" >> $conftest
- echo "END" >> $conftest
-
- echo $ac_n "checking for Windows native path bug in windres""... $ac_c" 1>&6
-echo "configure:1336: checking for Windows native path bug in windres" >&5
- cyg_conftest=`$CYGPATH $conftest`
- if { ac_try='$RC -o conftest.res.o $cyg_conftest'; { (eval echo configure:1338: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } ; then
- echo "$ac_t""no" 1>&6
- else
- echo "$ac_t""yes" 1>&6
- CYGPATH=echo
- fi
- conftest=
- cyg_conftest=
- fi
-
if test "$CYGPATH" = "echo" || test "$ac_cv_cygwin" = "yes"; then
DEPARG='"$<"'
else
DEPARG='"$(shell $(CYGPATH) $<)"'
fi
- # CYGNUS LOCAL
- VENDORPREFIX="rh"
- # END CYGNUS LOCAL
-
# set various compiler flags depending on whether we are using gcc or cl
echo $ac_n "checking compiler flags""... $ac_c" 1>&6
-echo "configure:1361: checking compiler flags" >&5
+echo "configure:1248: checking compiler flags" >&5
if test "${GCC}" = "yes" ; then
-
- # CYGNUS LOCAL
- if test "$ac_cv_cygwin" = "yes" ; then
- VENDORPREFIX="cyg"
+ if test "$do64bit" = "yes" ; then
+ echo "configure: warning: "64bit mode not supported with GCC on Windows"" 1>&2
fi
- # END CYGNUS LOCAL
-
SHLIB_LD=""
SHLIB_LD_LIBS=""
LIBS=""
- LIBS_GUI="-lgdi32 -lcomdlg32"
- STLIB_LD="${AR} cr"
+ LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32"
+ STLIB_LD='${AR} cr'
RC_OUT=-o
RC_TYPE=
RC_INCLUDE=--include
+ RC_DEFINE=--define
RES=res.o
MAKE_LIB="\${STLIB_LD} \$@"
POST_MAKE_LIB="\${RANLIB} \$@"
MAKE_EXE="\${CC} -o \$@"
- LIBPREFIX="lib${VENDORPREFIX}"
+ LIBPREFIX="lib"
+
+ if test "$ac_cv_cygwin" = "yes"; then
+ extra_cflags="-mno-cygwin"
+ extra_ldflags="-mno-cygwin"
+ else
+ extra_cflags=""
+ extra_ldflags=""
+ fi
if test "${SHARED_BUILD}" = "0" ; then
# static
@@ -1388,7 +1280,6 @@ echo "configure:1361: checking compiler flags" >&5
LIBSUFFIX="s\${DBGX}.a"
LIBRARIES="\${STATIC_LIBRARIES}"
EXESUFFIX="s\${DBGX}.exe"
- DLLSUFFIX=""
else
# dynamic
echo "$ac_t""using shared flags" 1>&6
@@ -1396,23 +1287,27 @@ echo "configure:1361: checking compiler flags" >&5
# ad-hoc check to see if CC supports -shared.
if "${CC}" -shared 2>&1 | egrep ': -shared not supported' >/dev/null; then
{ echo "configure: error: ${CC} does not support the -shared option.
- You will need to upgrade to a newer version of the toolchain." 1>&2; exit 1; }
+ You will need to upgrade to a newer version of the toolchain." 1>&2; exit 1; }
fi
runtime=
# Link with gcc since ld does not link to default libs like
- # -luser32 and -lmsvcrt. We also need to add CFLAGS so important
- # flags like -mno-cygwin get passed in to CC.
+ # -luser32 and -lmsvcrt by default. Make sure CFLAGS is
+ # included so -mno-cygwin passed the correct libs to the linker.
SHLIB_LD='${CC} -shared ${CFLAGS}'
# Add SHLIB_LD_LIBS to the Make rule, not here.
MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \$@ ${extra_ldflags} \
-Wl,--out-implib,\$(patsubst %.dll,lib%.a,\$@)"
LIBSUFFIX="\${DBGX}.a"
- DLLSUFFIX="\${DBGX}.dll"
EXESUFFIX="\${DBGX}.exe"
LIBRARIES="\${SHARED_LIBRARIES}"
fi
+ # DLLSUFFIX is separate because it is the building block for
+ # users of tclConfig.sh that may build shared or static.
+ DLLSUFFIX="\${DBGX}.dll"
+
+ EXTRA_CFLAGS="${extra_cflags}"
CFLAGS_DEBUG=-g
CFLAGS_OPTIMIZE=-O
@@ -1436,21 +1331,6 @@ echo "configure:1361: checking compiler flags" >&5
LDFLAGS_CONSOLE="-mconsole ${extra_ldflags}"
LDFLAGS_WINDOW="-mwindows -e _WinMain@16 ${extra_ldflags}"
else
- SHLIB_LD="link -dll -nologo"
- SHLIB_LD_LIBS="user32.lib advapi32.lib"
- LIBS="user32.lib advapi32.lib"
- LIBS_GUI="gdi32.lib comdlg32.lib"
- STLIB_LD="lib -nologo"
- RC="rc"
- RC_OUT=-fo
- RC_TYPE=-r
- RC_INCLUDE=-i
- RES=res
- MAKE_LIB="\${STLIB_LD} -out:\$@"
- POST_MAKE_LIB=
- MAKE_EXE="\${CC} -Fe\$@"
- LIBPREFIX=${VENDORPREFIX}
-
if test "${SHARED_BUILD}" = "0" ; then
# static
echo "$ac_t""using static flags" 1>&6
@@ -1459,7 +1339,6 @@ echo "configure:1361: checking compiler flags" >&5
LIBSUFFIX="s\${DBGX}.lib"
LIBRARIES="\${STATIC_LIBRARIES}"
EXESUFFIX="s\${DBGX}.exe"
- DLLSUFFIX=""
else
# dynamic
echo "$ac_t""using shared flags" 1>&6
@@ -1467,33 +1346,84 @@ echo "configure:1361: checking compiler flags" >&5
# Add SHLIB_LD_LIBS to the Make rule, not here.
MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\$@"
LIBSUFFIX="\${DBGX}.lib"
- DLLSUFFIX="\${DBGX}.dll"
EXESUFFIX="\${DBGX}.exe"
LIBRARIES="\${SHARED_LIBRARIES}"
fi
+ # DLLSUFFIX is separate because it is the building block for
+ # users of tclConfig.sh that may build shared or static.
+ DLLSUFFIX="\${DBGX}.dll"
+
+ # This is a 2-stage check to make sure we have the 64-bit SDK
+ # We have to know where the SDK is installed.
+ if test "$do64bit" = "yes" ; then
+ if test "x${MSSDK}x" = "xx" ; then
+ MSSDK="C:/Progra~1/Microsoft SDK"
+ fi
+ # In order to work in the tortured autoconf environment,
+ # we need to ensure that this path has no spaces
+ MSSDK=$(cygpath -w -s "$MSSDK" | sed -e 's!\\!/!g')
+ if test ! -d "${MSSDK}/bin/win64" ; then
+ echo "configure: warning: "could not find 64-bit SDK to enable 64bit mode"" 1>&2
+ do64bit="no"
+ fi
+ fi
+
+ if test "$do64bit" = "yes" ; then
+ # All this magic is necessary for the Win64 SDK RC1 - hobbs
+ CC="${MSSDK}/Bin/Win64/cl.exe \
+ -I${MSSDK}/Include/prerelease \
+ -I${MSSDK}/Include/Win64/crt \
+ -I${MSSDK}/Include/Win64/crt/sys \
+ -I${MSSDK}/Include"
+ RC="${MSSDK}/bin/rc.exe"
+ CFLAGS_DEBUG="-nologo -Zi -Od ${runtime}d"
+ CFLAGS_OPTIMIZE="-nologo -O2 -Gs ${runtime}"
+ lflags="-MACHINE:IA64 -LIBPATH:${MSSDK}/Lib/IA64 \
+ -LIBPATH:${MSSDK}/Lib/Prerelease/IA64"
+ STLIB_LD="${MSSDK}/bin/win64/lib.exe -nologo ${lflags}"
+ LINKBIN="${MSSDK}/bin/win64/link.exe ${lflags}"
+ else
+ RC="rc"
+ CFLAGS_DEBUG="-nologo -Z7 -Od -WX ${runtime}d"
+ CFLAGS_OPTIMIZE="-nologo -Oti -Gs -GD ${runtime}"
+ STLIB_LD="lib -nologo"
+ LINKBIN="link -link50compat"
+ fi
+
+ SHLIB_LD="${LINKBIN} -dll -nologo -incremental:no"
+ SHLIB_LD_LIBS="user32.lib advapi32.lib"
+ LIBS="user32.lib advapi32.lib"
+ LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib"
+ RC_OUT=-fo
+ RC_TYPE=-r
+ RC_INCLUDE=-i
+ RC_DEFINE=-d
+ RES=res
+ MAKE_LIB="\${STLIB_LD} -out:\$@"
+ POST_MAKE_LIB=
+ MAKE_EXE="\${CC} -Fe\$@"
+ LIBPREFIX=""
EXTRA_CFLAGS="-YX"
- CFLAGS_DEBUG="-nologo -Z7 -Od -WX ${runtime}d"
-# CFLAGS_OPTIMIZE="-nologo -O2 -Gs -GD ${runtime}"
- CFLAGS_OPTIMIZE="-nologo -Oti -Gs -GD ${runtime}"
CFLAGS_WARNING="-W3"
- LDFLAGS_DEBUG="-debug:full -debugtype:cv"
+ LDFLAGS_DEBUG="-debug:full -debugtype:both"
LDFLAGS_OPTIMIZE="-release"
-
+
# Specify the CC output file names based on the target name
CC_OBJNAME="-Fo\$@"
CC_EXENAME="-Fe\"\$(shell \$(CYGPATH) '\$@')\""
# Specify linker flags depending on the type of app being
# built -- Console vs. Window.
- LDFLAGS_CONSOLE="-link -subsystem:console"
- LDFLAGS_WINDOW="-link -subsystem:windows"
+ LDFLAGS_CONSOLE="-link -subsystem:console ${lflags}"
+ LDFLAGS_WINDOW="-link -subsystem:windows ${lflags}"
fi
- # Define the same variables as used in tclConfig.sh so that macros
- # that depend on these variables work for both Tcl and extensions.
- TCL_LIB_SUFFIX=$LIBSUFFIX
- TCL_VENDOR_PREFIX=$VENDORPREFIX
+ # DL_LIBS is empty, but then we match the Unix version
+
+
+
+
#--------------------------------------------------------------------
@@ -1504,7 +1434,7 @@ echo "configure:1361: checking compiler flags" >&5
echo $ac_n "checking for build with symbols""... $ac_c" 1>&6
-echo "configure:1508: checking for build with symbols" >&5
+echo "configure:1438: checking for build with symbols" >&5
# Check whether --enable-symbols or --disable-symbols was given.
if test "${enable_symbols+set}" = set; then
enableval="$enable_symbols"
@@ -1527,12 +1457,34 @@ fi
fi
-#------------------------------------------------------------------------------
-# Find out all about time handling differences.
-#------------------------------------------------------------------------------
+ echo $ac_n "checking for build with memory debugging""... $ac_c" 1>&6
+echo "configure:1462: checking for build with memory debugging" >&5
+ # Check whether --enable-memdebug or --disable-memdebug was given.
+if test "${enable_memdebug+set}" = set; then
+ enableval="$enable_memdebug"
+ tcl_ok=$enableval
+else
+ tcl_ok=no
+fi
+
+ if test "$tcl_ok" = "yes"; then
+ MEM_DEBUG_FLAGS=-DTCL_MEM_DEBUG
+ echo "$ac_t""yes" 1>&6
+ else
+ MEM_DEBUG_FLAGS=""
+ echo "$ac_t""no" 1>&6
+ fi
+
+
+
+TCL_DBGX=${DBGX}
+
+#--------------------------------------------------------------------
+# man2tcl needs this so that it can use errno.h
+#--------------------------------------------------------------------
echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6
-echo "configure:1536: checking how to run the C preprocessor" >&5
+echo "configure:1488: checking how to run the C preprocessor" >&5
# On Suns, sometimes $CPP names a directory.
if test -n "$CPP" && test -d "$CPP"; then
CPP=
@@ -1547,13 +1499,13 @@ else
# On the NeXT, cc -E runs the code through the compiler's parser,
# not just through cpp.
cat > conftest.$ac_ext <<EOF
-#line 1551 "configure"
+#line 1503 "configure"
#include "confdefs.h"
#include <assert.h>
Syntax Error
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:1557: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:1509: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
:
@@ -1564,13 +1516,13 @@ else
rm -rf conftest*
CPP="${CC-cc} -E -traditional-cpp"
cat > conftest.$ac_ext <<EOF
-#line 1568 "configure"
+#line 1520 "configure"
#include "confdefs.h"
#include <assert.h>
Syntax Error
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:1574: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:1526: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
:
@@ -1581,13 +1533,13 @@ else
rm -rf conftest*
CPP="${CC-cc} -nologo -E"
cat > conftest.$ac_ext <<EOF
-#line 1585 "configure"
+#line 1537 "configure"
#include "confdefs.h"
#include <assert.h>
Syntax Error
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:1591: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:1543: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
:
@@ -1611,411 +1563,19 @@ else
fi
echo "$ac_t""$CPP" 1>&6
-echo $ac_n "checking whether struct tm is in sys/time.h or time.h""... $ac_c" 1>&6
-echo "configure:1616: checking whether struct tm is in sys/time.h or time.h" >&5
-if eval "test \"`echo '$''{'ac_cv_struct_tm'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- cat > conftest.$ac_ext <<EOF
-#line 1621 "configure"
-#include "confdefs.h"
-#include <sys/types.h>
-#include <time.h>
-int main() {
-struct tm *tp; tp->tm_sec;
-; return 0; }
-EOF
-if { (eval echo configure:1629: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
- rm -rf conftest*
- ac_cv_struct_tm=time.h
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- ac_cv_struct_tm=sys/time.h
-fi
-rm -f conftest*
-fi
-
-echo "$ac_t""$ac_cv_struct_tm" 1>&6
-if test $ac_cv_struct_tm = sys/time.h; then
- cat >> confdefs.h <<\EOF
-#define TM_IN_SYS_TIME 1
-EOF
-
-fi
-
-
- for ac_hdr in sys/time.h
-do
-ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
-echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
-echo "configure:1654: checking for $ac_hdr" >&5
-if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- cat > conftest.$ac_ext <<EOF
-#line 1659 "configure"
-#include "confdefs.h"
-#include <$ac_hdr>
-EOF
-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:1664: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
-ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
-if test -z "$ac_err"; then
- rm -rf conftest*
- eval "ac_cv_header_$ac_safe=yes"
-else
- echo "$ac_err" >&5
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- eval "ac_cv_header_$ac_safe=no"
-fi
-rm -f conftest*
-fi
-if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
- echo "$ac_t""yes" 1>&6
- ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'`
- cat >> confdefs.h <<EOF
-#define $ac_tr_hdr 1
-EOF
-
-else
- echo "$ac_t""no" 1>&6
-fi
-done
-
- echo $ac_n "checking whether time.h and sys/time.h may both be included""... $ac_c" 1>&6
-echo "configure:1691: checking whether time.h and sys/time.h may both be included" >&5
-if eval "test \"`echo '$''{'ac_cv_header_time'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- cat > conftest.$ac_ext <<EOF
-#line 1696 "configure"
-#include "confdefs.h"
-#include <sys/types.h>
-#include <sys/time.h>
-#include <time.h>
-int main() {
-struct tm *tp;
-; return 0; }
-EOF
-if { (eval echo configure:1705: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
- rm -rf conftest*
- ac_cv_header_time=yes
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- ac_cv_header_time=no
-fi
-rm -f conftest*
-fi
-
-echo "$ac_t""$ac_cv_header_time" 1>&6
-if test $ac_cv_header_time = yes; then
- cat >> confdefs.h <<\EOF
-#define TIME_WITH_SYS_TIME 1
-EOF
-
-fi
-
- echo $ac_n "checking for tm_zone in struct tm""... $ac_c" 1>&6
-echo "configure:1726: checking for tm_zone in struct tm" >&5
-if eval "test \"`echo '$''{'ac_cv_struct_tm_zone'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- cat > conftest.$ac_ext <<EOF
-#line 1731 "configure"
-#include "confdefs.h"
-#include <sys/types.h>
-#include <$ac_cv_struct_tm>
-int main() {
-struct tm tm; tm.tm_zone;
-; return 0; }
-EOF
-if { (eval echo configure:1739: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
- rm -rf conftest*
- ac_cv_struct_tm_zone=yes
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- ac_cv_struct_tm_zone=no
-fi
-rm -f conftest*
-fi
-
-echo "$ac_t""$ac_cv_struct_tm_zone" 1>&6
-if test "$ac_cv_struct_tm_zone" = yes; then
- cat >> confdefs.h <<\EOF
-#define HAVE_TM_ZONE 1
-EOF
-
-else
- echo $ac_n "checking for tzname""... $ac_c" 1>&6
-echo "configure:1759: checking for tzname" >&5
-if eval "test \"`echo '$''{'ac_cv_var_tzname'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- cat > conftest.$ac_ext <<EOF
-#line 1764 "configure"
-#include "confdefs.h"
-#include <time.h>
-#ifndef tzname /* For SGI. */
-extern char *tzname[]; /* RS6000 and others reject char **tzname. */
-#endif
-int main() {
-atoi(*tzname);
-; return 0; }
-EOF
-if { (eval echo configure:1774: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
- rm -rf conftest*
- ac_cv_var_tzname=yes
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- ac_cv_var_tzname=no
-fi
-rm -f conftest*
-fi
-
-echo "$ac_t""$ac_cv_var_tzname" 1>&6
- if test $ac_cv_var_tzname = yes; then
- cat >> confdefs.h <<\EOF
-#define HAVE_TZNAME 1
-EOF
-
- fi
-fi
-
-
- echo $ac_n "checking tm_tzadj in struct tm""... $ac_c" 1>&6
-echo "configure:1797: checking tm_tzadj in struct tm" >&5
- cat > conftest.$ac_ext <<EOF
-#line 1799 "configure"
-#include "confdefs.h"
-#include <time.h>
-int main() {
-struct tm tm; tm.tm_tzadj;
-; return 0; }
-EOF
-if { (eval echo configure:1806: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
- rm -rf conftest*
- cat >> confdefs.h <<\EOF
-#define HAVE_TM_TZADJ 1
-EOF
-
- echo "$ac_t""yes" 1>&6
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- echo "$ac_t""no" 1>&6
-fi
-rm -f conftest*
-
- echo $ac_n "checking tm_gmtoff in struct tm""... $ac_c" 1>&6
-echo "configure:1822: checking tm_gmtoff in struct tm" >&5
- cat > conftest.$ac_ext <<EOF
-#line 1824 "configure"
-#include "confdefs.h"
-#include <time.h>
-int main() {
-struct tm tm; tm.tm_gmtoff;
-; return 0; }
-EOF
-if { (eval echo configure:1831: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
- rm -rf conftest*
- cat >> confdefs.h <<\EOF
-#define HAVE_TM_GMTOFF 1
-EOF
-
- echo "$ac_t""yes" 1>&6
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- echo "$ac_t""no" 1>&6
-fi
-rm -f conftest*
-
- #
- # Its important to include time.h in this check, as some systems
- # (like convex) have timezone functions, etc.
- #
- have_timezone=no
- echo $ac_n "checking long timezone variable""... $ac_c" 1>&6
-echo "configure:1852: checking long timezone variable" >&5
- cat > conftest.$ac_ext <<EOF
-#line 1854 "configure"
-#include "confdefs.h"
-#include <time.h>
-int main() {
-extern long timezone;
- timezone += 1;
- exit (0);
-; return 0; }
-EOF
-if { (eval echo configure:1863: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
- rm -rf conftest*
- have_timezone=yes
- cat >> confdefs.h <<\EOF
-#define HAVE_TIMEZONE_VAR 1
-EOF
-
- echo "$ac_t""yes" 1>&6
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- echo "$ac_t""no" 1>&6
-fi
-rm -f conftest*
-
- #
- # On some systems (eg IRIX 6.2), timezone is a time_t and not a long.
- #
- if test "$have_timezone" = no; then
- echo $ac_n "checking time_t timezone variable""... $ac_c" 1>&6
-echo "configure:1884: checking time_t timezone variable" >&5
- cat > conftest.$ac_ext <<EOF
-#line 1886 "configure"
-#include "confdefs.h"
-#include <time.h>
-int main() {
-extern time_t timezone;
- timezone += 1;
- exit (0);
-; return 0; }
-EOF
-if { (eval echo configure:1895: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
- rm -rf conftest*
- cat >> confdefs.h <<\EOF
-#define HAVE_TIMEZONE_VAR 1
-EOF
-
- echo "$ac_t""yes" 1>&6
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- echo "$ac_t""no" 1>&6
-fi
-rm -f conftest*
- fi
-
- #
- # On some systems (eg Solaris 2.5.1), timezone is not declared in
- # time.h unless you jump through hoops. Instead of that, we just
- # declare it ourselves when necessary.
- #
- if test "$have_timezone" = yes; then
- echo $ac_n "checking for timezone declaration""... $ac_c" 1>&6
-echo "configure:1918: checking for timezone declaration" >&5
-
- tzrx='^[ ]*extern.*timezone'
-
- cat > conftest.$ac_ext <<EOF
-#line 1923 "configure"
-#include "confdefs.h"
-#include <time.h>
-EOF
-if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
- egrep "$tzrx" >/dev/null 2>&1; then
- rm -rf conftest*
-
- cat >> confdefs.h <<\EOF
-#define HAVE_TIMEZONE_DECL 1
-EOF
-
- echo "$ac_t""found" 1>&6
-else
- rm -rf conftest*
- echo "$ac_t""missing" 1>&6
-fi
-rm -f conftest*
-
- fi
-
- #
- # AIX does not have a timezone field in struct tm. When the AIX bsd
- # library is used, the timezone global and the gettimeofday methods are
- # to be avoided for timezone deduction instead, we deduce the timezone
- # by comparing the localtime result on a known GMT value.
- #
-
- if test "`uname -s`" = "AIX" ; then
- echo $ac_n "checking for gettimeofday in -lbsd""... $ac_c" 1>&6
-echo "configure:1953: checking for gettimeofday in -lbsd" >&5
-ac_lib_var=`echo bsd'_'gettimeofday | sed 'y%./+-%__p_%'`
-if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- ac_save_LIBS="$LIBS"
-LIBS="-lbsd $LIBS"
-cat > conftest.$ac_ext <<EOF
-#line 1961 "configure"
-#include "confdefs.h"
-/* Override any gcc2 internal prototype to avoid an error. */
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char gettimeofday();
-
-int main() {
-gettimeofday()
-; return 0; }
-EOF
-if { (eval echo configure:1972: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
- rm -rf conftest*
- eval "ac_cv_lib_$ac_lib_var=yes"
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- rm -rf conftest*
- eval "ac_cv_lib_$ac_lib_var=no"
-fi
-rm -f conftest*
-LIBS="$ac_save_LIBS"
-
-fi
-if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
- echo "$ac_t""yes" 1>&6
- libbsd=yes
-else
- echo "$ac_t""no" 1>&6
-fi
-
- if test $libbsd = yes; then
- cat >> confdefs.h <<\EOF
-#define USE_DELTA_FOR_TZ 1
-EOF
-
- fi
- fi
-
-
-TCL_DBGX=${DBGX}
-
-#--------------------------------------------------------------------
-# man2tcl needs this so that it can use errno.h
-#--------------------------------------------------------------------
-
ac_safe=`echo "errno.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for errno.h""... $ac_c" 1>&6
-echo "configure:2009: checking for errno.h" >&5
+echo "configure:1569: checking for errno.h" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 2014 "configure"
+#line 1574 "configure"
#include "confdefs.h"
#include <errno.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:2019: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:1579: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
@@ -2049,686 +1609,72 @@ TCL_SHARED_BUILD=${SHARED_BUILD}
# Perform final evaluations of variables with possible substitutions.
#--------------------------------------------------------------------
-NODOT_VERSION=${VER}
-
TCL_SHARED_LIB_SUFFIX="\${NODOT_VERSION}${DLLSUFFIX}"
TCL_UNSHARED_LIB_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"
TCL_EXPORT_FILE_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"
+eval "TCL_SRC_DIR=\"`cd $srcdir/..; pwd`\""
- val="`cd $srcdir/..; pwd`"
+eval "TCL_DLL_FILE=tcl${VER}${DLLSUFFIX}"
- if test "$val" = "" ; then
- { echo "configure: error: Empty value for variable TCL_SRC_DIR" 1>&2; exit 1; }
- fi
+eval "TCL_LIB_FILE=${LIBPREFIX}tcl$VER${LIBSUFFIX}"
+# FIMXE: These variables decls are missing
+#TCL_LIB_FLAG
+#TCL_BUILD_LIB_SPEC
+#TCL_LIB_SPEC
- case "${host}" in
- *windows32* | *mingw32*)
- if test "${CYGPATH}" = ""; then
- { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
- elif test "${CYGPATH}" = "echo"; then
- # No cygpath when cross compiling
- TCL_SRC_DIR=$val
- else
- # store literal argument text in a variable
- val=$val
- # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
- val="`${CYGPATH} $val`"
- # Convert path like C:\Tmp\foo to C:/Tmp/foo
- TCL_SRC_DIR="`echo $val | sed -e s#\\\\\\\\#/#g`"
- fi
- ;;
- *)
- # Default to a no-op under Unix or Cygwin gcc
- TCL_SRC_DIR=$val
- ;;
- esac
+eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${VER}${LIBSUFFIX}\""
+eval "TCL_STUB_LIB_FLAG=\"-ltclstub${VER}${TCL_DBGX}\""
+eval "TCL_BUILD_STUB_LIB_SPEC=\"-L`pwd` ${TCL_STUB_LIB_FLAG}\""
+eval "TCL_STUB_LIB_SPEC=\"-L${libdir} ${TCL_STUB_LIB_FLAG}\""
+eval "TCL_BUILD_STUB_LIB_PATH=\"`pwd`/${TCL_STUB_LIB_FILE}\""
+eval "TCL_STUB_LIB_PATH=\"${libdir}/${TCL_STUB_LIB_FILE}\""
+# Install time header dir can be set via --includedir
+eval "TCL_INCLUDE_SPEC=\"-I${includedir}\""
+eval "DLLSUFFIX=${DLLSUFFIX}"
+eval "LIBPREFIX=${LIBPREFIX}"
+eval "LIBSUFFIX=${LIBSUFFIX}"
+eval "EXESUFFIX=${EXESUFFIX}"
- libname=tcl
- suffix=${TCL_UNSHARED_LIB_SUFFIX}
-
- case "${host}" in
- *windows32* | *mingw32*)
- if test "$GCC" != yes; then
- eval "long_libname=\"${TCL_VENDOR_PREFIX}${libname}${suffix}\""
- else
- eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
- fi
- ;;
- *)
- eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
- ;;
- esac
-
- eval "long_libname=${long_libname}"
-
- # Trick to replace DBGX with TCL_DBGX
- DBGX='${TCL_DBGX}'
- eval "long_libname=${long_libname}"
-
- TCL_LIB_FILE=$long_libname
-
-
- libname=tcl
- suffix=${TCL_SHARED_LIB_SUFFIX}
-
- case "${host}" in
- *windows32* | *mingw32* | *cygwin*)
- eval "long_libname=\"${TCL_VENDOR_PREFIX}${libname}${suffix}\""
- ;;
- *)
- eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
- ;;
- esac
-
- eval "long_libname=${long_libname}"
-
- # Trick to replace DBGX with TCL_DBGX
- DBGX='${TCL_DBGX}'
- eval "long_libname=${long_libname}"
-
- TCL_DLL_FILE=$long_libname
+CFG_TCL_SHARED_LIB_SUFFIX=${TCL_SHARED_LIB_SUFFIX}
+CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX}
+CFG_TCL_EXPORT_FILE_SUFFIX=${TCL_EXPORT_FILE_SUFFIX}
+#--------------------------------------------------------------------
+# Adjust the defines for how the resources are built depending
+# on symbols and static vs. shared.
+#--------------------------------------------------------------------
-if test "$GCC" = "yes"; then
- GNU_TCL_LIB_FILE=${TCL_LIB_FILE}
- MSVC_TCL_LIB_FILE=
+if test ${SHARED_BUILD} = 0 ; then
+ if test "${DBGX}" = "d"; then
+ RC_DEFINES="${RC_DEFINE} STATIC_BUILD ${RC_DEFINE} DEBUG"
+ else
+ RC_DEFINES="${RC_DEFINE} STATIC_BUILD"
+ fi
else
- GNU_TCL_LIB_FILE=
- MSVC_TCL_LIB_FILE=${TCL_LIB_FILE}
+ if test "${DBGX}" = "d"; then
+ RC_DEFINES="${RC_DEFINE} DEBUG"
+ else
+ RC_DEFINES=""
+ fi
fi
- libname=tcl
- version=$TCL_VERSION
- if test "$TCL_LIB_SUFFIX" = "" ; then
- { echo "configure: error: The TCL_LIB_SUFFIX variable is not defined" 1>&2; exit 1; }
- fi
- # If the . character is not allowed in lib name, remove it from version
- if test "${TCL_LIB_VERSIONS_OK}" != "ok"; then
- version=`echo $version | tr -d .`
- fi
- case "${host}" in
- *windows32* | *mingw32*)
- if test "$GCC" != yes; then
- eval "short_libname=\"${TCL_VENDOR_PREFIX}${libname}${version}${TCL_LIB_SUFFIX}\""
- else
- short_libname="-l${TCL_VENDOR_PREFIX}${libname}${version}${TCL_DBGX}"
- fi
- ;;
- *)
- short_libname="-l${TCL_VENDOR_PREFIX}${libname}${version}\${TCL_DBGX}"
- ;;
- esac
- TCL_LIB_FLAG=$short_libname
- case "${host}" in
- *windows32* | *mingw32*)
- if test "$GCC" != yes; then
-
- val="`pwd`/${TCL_LIB_FLAG}"
+# empty on win
- if test "$val" = "" ; then
- { echo "configure: error: Empty value for variable TCL_BUILD_LIB_SPEC" 1>&2; exit 1; }
- fi
- case "${host}" in
- *windows32* | *mingw32*)
- if test "${CYGPATH}" = ""; then
- { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
- elif test "${CYGPATH}" = "echo"; then
- # No cygpath when cross compiling
- TCL_BUILD_LIB_SPEC=$val
- else
- # store literal argument text in a variable
- val=$val
- # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
- val="`${CYGPATH} $val`"
- # Convert path like C:\Tmp\foo to C:/Tmp/foo
- TCL_BUILD_LIB_SPEC="`echo $val | sed -e s#\\\\\\\\#/#g`"
- fi
- ;;
- *)
- # Default to a no-op under Unix or Cygwin gcc
- TCL_BUILD_LIB_SPEC=$val
- ;;
- esac
- else
-
- val=`pwd`
- if test "$val" = "" ; then
- { echo "configure: error: Empty value for variable dirname" 1>&2; exit 1; }
- fi
-
- case "${host}" in
- *windows32* | *mingw32*)
- if test "${CYGPATH}" = ""; then
- { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
- elif test "${CYGPATH}" = "echo"; then
- # No cygpath when cross compiling
- dirname=$val
- else
- # store literal argument text in a variable
- val=$val
- # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
- val="`${CYGPATH} $val`"
- # Convert path like C:\Tmp\foo to C:/Tmp/foo
- dirname="`echo $val | sed -e s#\\\\\\\\#/#g`"
- fi
- ;;
- *)
- # Default to a no-op under Unix or Cygwin gcc
- dirname=$val
- ;;
- esac
-
- TCL_BUILD_LIB_SPEC="-L${dirname} ${TCL_LIB_FLAG}"
- fi
- ;;
- *)
- TCL_BUILD_LIB_SPEC="-L`pwd` ${TCL_LIB_FLAG}"
- ;;
- esac
-
-
- case "${host}" in
- *windows32* | *mingw32*)
- if test "$GCC" != yes; then
-
- val="${exec_prefix}/lib/${TCL_LIB_FLAG}"
-
- if test "$val" = "" ; then
- { echo "configure: error: Empty value for variable TCL_LIB_SPEC" 1>&2; exit 1; }
- fi
-
- case "${host}" in
- *windows32* | *mingw32*)
- if test "${CYGPATH}" = ""; then
- { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
- elif test "${CYGPATH}" = "echo"; then
- # No cygpath when cross compiling
- TCL_LIB_SPEC=$val
- else
- # store literal argument text in a variable
- val=$val
- # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
- val="`${CYGPATH} $val`"
- # Convert path like C:\Tmp\foo to C:/Tmp/foo
- TCL_LIB_SPEC="`echo $val | sed -e s#\\\\\\\\#/#g`"
- fi
- ;;
- *)
- # Default to a no-op under Unix or Cygwin gcc
- TCL_LIB_SPEC=$val
- ;;
- esac
-
- else
-
- val=${exec_prefix}/lib
-
- if test "$val" = "" ; then
- { echo "configure: error: Empty value for variable dirname" 1>&2; exit 1; }
- fi
-
- case "${host}" in
- *windows32* | *mingw32*)
- if test "${CYGPATH}" = ""; then
- { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
- elif test "${CYGPATH}" = "echo"; then
- # No cygpath when cross compiling
- dirname=$val
- else
- # store literal argument text in a variable
- val=$val
- # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
- val="`${CYGPATH} $val`"
- # Convert path like C:\Tmp\foo to C:/Tmp/foo
- dirname="`echo $val | sed -e s#\\\\\\\\#/#g`"
- fi
- ;;
- *)
- # Default to a no-op under Unix or Cygwin gcc
- dirname=$val
- ;;
- esac
-
- TCL_LIB_SPEC="-L${dirname} ${TCL_LIB_FLAG}"
- fi
- ;;
- *)
- TCL_LIB_SPEC="-L${exec_prefix}/lib ${TCL_LIB_FLAG}"
- ;;
- esac
-
-
-
- val="`pwd`/${TCL_LIB_FILE}"
-
- if test "$val" = "" ; then
- { echo "configure: error: Empty value for variable TCL_LIB_FULL_PATH" 1>&2; exit 1; }
- fi
-
- case "${host}" in
- *windows32* | *mingw32*)
- if test "${CYGPATH}" = ""; then
- { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
- elif test "${CYGPATH}" = "echo"; then
- # No cygpath when cross compiling
- TCL_LIB_FULL_PATH=$val
- else
- # store literal argument text in a variable
- val=$val
- # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
- val="`${CYGPATH} $val`"
- # Convert path like C:\Tmp\foo to C:/Tmp/foo
- TCL_LIB_FULL_PATH="`echo $val | sed -e s#\\\\\\\\#/#g`"
- fi
- ;;
- *)
- # Default to a no-op under Unix or Cygwin gcc
- TCL_LIB_FULL_PATH=$val
- ;;
- esac
-
-
-
-
-
- libname=tclstub
- suffix=${TCL_UNSHARED_LIB_SUFFIX}
-
- case "${host}" in
- *windows32* | *mingw32*)
- if test "$GCC" != yes; then
- eval "long_libname=\"${TCL_VENDOR_PREFIX}${libname}${suffix}\""
- else
- eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
- fi
- ;;
- *)
- eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
- ;;
- esac
-
- eval "long_libname=${long_libname}"
-
- # Trick to replace DBGX with TCL_DBGX
- DBGX='${TCL_DBGX}'
- eval "long_libname=${long_libname}"
-
- TCL_STUB_LIB_FILE=$long_libname
-
-
- libname=tclstub
- version=$TCL_VERSION
-
- if test "$TCL_LIB_SUFFIX" = "" ; then
- { echo "configure: error: The TCL_LIB_SUFFIX variable is not defined" 1>&2; exit 1; }
- fi
-
- # If the . character is not allowed in lib name, remove it from version
- if test "${TCL_LIB_VERSIONS_OK}" != "ok"; then
- version=`echo $version | tr -d .`
- fi
-
- case "${host}" in
- *windows32* | *mingw32*)
- if test "$GCC" != yes; then
- eval "short_libname=\"${TCL_VENDOR_PREFIX}${libname}${version}${TCL_LIB_SUFFIX}\""
- else
- short_libname="-l${TCL_VENDOR_PREFIX}${libname}${version}${TCL_DBGX}"
- fi
- ;;
- *)
- short_libname="-l${TCL_VENDOR_PREFIX}${libname}${version}\${TCL_DBGX}"
- ;;
- esac
-
- TCL_STUB_LIB_FLAG=$short_libname
-
-
- case "${host}" in
- *windows32* | *mingw32*)
- if test "$GCC" != yes; then
-
- val="`pwd`/${TCL_STUB_LIB_FLAG}"
-
- if test "$val" = "" ; then
- { echo "configure: error: Empty value for variable TCL_BUILD_STUB_LIB_SPEC" 1>&2; exit 1; }
- fi
-
- case "${host}" in
- *windows32* | *mingw32*)
- if test "${CYGPATH}" = ""; then
- { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
- elif test "${CYGPATH}" = "echo"; then
- # No cygpath when cross compiling
- TCL_BUILD_STUB_LIB_SPEC=$val
- else
- # store literal argument text in a variable
- val=$val
- # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
- val="`${CYGPATH} $val`"
- # Convert path like C:\Tmp\foo to C:/Tmp/foo
- TCL_BUILD_STUB_LIB_SPEC="`echo $val | sed -e s#\\\\\\\\#/#g`"
- fi
- ;;
- *)
- # Default to a no-op under Unix or Cygwin gcc
- TCL_BUILD_STUB_LIB_SPEC=$val
- ;;
- esac
-
- else
-
- val=`pwd`
-
- if test "$val" = "" ; then
- { echo "configure: error: Empty value for variable dirname" 1>&2; exit 1; }
- fi
-
- case "${host}" in
- *windows32* | *mingw32*)
- if test "${CYGPATH}" = ""; then
- { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
- elif test "${CYGPATH}" = "echo"; then
- # No cygpath when cross compiling
- dirname=$val
- else
- # store literal argument text in a variable
- val=$val
- # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
- val="`${CYGPATH} $val`"
- # Convert path like C:\Tmp\foo to C:/Tmp/foo
- dirname="`echo $val | sed -e s#\\\\\\\\#/#g`"
- fi
- ;;
- *)
- # Default to a no-op under Unix or Cygwin gcc
- dirname=$val
- ;;
- esac
-
- TCL_BUILD_STUB_LIB_SPEC="-L${dirname} ${TCL_STUB_LIB_FLAG}"
- fi
- ;;
- *)
- TCL_BUILD_STUB_LIB_SPEC="-L`pwd` ${TCL_STUB_LIB_FLAG}"
- ;;
- esac
-
-
- case "${host}" in
- *windows32* | *mingw32*)
- if test "$GCC" != yes; then
-
- val="${exec_prefix}/lib/${TCL_STUB_LIB_FLAG}"
-
- if test "$val" = "" ; then
- { echo "configure: error: Empty value for variable TCL_STUB_LIB_SPEC" 1>&2; exit 1; }
- fi
-
- case "${host}" in
- *windows32* | *mingw32*)
- if test "${CYGPATH}" = ""; then
- { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
- elif test "${CYGPATH}" = "echo"; then
- # No cygpath when cross compiling
- TCL_STUB_LIB_SPEC=$val
- else
- # store literal argument text in a variable
- val=$val
- # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
- val="`${CYGPATH} $val`"
- # Convert path like C:\Tmp\foo to C:/Tmp/foo
- TCL_STUB_LIB_SPEC="`echo $val | sed -e s#\\\\\\\\#/#g`"
- fi
- ;;
- *)
- # Default to a no-op under Unix or Cygwin gcc
- TCL_STUB_LIB_SPEC=$val
- ;;
- esac
-
- else
-
- val=${exec_prefix}/lib
-
- if test "$val" = "" ; then
- { echo "configure: error: Empty value for variable dirname" 1>&2; exit 1; }
- fi
-
- case "${host}" in
- *windows32* | *mingw32*)
- if test "${CYGPATH}" = ""; then
- { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
- elif test "${CYGPATH}" = "echo"; then
- # No cygpath when cross compiling
- dirname=$val
- else
- # store literal argument text in a variable
- val=$val
- # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
- val="`${CYGPATH} $val`"
- # Convert path like C:\Tmp\foo to C:/Tmp/foo
- dirname="`echo $val | sed -e s#\\\\\\\\#/#g`"
- fi
- ;;
- *)
- # Default to a no-op under Unix or Cygwin gcc
- dirname=$val
- ;;
- esac
-
- TCL_STUB_LIB_SPEC="-L${dirname} ${TCL_STUB_LIB_FLAG}"
- fi
- ;;
- *)
- TCL_STUB_LIB_SPEC="-L${exec_prefix}/lib ${TCL_STUB_LIB_FLAG}"
- ;;
- esac
-
-
-
- val="`pwd`/${TCL_STUB_LIB_FILE}"
-
- if test "$val" = "" ; then
- { echo "configure: error: Empty value for variable TCL_BUILD_STUB_LIB_PATH" 1>&2; exit 1; }
- fi
-
- case "${host}" in
- *windows32* | *mingw32*)
- if test "${CYGPATH}" = ""; then
- { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
- elif test "${CYGPATH}" = "echo"; then
- # No cygpath when cross compiling
- TCL_BUILD_STUB_LIB_PATH=$val
- else
- # store literal argument text in a variable
- val=$val
- # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
- val="`${CYGPATH} $val`"
- # Convert path like C:\Tmp\foo to C:/Tmp/foo
- TCL_BUILD_STUB_LIB_PATH="`echo $val | sed -e s#\\\\\\\\#/#g`"
- fi
- ;;
- *)
- # Default to a no-op under Unix or Cygwin gcc
- TCL_BUILD_STUB_LIB_PATH=$val
- ;;
- esac
-
-
-
-
- val="${exec_prefix}/lib/${TCL_STUB_LIB_FILE}"
-
- if test "$val" = "" ; then
- { echo "configure: error: Empty value for variable TCL_STUB_LIB_PATH" 1>&2; exit 1; }
- fi
-
- case "${host}" in
- *windows32* | *mingw32*)
- if test "${CYGPATH}" = ""; then
- { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
- elif test "${CYGPATH}" = "echo"; then
- # No cygpath when cross compiling
- TCL_STUB_LIB_PATH=$val
- else
- # store literal argument text in a variable
- val=$val
- # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
- val="`${CYGPATH} $val`"
- # Convert path like C:\Tmp\foo to C:/Tmp/foo
- TCL_STUB_LIB_PATH="`echo $val | sed -e s#\\\\\\\\#/#g`"
- fi
- ;;
- *)
- # Default to a no-op under Unix or Cygwin gcc
- TCL_STUB_LIB_PATH=$val
- ;;
- esac
-
-
-
-
-
- libname=tcldde
- suffix=${TCL_SHARED_LIB_SUFFIX}
-
- case "${host}" in
- *windows32* | *mingw32* | *cygwin*)
- eval "long_libname=\"${TCL_VENDOR_PREFIX}${libname}${suffix}\""
- ;;
- *)
- eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
- ;;
- esac
-
- eval "long_libname=${long_libname}"
-
- # Trick to replace DBGX with TCL_DBGX
- DBGX='${TCL_DBGX}'
- eval "long_libname=${long_libname}"
-
- DDE_DLL_FILE=$long_libname
-
-
- libname=tcldde
- suffix=${TCL_UNSHARED_LIB_SUFFIX}
-
- case "${host}" in
- *windows32* | *mingw32*)
- if test "$GCC" != yes; then
- eval "long_libname=\"${TCL_VENDOR_PREFIX}${libname}${suffix}\""
- else
- eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
- fi
- ;;
- *)
- eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
- ;;
- esac
-
- eval "long_libname=${long_libname}"
-
- # Trick to replace DBGX with TCL_DBGX
- DBGX='${TCL_DBGX}'
- eval "long_libname=${long_libname}"
-
- DDE_LIB_FILE=$long_libname
-
-
-
- libname=tclreg
- suffix=${TCL_SHARED_LIB_SUFFIX}
-
- case "${host}" in
- *windows32* | *mingw32* | *cygwin*)
- eval "long_libname=\"${TCL_VENDOR_PREFIX}${libname}${suffix}\""
- ;;
- *)
- eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
- ;;
- esac
-
- eval "long_libname=${long_libname}"
-
- # Trick to replace DBGX with TCL_DBGX
- DBGX='${TCL_DBGX}'
- eval "long_libname=${long_libname}"
-
- REG_DLL_FILE=$long_libname
-
-
- libname=tclreg
- suffix=${TCL_UNSHARED_LIB_SUFFIX}
-
- case "${host}" in
- *windows32* | *mingw32*)
- if test "$GCC" != yes; then
- eval "long_libname=\"${TCL_VENDOR_PREFIX}${libname}${suffix}\""
- else
- eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
- fi
- ;;
- *)
- eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
- ;;
- esac
-
- eval "long_libname=${long_libname}"
-
- # Trick to replace DBGX with TCL_DBGX
- DBGX='${TCL_DBGX}'
- eval "long_libname=${long_libname}"
-
- REG_LIB_FILE=$long_libname
-
-
-
- libname=tclpip
- suffix=${TCL_SHARED_LIB_SUFFIX}
-
- case "${host}" in
- *windows32* | *mingw32* | *cygwin*)
- eval "long_libname=\"${TCL_VENDOR_PREFIX}${libname}${suffix}\""
- ;;
- *)
- eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
- ;;
- esac
-
- eval "long_libname=${long_libname}"
-
- # Trick to replace DBGX with TCL_DBGX
- DBGX='${TCL_DBGX}'
- eval "long_libname=${long_libname}"
-
- PIPE_DLL_FILE=$long_libname
-
-
-
-eval "DLLSUFFIX=${DLLSUFFIX}"
-eval "LIBPREFIX=${LIBPREFIX}"
-eval "LIBSUFFIX=${LIBSUFFIX}"
-eval "EXESUFFIX=${EXESUFFIX}"
-
-CFG_TCL_SHARED_LIB_SUFFIX=${TCL_SHARED_LIB_SUFFIX}
-CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX}
-CFG_TCL_EXPORT_FILE_SUFFIX=${TCL_EXPORT_FILE_SUFFIX}
@@ -2742,6 +1688,7 @@ CFG_TCL_EXPORT_FILE_SUFFIX=${TCL_EXPORT_FILE_SUFFIX}
+# win/tcl.m4 doesn't set (CFLAGS)
@@ -2749,6 +1696,7 @@ CFG_TCL_EXPORT_FILE_SUFFIX=${TCL_EXPORT_FILE_SUFFIX}
+# win/tcl.m4 doesn't set (LDFLAGS)
@@ -2776,6 +1724,7 @@ CFG_TCL_EXPORT_FILE_SUFFIX=${TCL_EXPORT_FILE_SUFFIX}
+# empty on win, but needs sub'ing
@@ -2786,6 +1735,7 @@ CFG_TCL_EXPORT_FILE_SUFFIX=${TCL_EXPORT_FILE_SUFFIX}
+# win only
@@ -2948,81 +1898,60 @@ s%@oldincludedir@%$oldincludedir%g
s%@infodir@%$infodir%g
s%@mandir@%$mandir%g
s%@CC@%$CC%g
-s%@host@%$host%g
-s%@host_alias@%$host_alias%g
-s%@host_cpu@%$host_cpu%g
-s%@host_vendor@%$host_vendor%g
-s%@host_os@%$host_os%g
-s%@build@%$build%g
-s%@build_alias@%$build_alias%g
-s%@build_cpu@%$build_cpu%g
-s%@build_vendor@%$build_vendor%g
-s%@build_os@%$build_os%g
s%@AR@%$AR%g
s%@RANLIB@%$RANLIB%g
s%@RC@%$RC%g
s%@SET_MAKE@%$SET_MAKE%g
s%@OBJEXT@%$OBJEXT%g
s%@EXEEXT@%$EXEEXT%g
+s%@TCL_THREADS@%$TCL_THREADS%g
s%@CYGPATH@%$CYGPATH%g
+s%@DL_LIBS@%$DL_LIBS%g
+s%@CFLAGS_DEBUG@%$CFLAGS_DEBUG%g
+s%@CFLAGS_OPTIMIZE@%$CFLAGS_OPTIMIZE%g
+s%@CFLAGS_WARNING@%$CFLAGS_WARNING%g
+s%@MEM_DEBUG_FLAGS@%$MEM_DEBUG_FLAGS%g
s%@CPP@%$CPP%g
s%@MAN2TCLFLAGS@%$MAN2TCLFLAGS%g
s%@TCL_VERSION@%$TCL_VERSION%g
s%@TCL_MAJOR_VERSION@%$TCL_MAJOR_VERSION%g
s%@TCL_MINOR_VERSION@%$TCL_MINOR_VERSION%g
-s%@TCL_LIB_VERSIONS_OK@%$TCL_LIB_VERSIONS_OK%g
s%@TCL_PATCH_LEVEL@%$TCL_PATCH_LEVEL%g
s%@TCL_LIB_FILE@%$TCL_LIB_FILE%g
-s%@GNU_TCL_LIB_FILE@%$GNU_TCL_LIB_FILE%g
-s%@MSVC_TCL_LIB_FILE@%$MSVC_TCL_LIB_FILE%g
-s%@TCL_DLL_FILE@%$TCL_DLL_FILE%g
s%@TCL_LIB_FLAG@%$TCL_LIB_FLAG%g
-s%@TCL_BUILD_LIB_SPEC@%$TCL_BUILD_LIB_SPEC%g
s%@TCL_LIB_SPEC@%$TCL_LIB_SPEC%g
-s%@TCL_LIB_FULL_PATH@%$TCL_LIB_FULL_PATH%g
s%@TCL_STUB_LIB_FILE@%$TCL_STUB_LIB_FILE%g
s%@TCL_STUB_LIB_FLAG@%$TCL_STUB_LIB_FLAG%g
-s%@TCL_BUILD_STUB_LIB_SPEC@%$TCL_BUILD_STUB_LIB_SPEC%g
s%@TCL_STUB_LIB_SPEC@%$TCL_STUB_LIB_SPEC%g
-s%@TCL_BUILD_STUB_LIB_PATH@%$TCL_BUILD_STUB_LIB_PATH%g
s%@TCL_STUB_LIB_PATH@%$TCL_STUB_LIB_PATH%g
-s%@DDE_DLL_FILE@%$DDE_DLL_FILE%g
-s%@DDE_LIB_FILE@%$DDE_LIB_FILE%g
-s%@REG_DLL_FILE@%$REG_DLL_FILE%g
-s%@REG_LIB_FILE@%$REG_LIB_FILE%g
-s%@PIPE_DLL_FILE@%$PIPE_DLL_FILE%g
+s%@TCL_INCLUDE_SPEC@%$TCL_INCLUDE_SPEC%g
+s%@TCL_BUILD_STUB_LIB_SPEC@%$TCL_BUILD_STUB_LIB_SPEC%g
+s%@TCL_BUILD_STUB_LIB_PATH@%$TCL_BUILD_STUB_LIB_PATH%g
+s%@TCL_DLL_FILE@%$TCL_DLL_FILE%g
s%@TCL_SRC_DIR@%$TCL_SRC_DIR%g
s%@TCL_BIN_DIR@%$TCL_BIN_DIR%g
s%@TCL_DBGX@%$TCL_DBGX%g
s%@CFG_TCL_SHARED_LIB_SUFFIX@%$CFG_TCL_SHARED_LIB_SUFFIX%g
s%@CFG_TCL_UNSHARED_LIB_SUFFIX@%$CFG_TCL_UNSHARED_LIB_SUFFIX%g
s%@CFG_TCL_EXPORT_FILE_SUFFIX@%$CFG_TCL_EXPORT_FILE_SUFFIX%g
-s%@TCL_SHARED_BUILD@%$TCL_SHARED_BUILD%g
-s%@DEPARG@%$DEPARG%g
s%@CFLAGS_DEFAULT@%$CFLAGS_DEFAULT%g
-s%@CFLAGS_DEBUG@%$CFLAGS_DEBUG%g
-s%@CFLAGS_OPTIMIZE@%$CFLAGS_OPTIMIZE%g
-s%@CFLAGS_WARNING@%$CFLAGS_WARNING%g
s%@EXTRA_CFLAGS@%$EXTRA_CFLAGS%g
-s%@STLIB_LD@%$STLIB_LD%g
-s%@SHLIB_LD@%$SHLIB_LD%g
-s%@SHLIB_LD_LIBS@%$SHLIB_LD_LIBS%g
-s%@SHLIB_CFLAGS@%$SHLIB_CFLAGS%g
+s%@DEPARG@%$DEPARG%g
s%@CC_OBJNAME@%$CC_OBJNAME%g
s%@CC_EXENAME@%$CC_EXENAME%g
-s%@TCL_LD_SEARCH_FLAGS@%$TCL_LD_SEARCH_FLAGS%g
s%@LDFLAGS_DEFAULT@%$LDFLAGS_DEFAULT%g
s%@LDFLAGS_DEBUG@%$LDFLAGS_DEBUG%g
s%@LDFLAGS_OPTIMIZE@%$LDFLAGS_OPTIMIZE%g
s%@LDFLAGS_CONSOLE@%$LDFLAGS_CONSOLE%g
s%@LDFLAGS_WINDOW@%$LDFLAGS_WINDOW%g
-s%@RC_OUT@%$RC_OUT%g
-s%@RC_TYPE@%$RC_TYPE%g
-s%@RC_INCLUDE@%$RC_INCLUDE%g
-s%@RES@%$RES%g
+s%@STLIB_LD@%$STLIB_LD%g
+s%@SHLIB_LD@%$SHLIB_LD%g
+s%@SHLIB_LD_LIBS@%$SHLIB_LD_LIBS%g
+s%@SHLIB_CFLAGS@%$SHLIB_CFLAGS%g
+s%@SHLIB_SUFFIX@%$SHLIB_SUFFIX%g
+s%@TCL_SHARED_BUILD@%$TCL_SHARED_BUILD%g
s%@LIBS_GUI@%$LIBS_GUI%g
s%@DLLSUFFIX@%$DLLSUFFIX%g
-s%@VENDORPREFIX@%$VENDORPREFIX%g
s%@LIBPREFIX@%$LIBPREFIX%g
s%@LIBSUFFIX@%$LIBSUFFIX%g
s%@EXESUFFIX@%$EXESUFFIX%g
@@ -3031,6 +1960,28 @@ s%@MAKE_LIB@%$MAKE_LIB%g
s%@POST_MAKE_LIB@%$POST_MAKE_LIB%g
s%@MAKE_DLL@%$MAKE_DLL%g
s%@MAKE_EXE@%$MAKE_EXE%g
+s%@TCL_BUILD_LIB_SPEC@%$TCL_BUILD_LIB_SPEC%g
+s%@TCL_LD_SEARCH_FLAGS@%$TCL_LD_SEARCH_FLAGS%g
+s%@TCL_NEEDS_EXP_FILE@%$TCL_NEEDS_EXP_FILE%g
+s%@TCL_BUILD_EXP_FILE@%$TCL_BUILD_EXP_FILE%g
+s%@TCL_EXP_FILE@%$TCL_EXP_FILE%g
+s%@LIBOBJS@%$LIBOBJS%g
+s%@TCL_LIB_VERSIONS_OK@%$TCL_LIB_VERSIONS_OK%g
+s%@TCL_PACKAGE_PATH@%$TCL_PACKAGE_PATH%g
+s%@TCL_DDE_VERSION@%$TCL_DDE_VERSION%g
+s%@TCL_DDE_MAJOR_VERSION@%$TCL_DDE_MAJOR_VERSION%g
+s%@TCL_DDE_MINOR_VERSION@%$TCL_DDE_MINOR_VERSION%g
+s%@TCL_DDE_PATCH_LEVEL@%$TCL_DDE_PATCH_LEVEL%g
+s%@TCL_REG_VERSION@%$TCL_REG_VERSION%g
+s%@TCL_REG_MAJOR_VERSION@%$TCL_REG_MAJOR_VERSION%g
+s%@TCL_REG_MINOR_VERSION@%$TCL_REG_MINOR_VERSION%g
+s%@TCL_REG_PATCH_LEVEL@%$TCL_REG_PATCH_LEVEL%g
+s%@RC_OUT@%$RC_OUT%g
+s%@RC_TYPE@%$RC_TYPE%g
+s%@RC_INCLUDE@%$RC_INCLUDE%g
+s%@RC_DEFINE@%$RC_DEFINE%g
+s%@RC_DEFINES@%$RC_DEFINES%g
+s%@RES@%$RES%g
CEOF
EOF
@@ -3138,4 +2089,3 @@ chmod +x $CONFIG_STATUS
rm -fr confdefs* $ac_clean_files
test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1
-
diff --git a/tcl/win/configure.in b/tcl/win/configure.in
index a926e615033..c700e52736f 100755
--- a/tcl/win/configure.in
+++ b/tcl/win/configure.in
@@ -1,3 +1,4 @@
+#! /bin/bash -norc
# This file is an input file used by the GNU "autoconf" program to
# generate the file "configure", which is run during Tcl installation
# to configure the system for the local environment.
@@ -5,29 +6,66 @@
# RCS: @(#) $Id$
AC_INIT(../generic/tcl.h)
+AC_PREREQ(2.13)
-TCL_VERSION=8.3
+TCL_VERSION=8.4
TCL_MAJOR_VERSION=8
-TCL_MINOR_VERSION=3
-TCL_PATCH_LEVEL=".2"
+TCL_MINOR_VERSION=4
+TCL_PATCH_LEVEL=".0"
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
+TCL_DDE_VERSION=1.2
+TCL_DDE_MAJOR_VERSION=1
+TCL_DDE_MINOR_VERSION=2
+TCL_DDE_PATCH_LEVEL=""
+DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION
+
+TCL_REG_VERSION=1.0
+TCL_REG_MAJOR_VERSION=1
+TCL_REG_MINOR_VERSION=0
+TCL_REG_PATCH_LEVEL=""
+REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION
+
+#------------------------------------------------------------------------
+# Handle the --prefix=... option
+#------------------------------------------------------------------------
+
if test "${prefix}" = "NONE"; then
prefix=/usr/local
fi
if test "${exec_prefix}" = "NONE"; then
exec_prefix=$prefix
fi
+# libdir must be a fully qualified path (not ${exec_prefix}/lib)
+eval libdir="$libdir"
#------------------------------------------------------------------------
# Standard compiler checks
#------------------------------------------------------------------------
+# If the user did not set CFLAGS, set it now to keep
+# the AC_PROG_CC macro from adding "-g -O2".
+if test "${CFLAGS+set}" != "set" ; then
+ CFLAGS=""
+fi
+
AC_PROG_CC
-AC_CHECK_TOOL(AR, ar, :)
-AC_CHECK_TOOL(RANLIB, ranlib, :)
-AC_CHECK_TOOL(RC, windres, :)
+# To properly support cross-compilation, one would
+# need to use these tool checks instead of
+# the ones below and reconfigure with
+# autoconf 2.50. You can also just set
+# the CC, AR, RANLIB, and RC environment
+# variables if you want to cross compile.
+dnl AC_CHECK_TOOL(AR, ar, :)
+dnl AC_CHECK_TOOL(RANLIB, ranlib, :)
+dnl AC_CHECK_TOOL(RC, windres, :)
+
+if test "${GCC}" = "yes" ; then
+ AC_CHECK_PROG(AR, ar, ar)
+ AC_CHECK_PROG(RANLIB, ranlib, ranlib)
+ AC_CHECK_PROG(RC, windres, windres)
+fi
#--------------------------------------------------------------------
# Checks to see if the make progeam sets the $MAKE variable.
@@ -36,11 +74,44 @@ AC_CHECK_TOOL(RC, windres, :)
AC_PROG_MAKE_SET
#--------------------------------------------------------------------
-# These two macros perform additinal compiler test.
+# Perform additinal compiler tests.
#--------------------------------------------------------------------
AC_CYGWIN
+if test "$ac_cv_cygwin" = "yes" ; then
+ AC_MSG_ERROR([Compiling with the Cygwin version of gcc is not supported.
+ Use the Mingw version of gcc from www.mingw.org instead.])
+fi
+
+
+AC_CACHE_CHECK(for SEH support in compiler,
+ tcl_cv_seh,
+AC_TRY_RUN([
+#define WIN32_LEAN_AND_MEAN
+#include <windows.h>
+#undef WIN32_LEAN_AND_MEAN
+
+int main(int argc, char** argv) {
+ int a, b = 0;
+ __try {
+ a = 666 / b;
+ }
+ __except (EXCEPTION_EXECUTE_HANDLER) {
+ return 0;
+ }
+ return 1;
+}
+],
+ tcl_cv_seh=yes,
+ tcl_cv_seh=no,
+ tcl_cv_seh=no)
+)
+if test "$tcl_cv_seh" = "no" ; then
+ AC_DEFINE(HAVE_NO_SEH,,
+ [Defined when mingw does not support SEH])
+fi
+
#--------------------------------------------------------------------
# Determines the correct binary file extension (.o, .obj, .exe etc.)
#--------------------------------------------------------------------
@@ -76,12 +147,7 @@ SC_CONFIG_CFLAGS
#--------------------------------------------------------------------
SC_ENABLE_SYMBOLS
-
-#------------------------------------------------------------------------------
-# Find out all about time handling differences.
-#------------------------------------------------------------------------------
-
-SC_TIME_HANDLER
+SC_ENABLE_MEMDEBUG
TCL_DBGX=${DBGX}
@@ -102,49 +168,29 @@ TCL_SHARED_BUILD=${SHARED_BUILD}
# Perform final evaluations of variables with possible substitutions.
#--------------------------------------------------------------------
-NODOT_VERSION=${VER}
-
TCL_SHARED_LIB_SUFFIX="\${NODOT_VERSION}${DLLSUFFIX}"
TCL_UNSHARED_LIB_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"
TCL_EXPORT_FILE_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"
-TCL_TOOL_PATH(TCL_SRC_DIR, "`cd $srcdir/..; pwd`")
-
-dnl CYGNUS LOCAL - Can't conflict with installed tcl package
-
-TCL_TOOL_STATIC_LIB_LONGNAME(TCL_LIB_FILE, tcl, ${TCL_UNSHARED_LIB_SUFFIX})
-TCL_TOOL_SHARED_LIB_LONGNAME(TCL_DLL_FILE, tcl, ${TCL_SHARED_LIB_SUFFIX})
-
-if test "$GCC" = "yes"; then
- GNU_TCL_LIB_FILE=${TCL_LIB_FILE}
- MSVC_TCL_LIB_FILE=
-else
- GNU_TCL_LIB_FILE=
- MSVC_TCL_LIB_FILE=${TCL_LIB_FILE}
-fi
-
-
-TCL_TOOL_LIB_SHORTNAME(TCL_LIB_FLAG, tcl, $TCL_VERSION)
-TCL_TOOL_LIB_SPEC(TCL_BUILD_LIB_SPEC, `pwd`, ${TCL_LIB_FLAG})
-TCL_TOOL_LIB_SPEC(TCL_LIB_SPEC, ${exec_prefix}/lib, ${TCL_LIB_FLAG})
-TCL_TOOL_LIB_PATH(TCL_LIB_FULL_PATH, `pwd`, ${TCL_LIB_FILE})
-
+eval "TCL_SRC_DIR=\"`cd $srcdir/..; pwd`\""
-TCL_TOOL_STATIC_LIB_LONGNAME(TCL_STUB_LIB_FILE, tclstub, ${TCL_UNSHARED_LIB_SUFFIX})
-TCL_TOOL_LIB_SHORTNAME(TCL_STUB_LIB_FLAG, tclstub, $TCL_VERSION)
-TCL_TOOL_LIB_SPEC(TCL_BUILD_STUB_LIB_SPEC, `pwd`, ${TCL_STUB_LIB_FLAG})
-TCL_TOOL_LIB_SPEC(TCL_STUB_LIB_SPEC, ${exec_prefix}/lib, ${TCL_STUB_LIB_FLAG})
-TCL_TOOL_LIB_PATH(TCL_BUILD_STUB_LIB_PATH, `pwd`, ${TCL_STUB_LIB_FILE})
-TCL_TOOL_LIB_PATH(TCL_STUB_LIB_PATH, ${exec_prefix}/lib, ${TCL_STUB_LIB_FILE})
+eval "TCL_DLL_FILE=tcl${VER}${DLLSUFFIX}"
+eval "TCL_LIB_FILE=${LIBPREFIX}tcl$VER${LIBSUFFIX}"
+# FIMXE: These variables decls are missing
+#TCL_LIB_FLAG
+#TCL_BUILD_LIB_SPEC
+#TCL_LIB_SPEC
-TCL_TOOL_SHARED_LIB_LONGNAME(DDE_DLL_FILE, tcldde, ${TCL_SHARED_LIB_SUFFIX})
-TCL_TOOL_STATIC_LIB_LONGNAME(DDE_LIB_FILE, tcldde, ${TCL_UNSHARED_LIB_SUFFIX})
+eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${VER}${LIBSUFFIX}\""
+eval "TCL_STUB_LIB_FLAG=\"-ltclstub${VER}${TCL_DBGX}\""
+eval "TCL_BUILD_STUB_LIB_SPEC=\"-L`pwd` ${TCL_STUB_LIB_FLAG}\""
+eval "TCL_STUB_LIB_SPEC=\"-L${libdir} ${TCL_STUB_LIB_FLAG}\""
+eval "TCL_BUILD_STUB_LIB_PATH=\"`pwd`/${TCL_STUB_LIB_FILE}\""
+eval "TCL_STUB_LIB_PATH=\"${libdir}/${TCL_STUB_LIB_FILE}\""
-TCL_TOOL_SHARED_LIB_LONGNAME(REG_DLL_FILE, tclreg, ${TCL_SHARED_LIB_SUFFIX})
-TCL_TOOL_STATIC_LIB_LONGNAME(REG_LIB_FILE, tclreg, ${TCL_UNSHARED_LIB_SUFFIX})
-
-TCL_TOOL_SHARED_LIB_LONGNAME(PIPE_DLL_FILE, tclpip, ${TCL_SHARED_LIB_SUFFIX})
+# Install time header dir can be set via --includedir
+eval "TCL_INCLUDE_SPEC=\"-I${includedir}\""
eval "DLLSUFFIX=${DLLSUFFIX}"
@@ -156,31 +202,43 @@ CFG_TCL_SHARED_LIB_SUFFIX=${TCL_SHARED_LIB_SUFFIX}
CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX}
CFG_TCL_EXPORT_FILE_SUFFIX=${TCL_EXPORT_FILE_SUFFIX}
+#--------------------------------------------------------------------
+# Adjust the defines for how the resources are built depending
+# on symbols and static vs. shared.
+#--------------------------------------------------------------------
+
+if test ${SHARED_BUILD} = 0 ; then
+ if test "${DBGX}" = "d"; then
+ RC_DEFINES="${RC_DEFINE} STATIC_BUILD ${RC_DEFINE} DEBUG"
+ else
+ RC_DEFINES="${RC_DEFINE} STATIC_BUILD"
+ fi
+else
+ if test "${DBGX}" = "d"; then
+ RC_DEFINES="${RC_DEFINE} DEBUG"
+ else
+ RC_DEFINES=""
+ fi
+fi
+
+
AC_SUBST(TCL_VERSION)
AC_SUBST(TCL_MAJOR_VERSION)
AC_SUBST(TCL_MINOR_VERSION)
-AC_SUBST(TCL_LIB_VERSIONS_OK)
AC_SUBST(TCL_PATCH_LEVEL)
+
AC_SUBST(TCL_LIB_FILE)
-AC_SUBST(GNU_TCL_LIB_FILE)
-AC_SUBST(MSVC_TCL_LIB_FILE)
-AC_SUBST(TCL_DLL_FILE)
AC_SUBST(TCL_LIB_FLAG)
-AC_SUBST(TCL_BUILD_LIB_SPEC)
+# empty on win
AC_SUBST(TCL_LIB_SPEC)
-AC_SUBST(TCL_LIB_FULL_PATH)
AC_SUBST(TCL_STUB_LIB_FILE)
AC_SUBST(TCL_STUB_LIB_FLAG)
-AC_SUBST(TCL_BUILD_STUB_LIB_SPEC)
AC_SUBST(TCL_STUB_LIB_SPEC)
-AC_SUBST(TCL_BUILD_STUB_LIB_PATH)
AC_SUBST(TCL_STUB_LIB_PATH)
-
-AC_SUBST(DDE_DLL_FILE)
-AC_SUBST(DDE_LIB_FILE)
-AC_SUBST(REG_DLL_FILE)
-AC_SUBST(REG_LIB_FILE)
-AC_SUBST(PIPE_DLL_FILE)
+AC_SUBST(TCL_INCLUDE_SPEC)
+AC_SUBST(TCL_BUILD_STUB_LIB_SPEC)
+AC_SUBST(TCL_BUILD_STUB_LIB_PATH)
+AC_SUBST(TCL_DLL_FILE)
AC_SUBST(TCL_SRC_DIR)
AC_SUBST(TCL_BIN_DIR)
@@ -188,22 +246,16 @@ AC_SUBST(TCL_DBGX)
AC_SUBST(CFG_TCL_SHARED_LIB_SUFFIX)
AC_SUBST(CFG_TCL_UNSHARED_LIB_SUFFIX)
AC_SUBST(CFG_TCL_EXPORT_FILE_SUFFIX)
-AC_SUBST(TCL_SHARED_BUILD)
-AC_SUBST(CYGPATH)
-AC_SUBST(DEPARG)
+# win/tcl.m4 doesn't set (CFLAGS)
AC_SUBST(CFLAGS_DEFAULT)
-AC_SUBST(CFLAGS_DEBUG)
-AC_SUBST(CFLAGS_OPTIMIZE)
-AC_SUBST(CFLAGS_WARNING)
AC_SUBST(EXTRA_CFLAGS)
-AC_SUBST(STLIB_LD)
-AC_SUBST(SHLIB_LD)
-AC_SUBST(SHLIB_LD_LIBS)
-AC_SUBST(SHLIB_CFLAGS)
+AC_SUBST(CYGPATH)
+AC_SUBST(DEPARG)
AC_SUBST(CC_OBJNAME)
AC_SUBST(CC_EXENAME)
-AC_SUBST(TCL_LD_SEARCH_FLAGS)
+
+# win/tcl.m4 doesn't set (LDFLAGS)
AC_SUBST(LDFLAGS_DEFAULT)
AC_SUBST(LDFLAGS_DEBUG)
AC_SUBST(LDFLAGS_OPTIMIZE)
@@ -211,15 +263,17 @@ AC_SUBST(LDFLAGS_CONSOLE)
AC_SUBST(LDFLAGS_WINDOW)
AC_SUBST(AR)
AC_SUBST(RANLIB)
-AC_SUBST(RC)
-AC_SUBST(RC_OUT)
-AC_SUBST(RC_TYPE)
-AC_SUBST(RC_INCLUDE)
-AC_SUBST(RES)
+
+AC_SUBST(STLIB_LD)
+AC_SUBST(SHLIB_LD)
+AC_SUBST(SHLIB_LD_LIBS)
+AC_SUBST(SHLIB_CFLAGS)
+AC_SUBST(SHLIB_SUFFIX)
+AC_SUBST(TCL_SHARED_BUILD)
+
AC_SUBST(LIBS)
AC_SUBST(LIBS_GUI)
AC_SUBST(DLLSUFFIX)
-AC_SUBST(VENDORPREFIX)
AC_SUBST(LIBPREFIX)
AC_SUBST(LIBSUFFIX)
AC_SUBST(EXESUFFIX)
@@ -229,5 +283,33 @@ AC_SUBST(POST_MAKE_LIB)
AC_SUBST(MAKE_DLL)
AC_SUBST(MAKE_EXE)
-AC_OUTPUT(Makefile tclConfig.sh tcl.hpj)
+# empty on win, but needs sub'ing
+AC_SUBST(TCL_BUILD_LIB_SPEC)
+AC_SUBST(TCL_LD_SEARCH_FLAGS)
+AC_SUBST(TCL_NEEDS_EXP_FILE)
+AC_SUBST(TCL_BUILD_EXP_FILE)
+AC_SUBST(TCL_EXP_FILE)
+AC_SUBST(DL_LIBS)
+AC_SUBST(LIBOBJS)
+AC_SUBST(TCL_LIB_VERSIONS_OK)
+AC_SUBST(TCL_PACKAGE_PATH)
+
+# win only
+AC_SUBST(TCL_DDE_VERSION)
+AC_SUBST(TCL_DDE_MAJOR_VERSION)
+AC_SUBST(TCL_DDE_MINOR_VERSION)
+AC_SUBST(TCL_DDE_PATCH_LEVEL)
+AC_SUBST(TCL_REG_VERSION)
+AC_SUBST(TCL_REG_MAJOR_VERSION)
+AC_SUBST(TCL_REG_MINOR_VERSION)
+AC_SUBST(TCL_REG_PATCH_LEVEL)
+AC_SUBST(RC)
+AC_SUBST(RC_OUT)
+AC_SUBST(RC_TYPE)
+AC_SUBST(RC_INCLUDE)
+AC_SUBST(RC_DEFINE)
+AC_SUBST(RC_DEFINES)
+AC_SUBST(RES)
+
+AC_OUTPUT(Makefile tclConfig.sh tcl.hpj)
diff --git a/tcl/win/license.terms b/tcl/win/license.terms
index fd2572c083a..f1dcaa5245c 100644
--- a/tcl/win/license.terms
+++ b/tcl/win/license.terms
@@ -1,7 +1,8 @@
This software is copyrighted by the Regents of the University of
-California, Sun Microsystems, Inc., Scriptics Corporation,
-and other parties. The following terms apply to all files associated
-with the software unless explicitly disclaimed in individual files.
+California, Sun Microsystems, Inc., Scriptics Corporation, ActiveState
+Corporation and other parties. The following terms apply to all files
+associated with the software unless explicitly disclaimed in
+individual files.
The authors hereby grant permission to use, copy, modify, distribute,
and license this software and its documentation for any purpose, provided
@@ -37,5 +38,3 @@ Government shall have only "Restricted Rights" as defined in Clause
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/tcl/win/makefile.bc b/tcl/win/makefile.bc
index 42b8101a474..a352f707406 100644
--- a/tcl/win/makefile.bc
+++ b/tcl/win/makefile.bc
@@ -1,388 +1,566 @@
-# Copyright (c) 1995-1996 Sun Microsystems, Inc.
-# RCS: @(#) $Id$
-#
-# Borland C++ 4.5 makefile
-#
-
-#
-# Project directories
-#
-# ROOT = top of source tree
-# TMPDIR = location where .obj files should be stored during build
-# TOOLS = location of compiler and other development tools
-#
-
-ROOT = ..
-TMPDIR = .
-TOOLS = c:\bc45
-
-# uncomment the following line to compile with symbols
-#DEBUG=1
-
-# uncomment one of the following lines to compile with TCL_MEM_DEBUG,
-# TCL_COMPILE_DEBUG, or TCL_COMPILE_STATS
-#DEBUGDEFINES =TCL_MEM_DEBUG
-#DEBUGDEFINES =TCL_MEM_DEBUG;TCL_COMPILE_DEBUG
-#DEBUGDEFINES =TCL_MEM_DEBUG;TCL_COMPILE_STATS
-#DEBUGDEFINES =TCL_MEM_DEBUG;TCL_COMPILE_DEBUG;TCL_COMPILE_STATS
-
-
-######################################################################
-# Do not modify below this line
-######################################################################
-
-STACKSIZE = 1f0001
-
-VERSION = 80
-
-TCLLIB = tcl$(VERSION).lib
-TCLDLL = tcl$(VERSION).dll
-TCL16DLL = tcl16$(VERSION).dll
-TCLSH = tclsh$(VERSION).exe
-TCLTEST = tcltest.exe
-DUMPEXTS = dumpexts.exe
-TCLPIPEDLL = tclpip$(VERSION).dll
-TCLREGDLL = tclreg$(VERSION).dll
-CAT16 = cat16.exe
-CAT32 = cat32.exe
-
-TCLSHOBJS = \
- $(TMPDIR)\tclAppInit.obj
-
-TCLTESTOBJS = \
- $(TMPDIR)\tclTest.obj \
- $(TMPDIR)\tclTestObj.obj \
- $(TMPDIR)\tclWinTest.obj \
- $(TMPDIR)\testMain.obj
-
-TCLOBJS = \
- $(TMPDIR)\panic.obj \
- $(TMPDIR)\regexp.obj \
- $(TMPDIR)\strftime.obj \
- $(TMPDIR)\tclAlloc.obj \
- $(TMPDIR)\tclAsync.obj \
- $(TMPDIR)\tclBasic.obj \
- $(TMPDIR)\tclBinary.obj \
- $(TMPDIR)\tclCkalloc.obj \
- $(TMPDIR)\tclClock.obj \
- $(TMPDIR)\tclCmdAH.obj \
- $(TMPDIR)\tclCmdIL.obj \
- $(TMPDIR)\tclCmdMZ.obj \
- $(TMPDIR)\tclCompExpr.obj \
- $(TMPDIR)\tclCompile.obj \
- $(TMPDIR)\tclDate.obj \
- $(TMPDIR)\tclEnv.obj \
- $(TMPDIR)\tclEvent.obj \
- $(TMPDIR)\tclExecute.obj \
- $(TMPDIR)\tclFCmd.obj \
- $(TMPDIR)\tclFileName.obj \
- $(TMPDIR)\tclGet.obj \
- $(TMPDIR)\tclHash.obj \
- $(TMPDIR)\tclHistory.obj \
- $(TMPDIR)\tclIndexObj.obj \
- $(TMPDIR)\tclInterp.obj \
- $(TMPDIR)\tclIO.obj \
- $(TMPDIR)\tclIOCmd.obj \
- $(TMPDIR)\tclIOSock.obj \
- $(TMPDIR)\tclIOUtil.obj \
- $(TMPDIR)\tclLink.obj \
- $(TMPDIR)\tclListObj.obj \
- $(TMPDIR)\tclLoad.obj \
- $(TMPDIR)\tclMain.obj \
- $(TMPDIR)\tclNamesp.obj \
- $(TMPDIR)\tclNotify.obj \
- $(TMPDIR)\tclObj.obj \
- $(TMPDIR)\tclParse.obj \
- $(TMPDIR)\tclPipe.obj \
- $(TMPDIR)\tclPkg.obj \
- $(TMPDIR)\tclPosixStr.obj \
- $(TMPDIR)\tclPreserve.obj \
- $(TMPDIR)\tclProc.obj \
- $(TMPDIR)\tclResolve.obj \
- $(TMPDIR)\tclStringObj.obj \
- $(TMPDIR)\tclTimer.obj \
- $(TMPDIR)\tclUtil.obj \
- $(TMPDIR)\tclVar.obj \
- $(TMPDIR)\tclWin32Dll.obj \
- $(TMPDIR)\tclWinChan.obj \
- $(TMPDIR)\tclWinError.obj \
- $(TMPDIR)\tclWinFCmd.obj \
- $(TMPDIR)\tclWinFile.obj \
- $(TMPDIR)\tclWinInit.obj \
- $(TMPDIR)\tclWinLoad.obj \
- $(TMPDIR)\tclWinMtherr.obj \
- $(TMPDIR)\tclWinNotify.obj \
- $(TMPDIR)\tclWinPipe.obj \
- $(TMPDIR)\tclWinSock.obj \
- $(TMPDIR)\tclWinTime.obj
-
-cc32 = $(TOOLS)\bin\bcc32.exe
-link32 = $(TOOLS)\bin\tlink32.exe
-rc32 = $(TOOLS)\bin\brcc32.exe
-implib = $(TOOLS)\bin\implib.exe
-
-cc16 = $(TOOLS)\bin\bcc.exe
-link16 = $(TOOLS)\bin\tlink.exe
-rc16 = $(TOOLS)\bin\brcc32.exe -31
-
-CP = copy
-RM = del
-
-WINDIR = $(ROOT)\win
-GENERICDIR = $(ROOT)\generic
-
-INCLUDES = $(TOOLS)\include;$(WINDIR);$(GENERICDIR)
-LIBDIRS = $(TOOLS)\lib;$(WINDIR)
-
-CON_CFLAGS = +cfgexe.cfg -WC
-TEST_CFLAGS = +cfgtest.cfg
-DLL16_CFLAGS = $(PROJECTCCFLAGS) -I$(INCLUDES) -D$(DEFINES) -WD -ml -c \
- -3 -d -w
-TCL_CFLAGS = +cfgdll.cfg
-
-CON_LFLAGS = -Tpe -ap -c $(DEBUGLDFLAGS) $(TOOLS)\lib\c0x32
-DLL_LFLAGS = -Tpd -aa -c $(DEBUGLDFLAGS) $(TOOLS)\lib\c0d32
-GUI_LFLAGS = -Tpe -aa -c $(DEBUGLDFLAGS) $(TOOLS)\lib\c0w32
-DLL16_LFLAGS = -Twd -c -C -A=16 $(DEBUGLDFLAGS16) $(TOOLS)\lib\c0dl
-
-DLL_LIBS = import32 cw32mti
-CON_LIBS = $(TCLLIB) import32 cw32mti
-DLL16_LIBS = import cwl
-
-!ifndef DEBUG
-
-# these macros cause maximum optimization and no symbols
-DEBUGLDFLAGS =
-DEBUGCCFLAGS = -v- -vi- -O2
-DEBUGLDFLAGS16 = -Oc -Oi -Oa -Or
-!else
-
-# these macros enable debugging
-DEBUGLDFLAGS = -v
-DEBUGCCFLAGS = -k -Od -v
-DEBUGLDFLAGS16 =
-
-!endif
-
-DEFINES = MT;_RTLDLL;$(DEBUGDEFINES)
-PROJECTCCFLAGS = $(DEBUGCCFLAGS) -w-par -w-stu
-
-
-#
-# Global makefile settings
-#
-
-.AUTODEPEND
-.CACHEAUTODEPEND
-
-.suffixes:
-
-#.path.c=$(ROOT)\win;$(ROOT)\generic;$(ROOT)\compat
-#.path.obj=$(TMPDIR)
-#.path.dll=$(ROOT)\win
-
-#
-# Targets
-#
-
-release: $(TCLSH) dlls
-all: $(TCLSH) dlls $(CAT16) $(CAT32)
-tcltest: $(TCLTEST) dlls $(CAT16) $(CAT32)
-dlls: $(TCL16DLL) $(TCLPIPEDLL) $(TCLREGDLL)
-
-test: tcltest
- $(TCLTEST) &&|
- cd ../tests
- source all
-|
-
-
-$(DUMPEXTS): cfgexe.cfg $(WINDIR)\winDumpExts.c
- $(cc32) $(CON_CFLAGS) $(WINDIR)\winDumpExts.c
- $(link32) $(CON_LFLAGS) \
- $(TMPDIR)\winDumpExts.obj,$@,,import32 cw32mti,,
-
-$(TCLLIB): $(TCLDLL)
- $(implib) -c $@ $(TCLDLL)
-
-$(TCLDLL): cfgdll.cfg $(TCLOBJS) $(TMPDIR)\tcl.def $(TMPDIR)\tcl.res
- $(link32) $(DLL_LFLAGS) @&&|
- $(TCLOBJS)
-$@
--x
-$(DLL_LIBS)
-|, $(TMPDIR)\tcl.def, $(TMPDIR)\tcl.res
-
-
-$(TCLSH): cfgexe.cfg $(TCLSHOBJS) $(TCLLIB) $(TMPDIR)\tclsh.res
- $(link32) -S:$(STACKSIZE) $(CON_LFLAGS) @&&|
- $(TCLSHOBJS)
-$@
--x
-$(CON_LIBS)
-|, &&|
-EXETYPE WINDOWS
-CODE PRELOAD MOVEABLE DISCARDABLE
-DATA PRELOAD MOVEABLE MULTIPLE
-|, $(TMPDIR)\tclsh.res
-
-$(TCLTEST): cfgtest.cfg $(TCLTESTOBJS) $(TCLLIB) $(TMPDIR)\tclsh.res
- $(link32) -S:$(STACKSIZE) $(CON_LFLAGS) @&&|
- $(TCLTESTOBJS)
-$@
--x
-$(CON_LIBS)
-|, &&|
-EXETYPE WINDOWS
-CODE PRELOAD MOVEABLE DISCARDABLE
-DATA PRELOAD MOVEABLE MULTIPLE
-|, $(TMPDIR)\tclsh.res
-
-
-$(TCL16DLL): tcl16.rc $(ROOT)\win\tclWin16.c
- $(cc16) @&&|
-$(DLL16_CFLAGS) -n$(TMPDIR)
-| $(ROOT)\win\tclWin16.c
- $(rc16) @&&|
--i$(INCLUDES) -d__WIN32__;$(DEFINES) -fo$(TMPDIR)\tcl16.res
-| tcl16.rc
- @copy >nul &&|
-LIBRARY $&;dll
-EXETYPE WINDOWS
-CODE PRELOAD MOVEABLE DISCARDABLE
-DATA PRELOAD MOVEABLE SINGLE
-HEAPSIZE 1024
-EXPORTS
- WEP @1 RESIDENTNAME
- UTPROC @2
-| $(TMPDIR)\tclWin16.def
- $(link16) $(DLL16_LFLAGS) @&&|
-$(TMPDIR)\tclWin16.obj
-$@
-nul
-$(DLL16_LIBS)
-$(TMPDIR)\tclWin16.def
-|
- $(TOOLS)\bin\rlink $(TMPDIR)\tcl16.res $@
-
-$(TCLPIPEDLL): cfgexe.cfg stub16.c
- $(cc32) -c -tWC stub16.c
- $(link32) $(CON_LFLAGS) -L$(TOOLS)\lib \
- stub16.obj,$@,,import32 cw32,,
-
-$(TCLREGDLL): extdll.cfg $(TMPDIR)\tclWinReg.obj
- $(link32) $(DLL_LFLAGS) @&&|
- $(TMPDIR)\tclWinReg.obj
-$@
--x
-$(DLL_LIBS) $(TCLLIB)
-|,,
-
-#
-# Special test targets
-#
-
-$(CAT32): cat.c
- $(cc32) -c -Ox -tWC -ocat32.obj cat.c
- $(link32) $(CON_LFLAGS) -L$(TOOLS)\lib \
- cat32.obj,$@,,import32 cw32,,
-
-$(CAT16): cat.c
- $(cc16) -W- -ml -Ox -c -ocat16.obj cat.c
- $(link16) -Tde -c -L$(TOOLS)\lib $(TOOLS)\lib\c0l.obj cat16.obj,cat16.exe,,cl.lib,,
-
-#######################################################################
-# Implicit Targets
-#######################################################################
-
-
-{$(WINDIR)}.c{$(TMPDIR)}.obj:
- @$(cc32) $(TCL_CFLAGS) {$< }
-
-{$(GENERICDIR)}.c{$(TMPDIR)}.obj:
- @$(cc32) $(TCL_CFLAGS) {$< }
-
-{$(ROOT)\compat}.c{$(TMPDIR)}.obj:
- @$(cc32) $(TCL_CFLAGS) {$< }
-
-{$(WINDIR)}.rc{$(TMPDIR)}.res:
- $(rc32) -i$(INCLUDES) -fo$@ @&&|
--d__WIN32__;$(DEFINES) $<
-|
-
-#
-# Special case object file targets
-#
-
-$(TMPDIR)\tclWinReg.obj : extdll.cfg $(ROOT)\win\tclWinReg.c
- $(cc32) +extdll.cfg -o$@ $(ROOT)\win\tclWinReg.c
-
-$(TMPDIR)\tclAppInit.obj : cfgexe.cfg $(ROOT)\win\tclAppInit.c
- $(cc32) $(CON_CFLAGS) -o$@ $(ROOT)\win\tclAppInit.c
-
-$(TMPDIR)\testMain.obj : cfgexe.cfg $(ROOT)\win\tclAppInit.c
- $(cc32) $(TEST_CFLAGS) -o$@ $(ROOT)\win\tclAppInit.c
-
-$(TMPDIR)\tclWin16.obj : $(ROOT)\win\tclWin16.c
- $(cc16) $(DLL16_CFLAGS) -o$@ $(ROOT)\win\tclWin16.c
-
-#
-# Configuration file targets - these files are implicitly used by the compiler
-#
-
-cfgdll.cfg:
- @$(CP) &&|
- -n$(TMPDIR) -I$(INCLUDES) -c -WM
- -D$(DEFINES) -3 -d -w $(PROJECTCCFLAGS)
-| cfgdll.cfg >NUL
-
-extdll.cfg:
- @$(CP) &&|
- -n$(TMPDIR) -I$(INCLUDES) -c -WD
- -D_RTLDLL;$(DEBUGDEFINES) -3 -d -w $(PROJECTCCFLAGS)
-| extdll.cfg >NUL
-
-cfgexe.cfg:
- @$(CP) &&|
- -n$(TMPDIR) -I$(INCLUDES) -c -W
- -D$(DEFINES) -3 -d -w $(PROJECTCCFLAGS)
-| cfgexe.cfg >NUL
-
-cfgtest.cfg:
- @$(CP) &&|
- -n$(TMPDIR) -I$(INCLUDES) -c -W
- -D$(DEFINES);TCL_TEST -3 -d -w $(PROJECTCCFLAGS)
-| cfgtest.cfg >NUL
-
-cfgcln:
- -@$(RM) *.cfg
-
-
-# The following rule automatically generates a tcl.def file containing
-# an export entry for every public symbol in the tcl.dll library.
-
-$(TMPDIR)\tcl.def: $(TCLOBJS) $(DUMPEXTS)
- $(DUMPEXTS) -o $(TMPDIR)\tcl.def $(TCLDLL) @&&|
- $(TCLOBJS)
-|
-
-
-# the following two rules are a hack to get around the fact that the
-# 16-bit compiler doesn't handle long file names :-(
-
-$(ROOT)\win\tclWinIn.h: $(ROOT)\win\tclWinInt.h
- $(CP) $(ROOT)\win\tclWinInt.h $(ROOT)\win\tclWinIn.h
-
-$(ROOT)\win\tclWin16.c: $(ROOT)\win\tclWinIn.h
-
-# remove all generated files
-
-clean:
- -@$(RM) *.exe
- -@$(RM) *.lib
- -@$(RM) *.dll
- -@$(RM) $(TMPDIR)\*.res
- -@$(RM) $(TMPDIR)\*.def
- -@$(RM) $(TMPDIR)\*.obj
- -@$(RM) $(TMPDIR)\*.cfg
- -@$(RM) $(ROOT)\win\tclWinIn.h
+#
+# Makefile for Borland C++ 5.5 (or C++ Builder 5), adapted from the makefile
+# for Visual C++ that came with tcl 8.3.3
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# Copyright (c) 1995-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+#
+# Have a look at the complete description on how to build and test Tcl with
+# the current Borland compilers at www.ratiosoft.com/tcl/borland.
+#
+# Usage:
+# - Adapt the paths below to match your compiler's location
+# - Make sure the compiler's bin directory is on your path
+# - Open a console
+# - To make a debug version enter
+# make -fmakefile.bc -DNODEBUG=0 xxx
+# where 'xxx' is the target you want (e.g. 'all', 'test', ...)
+# Please note: I omitted the 'd' suffix for debug versions because Tcl
+# will always call tclpip83.dll and not tclpip83d.dll, causing an error.
+# ^
+# Besides, the debug version goes into a separate directory, so there
+# should be no problem having DLLs and EXEs with the same name.
+# If you prefer your debug version having the 'd' suffix just uncomment
+# the line
+# #DBGX = d
+#
+# - To make a 'normal' version enter
+# make -fmakefile.bc xxx
+# where 'xxx' is the target you want (e.g. 'all', 'test', ...)
+#
+# DISCLAIMER:
+# This makefile has an experimental status - that is those targets which
+# have been modified do in fact compile and link with Borland's C++
+# Builder 5 and with the free Borland compiler (Borland C++ 5.5).
+# However the author assumes no responsiblity for any effect which the use of
+# this makefile or of the resulting programs might have on your system.
+#
+# Not yet modified:
+# - The 'plug-in-DLL' and the associated shell.
+# - The programs to create the windows help files.
+#
+# Suggestions and / or improvements are always welcome.
+#
+# May 2001, H. Giese (hgiese@ratiosoft.com)
+#
+
+# Does not depend on the presence of any environment variables in
+# order to compile tcl; all needed information is derived from
+# location of the compiler directories.
+
+#
+# Project directories
+#
+# ROOT = top of source tree
+#
+# TOOLS32 = location of Borland development tools.
+#
+# INSTALLDIR = where the install-targets should copy the binaries and
+# support files
+#
+
+ROOT = ..
+INSTALLDIR = c:\program files\tcl
+
+# If you have C++ Builder 5 or the free Borland C++ 5.5 compiler
+# adapt the following paths as appropriate for your system
+TOOLS32 = c:\dev\bcc55
+TOOLS32_rc = c:\dev\bcc55
+#TOOLS32 = c:\bc55
+#TOOLS32_rc = c:\bc55
+
+cc32 = "$(TOOLS32)\bin\bcc32.exe"
+link32 = "$(TOOLS32)\bin\ilink32.exe"
+lib32 = "$(TOOLS32)\bin\tlib.exe"
+rc32 = "$(TOOLS32_rc)\bin\brcc32.exe"
+include32 = -I"$(TOOLS32)\include"
+libpath32 = -L"$(TOOLS32)\lib"
+
+# Uncomment the following line to compile with thread support
+#THREADDEFINES = -DTCL_THREADS=1
+
+# Allow definition of NDEBUG via command line
+# Set NODEBUG to 0 to compile with symbols
+!if !defined(NODEBUG)
+NODEBUG = 1
+!endif
+
+# The following defines can be used to control the amount of debugging
+# code that is added to the compilation.
+#
+# -DTCL_MEM_DEBUG Enables the debugging memory allocator.
+# -DTCL_COMPILE_DEBUG Enables byte compilation logging.
+# -DTCL_COMPILE_STATS Enables byte compilation statistics gathering.
+# -DUSE_TCLALLOC=0 Disables the Tcl memory allocator in favor
+# of the native malloc implementation. This is
+# needed when using Purify.
+#
+#DEBUGDEFINES = -DTCL_MEM_DEBUG -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS
+#DEBUGDEFINES = -DUSE_TCLALLOC=0
+
+######################################################################
+# Do not modify below this line
+######################################################################
+
+NAMEPREFIX = tcl
+STUBPREFIX = $(NAMEPREFIX)stub
+DOTVERSION = 8.4
+VERSION = 84
+
+DDEVERSION = 12
+DDEDOTVERSION = 1.2
+
+REGVERSION = 10
+REGDOTVERSION = 1.0
+
+BINROOT = ..
+!IF "$(NODEBUG)" == "1"
+TMPDIRNAME = Release
+DBGX =
+!ELSE
+TMPDIRNAME = Debug
+#DBGX = d
+DBGX =
+!ENDIF
+TMPDIR = $(BINROOT)\$(TMPDIRNAME)
+OUTDIRNAME = $(TMPDIRNAME)
+OUTDIR = $(TMPDIR)
+
+TCLLIB = $(OUTDIR)\$(NAMEPREFIX)$(VERSION)$(DBGX).lib
+TCLDLLNAME = $(NAMEPREFIX)$(VERSION)$(DBGX).dll
+TCLDLL = $(OUTDIR)\$(TCLDLLNAME)
+
+TCLSTUBLIBNAME = $(STUBPREFIX)$(VERSION)$(DBGX).lib
+TCLSTUBLIB = $(OUTDIR)\$(TCLSTUBLIBNAME)
+
+TCLPLUGINLIB = $(OUTDIR)\$(NAMEPREFIX)$(VERSION)p$(DBGX).lib
+TCLPLUGINDLLNAME = $(NAMEPREFIX)$(VERSION)p$(DBGX).dll
+TCLPLUGINDLL = $(OUTDIR)\$(TCLPLUGINDLLNAME)
+TCLSH = $(OUTDIR)\$(NAMEPREFIX)sh$(VERSION)$(DBGX).exe
+TCLSHP = $(OUTDIR)\$(NAMEPREFIX)shp$(VERSION)$(DBGX).exe
+TCLPIPEDLLNAME = $(NAMEPREFIX)pip$(VERSION)$(DBGX).dll
+TCLPIPEDLL = $(OUTDIR)\$(TCLPIPEDLLNAME)
+TCLREGDLLNAME = $(NAMEPREFIX)reg$(REGVERSION)$(DBGX).dll
+TCLREGDLL = $(OUTDIR)\$(TCLREGDLLNAME)
+TCLDDEDLLNAME = $(NAMEPREFIX)dde$(DDEVERSION)$(DBGX).dll
+TCLDDEDLL = $(OUTDIR)\$(TCLDDEDLLNAME)
+TCLTEST = $(OUTDIR)\$(NAMEPREFIX)test.exe
+CAT32 = $(TMPDIR)\cat32.exe
+RMDIR = .\rmd.bat
+MKDIR = .\mkd.bat
+RM = del
+
+LIB_INSTALL_DIR = $(INSTALLDIR)\lib
+BIN_INSTALL_DIR = $(INSTALLDIR)\bin
+SCRIPT_INSTALL_DIR = $(INSTALLDIR)\lib\tcl$(DOTVERSION)
+INCLUDE_INSTALL_DIR = $(INSTALLDIR)\include
+
+TCLSHOBJS = \
+ $(TMPDIR)\tclAppInit.obj
+
+TCLTESTOBJS = \
+ $(TMPDIR)\tclTest.obj \
+ $(TMPDIR)\tclTestObj.obj \
+ $(TMPDIR)\tclTestProcBodyObj.obj \
+ $(TMPDIR)\tclThreadTest.obj \
+ $(TMPDIR)\tclWinTest.obj \
+ $(TMPDIR)\testMain.obj
+
+TCLOBJS = \
+ $(TMPDIR)\regcomp.obj \
+ $(TMPDIR)\regexec.obj \
+ $(TMPDIR)\regfree.obj \
+ $(TMPDIR)\regerror.obj \
+ $(TMPDIR)\strftime.obj \
+ $(TMPDIR)\strtoll.obj \
+ $(TMPDIR)\strtoull.obj \
+ $(TMPDIR)\tclAlloc.obj \
+ $(TMPDIR)\tclAsync.obj \
+ $(TMPDIR)\tclBasic.obj \
+ $(TMPDIR)\tclBinary.obj \
+ $(TMPDIR)\tclCkalloc.obj \
+ $(TMPDIR)\tclClock.obj \
+ $(TMPDIR)\tclCmdAH.obj \
+ $(TMPDIR)\tclCmdIL.obj \
+ $(TMPDIR)\tclCmdMZ.obj \
+ $(TMPDIR)\tclCompCmds.obj \
+ $(TMPDIR)\tclCompExpr.obj \
+ $(TMPDIR)\tclCompile.obj \
+ $(TMPDIR)\tclDate.obj \
+ $(TMPDIR)\tclEncoding.obj \
+ $(TMPDIR)\tclEnv.obj \
+ $(TMPDIR)\tclEvent.obj \
+ $(TMPDIR)\tclExecute.obj \
+ $(TMPDIR)\tclFCmd.obj \
+ $(TMPDIR)\tclFileName.obj \
+ $(TMPDIR)\tclGet.obj \
+ $(TMPDIR)\tclHash.obj \
+ $(TMPDIR)\tclHistory.obj \
+ $(TMPDIR)\tclIndexObj.obj \
+ $(TMPDIR)\tclInterp.obj \
+ $(TMPDIR)\tclIO.obj \
+ $(TMPDIR)\tclIOCmd.obj \
+ $(TMPDIR)\tclIOGT.obj \
+ $(TMPDIR)\tclIOSock.obj \
+ $(TMPDIR)\tclIOUtil.obj \
+ $(TMPDIR)\tclLink.obj \
+ $(TMPDIR)\tclLiteral.obj \
+ $(TMPDIR)\tclListObj.obj \
+ $(TMPDIR)\tclLoad.obj \
+ $(TMPDIR)\tclMain.obj \
+ $(TMPDIR)\tclNamesp.obj \
+ $(TMPDIR)\tclNotify.obj \
+ $(TMPDIR)\tclObj.obj \
+ $(TMPDIR)\tclPanic.obj \
+ $(TMPDIR)\tclParse.obj \
+ $(TMPDIR)\tclParseExpr.obj \
+ $(TMPDIR)\tclPipe.obj \
+ $(TMPDIR)\tclPkg.obj \
+ $(TMPDIR)\tclPosixStr.obj \
+ $(TMPDIR)\tclPreserve.obj \
+ $(TMPDIR)\tclProc.obj \
+ $(TMPDIR)\tclRegexp.obj \
+ $(TMPDIR)\tclResolve.obj \
+ $(TMPDIR)\tclResult.obj \
+ $(TMPDIR)\tclScan.obj \
+ $(TMPDIR)\tclStringObj.obj \
+ $(TMPDIR)\tclStubInit.obj \
+ $(TMPDIR)\tclStubLib.obj \
+ $(TMPDIR)\tclThread.obj \
+ $(TMPDIR)\tclThreadJoin.obj \
+ $(TMPDIR)\tclTimer.obj \
+ $(TMPDIR)\tclUtf.obj \
+ $(TMPDIR)\tclUtil.obj \
+ $(TMPDIR)\tclVar.obj \
+ $(TMPDIR)\tclWin32Dll.obj \
+ $(TMPDIR)\tclWinChan.obj \
+ $(TMPDIR)\tclWinConsole.obj \
+ $(TMPDIR)\tclWinSerial.obj \
+ $(TMPDIR)\tclWinError.obj \
+ $(TMPDIR)\tclWinFCmd.obj \
+ $(TMPDIR)\tclWinFile.obj \
+ $(TMPDIR)\tclWinInit.obj \
+ $(TMPDIR)\tclWinLoad.obj \
+ $(TMPDIR)\tclWinMtherr.obj \
+ $(TMPDIR)\tclWinNotify.obj \
+ $(TMPDIR)\tclWinPipe.obj \
+ $(TMPDIR)\tclWinSock.obj \
+ $(TMPDIR)\tclWinThrd.obj \
+ $(TMPDIR)\tclWinTime.obj
+
+TCLSTUBOBJS = $(TMPDIR)\tclStubLib.obj
+
+WINDIR = $(ROOT)\win
+GENERICDIR = $(ROOT)\generic
+
+TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)"
+TCL_DEFINES = $(DEBUGDEFINES) $(THREADDEFINES)
+
+######################################################################
+# Compiler flags
+######################################################################
+
+!IF "$(NODEBUG)" == "1"
+# these macros cause maximum optimization and no symbols
+cdebug = -v- -vi- -O2 -D_DEBUG
+!ELSE
+# these macros enable debugging
+cdebug = -k -Od -r- -v -vi- -y
+!ENDIF
+
+SYSDEFINES = _MT;NO_STRICT;_NO_VCL
+
+# declarations common to all compiler options
+cbase = -c -q -3 -a4 -g0 -tWM -Ve -Vx -X-
+WARNINGS = -w-rch -w-pch -w-par -w-dup -w-pro -w-dpu
+
+ccons = -tWC
+
+INCLUDEPATH = $(include32) $(TCL_INCLUDES)
+
+CFLAGS = $(cdebug) $(cbase) $(INCLUDEPATH) $(WARNINGS) -D$(SYSDEFINES)
+TCL_CFLAGS = $(CFLAGS) $(TCL_DEFINES)
+CONS_CFLAGS = $(CFLAGS) $(TCL_DEFINES) $(ccons)
+
+######################################################################
+# Linker flags
+######################################################################
+
+!IF "$(NODEBUG)" == "1"
+ldebug =
+!ELSE
+ldebug = -v
+!ENDIF
+
+# declarations common to all linker options
+LNFLAGS = -D"" -Gn -I$(TMPDIR) -x $(ldebug) $(libpath32)
+# -Gi: create lib file (is -Gl in doc)
+# -aa: Windows app, -ap: Windows console app
+LNFLAGS_DLL = -ap -Gi -Tpd
+LNFLAGS_CONS = -ap -Tpe
+
+LNLIBS = import32 cw32mt
+
+
+######################################################################
+# Project specific targets
+######################################################################
+
+release: setup $(TCLSH) dlls
+dlls: setup $(TCLPIPEDLL) $(TCLREGDLL) $(TCLDDEDLL)
+all: setup $(TCLSH) dlls $(CAT32)
+tcltest: setup $(TCLTEST) dlls $(CAT32)
+plugin: setup $(TCLPLUGINDLL) $(TCLSHP)
+install: install-binaries install-libraries
+
+test: setup $(TCLTEST) dlls $(CAT32)
+ set TCL_LIBRARY=$(ROOT)/library
+ $(TCLTEST) $(ROOT)/tests/all.tcl
+
+setup:
+ @if not exist $(OUT_DIR)\nul mkdir $(OUT_DIR) &\
+ echo *** Created directory '$(OUT_DIR)'
+ @if not exist $(TMP_DIR)\nul mkdir $(TMP_DIR) &\
+ echo *** Created directory '$(TMP_DIR)'
+
+
+$(TCLLIB): $(TCLDLL)
+
+$(TCLDLL): $(TCLOBJS) $(TMPDIR)\$(NAMEPREFIX).res
+ $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_DLL) $(TOOLS32)\lib\c0d32 @&&!
+ $(TCLOBJS), $@, -x, $(LNLIBS),, $(TMPDIR)\$(NAMEPREFIX).res
+!
+
+$(TCLSTUBLIB): $(TCLSTUBOBJS)
+ $(lib32) /u $@ $(TCLSTUBOBJS)
+
+$(TCLPLUGINLIB): $(TCLPLUGINDLL)
+
+$(TCLPLUGINDLL): $(TCLOBJS) $(TMPDIR)\tcl.res
+ $(link32) $(ldebug) $(dlllflags) \
+ -out:$@ $(TMPDIR)\tcl.res $(guilibsdll) @&&!
+$(TCLOBJS)
+!
+
+$(TCLSH): $(TCLSHOBJS) $(TCLLIB) $(TMPDIR)\$(NAMEPREFIX)sh.res
+ $(link32) $(ldebug) -S:2400000 $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 @&&!
+ $(TCLSHOBJS), $@, -x, $(LNLIBS) $(TCLLIB),, $(TMPDIR)\$(NAMEPREFIX)sh.res
+!
+
+$(TCLSHP): $(TCLSHOBJS) $(TCLPLUGINLIB) $(TMPDIR)\tclsh.res
+ $(link32) $(ldebug) $(conlflags) $(TMPDIR)\tclsh.res -stack:2300000 \
+ -out:$@ $(conlibsdll) $(TCLPLUGINLIB) $(TCLSHOBJS)
+
+$(TCLTEST): $(TCLTESTOBJS) $(TCLLIB) $(TMPDIR)\$(NAMEPREFIX)sh.res
+ $(link32) $(ldebug) -S:2400000 $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 @&&!
+ $(TCLTESTOBJS), $@, -x, $(LNLIBS) $(TCLLIB),, $(TMPDIR)\$(NAMEPREFIX)sh.res
+!
+
+$(TCLPIPEDLL): $(WINDIR)\stub16.c
+ $(cc32) $(CFLAGS) -o$(TMPDIR)\stub16.obj $(WINDIR)\stub16.c
+ $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 \
+ $(TMPDIR)\stub16.obj, $@, -x, $(LNLIBS),, $(TMPDIR)\$(NAMEPREFIX).res
+
+$(TCLDDEDLL): $(TMPDIR)\tclWinDde.obj $(TCLSTUBLIB)
+ $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_DLL) $(TOOLS32)\lib\c0d32 \
+ $(TMPDIR)\tclWinDde.obj, $@, -x, $(LNLIBS) $(TCLSTUBLIB),, \
+ $(TMPDIR)\$(NAMEPREFIX).res
+
+$(TCLREGDLL): $(TMPDIR)\tclWinReg.obj $(TCLSTUBLIB)
+ $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_DLL) $(TOOLS32)\lib\c0d32 \
+ $(TMPDIR)\tclWinReg.obj, $@, -x, $(LNLIBS) $(TCLSTUBLIB),, \
+ $(TMPDIR)\$(NAMEPREFIX).res
+
+$(CAT32): $(WINDIR)\cat.c
+ $(cc32) $(CONS_CFLAGS) -o$(TMPDIR)\cat.obj $?
+ $(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 \
+ $(TMPDIR)\cat.obj, $@, -x, $(LNLIBS),,
+
+install-binaries: $(TCLSH)
+ $(MKDIR) "$(BIN_INSTALL_DIR)"
+ $(MKDIR) "$(LIB_INSTALL_DIR)"
+ @echo installing $(TCLDLLNAME)
+ @copy "$(TCLDLL)" "$(BIN_INSTALL_DIR)"
+ @copy "$(TCLLIB)" "$(LIB_INSTALL_DIR)"
+ @echo installing "$(TCLSH)"
+ @copy "$(TCLSH)" "$(BIN_INSTALL_DIR)"
+ @echo installing $(TCLPIPEDLLNAME)
+ @copy "$(TCLPIPEDLL)" "$(BIN_INSTALL_DIR)"
+ @echo installing $(TCLSTUBLIBNAME)
+ @copy "$(TCLSTUBLIB)" "$(LIB_INSTALL_DIR)"
+
+install-libraries:
+ -@$(MKDIR) "$(LIB_INSTALL_DIR)"
+ -@$(MKDIR) "$(INCLUDE_INSTALL_DIR)"
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)"
+ @echo installing http1.0
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\http1.0"
+ -@copy "$(ROOT)\library\http1.0\http.tcl" "$(SCRIPT_INSTALL_DIR)\http1.0"
+ -@copy "$(ROOT)\library\http1.0\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http1.0"
+ @echo installing http2.4
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\http2.4"
+ -@copy "$(ROOT)\library\http\http.tcl" "$(SCRIPT_INSTALL_DIR)\http2.4"
+ -@copy "$(ROOT)\library\http\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http2.4"
+ @echo installing opt0.4
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\opt0.4"
+ -@copy "$(ROOT)\library\opt\optparse.tcl" "$(SCRIPT_INSTALL_DIR)\opt0.4"
+ -@copy "$(ROOT)\library\opt\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\opt0.4"
+ @echo installing msgcat1.3
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\msgcat1.3"
+ -@copy "$(ROOT)\library\msgcat\msgcat.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.3"
+ -@copy "$(ROOT)\library\msgcat\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.3"
+ @echo installing tcltest2.2
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\tcltest2.2"
+ -@copy "$(ROOT)\library\tcltest\tcltest.tcl" "$(SCRIPT_INSTALL_DIR)\tcltest2.2"
+ -@copy "$(ROOT)\library\tcltest\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\tcltest2.2"
+ @echo installing $(TCLDDEDLLNAME)
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\dde1.1"
+ -@copy "$(TCLDDEDLL)" "$(SCRIPT_INSTALL_DIR)\dde1.1"
+ -@copy "$(ROOT)\library\dde\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\dde1.1"
+ @echo installing $(TCLREGDLLNAME)
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\reg1.0"
+ -@copy "$(TCLREGDLL)" "$(SCRIPT_INSTALL_DIR)\reg1.0"
+ -@copy "$(ROOT)\library\reg\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\reg1.0"
+ @echo installing encoding files
+ -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\encoding"
+ -@copy "$(ROOT)\library\encoding\*.enc" "$(SCRIPT_INSTALL_DIR)\encoding"
+ @echo installing library files
+ -@copy "$(GENERICDIR)\tcl.h" "$(INCLUDE_INSTALL_DIR)"
+ -@copy "$(GENERICDIR)\tclDecls.h" "$(INCLUDE_INSTALL_DIR)"
+ -@copy "$(GENERICDIR)\tclPlatDecls.h" "$(INCLUDE_INSTALL_DIR)"
+ -@copy "$(ROOT)\library\history.tcl" "$(SCRIPT_INSTALL_DIR)"
+ -@copy "$(ROOT)\library\init.tcl" "$(SCRIPT_INSTALL_DIR)"
+ -@copy "$(ROOT)\library\ldAout.tcl" "$(SCRIPT_INSTALL_DIR)"
+ -@copy "$(ROOT)\library\parray.tcl" "$(SCRIPT_INSTALL_DIR)"
+ -@copy "$(ROOT)\library\safe.tcl" "$(SCRIPT_INSTALL_DIR)"
+ -@copy "$(ROOT)\library\tclIndex" "$(SCRIPT_INSTALL_DIR)"
+ -@copy "$(ROOT)\library\package.tcl" "$(SCRIPT_INSTALL_DIR)"
+ -@copy "$(ROOT)\library\word.tcl" "$(SCRIPT_INSTALL_DIR)"
+ -@copy "$(ROOT)\library\auto.tcl" "$(SCRIPT_INSTALL_DIR)"
+
+#
+# Regenerate the stubs files.
+#
+
+genstubs:
+ tclsh$(VERSION) $(ROOT)\tools\genStubs.tcl $(GENERICDIR) \
+ $(GENERICDIR)\tcl.decls $(GENERICDIR)\tclInt.decls
+
+#
+# Regenerate the windows help files.
+#
+
+TCLTOOLS = $(ROOT)/tools
+MAN2TCL = $(TCLTOOLS)/man2tcl
+TCLRTF = $(TCLTOOLS)/tcl.rtf
+TCLHPJ = $(TCLTOOLS)/tcl.hpj
+MAN2HELP = $(TCLTOOLS)/man2help.tcl
+HCRTF = $(TOOLS32)/bin/hcrtf.exe
+
+winhelp: $(TCLRTF)
+ cd $(TCLTOOLS)
+ start /wait $(HCRTF) -xn $(TCLHPJ)
+
+$(MAN2TCL).exe: $(MAN2TCL).obj
+ cd $(TCLTOOLS)
+ $(cc32) /nologo /G4 /ML /O2 $(MAN2TCL).c
+
+$(TCLRTF): $(MAN2TCL).exe $(TCLSH)
+ cd $(TCLTOOLS)
+ ..\win\$(TCLSH) $(MAN2HELP) $(NAMEPREFIX) $(VERSION) $(ROOT)/doc ../../tk$(DOTVERSION)/doc
+
+#
+# Special case object file targets
+#
+$(TMPDIR)\tclWinInit.obj: $(WINDIR)\tclWinInit.c
+ $(cc32) -DBUILD_tcl $(TCL_CFLAGS) -o$(TMPDIR)\$@ $?
+
+$(TMPDIR)\testMain.obj: $(WINDIR)\tclAppInit.c
+ $(cc32) $(TCL_CFLAGS) -DTCL_TEST -o$(TMPDIR)\testMain.obj $?
+
+$(TMPDIR)\tclTest.obj: $(GENERICDIR)\tclTest.c
+ $(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $?
+
+$(TMPDIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c
+ $(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $?
+
+$(TMPDIR)\tclWinTest.obj: $(WINDIR)\tclWinTest.c
+ $(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $?
+
+$(TMPDIR)\tclAppInit.obj : $(WINDIR)\tclAppInit.c
+ $(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $?
+
+# The following objects should be built using the stub interfaces
+
+# tclWinReg: Produces errors in ANSI mode
+$(TMPDIR)\tclWinReg.obj : $(WINDIR)\tclWinReg.c
+ $(cc32) $(TCL_CFLAGS) -DUSE_TCL_STUBS -o$(TMPDIR)\$@ $?
+
+# tclWinDde: Produces errors in ANSI mode
+$(TMPDIR)\tclWinDde.obj : $(WINDIR)\tclWinDde.c
+ $(cc32) $(TCL_CFLAGS) -DUSE_TCL_STUBS -o$(TMPDIR)\$@ $?
+
+
+# The following objects are part of the stub library and should not
+# be built as DLL objects but none of the symbols should be exported
+
+$(TMPDIR)\tclStubLib.obj : $(GENERICDIR)\tclStubLib.c
+ $(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -o$(TMPDIR)\$@ $?
+
+
+# Dedependency rules
+
+$(GENERICDIR)\regcomp.c: \
+ $(GENERICDIR)\regguts.h \
+ $(GENERICDIR)\regc_lex.c \
+ $(GENERICDIR)\regc_color.c \
+ $(GENERICDIR)\regc_nfa.c \
+ $(GENERICDIR)\regc_cvec.c \
+ $(GENERICDIR)\regc_locale.c
+
+$(GENERICDIR)\regcustom.h: \
+ $(GENERICDIR)\tclInt.h \
+ $(GENERICDIR)\tclPort.h \
+ $(GENERICDIR)\regex.h
+
+$(GENERICDIR)\regexec.c: \
+ $(GENERICDIR)\rege_dfa.c \
+ $(GENERICDIR)\regguts.h
+
+$(GENERICDIR)\regerror.c: $(GENERICDIR)\regguts.h
+$(GENERICDIR)\regfree.c: $(GENERICDIR)\regguts.h
+$(GENERICDIR)\regfronts.c: $(GENERICDIR)\regguts.h
+$(GENERICDIR)\regguts.h: $(GENERICDIR)\regcustom.h
+
+#
+# Implicit rules
+#
+
+{$(WINDIR)}.c{$(TMPDIR)}.obj:
+ $(cc32) -DBUILD_tcl $(TCL_CFLAGS) -o$@ $<
+
+{$(GENERICDIR)}.c{$(TMPDIR)}.obj:
+ $(cc32) -DBUILD_tcl $(TCL_CFLAGS) -o$@ $<
+
+{$(ROOT)\compat}.c{$(TMPDIR)}.obj:
+ $(cc32) -DBUILD_tcl $(TCL_CFLAGS) -o$@ $<
+
+{$(WINDIR)}.rc{$(TMPDIR)}.res:
+ $(rc32) $(INCLUDEPATH) -D$(USERDEFINES);$(SYSDEFINES) -fo$@ $<
+
+clean:
+ -@$(RM) $(OUTDIR)\*.exp
+ -@$(RM) $(OUTDIR)\*.lib
+ -@$(RM) $(OUTDIR)\*.dll
+ -@$(RM) $(OUTDIR)\*.exe
+ -@$(RM) $(OUTDIR)\*.pdb
+ -@$(RM) $(TMPDIR)\*.pch
+ -@$(RM) $(TMPDIR)\*.obj
+ -@$(RM) $(TMPDIR)\*.res
+ -@$(RM) $(TMPDIR)\*.exe
+ -@$(RMDIR) $(OUTDIR)
+ -@$(RMDIR) $(TMPDIR)
+
diff --git a/tcl/win/makefile.vc b/tcl/win/makefile.vc
index 3fc7e2cca66..e8de4a25f55 100644
--- a/tcl/win/makefile.vc
+++ b/tcl/win/makefile.vc
@@ -1,527 +1,796 @@
-# Visual C++ 2.x and 4.0 makefile
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# Copyright (c) 1995-1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
-#
-# RCS: @(#) $Id$
-
-# Does not depend on the presence of any environment variables in
-# order to compile tcl; all needed information is derived from
-# location of the compiler directories.
-
-#
-# Project directories
-#
-# ROOT = top of source tree
-#
-# TOOLS32 = location of VC++ 32-bit development tools. Note that the
-# VC++ 2.0 header files are broken, so you need to use the
-# ones that come with the developer network CD's, or later
-# versions of VC++.
-#
-# INSTALLDIR = where the install- targets should copy the binaries and
-# support files
-#
-
-# Set this to the appropriate value of /MACHINE: for your platform
-MACHINE = IX86
-
-ROOT = ..
-INSTALLDIR = c:\Progra~1\Tcl
-
-!IF "$(MACHINE)" == "IA64"
-TOOLS32 = c:\ia64sdk17
-TOOLS32_rc = c:\ia64sdk17
-!ELSE
-TOOLS32 = c:\Progra~1\devstudio\vc
-TOOLS32_rc = c:\Progra~1\devstudio\sharedide
-!ENDIF
-
-# Uncomment the following line to compile with thread support
-#THREADDEFINES = -DTCL_THREADS=1
-
-# Set NODEBUG to 0 to compile with symbols
-NODEBUG = 1
-
-# The following defines can be used to control the amount of debugging
-# code that is added to the compilation.
-#
-# -DTCL_MEM_DEBUG Enables the debugging memory allocator.
-# -DTCL_COMPILE_DEBUG Enables byte compilation logging.
-# -DTCL_COMPILE_STATS Enables byte compilation statistics gathering.
-# -DUSE_TCLALLOC=0 Disables the Tcl memory allocator in favor
-# of the native malloc implementation. This is
-# needed when using Purify.
-#
-#DEBUGDEFINES = -DTCL_MEM_DEBUG -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS
-#DEBUGDEFINES = -DUSE_TCLALLOC=0
-
-######################################################################
-# Do not modify below this line
-######################################################################
-
-NAMEPREFIX = tcl
-STUBPREFIX = $(NAMEPREFIX)stub
-DOTVERSION = 8.3
-VERSION = 83
-
-BINROOT = .
-!IF "$(NODEBUG)" == "1"
-TMPDIRNAME = Release
-DBGX =
-!ELSE
-TMPDIRNAME = Debug
-DBGX = d
-!ENDIF
-TMPDIR = $(BINROOT)\$(TMPDIRNAME)
-OUTDIRNAME = $(TMPDIRNAME)
-OUTDIR = $(TMPDIR)
-
-TCLLIB = $(OUTDIR)\$(NAMEPREFIX)$(VERSION)$(DBGX).lib
-TCLDLLNAME = $(NAMEPREFIX)$(VERSION)$(DBGX).dll
-TCLDLL = $(OUTDIR)\$(TCLDLLNAME)
-
-TCLSTUBLIBNAME = $(STUBPREFIX)$(VERSION)$(DBGX).lib
-TCLSTUBLIB = $(OUTDIR)\$(TCLSTUBLIBNAME)
-
-TCLPLUGINLIB = $(OUTDIR)\$(NAMEPREFIX)$(VERSION)p$(DBGX).lib
-TCLPLUGINDLLNAME= $(NAMEPREFIX)$(VERSION)p$(DBGX).dll
-TCLPLUGINDLL = $(OUTDIR)\$(TCLPLUGINDLLNAME)
-TCLSH = $(OUTDIR)\$(NAMEPREFIX)sh$(VERSION)$(DBGX).exe
-TCLSHP = $(OUTDIR)\$(NAMEPREFIX)shp$(VERSION)$(DBGX).exe
-TCLPIPEDLLNAME = $(NAMEPREFIX)pip$(VERSION)$(DBGX).dll
-TCLPIPEDLL = $(OUTDIR)\$(TCLPIPEDLLNAME)
-TCLREGDLLNAME = $(NAMEPREFIX)reg$(VERSION)$(DBGX).dll
-TCLREGDLL = $(OUTDIR)\$(TCLREGDLLNAME)
-TCLDDEDLLNAME = $(NAMEPREFIX)dde$(VERSION)$(DBGX).dll
-TCLDDEDLL = $(OUTDIR)\$(TCLDDEDLLNAME)
-TCLTEST = $(OUTDIR)\$(NAMEPREFIX)test.exe
-CAT32 = $(TMPDIR)\cat32.exe
-RMDIR = .\rmd.bat
-MKDIR = .\mkd.bat
-RM = del
-
-LIB_INSTALL_DIR = $(INSTALLDIR)\lib
-BIN_INSTALL_DIR = $(INSTALLDIR)\bin
-SCRIPT_INSTALL_DIR = $(INSTALLDIR)\lib\tcl$(DOTVERSION)
-INCLUDE_INSTALL_DIR = $(INSTALLDIR)\include
-
-TCLSHOBJS = \
- $(TMPDIR)\tclAppInit.obj
-
-TCLTESTOBJS = \
- $(TMPDIR)\tclTest.obj \
- $(TMPDIR)\tclTestObj.obj \
- $(TMPDIR)\tclTestProcBodyObj.obj \
- $(TMPDIR)\tclThreadTest.obj \
- $(TMPDIR)\tclWinTest.obj \
- $(TMPDIR)\testMain.obj
-
-TCLOBJS = \
- $(TMPDIR)\regcomp.obj \
- $(TMPDIR)\regexec.obj \
- $(TMPDIR)\regfree.obj \
- $(TMPDIR)\regerror.obj \
- $(TMPDIR)\strftime.obj \
- $(TMPDIR)\tclAlloc.obj \
- $(TMPDIR)\tclAsync.obj \
- $(TMPDIR)\tclBasic.obj \
- $(TMPDIR)\tclBinary.obj \
- $(TMPDIR)\tclCkalloc.obj \
- $(TMPDIR)\tclClock.obj \
- $(TMPDIR)\tclCmdAH.obj \
- $(TMPDIR)\tclCmdIL.obj \
- $(TMPDIR)\tclCmdMZ.obj \
- $(TMPDIR)\tclCompCmds.obj \
- $(TMPDIR)\tclCompExpr.obj \
- $(TMPDIR)\tclCompile.obj \
- $(TMPDIR)\tclDate.obj \
- $(TMPDIR)\tclEncoding.obj \
- $(TMPDIR)\tclEnv.obj \
- $(TMPDIR)\tclEvent.obj \
- $(TMPDIR)\tclExecute.obj \
- $(TMPDIR)\tclFCmd.obj \
- $(TMPDIR)\tclFileName.obj \
- $(TMPDIR)\tclGet.obj \
- $(TMPDIR)\tclHash.obj \
- $(TMPDIR)\tclHistory.obj \
- $(TMPDIR)\tclIndexObj.obj \
- $(TMPDIR)\tclInterp.obj \
- $(TMPDIR)\tclIO.obj \
- $(TMPDIR)\tclIOCmd.obj \
- $(TMPDIR)\tclIOGT.obj \
- $(TMPDIR)\tclIOSock.obj \
- $(TMPDIR)\tclIOUtil.obj \
- $(TMPDIR)\tclLink.obj \
- $(TMPDIR)\tclLiteral.obj \
- $(TMPDIR)\tclListObj.obj \
- $(TMPDIR)\tclLoad.obj \
- $(TMPDIR)\tclMain.obj \
- $(TMPDIR)\tclNamesp.obj \
- $(TMPDIR)\tclNotify.obj \
- $(TMPDIR)\tclObj.obj \
- $(TMPDIR)\tclPanic.obj \
- $(TMPDIR)\tclParse.obj \
- $(TMPDIR)\tclParseExpr.obj \
- $(TMPDIR)\tclPipe.obj \
- $(TMPDIR)\tclPkg.obj \
- $(TMPDIR)\tclPosixStr.obj \
- $(TMPDIR)\tclPreserve.obj \
- $(TMPDIR)\tclProc.obj \
- $(TMPDIR)\tclRegexp.obj \
- $(TMPDIR)\tclResolve.obj \
- $(TMPDIR)\tclResult.obj \
- $(TMPDIR)\tclScan.obj \
- $(TMPDIR)\tclStringObj.obj \
- $(TMPDIR)\tclStubInit.obj \
- $(TMPDIR)\tclStubLib.obj \
- $(TMPDIR)\tclThread.obj \
- $(TMPDIR)\tclTimer.obj \
- $(TMPDIR)\tclUtf.obj \
- $(TMPDIR)\tclUtil.obj \
- $(TMPDIR)\tclVar.obj \
- $(TMPDIR)\tclWin32Dll.obj \
- $(TMPDIR)\tclWinChan.obj \
- $(TMPDIR)\tclWinConsole.obj \
- $(TMPDIR)\tclWinSerial.obj \
- $(TMPDIR)\tclWinError.obj \
- $(TMPDIR)\tclWinFCmd.obj \
- $(TMPDIR)\tclWinFile.obj \
- $(TMPDIR)\tclWinInit.obj \
- $(TMPDIR)\tclWinLoad.obj \
- $(TMPDIR)\tclWinMtherr.obj \
- $(TMPDIR)\tclWinNotify.obj \
- $(TMPDIR)\tclWinPipe.obj \
- $(TMPDIR)\tclWinSock.obj \
- $(TMPDIR)\tclWinThrd.obj \
- $(TMPDIR)\tclWinTime.obj
-
-TCLSTUBOBJS = $(TMPDIR)\tclStubLib.obj \
-
-cc32 = "$(TOOLS32)\bin\cl.exe"
-link32 = "$(TOOLS32)\bin\link.exe"
-rc32 = "$(TOOLS32_rc)\bin\rc.exe"
-include32 = -I"$(TOOLS32)\include"
-libpath32 = /LIBPATH:"$(TOOLS32)\lib"
-lib32 = "$(TOOLS32)\bin\lib.exe"
-
-WINDIR = $(ROOT)\win
-GENERICDIR = $(ROOT)\generic
-
-TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)"
-TCL_DEFINES = $(DEBUGDEFINES) $(THREADDEFINES)
-
-######################################################################
-# Compile flags
-######################################################################
-
-!IF "$(NODEBUG)" == "1"
-# This cranks the optimization level to maximize speed
-cdebug = -O2 -Gs -GD
-!ELSE
-!IF "$(MACHINE)" == "IA64"
-cdebug = -Od -Zi
-!ELSE
-cdebug = -Z7 -Od -WX
-!ENDIF
-!ENDIF
-
-# declarations common to all compiler options
-cflags = -c -W3 -nologo -Fp$(TMPDIR)\ -YX
-cvarsdll = -MD$(DBGX)
-
-TCL_CFLAGS = $(cdebug) $(cflags) $(cvarsdll) $(include32) \
- $(TCL_INCLUDES) $(TCL_DEFINES)
-CON_CFLAGS = $(cdebug) $(cflags) $(include32) -DCONSOLE
-
-######################################################################
-# Link flags
-######################################################################
-
-!IF "$(NODEBUG)" == "1"
-ldebug = /RELEASE
-!ELSE
-ldebug = -debug:full -debugtype:cv
-!ENDIF
-
-# declarations common to all linker options
-lflags = /NODEFAULTLIB /NOLOGO /MACHINE:$(MACHINE) $(libpath32)
-
-# declarations for use on Intel i386, i486, and Pentium systems
-!IF "$(MACHINE)" == "IX86"
-DLLENTRY = @12
-dlllflags = $(lflags) -entry:_DllMainCRTStartup$(DLLENTRY) -dll
-!ELSE
-!IF "$(MACHINE)" == "IA64"
-DLLENTRY = @12
-dlllflags = $(lflags) -dll
-!ELSE
-dlllflags = $(lflags) -entry:_DllMainCRTStartup$(DLLENTRY) -dll
-!ENDIF
-!ENDIF
-
-conlflags = $(lflags) -subsystem:console -entry:mainCRTStartup
-guilflags = $(lflags) -subsystem:windows -entry:WinMainCRTStartup
-
-!IF "$(MACHINE)" == "PPC"
-libc = libc$(DBGX).lib
-libcdll = crtdll$(DBGX).lib
-!ELSE
-libc = libc$(DBGX).lib oldnames.lib
-libcdll = msvcrt$(DBGX).lib oldnames.lib
-!ENDIF
-
-baselibs = kernel32.lib $(optlibs) advapi32.lib user32.lib
-winlibs = $(baselibs) gdi32.lib comdlg32.lib winspool.lib
-
-guilibs = $(libc) $(winlibs)
-conlibs = $(libc) $(baselibs)
-guilibsdll = $(libcdll) $(winlibs)
-conlibsdll = $(libcdll) $(baselibs)
-
-######################################################################
-# Project specific targets
-######################################################################
-
-release: setup $(TCLSH) dlls
-dlls: setup $(TCLPIPEDLL) $(TCLREGDLL) $(TCLDDEDLL)
-all: setup $(TCLSH) dlls $(CAT32)
-tcltest: setup $(TCLTEST) dlls $(CAT32)
-plugin: setup $(TCLPLUGINDLL) $(TCLSHP)
-install: install-binaries install-libraries
-test: setup $(TCLTEST) dlls $(CAT32)
- set TCL_LIBRARY=$(ROOT)/library
- $(TCLTEST) $(ROOT)/tests/all.tcl
-
-setup:
- @$(MKDIR) $(TMPDIR)
- @$(MKDIR) $(OUTDIR)
-
-$(TCLLIB): $(TCLDLL)
-
-$(TCLDLL): $(TCLOBJS) $(TMPDIR)\tcl.res
- $(link32) $(ldebug) $(dlllflags) \
- -out:$@ $(TMPDIR)\tcl.res $(guilibsdll) @<<
-$(TCLOBJS)
-<<
-
-$(TCLSTUBLIB): $(TCLSTUBOBJS)
- $(lib32) /out:$@ $(TCLSTUBOBJS)
-
-$(TCLPLUGINLIB): $(TCLPLUGINDLL)
-
-$(TCLPLUGINDLL): $(TCLOBJS) $(TMPDIR)\tcl.res
- $(link32) $(ldebug) $(dlllflags) \
- -out:$@ $(TMPDIR)\tcl.res $(guilibsdll) @<<
-$(TCLOBJS)
-<<
-
-$(TCLSH): $(TCLSHOBJS) $(TCLLIB) $(TMPDIR)\tclsh.res
- $(link32) $(ldebug) $(conlflags) $(TMPDIR)\tclsh.res -stack:2300000 \
- -out:$@ $(conlibsdll) $(TCLLIB) $(TCLSHOBJS)
-
-$(TCLSHP): $(TCLSHOBJS) $(TCLPLUGINLIB) $(TMPDIR)\tclsh.res
- $(link32) $(ldebug) $(conlflags) $(TMPDIR)\tclsh.res -stack:2300000 \
- -out:$@ $(conlibsdll) $(TCLPLUGINLIB) $(TCLSHOBJS)
-
-$(TCLTEST): $(TCLTESTOBJS) $(TCLLIB) $(TMPDIR)\tclsh.res
- $(link32) $(ldebug) $(conlflags) $(TMPDIR)\tclsh.res -stack:2300000 \
- -out:$@ $(conlibsdll) $(TCLLIB) $(TCLTESTOBJS)
-
-$(TCLPIPEDLL): $(WINDIR)\stub16.c
- $(cc32) $(CON_CFLAGS) -Fo$(TMPDIR)\ $(WINDIR)\stub16.c
- $(link32) $(ldebug) $(conlflags) -out:$@ $(TMPDIR)\stub16.obj $(guilibs)
-
-$(TCLDDEDLL): $(TMPDIR)\tclWinDde.obj $(TCLSTUBLIB)
- $(link32) $(ldebug) $(dlllflags) -out:$@ $(TMPDIR)\tclWinDde.obj \
- $(conlibsdll) $(TCLSTUBLIB)
-
-$(TCLREGDLL): $(TMPDIR)\tclWinReg.obj $(TCLSTUBLIB)
- $(link32) $(ldebug) $(dlllflags) -out:$@ $(TMPDIR)\tclWinReg.obj \
- $(conlibsdll) $(TCLSTUBLIB)
-
-$(CAT32): $(WINDIR)\cat.c
- $(cc32) $(CON_CFLAGS) -Fo$(TMPDIR)\ $?
- $(link32) $(conlflags) -out:$@ -stack:16384 $(TMPDIR)\cat.obj $(conlibs)
-
-install-binaries: $(TCLSH)
- $(MKDIR) "$(BIN_INSTALL_DIR)"
- $(MKDIR) "$(LIB_INSTALL_DIR)"
- @echo installing $(TCLDLLNAME)
- @copy "$(TCLDLL)" "$(BIN_INSTALL_DIR)"
- @copy "$(TCLLIB)" "$(LIB_INSTALL_DIR)"
- @echo installing "$(TCLSH)"
- @copy "$(TCLSH)" "$(BIN_INSTALL_DIR)"
- @echo installing $(TCLPIPEDLLNAME)
- @copy "$(TCLPIPEDLL)" "$(BIN_INSTALL_DIR)"
- @echo installing $(TCLSTUBLIBNAME)
- @copy "$(TCLSTUBLIB)" "$(LIB_INSTALL_DIR)"
-
-install-libraries:
- -@$(MKDIR) "$(LIB_INSTALL_DIR)"
- -@$(MKDIR) "$(INCLUDE_INSTALL_DIR)"
- -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)"
- @echo installing http1.0
- -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\http1.0"
- -@copy "$(ROOT)\library\http1.0\http.tcl" "$(SCRIPT_INSTALL_DIR)\http1.0"
- -@copy "$(ROOT)\library\http1.0\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http1.0"
- @echo installing http2.3
- -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\http2.3"
- -@copy "$(ROOT)\library\http2.3\http.tcl" "$(SCRIPT_INSTALL_DIR)\http2.3"
- -@copy "$(ROOT)\library\http2.3\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http2.3"
- @echo installing opt0.4
- -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\opt0.4"
- -@copy "$(ROOT)\library\opt0.4\optparse.tcl" "$(SCRIPT_INSTALL_DIR)\opt0.4"
- -@copy "$(ROOT)\library\opt0.4\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\opt0.4"
- @echo installing msgcat1.0
- -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\msgcat1.0"
- -@copy "$(ROOT)\library\msgcat1.0\msgcat.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.0"
- -@copy "$(ROOT)\library\msgcat1.0\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.0"
- @echo installing $(TCLDDEDLLNAME)
- -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\dde1.1"
- -@copy "$(TCLDDEDLL)" "$(SCRIPT_INSTALL_DIR)\dde1.1"
- -@copy "$(ROOT)\library\dde1.1\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\dde1.1"
- @echo installing $(TCLREGDLLNAME)
- -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\reg1.0"
- -@copy "$(TCLREGDLL)" "$(SCRIPT_INSTALL_DIR)\reg1.0"
- -@copy "$(ROOT)\library\reg1.0\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\reg1.0"
- @echo installing encoding files
- -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\encoding"
- -@copy "$(ROOT)\library\encoding\*.enc" "$(SCRIPT_INSTALL_DIR)\encoding"
- @echo installing library files
- -@copy "$(GENERICDIR)\tcl.h" "$(INCLUDE_INSTALL_DIR)"
- -@copy "$(GENERICDIR)\tclDecls.h" "$(INCLUDE_INSTALL_DIR)"
- -@copy "$(ROOT)\library\history.tcl" "$(SCRIPT_INSTALL_DIR)"
- -@copy "$(ROOT)\library\init.tcl" "$(SCRIPT_INSTALL_DIR)"
- -@copy "$(ROOT)\library\ldAout.tcl" "$(SCRIPT_INSTALL_DIR)"
- -@copy "$(ROOT)\library\parray.tcl" "$(SCRIPT_INSTALL_DIR)"
- -@copy "$(ROOT)\library\safe.tcl" "$(SCRIPT_INSTALL_DIR)"
- -@copy "$(ROOT)\library\tclIndex" "$(SCRIPT_INSTALL_DIR)"
- -@copy "$(ROOT)\library\package.tcl" "$(SCRIPT_INSTALL_DIR)"
- -@copy "$(ROOT)\library\word.tcl" "$(SCRIPT_INSTALL_DIR)"
- -@copy "$(ROOT)\library\auto.tcl" "$(SCRIPT_INSTALL_DIR)"
-
-#
-# Regenerate the stubs files.
-#
-
-genstubs:
- tclsh$(VERSION) $(ROOT)\tools\genStubs.tcl $(GENERICDIR) \
- $(GENERICDIR)\tcl.decls $(GENERICDIR)\tclInt.decls
-
-#
-# Regenerate the windows help files.
-#
-
-TCLTOOLS = $(ROOT)/tools
-MAN2TCL = $(TCLTOOLS)/man2tcl
-TCLRTF = $(TCLTOOLS)/tcl.rtf
-TCLHPJ = $(TCLTOOLS)/tcl.hpj
-MAN2HELP = $(TCLTOOLS)/man2help.tcl
-HCRTF = $(TOOLS32)/bin/hcrtf.exe
-
-winhelp: $(TCLRTF)
- cd $(TCLTOOLS)
- start /wait $(HCRTF) -xn $(TCLHPJ)
-
-$(MAN2TCL).exe: $(MAN2TCL).obj
- cd $(TCLTOOLS)
- $(cc32) /nologo /G4 /ML /O2 $(MAN2TCL).c
-
-$(TCLRTF): $(MAN2TCL).exe $(TCLSH)
- cd $(TCLTOOLS)
- ..\win\$(TCLSH) $(MAN2HELP) $(NAMEPREFIX) $(VERSION) $(ROOT)/doc ../../tk$(DOTVERSION)/doc
-
-#
-# Special case object file targets
-#
-
-$(TMPDIR)\tclWinInit.obj: $(WINDIR)\tclWinInit.c
- $(cc32) -DBUILD_tcl $(TCL_CFLAGS) $(EXTFLAGS) -Fo$(TMPDIR)\ $?
-
-$(TMPDIR)\testMain.obj: $(WINDIR)\tclAppInit.c
- $(cc32) $(TCL_CFLAGS) -DTCL_TEST -Fo$(TMPDIR)\testMain.obj $?
-
-$(TMPDIR)\tclTest.obj: $(GENERICDIR)\tclTest.c
- $(cc32) $(TCL_CFLAGS) -Fo$@ $?
-
-$(TMPDIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c
- $(cc32) $(TCL_CFLAGS) -Fo$@ $?
-
-$(TMPDIR)\tclWinTest.obj: $(WINDIR)\tclWinTest.c
- $(cc32) $(TCL_CFLAGS) -Fo$@ $?
-
-$(TMPDIR)\tclAppInit.obj : $(WINDIR)\tclAppInit.c
- $(cc32) $(TCL_CFLAGS) -Fo$@ $?
-
-# The following objects should be built using the stub interfaces
-
-$(TMPDIR)\tclWinReg.obj : $(WINDIR)\tclWinReg.c
- $(cc32) $(TCL_CFLAGS) -DUSE_TCL_STUBS -Fo$@ $?
-
-$(TMPDIR)\tclWinDde.obj : $(WINDIR)\tclWinDde.c
- $(cc32) $(TCL_CFLAGS) -DUSE_TCL_STUBS -Fo$@ $?
-
-# The following objects are part of the stub library and should not
-# be built as DLL objects but none of the symbols should be exported
-
-$(TMPDIR)\tclStubLib.obj : $(GENERICDIR)\tclStubLib.c
- $(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -Fo$@ $?
-
-
-# Dedependency rules
-
-$(GENERICDIR)\regcomp.c: \
- $(GENERICDIR)\regguts.h \
- $(GENERICDIR)\regc_lex.c \
- $(GENERICDIR)\regc_color.c \
- $(GENERICDIR)\regc_nfa.c \
- $(GENERICDIR)\regc_cvec.c \
- $(GENERICDIR)\regc_locale.c
-$(GENERICDIR)\regcustom.h: \
- $(GENERICDIR)\tclInt.h \
- $(GENERICDIR)\tclPort.h \
- $(GENERICDIR)\regex.h
-$(GENERICDIR)\regexec.c: \
- $(GENERICDIR)\rege_dfa.c \
- $(GENERICDIR)\regguts.h
-$(GENERICDIR)\regerror.c: $(GENERICDIR)\regguts.h
-$(GENERICDIR)\regfree.c: $(GENERICDIR)\regguts.h
-$(GENERICDIR)\regfronts.c: $(GENERICDIR)\regguts.h
-$(GENERICDIR)\regguts.h: $(GENERICDIR)\regcustom.h
-
-#
-# Implicit rules
-#
-
-{$(WINDIR)}.c{$(TMPDIR)}.obj:
- $(cc32) -DBUILD_tcl $(TCL_CFLAGS) -Fo$(TMPDIR)\ $<
-
-{$(GENERICDIR)}.c{$(TMPDIR)}.obj:
- $(cc32) -DBUILD_tcl $(TCL_CFLAGS) -Fo$(TMPDIR)\ $<
-
-{$(ROOT)\compat}.c{$(TMPDIR)}.obj:
- $(cc32) -DBUILD_tcl $(TCL_CFLAGS) -Fo$(TMPDIR)\ $<
-
-{$(WINDIR)}.rc{$(TMPDIR)}.res:
- $(rc32) -fo $@ -r -i $(GENERICDIR) -i $(WINDIR) -D__WIN32__ \
- $(TCL_DEFINES) $<
-
-clean:
- -@$(RM) $(OUTDIR)\*.exp
- -@$(RM) $(OUTDIR)\*.lib
- -@$(RM) $(OUTDIR)\*.dll
- -@$(RM) $(OUTDIR)\*.exe
- -@$(RM) $(OUTDIR)\*.pdb
- -@$(RM) $(TMPDIR)\*.pch
- -@$(RM) $(TMPDIR)\*.obj
- -@$(RM) $(TMPDIR)\*.res
- -@$(RM) $(TMPDIR)\*.exe
- -@$(RMDIR) $(OUTDIR)
- -@$(RMDIR) $(TMPDIR)
-
-
-
+#------------------------------------------------------------------------------
+# makefile.vc --
+#
+# Microsoft Visual C++ makefile for use with nmake.exe v1.62+ (VC++ 5.0+)
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# Copyright (c) 1995-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-2000 Ajuba Solutions.
+# Copyright (c) 2001 ActiveState Corporation.
+# Copyright (c) 2001-2002 David Gravereaux.
+#
+#------------------------------------------------------------------------------
+# RCS: @(#) $Id$
+#------------------------------------------------------------------------------
+
+!if "$(MSVCDIR)" == ""
+MSG = ^
+You'll need to run vcvars32.bat from Developer Studio, first, to setup^
+the environment. Jump to this line to read the new instructions.
+!error $(MSG)
+!endif
+
+#------------------------------------------------------------------------------
+# HOW TO USE this makefile:
+#
+# 1) It is now necessary to have MSVCDir set in the environment. This is used
+# as a check to see if vcvars32.bat had been run prior to running nmake or
+# during the installation of Microsoft Visual C++, MSVCDir had been set
+# globally and the PATH adjusted. Either way is valid.
+#
+# You'll need to run vcvars32.bat contained in the MsDev's vc(98)/bin
+# directory to setup the proper environment, if needed, for your current
+# setup. This is a needed bootstrap requirement and allows the swapping of
+# different environments to be easier.
+#
+# 2) To use the Platform SDK (not expressly needed), run setenv.bat after
+# vcvars32.bat according to the instructions for it. This can also turn on
+# the 64-bit compiler, if your SDK has it.
+#
+# 3) Targets are:
+# release -- Builds the core, the shell and the dlls. (default)
+# dlls -- Just builds the windows extensions and the 16-bit DOS
+# pipe/thunk helper app.
+# shell -- Just builds the shell and the core.
+# core -- Only builds the core [tclXX.(dll|lib)].
+# all -- Builds everything.
+# test -- Builds and runs the test suite.
+# tcltest -- Just builds the test shell.
+# install -- Installs the built binaries and libraries to $(INSTALLDIR)
+# as the root of the install tree.
+# tidy/clean/hose -- varying levels of cleaning.
+# genstubs -- Rebuilds the Stubs table and support files (dev only).
+# depend -- Generates an accurate set of source dependancies for this
+# makefile. Helpful to avoid problems when the sources are
+# refreshed and you rebuild, but can "overbuild" when common
+# headers like tclInt.h just get small changes.
+# winhelp -- Builds the windows .hlp file for Tcl from the troff man
+# files found in $(ROOT)\doc .
+#
+# 4) Macros usable on the commandline:
+# INSTALLDIR=<path>
+# Sets where to install Tcl from the built binaries.
+# C:\Progra~1\Tcl is assumed when not specified.
+#
+# OPTS=static,msvcrt,linkexten,threads,symbols,profile,loimpact,none
+# Sets special options for the core. The default is for none.
+# Any combination of the above may be used (comma separated).
+# 'none' will over-ride everything to nothing.
+#
+# static = Builds a static library of the core instead of a
+# dll. The shell will be static (and large), as well.
+# msvcrt = Effects the static option only to switch it from
+# using libcmt(d) as the C runtime [by default] to
+# msvcrt(d). This is useful for static embedding
+# support.
+# linkexten = Effects the static option only to switch
+# tclshXX.exe to have the dde and reg extension linked
+# inside it.
+# threads = Turns on full multithreading support.
+# symbols = Adds symbols for step debugging.
+# profile = Adds profiling hooks. Map file is assumed.
+# loimpact = Adds a flag for how NT treats the heap to keep memory
+# in use, low. This is said to impact alloc performance.
+#
+# STATS=memdbg,compdbg,none
+# Sets optional memory and bytecode compiler debugging code added
+# to the core. The default is for none. Any combination of the
+# above may be used (comma separated). 'none' will over-ride
+# everything to nothing.
+#
+# memdbg = Enables the debugging memory allocator.
+# compdbg = Enables byte compilation logging.
+#
+# MACHINE=(IX86|IA64|ALPHA)
+# Set the machine type used for the compiler, linker, and
+# resource compiler. This hook is needed to tell the tools
+# when alternate platforms are requested. IX86 is the default
+# when not specified.
+#
+# TMP_DIR=<path>
+# OUT_DIR=<path>
+# Hooks to allow the intermediate and output directories to be
+# changed. $(OUT_DIR) is assumed to be
+# $(BINROOT)\(Release|Debug) based on if symbols are requested.
+# $(TMP_DIR) will de $(OUT_DIR)\<buildtype> by default.
+#
+# TESTPAT=<file>
+# Reads the tests requested to be run from this file.
+#
+# 5) Examples:
+#
+# Basic syntax of calling nmake looks like this:
+# nmake [-nologo] -f makefile.vc [target|macrodef [target|macrodef] [...]]
+#
+# Standard (no frills)
+# c:\tcl_src\win\>c:\progra~1\micros~1\vc98\bin\vcvars32.bat
+# Setting environment for using Microsoft Visual C++ tools.
+# c:\tcl_src\win\>nmake -f makefile.vc release
+# c:\tcl_src\win\>nmake -f makefile.vc install INSTALLDIR=c:\progra~1\tcl
+#
+# Building for Win64
+# c:\tcl_src\win\>c:\progra~1\micros~1\vc98\bin\vcvars32.bat
+# Setting environment for using Microsoft Visual C++ tools.
+# c:\tcl_src\win\>c:\progra~1\platfo~1\setenv.bat /pre64 /RETAIL
+# Targeting Windows pre64 RETAIL
+# c:\tcl_src\win\>nmake -f makefile.vc MACHINE=IA64
+#
+#------------------------------------------------------------------------------
+#==============================================================================
+###############################################################################
+
+
+# //==================================================================\\
+# >>[ -> Do not modify below this line. <- ]<<
+# >>[ Please, use the commandline macros to modify how Tcl is built. ]<<
+# >>[ If you need more features, send us a patch for more macros. ]<<
+# \\==================================================================//
+
+
+###############################################################################
+#==============================================================================
+#------------------------------------------------------------------------------
+
+!if !exist("makefile.vc")
+MSG = ^
+You must run this makefile only from the directory it is in.^
+Please `cd` to its location first.
+!error $(MSG)
+!endif
+
+PROJECT = tcl
+!include "rules.vc"
+
+STUBPREFIX = $(PROJECT)stub
+DOTVERSION = 8.4
+VERSION = $(DOTVERSION:.=)
+
+DDEDOTVERSION = 1.2
+DDEVERSION = $(DDEDOTVERSION:.=)
+
+REGDOTVERSION = 1.0
+REGVERSION = $(REGDOTVERSION:.=)
+
+BINROOT = .
+ROOT = ..
+
+TCLIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
+TCLLIBNAME = $(PROJECT)$(VERSION)$(SUFX).$(EXT)
+TCLLIB = $(OUT_DIR)\$(TCLLIBNAME)
+
+TCLSTUBLIBNAME = $(STUBPREFIX)$(VERSION).lib
+TCLSTUBLIB = $(OUT_DIR)\$(TCLSTUBLIBNAME)
+
+TCLSHNAME = $(PROJECT)sh$(VERSION)$(SUFX).exe
+TCLSH = $(OUT_DIR)\$(TCLSHNAME)
+TCLPIPEDLLNAME = $(PROJECT)pip$(VERSION).dll
+TCLPIPEDLL = $(OUT_DIR)\$(TCLPIPEDLLNAME)
+
+TCLREGLIBNAME = $(PROJECT)reg$(REGVERSION)$(SUFX:t=).$(EXT)
+TCLREGLIB = $(OUT_DIR)\$(TCLREGLIBNAME)
+
+TCLDDELIBNAME = $(PROJECT)dde$(DDEVERSION)$(SUFX:t=).$(EXT)
+TCLDDELIB = $(OUT_DIR)\$(TCLDDELIBNAME)
+
+TCLTEST = $(OUT_DIR)\$(PROJECT)test.exe
+CAT32 = $(OUT_DIR)\cat32.exe
+
+### Make sure we use backslash only.
+_INSTALLDIR = $(INSTALLDIR:/=\)
+LIB_INSTALL_DIR = $(_INSTALLDIR)\lib
+BIN_INSTALL_DIR = $(_INSTALLDIR)\bin
+DOC_INSTALL_DIR = $(_INSTALLDIR)\doc
+SCRIPT_INSTALL_DIR = $(_INSTALLDIR)\lib\tcl$(DOTVERSION)
+INCLUDE_INSTALL_DIR = $(_INSTALLDIR)\include
+
+TCLSHOBJS = \
+ $(TMP_DIR)\tclAppInit.obj \
+!if $(TCL_LINKWITHEXTENSIONS)
+ $(TMP_DIR)\tclWinReg.obj \
+ $(TMP_DIR)\tclWinDde.obj \
+!endif
+ $(TMP_DIR)\tclsh.res
+
+TCLTESTOBJS = \
+ $(TMP_DIR)\tclTest.obj \
+ $(TMP_DIR)\tclTestObj.obj \
+ $(TMP_DIR)\tclTestProcBodyObj.obj \
+ $(TMP_DIR)\tclThreadTest.obj \
+ $(TMP_DIR)\tclWinTest.obj \
+!if $(TCL_LINKWITHEXTENSIONS)
+ $(TMP_DIR)\tclWinReg.obj \
+ $(TMP_DIR)\tclWinDde.obj \
+!endif
+ $(TMP_DIR)\testMain.obj
+
+TCLOBJS = \
+ $(TMP_DIR)\regcomp.obj \
+ $(TMP_DIR)\regexec.obj \
+ $(TMP_DIR)\regfree.obj \
+ $(TMP_DIR)\regerror.obj \
+ $(TMP_DIR)\strftime.obj \
+ $(TMP_DIR)\strtoll.obj \
+ $(TMP_DIR)\strtoull.obj \
+ $(TMP_DIR)\tclAlloc.obj \
+ $(TMP_DIR)\tclAsync.obj \
+ $(TMP_DIR)\tclBasic.obj \
+ $(TMP_DIR)\tclBinary.obj \
+ $(TMP_DIR)\tclCkalloc.obj \
+ $(TMP_DIR)\tclClock.obj \
+ $(TMP_DIR)\tclCmdAH.obj \
+ $(TMP_DIR)\tclCmdIL.obj \
+ $(TMP_DIR)\tclCmdMZ.obj \
+ $(TMP_DIR)\tclCompCmds.obj \
+ $(TMP_DIR)\tclCompExpr.obj \
+ $(TMP_DIR)\tclCompile.obj \
+ $(TMP_DIR)\tclDate.obj \
+ $(TMP_DIR)\tclEncoding.obj \
+ $(TMP_DIR)\tclEnv.obj \
+ $(TMP_DIR)\tclEvent.obj \
+ $(TMP_DIR)\tclExecute.obj \
+ $(TMP_DIR)\tclFCmd.obj \
+ $(TMP_DIR)\tclFileName.obj \
+ $(TMP_DIR)\tclGet.obj \
+ $(TMP_DIR)\tclHash.obj \
+ $(TMP_DIR)\tclHistory.obj \
+ $(TMP_DIR)\tclIndexObj.obj \
+ $(TMP_DIR)\tclInterp.obj \
+ $(TMP_DIR)\tclIO.obj \
+ $(TMP_DIR)\tclIOCmd.obj \
+ $(TMP_DIR)\tclIOGT.obj \
+ $(TMP_DIR)\tclIOSock.obj \
+ $(TMP_DIR)\tclIOUtil.obj \
+ $(TMP_DIR)\tclLink.obj \
+ $(TMP_DIR)\tclLiteral.obj \
+ $(TMP_DIR)\tclListObj.obj \
+ $(TMP_DIR)\tclLoad.obj \
+ $(TMP_DIR)\tclMain.obj \
+ $(TMP_DIR)\tclNamesp.obj \
+ $(TMP_DIR)\tclNotify.obj \
+ $(TMP_DIR)\tclObj.obj \
+ $(TMP_DIR)\tclPanic.obj \
+ $(TMP_DIR)\tclParse.obj \
+ $(TMP_DIR)\tclParseExpr.obj \
+ $(TMP_DIR)\tclPipe.obj \
+ $(TMP_DIR)\tclPkg.obj \
+ $(TMP_DIR)\tclPosixStr.obj \
+ $(TMP_DIR)\tclPreserve.obj \
+ $(TMP_DIR)\tclProc.obj \
+ $(TMP_DIR)\tclRegexp.obj \
+ $(TMP_DIR)\tclResolve.obj \
+ $(TMP_DIR)\tclResult.obj \
+ $(TMP_DIR)\tclScan.obj \
+ $(TMP_DIR)\tclStringObj.obj \
+ $(TMP_DIR)\tclStubInit.obj \
+ $(TMP_DIR)\tclStubLib.obj \
+ $(TMP_DIR)\tclThread.obj \
+ $(TMP_DIR)\tclThreadJoin.obj \
+ $(TMP_DIR)\tclTimer.obj \
+ $(TMP_DIR)\tclUtf.obj \
+ $(TMP_DIR)\tclUtil.obj \
+ $(TMP_DIR)\tclVar.obj \
+ $(TMP_DIR)\tclWin32Dll.obj \
+ $(TMP_DIR)\tclWinChan.obj \
+ $(TMP_DIR)\tclWinConsole.obj \
+ $(TMP_DIR)\tclWinSerial.obj \
+ $(TMP_DIR)\tclWinError.obj \
+ $(TMP_DIR)\tclWinFCmd.obj \
+ $(TMP_DIR)\tclWinFile.obj \
+ $(TMP_DIR)\tclWinInit.obj \
+ $(TMP_DIR)\tclWinLoad.obj \
+ $(TMP_DIR)\tclWinMtherr.obj \
+ $(TMP_DIR)\tclWinNotify.obj \
+ $(TMP_DIR)\tclWinPipe.obj \
+ $(TMP_DIR)\tclWinSock.obj \
+ $(TMP_DIR)\tclWinThrd.obj \
+ $(TMP_DIR)\tclWinTime.obj \
+!if !$(STATIC_BUILD)
+ $(TMP_DIR)\tcl.res
+!endif
+
+TCLSTUBOBJS = $(TMP_DIR)\tclStubLib.obj
+
+### The following paths CANNOT have spaces in them.
+COMPATDIR = $(ROOT)\compat
+DOCDIR = $(ROOT)\doc
+GENERICDIR = $(ROOT)\generic
+TOOLSDIR = $(ROOT)\tools
+WINDIR = $(ROOT)\win
+
+
+#---------------------------------------------------------------------
+# Compile flags
+#---------------------------------------------------------------------
+
+!if !$(DEBUG)
+!if $(OPTIMIZING)
+### This cranks the optimization level to maximize speed
+cdebug = -O2 -Op -Gs
+!else
+cdebug =
+!endif
+!else if "$(MACHINE)" == "IA64"
+### Warnings are too many, can't support warnings into errors.
+cdebug = -Z7 -Od
+!else
+cdebug = -Z7 -WX -Od
+!endif
+
+### Declarations common to all compiler options
+cflags = -nologo -c -W3 -YX -Fp$(TMP_DIR)^\
+
+!if $(PENT_0F_ERRATA)
+cflags = $(cflags) -QI0f
+!endif
+
+!if $(ITAN_B_ERRATA)
+cflags = $(cflags) -QIA64_Bx
+!endif
+
+!if $(MSVCRT)
+crt = -MD$(DBGX)
+!else
+crt = -MT$(DBGX)
+!endif
+
+TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)"
+BASE_CLFAGS = $(cflags) $(cdebug) $(crt) $(TCL_INCLUDES)
+CON_CFLAGS = $(cflags) $(cdebug) $(crt) -DCONSOLE
+TCL_CFLAGS = $(BASE_CLFAGS) $(OPTDEFINES)
+
+
+#---------------------------------------------------------------------
+# Link flags
+#---------------------------------------------------------------------
+
+!if $(DEBUG)
+ldebug = -debug:full -debugtype:cv
+!else
+ldebug = -release -opt:ref -opt:icf,3
+!endif
+
+### Declarations common to all linker options
+lflags = -nologo -machine:$(MACHINE) $(ldebug)
+
+!if $(PROFILE)
+lflags = $(lflags) -profile
+!endif
+
+!if $(ALIGN98_HACK) && !$(STATIC_BUILD)
+### Align sections for PE size savings.
+lflags = $(lflags) -opt:nowin98
+!else if !$(ALIGN98_HACK) && $(STATIC_BUILD)
+### Align sections for speed in loading by choosing the virtual page size.
+lflags = $(lflags) -align:4096
+!endif
+
+!if $(LOIMPACT)
+lflags = $(lflags) -ws:aggressive
+!endif
+
+dlllflags = $(lflags) -dll
+conlflags = $(lflags) -subsystem:console
+guilflags = $(lflags) -subsystem:windows
+
+baselibs = kernel32.lib advapi32.lib user32.lib
+
+
+#---------------------------------------------------------------------
+# TclTest flags
+#---------------------------------------------------------------------
+
+!IF "$(TESTPAT)" != ""
+TESTFLAGS = -file $(TESTPAT)
+!ENDIF
+
+
+#---------------------------------------------------------------------
+# Project specific targets
+#---------------------------------------------------------------------
+
+release: setup $(TCLSH) $(TCLSTUBLIB) dlls
+core: setup $(TCLLIB) $(TCLSTUBLIB)
+shell: setup $(TCLSH)
+dlls: setup $(TCLPIPEDLL) $(TCLREGLIB) $(TCLDDELIB)
+all: setup $(TCLSH) $(TCLSTUBLIB) dlls $(CAT32)
+tcltest: setup $(TCLTEST) dlls $(CAT32)
+install: install-binaries install-libraries install-docs
+
+
+test: setup $(TCLTEST) dlls $(CAT32)
+ set TCL_LIBRARY=$(ROOT)/library
+!if "$(OS)" == "Windows_NT" || "$(MSVCDIR)" == "IDE"
+ $(TCLTEST) $(ROOT)/tests/all.tcl $(TESTFLAGS)
+!else
+ $(TCLTEST) $(ROOT)/tests/all.tcl $(TESTFLAGS) > tests.log
+ type tests.log | more
+!endif
+
+runtest: setup $(TCLTEST) dlls $(CAT32)
+ set TCL_LIBRARY=$(ROOT)/library
+ $(TCLTEST)
+
+setup:
+ @if not exist $(OUT_DIR)\nul mkdir $(OUT_DIR)
+ @if not exist $(TMP_DIR)\nul mkdir $(TMP_DIR)
+
+!if !$(STATIC_BUILD)
+$(TCLIMPLIB): $(TCLLIB)
+!endif
+
+$(TCLLIB): $(TCLOBJS)
+!if $(STATIC_BUILD)
+ $(lib32) -nologo -out:$@ @<<
+$**
+<<
+!else
+ $(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tcl -out:$@ \
+ $(baselibs) @<<
+$**
+<<
+ -@del $*.exp
+!endif
+
+$(TCLSTUBLIB): $(TCLSTUBOBJS)
+ $(lib32) -nologo -out:$@ $(TCLSTUBOBJS)
+
+$(TCLSH): $(TCLSHOBJS) $(TCLIMPLIB)
+ $(link32) $(conlflags) -stack:2300000 -out:$@ $(baselibs) $**
+
+$(TCLTEST): $(TCLTESTOBJS) $(TCLIMPLIB)
+ $(link32) $(conlflags) -stack:2300000 -out:$@ $(baselibs) $**
+
+$(TCLPIPEDLL): $(WINDIR)\stub16.c
+ $(cc32) $(CON_CFLAGS) -Fo$(TMP_DIR)\ $(WINDIR)\stub16.c
+ $(link32) $(conlflags) -out:$@ $(TMP_DIR)\stub16.obj $(baselibs)
+
+!if $(STATIC_BUILD)
+$(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj
+ $(lib32) -nologo -out:$@ $(TMP_DIR)\tclWinDde.obj
+!else
+$(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj $(TCLSTUBLIB)
+ $(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tcldde -out:$@ \
+ $** $(baselibs)
+ -@del $*.exp
+ -@del $*.lib
+!endif
+
+!if $(STATIC_BUILD)
+$(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj
+ $(lib32) -nologo -out:$@ $(TMP_DIR)\tclWinReg.obj
+!else
+$(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj $(TCLSTUBLIB)
+ $(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tclreg -out:$@ \
+ $** $(baselibs)
+ -@del $*.exp
+ -@del $*.lib
+!endif
+
+$(CAT32): $(WINDIR)\cat.c
+ $(cc32) $(CON_CFLAGS) -Fo$(TMP_DIR)\ $?
+ $(link32) $(conlflags) -out:$@ -stack:16384 $(TMP_DIR)\cat.obj \
+ $(baselibs)
+
+
+#---------------------------------------------------------------------
+# Regenerate the stubs files. [Development use only]
+#---------------------------------------------------------------------
+
+genstubs:
+!if !exist($(TCLSH))
+ @echo Build tclsh first!
+!else
+ $(TCLSH) $(TOOLSDIR:\=/)\genStubs.tcl $(GENERICDIR:\=/) \
+ $(GENERICDIR:\=/)/tcl.decls $(GENERICDIR:\=/)/tclInt.decls
+!endif
+
+
+#---------------------------------------------------------------------
+# Generate the makefile depedancies.
+#---------------------------------------------------------------------
+
+depend:
+!if !exist($(TCLSH))
+ @echo Build tclsh first!
+!else
+ $(TCLSH) $(TOOLSDIR:\=/)/mkdepend.tcl -vc32 -out:"$(OUT_DIR)\depend.mk" \
+ -passthru:"-DBUILD_tcl $(TCL_INCLUDES:"="")" $(GENERICDIR) \
+ $(COMPATDIR) $(WINDIR) @<<
+$(TCLOBJS)
+<<
+!endif
+
+
+#---------------------------------------------------------------------
+# Build the windows help file.
+#---------------------------------------------------------------------
+
+TCLHLPBASE = $(PROJECT)$(VERSION)
+HELPFILE = $(OUT_DIR)\$(TCLHLPBASE).hlp
+HELPCNT = $(OUT_DIR)\$(TCLHLPBASE).cnt
+DOCTMP_DIR = $(OUT_DIR)\$(PROJECT)_docs
+HELPRTF = $(DOCTMP_DIR)\$(PROJECT).rtf
+MAN2HELP = $(DOCTMP_DIR)\man2help.tcl
+MAN2HELP2 = $(DOCTMP_DIR)\man2help2.tcl
+INDEX = $(DOCTMP_DIR)\index.tcl
+BMP = $(DOCTMP_DIR)\feather.bmp
+BMP_NOPATH = feather.bmp
+MAN2TCL = $(DOCTMP_DIR)\man2tcl.exe
+
+winhelp: docsetup $(HELPFILE)
+
+docsetup:
+ @if not exist $(DOCTMP_DIR)\nul mkdir $(DOCTMP_DIR)
+
+$(MAN2HELP) $(MAN2HELP2) $(INDEX) $(BMP): $(TOOLSDIR)\$$(@F)
+ copy $(TOOLSDIR)\$(@F) $(@D)
+
+$(HELPFILE): $(HELPRTF) $(BMP)
+ cd $(DOCTMP_DIR)
+ start /wait hcrtf.exe -x <<$(PROJECT).hpj
+[OPTIONS]
+COMPRESS=12 Hall Zeck
+LCID=0x409 0x0 0x0 ; English (United States)
+TITLE=Tcl/Tk Reference Manual
+BMROOT=.
+CNT=$(@B).cnt
+HLP=$(@B).hlp
+
+[FILES]
+$(PROJECT).rtf
+
+[WINDOWS]
+main="Tcl/Tk Reference Manual",,27648,(r15263976),(r65535)
+
+[CONFIG]
+BrowseButtons()
+CreateButton(1, "Web", ExecFile("http://www.tcl.tk"))
+CreateButton(2, "SF", ExecFile("http://sf.net/projects/tcl"))
+CreateButton(3, "Wiki", ExecFile("http://wiki.tcl.tk"))
+CreateButton(4, "FAQ", ExecFile("http://www.purl.org/NET/Tcl-FAQ/"))
+<<
+ cd $(MAKEDIR)
+ copy "$(DOCTMP_DIR)\$(@B).hlp" "$(OUT_DIR)"
+ copy "$(DOCTMP_DIR)\$(@B).cnt" "$(OUT_DIR)"
+
+$(MAN2TCL): $(TOOLSDIR)\$$(@B).c
+ $(cc32) -nologo -G4 -ML -O2 -Fo$(@D)\ $(TOOLSDIR)\$(@B).c -link -out:$@
+
+$(HELPRTF): $(MAN2TCL) $(MAN2HELP) $(MAN2HELP2) $(INDEX) $(DOCDIR)\*
+ $(TCLSH) $(MAN2HELP:\=/) -bitmap $(BMP_NOPATH) $(PROJECT) $(VERSION) $(DOCDIR:\=/)
+
+install-docs:
+!if exist($(HELPFILE))
+ @xcopy /i /y "$(HELPFILE)" "$(DOC_INSTALL_DIR)\"
+ @xcopy /i /y "$(HELPCNT)" "$(DOC_INSTALL_DIR)\"
+!endif
+
+
+#---------------------------------------------------------------------
+# Special case object file targets
+#---------------------------------------------------------------------
+
+$(TMP_DIR)\testMain.obj: $(WINDIR)\tclAppInit.c
+!if $(TCL_LINKWITHEXTENSIONS)
+ $(cc32) $(TCL_CFLAGS) -DTCL_TEST -DTCL_LINKWITHEXTENSIONS -Fo$@ $?
+!else
+ $(cc32) $(TCL_CFLAGS) -DTCL_TEST -Fo$@ $?
+!endif
+
+$(TMP_DIR)\tclTest.obj: $(GENERICDIR)\tclTest.c
+ $(cc32) $(TCL_CFLAGS) -Fo$@ $?
+
+$(TMP_DIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c
+ $(cc32) $(TCL_CFLAGS) -Fo$@ $?
+
+$(TMP_DIR)\tclWinTest.obj: $(WINDIR)\tclWinTest.c
+ $(cc32) $(TCL_CFLAGS) -Fo$@ $?
+
+$(TMP_DIR)\tclAppInit.obj: $(WINDIR)\tclAppInit.c
+!if $(TCL_LINKWITHEXTENSIONS)
+ $(cc32) $(TCL_CFLAGS) -DTCL_LINKWITHEXTENSIONS -Fo$@ $?
+!else
+ $(cc32) $(TCL_CFLAGS) -Fo$@ $?
+!endif
+
+### The following objects should be built using the stub interfaces
+
+$(TMP_DIR)\tclWinReg.obj: $(WINDIR)\tclWinReg.c
+!if $(STATIC_BUILD)
+ $(cc32) $(BASE_CLFAGS) -DTCL_THREADS=1 -DSTATIC_BUILD -Fo$@ $?
+!else
+ $(cc32) $(BASE_CLFAGS) -DTCL_THREADS=1 -DUSE_TCL_STUBS -Fo$@ $?
+!endif
+
+
+$(TMP_DIR)\tclWinDde.obj: $(WINDIR)\tclWinDde.c
+!if $(STATIC_BUILD)
+ $(cc32) $(BASE_CLFAGS) -DTCL_THREADS=1 -DSTATIC_BUILD -Fo$@ $?
+!else
+ $(cc32) $(BASE_CLFAGS) -DTCL_THREADS=1 -DUSE_TCL_STUBS -Fo$@ $?
+!endif
+
+
+### The following objects are part of the stub library and should not
+### be built as DLL objects but none of the symbols should be exported
+
+$(TMP_DIR)\tclStubLib.obj: $(GENERICDIR)\tclStubLib.c
+ $(cc32) $(cdebug) $(cflags) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $?
+
+
+#---------------------------------------------------------------------
+# Dedependency rules
+#---------------------------------------------------------------------
+
+$(GENERICDIR)\regcomp.c: \
+ $(GENERICDIR)\regguts.h \
+ $(GENERICDIR)\regc_lex.c \
+ $(GENERICDIR)\regc_color.c \
+ $(GENERICDIR)\regc_nfa.c \
+ $(GENERICDIR)\regc_cvec.c \
+ $(GENERICDIR)\regc_locale.c
+$(GENERICDIR)\regcustom.h: \
+ $(GENERICDIR)\tclInt.h \
+ $(GENERICDIR)\tclPort.h \
+ $(GENERICDIR)\regex.h
+$(GENERICDIR)\regexec.c: \
+ $(GENERICDIR)\rege_dfa.c \
+ $(GENERICDIR)\regguts.h
+$(GENERICDIR)\regerror.c: $(GENERICDIR)\regguts.h
+$(GENERICDIR)\regfree.c: $(GENERICDIR)\regguts.h
+$(GENERICDIR)\regfronts.c: $(GENERICDIR)\regguts.h
+$(GENERICDIR)\regguts.h: $(GENERICDIR)\regcustom.h
+
+!if exist("$(OUT_DIR)\depend.mk")
+!include "$(OUT_DIR)\depend.mk"
+!message *** Dependency rules in effect.
+!else
+!message *** Dependency rules are not being used.
+!endif
+
+### add a spacer in the output
+!message
+
+
+#---------------------------------------------------------------------
+# Implicit rules
+#---------------------------------------------------------------------
+
+{$(WINDIR)}.c{$(TMP_DIR)}.obj::
+ $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
+$<
+<<
+
+{$(GENERICDIR)}.c{$(TMP_DIR)}.obj::
+ $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
+$<
+<<
+
+{$(COMPATDIR)}.c{$(TMP_DIR)}.obj::
+ $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
+$<
+<<
+
+{$(WINDIR)}.rc{$(TMP_DIR)}.res:
+ $(rc32) -fo $@ -r -i "$(GENERICDIR)" -D__WIN32__ \
+!if $(DEBUG)
+ -d DEBUG \
+!endif
+!if $(TCL_THREADS)
+ -d TCL_THREADS \
+!endif
+!if $(STATIC_BUILD)
+ -d STATIC_BUILD \
+!endif
+ $<
+
+.SUFFIXES:
+.SUFFIXES:.c .rc
+
+
+#---------------------------------------------------------------------
+# Installation.
+#---------------------------------------------------------------------
+
+install-binaries:
+ @echo installing $(TCLLIBNAME)
+!if "$(TCLLIB)" != "$(TCLIMPLIB)"
+ @xcopy /i /y "$(TCLLIB)" "$(BIN_INSTALL_DIR)\"
+!endif
+ @xcopy /i /y "$(TCLIMPLIB)" "$(LIB_INSTALL_DIR)\"
+!if exist($(TCLSH))
+ @echo installing $(TCLSHNAME)
+ @xcopy /i /y "$(TCLSH)" "$(BIN_INSTALL_DIR)\"
+!endif
+!if exist($(TCLPIPEDLL))
+ @echo installing $(TCLPIPEDLLNAME)
+ @xcopy /i /y "$(TCLPIPEDLL)" "$(BIN_INSTALL_DIR)\"
+!endif
+ @echo installing $(TCLSTUBLIBNAME)
+ @xcopy /i /y "$(TCLSTUBLIB)" "$(LIB_INSTALL_DIR)\"
+
+install-libraries:
+ @echo installing http1.0
+ @xcopy /i /y "$(ROOT)\library\http1.0\*.tcl" \
+ "$(SCRIPT_INSTALL_DIR)\http1.0\"
+ @echo installing http2.4
+ @xcopy /i /y "$(ROOT)\library\http\*.tcl" \
+ "$(SCRIPT_INSTALL_DIR)\http2.4\"
+ @echo installing opt0.4
+ @xcopy /i /y "$(ROOT)\library\opt\*.tcl" \
+ "$(SCRIPT_INSTALL_DIR)\opt0.4\"
+ @echo installing msgcat1.3
+ @xcopy /i /y "$(ROOT)\library\msgcat\*.tcl" \
+ "$(SCRIPT_INSTALL_DIR)\msgcat1.3\"
+ @echo installing tcltest2.2
+ @xcopy /i /y "$(ROOT)\library\tcltest\*.tcl" \
+ "$(SCRIPT_INSTALL_DIR)\tcltest2.2\"
+ @echo installing $(TCLDDELIBNAME)
+!if $(STATIC_BUILD)
+ @xcopy /i /y "$(TCLDDELIB)" "$(LIB_INSTALL_DIR)\"
+!else
+ @xcopy /i /y "$(TCLDDELIB)" "$(LIB_INSTALL_DIR)\dde$(DDEDOTVERSION)\"
+ @xcopy /i /y "$(ROOT)\library\dde\pkgIndex.tcl" \
+ "$(LIB_INSTALL_DIR)\dde$(DDEDOTVERSION)\"
+!endif
+ @echo installing $(TCLREGLIBNAME)
+!if $(STATIC_BUILD)
+ @xcopy /i /y "$(TCLREGLIB)" "$(LIB_INSTALL_DIR)\"
+!else
+ @xcopy /i /y "$(TCLREGLIB)" "$(LIB_INSTALL_DIR)\reg$(REGDOTVERSION)\"
+ @xcopy /i /y "$(ROOT)\library\reg\pkgIndex.tcl" \
+ "$(LIB_INSTALL_DIR)\reg$(REGDOTVERSION)\"
+!endif
+ @echo installing encoding files
+ @xcopy /i /y "$(ROOT)\library\encoding\*.enc" \
+ "$(SCRIPT_INSTALL_DIR)\encoding\"
+ @echo installing library files
+ @xcopy /i /y "$(GENERICDIR)\tcl.h" "$(INCLUDE_INSTALL_DIR)\"
+ @xcopy /i /y "$(GENERICDIR)\tclDecls.h" "$(INCLUDE_INSTALL_DIR)\"
+ @xcopy /i /y "$(GENERICDIR)\tclPlatDecls.h" "$(INCLUDE_INSTALL_DIR)\"
+ @xcopy /i /y "$(ROOT)\library\history.tcl" "$(SCRIPT_INSTALL_DIR)\"
+ @xcopy /i /y "$(ROOT)\library\init.tcl" "$(SCRIPT_INSTALL_DIR)\"
+ @xcopy /i /y "$(ROOT)\library\ldAout.tcl" "$(SCRIPT_INSTALL_DIR)\"
+ @xcopy /i /y "$(ROOT)\library\parray.tcl" "$(SCRIPT_INSTALL_DIR)\"
+ @xcopy /i /y "$(ROOT)\library\safe.tcl" "$(SCRIPT_INSTALL_DIR)\"
+ @xcopy /i /y "$(ROOT)\library\tclIndex" "$(SCRIPT_INSTALL_DIR)\"
+ @xcopy /i /y "$(ROOT)\library\package.tcl" "$(SCRIPT_INSTALL_DIR)\"
+ @xcopy /i /y "$(ROOT)\library\word.tcl" "$(SCRIPT_INSTALL_DIR)\"
+ @xcopy /i /y "$(ROOT)\library\auto.tcl" "$(SCRIPT_INSTALL_DIR)\"
+
+
+#---------------------------------------------------------------------
+# Clean up
+#---------------------------------------------------------------------
+
+!if "$(OS)" == "Windows_NT"
+RMDIR = rmdir /S /Q
+!else
+RMDIR = deltree /Y
+!endif
+
+tidy:
+ if exist $(TCLLIB) del $(TCLLIB)
+ if exist $(TCLSH) del $(TCLSH)
+ if exist $(TCLTEST) del $(TCLTEST)
+ if exist $(TCLDDELIB) del $(TCLDDELIB)
+ if exist $(TCLREGLIB) del $(TCLREGLIB)
+
+clean:
+ if exist $(TMP_DIR)\nul $(RMDIR) $(TMP_DIR)
+
+hose:
+ if exist $(OUT_DIR)\nul $(RMDIR) $(OUT_DIR)
+
diff --git a/tcl/win/nmakehlp.c b/tcl/win/nmakehlp.c
new file mode 100644
index 00000000000..5021ae11cbe
--- /dev/null
+++ b/tcl/win/nmakehlp.c
@@ -0,0 +1,297 @@
+/* ----------------------------------------------------------------------------
+ * nmakehlp.c --
+ *
+ * This is used to fix limitations within nmake and the environment.
+ *
+ * Copyright (c) 2002 by David Gravereaux.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * ----------------------------------------------------------------------------
+ * RCS: @(#) $Id$
+ * ----------------------------------------------------------------------------
+ */
+#include <windows.h>
+#pragma comment (lib, "user32.lib")
+#pragma comment (lib, "kernel32.lib")
+
+/* protos */
+int CheckForCompilerFeature (const char *option);
+int CheckForLinkerFeature (const char *option);
+int IsIn (const char *string, const char *substring);
+DWORD WINAPI ReadFromPipe (LPVOID args);
+
+/* globals */
+typedef struct {
+ HANDLE pipe;
+ char buffer[1000];
+} pipeinfo;
+
+pipeinfo Out = {INVALID_HANDLE_VALUE, '\0'};
+pipeinfo Err = {INVALID_HANDLE_VALUE, '\0'};
+
+
+
+/* exitcodes: 0 == no, 1 == yes, 2 == error */
+int
+main (int argc, char *argv[])
+{
+ char msg[300];
+ DWORD dwWritten;
+ int chars;
+
+ if (argc > 1 && *argv[1] == '-') {
+ switch (*(argv[1]+1)) {
+ case 'c':
+ if (argc != 3) {
+ chars = wsprintf(msg, "usage: %s -c <compiler option>\n"
+ "Tests for whether cl.exe supports an option\n"
+ "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]);
+ WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL);
+ return 2;
+ }
+ return CheckForCompilerFeature(argv[2]);
+ case 'l':
+ if (argc != 3) {
+ chars = wsprintf(msg, "usage: %s -l <linker option>\n"
+ "Tests for whether link.exe supports an option\n"
+ "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]);
+ WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL);
+ return 2;
+ }
+ return CheckForLinkerFeature(argv[2]);
+ case 'f':
+ if (argc == 2) {
+ chars = wsprintf(msg, "usage: %s -f <string> <substring>\n"
+ "Find a substring within another\n"
+ "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]);
+ WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL);
+ return 2;
+ } else if (argc == 3) {
+ /* if the string is blank, there is no match */
+ return 0;
+ } else {
+ return IsIn(argv[2], argv[3]);
+ }
+ }
+ }
+ chars = wsprintf(msg, "usage: %s -c|-l|-f ...\n"
+ "This is a little helper app to equalize shell differences between WinNT and\n"
+ "Win9x and get nmake.exe to accomplish its job.\n",
+ argv[0]);
+ WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL);
+ return 2;
+}
+
+int
+CheckForCompilerFeature (const char *option)
+{
+ STARTUPINFO si;
+ PROCESS_INFORMATION pi;
+ SECURITY_ATTRIBUTES sa;
+ DWORD threadID;
+ char msg[300];
+ BOOL ok;
+ HANDLE hProcess, h, pipeThreads[2];
+ char cmdline[100];
+
+ hProcess = GetCurrentProcess();
+
+ ZeroMemory(&pi, sizeof(PROCESS_INFORMATION));
+ ZeroMemory(&si, sizeof(STARTUPINFO));
+ si.cb = sizeof(STARTUPINFO);
+ si.dwFlags = STARTF_USESTDHANDLES;
+ si.hStdInput = INVALID_HANDLE_VALUE;
+
+ ZeroMemory(&sa, sizeof(SECURITY_ATTRIBUTES));
+ sa.nLength = sizeof(SECURITY_ATTRIBUTES);
+ sa.lpSecurityDescriptor = NULL;
+ sa.bInheritHandle = FALSE;
+
+ /* create a non-inheritible pipe. */
+ CreatePipe(&Out.pipe, &h, &sa, 0);
+
+ /* dupe the write side, make it inheritible, and close the original. */
+ DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput,
+ 0, TRUE, DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE);
+
+ /* Same as above, but for the error side. */
+ CreatePipe(&Err.pipe, &h, &sa, 0);
+ DuplicateHandle(hProcess, h, hProcess, &si.hStdError,
+ 0, TRUE, DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE);
+
+ /* base command line */
+ strcpy(cmdline, "cl.exe -nologo -c -TC -Fdtemp ");
+ /* append our option for testing */
+ strcat(cmdline, option);
+ /* filename to compile, which exists, but is nothing and empty. */
+ strcat(cmdline, " nul");
+
+ ok = CreateProcess(
+ NULL, /* Module name. */
+ cmdline, /* Command line. */
+ NULL, /* Process handle not inheritable. */
+ NULL, /* Thread handle not inheritable. */
+ TRUE, /* yes, inherit handles. */
+ DETACHED_PROCESS, /* No console for you. */
+ NULL, /* Use parent's environment block. */
+ NULL, /* Use parent's starting directory. */
+ &si, /* Pointer to STARTUPINFO structure. */
+ &pi); /* Pointer to PROCESS_INFORMATION structure. */
+
+ if (!ok) {
+ DWORD err = GetLastError();
+ int chars = wsprintf(msg, "Tried to launch: \"%s\", but got error [%u]: ", cmdline, err);
+
+ FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS |
+ FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID) &msg[chars],
+ (300-chars), 0);
+ WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, strlen(msg), &err, NULL);
+ return 2;
+ }
+
+ /* close our references to the write handles that have now been inherited. */
+ CloseHandle(si.hStdOutput);
+ CloseHandle(si.hStdError);
+
+ WaitForInputIdle(pi.hProcess, 5000);
+ CloseHandle(pi.hThread);
+
+ /* start the pipe reader threads. */
+ pipeThreads[0] = CreateThread(NULL, 0, ReadFromPipe, &Out, 0, &threadID);
+ pipeThreads[1] = CreateThread(NULL, 0, ReadFromPipe, &Err, 0, &threadID);
+
+ /* block waiting for the process to end. */
+ WaitForSingleObject(pi.hProcess, INFINITE);
+ CloseHandle(pi.hProcess);
+
+ /* clean up temporary files before returning */
+ DeleteFile("temp.idb");
+ DeleteFile("temp.pdb");
+
+ /* wait for our pipe to get done reading, should it be a little slow. */
+ WaitForMultipleObjects(2, pipeThreads, TRUE, 500);
+ CloseHandle(pipeThreads[0]);
+ CloseHandle(pipeThreads[1]);
+
+ /* look for the commandline warning code in both streams. */
+ return !(strstr(Out.buffer, "D4002") != NULL || strstr(Err.buffer, "D4002") != NULL);
+}
+
+int
+CheckForLinkerFeature (const char *option)
+{
+ STARTUPINFO si;
+ PROCESS_INFORMATION pi;
+ SECURITY_ATTRIBUTES sa;
+ DWORD threadID;
+ char msg[300];
+ BOOL ok;
+ HANDLE hProcess, h, pipeThreads[2];
+ char cmdline[100];
+
+ hProcess = GetCurrentProcess();
+
+ ZeroMemory(&pi, sizeof(PROCESS_INFORMATION));
+ ZeroMemory(&si, sizeof(STARTUPINFO));
+ si.cb = sizeof(STARTUPINFO);
+ si.dwFlags = STARTF_USESTDHANDLES;
+ si.hStdInput = INVALID_HANDLE_VALUE;
+
+ ZeroMemory(&sa, sizeof(SECURITY_ATTRIBUTES));
+ sa.nLength = sizeof(SECURITY_ATTRIBUTES);
+ sa.lpSecurityDescriptor = NULL;
+ sa.bInheritHandle = TRUE;
+
+ /* create a non-inheritible pipe. */
+ CreatePipe(&Out.pipe, &h, &sa, 0);
+
+ /* dupe the write side, make it inheritible, and close the original. */
+ DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput,
+ 0, TRUE, DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE);
+
+ /* Same as above, but for the error side. */
+ CreatePipe(&Err.pipe, &h, &sa, 0);
+ DuplicateHandle(hProcess, h, hProcess, &si.hStdError,
+ 0, TRUE, DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE);
+
+ /* base command line */
+ strcpy(cmdline, "link.exe -nologo ");
+ /* append our option for testing */
+ strcat(cmdline, option);
+ /* filename to compile, which exists, but is nothing and empty. */
+// strcat(cmdline, " nul");
+
+ ok = CreateProcess(
+ NULL, /* Module name. */
+ cmdline, /* Command line. */
+ NULL, /* Process handle not inheritable. */
+ NULL, /* Thread handle not inheritable. */
+ TRUE, /* yes, inherit handles. */
+ DETACHED_PROCESS, /* No console for you. */
+ NULL, /* Use parent's environment block. */
+ NULL, /* Use parent's starting directory. */
+ &si, /* Pointer to STARTUPINFO structure. */
+ &pi); /* Pointer to PROCESS_INFORMATION structure. */
+
+ if (!ok) {
+ DWORD err = GetLastError();
+ int chars = wsprintf(msg, "Tried to launch: \"%s\", but got error [%u]: ", cmdline, err);
+
+ FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS |
+ FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID) &msg[chars],
+ (300-chars), 0);
+ WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, strlen(msg), &err, NULL);
+ return 2;
+ }
+
+ /* close our references to the write handles that have now been inherited. */
+ CloseHandle(si.hStdOutput);
+ CloseHandle(si.hStdError);
+
+ WaitForInputIdle(pi.hProcess, 5000);
+ CloseHandle(pi.hThread);
+
+ /* start the pipe reader threads. */
+ pipeThreads[0] = CreateThread(NULL, 0, ReadFromPipe, &Out, 0, &threadID);
+ pipeThreads[1] = CreateThread(NULL, 0, ReadFromPipe, &Err, 0, &threadID);
+
+ /* block waiting for the process to end. */
+ WaitForSingleObject(pi.hProcess, INFINITE);
+ CloseHandle(pi.hProcess);
+
+ /* wait for our pipe to get done reading, should it be a little slow. */
+ WaitForMultipleObjects(2, pipeThreads, TRUE, 500);
+ CloseHandle(pipeThreads[0]);
+ CloseHandle(pipeThreads[1]);
+
+ /* look for the commandline warning code in the stderr stream. */
+ return !(strstr(Out.buffer, "LNK1117") != NULL || strstr(Err.buffer, "LNK1117") != NULL);
+}
+
+DWORD WINAPI
+ReadFromPipe (LPVOID args)
+{
+ pipeinfo *pi = (pipeinfo *) args;
+ char *lastBuf = pi->buffer;
+ DWORD dwRead;
+ BOOL ok;
+
+again:
+ ok = ReadFile(pi->pipe, lastBuf, 25, &dwRead, 0L);
+ if (!ok || dwRead == 0) {
+ CloseHandle(pi->pipe);
+ return 0;
+ }
+ lastBuf += dwRead;
+ goto again;
+
+ return 0; /* makes the compiler happy */
+}
+
+int
+IsIn (const char *string, const char *substring)
+{
+ return (strstr(string, substring) != NULL);
+}
diff --git a/tcl/win/rules.vc b/tcl/win/rules.vc
new file mode 100644
index 00000000000..84b6ad040cd
--- /dev/null
+++ b/tcl/win/rules.vc
@@ -0,0 +1,263 @@
+#------------------------------------------------------------------------------
+# rules.vc --
+#
+# Microsoft Visual C++ makefile include for decoding the commandline
+# macros. This file does not need editing to build Tcl.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# Copyright (c) 2001-2002 David Gravereaux.
+#
+#------------------------------------------------------------------------------
+# RCS: @(#) $Id$
+#------------------------------------------------------------------------------
+
+!ifndef _RULES_VC
+_RULES_VC = 1
+
+cc32 = $(CC) # built-in default.
+link32 = link
+lib32 = lib
+rc32 = $(RC) # built-in default.
+
+!ifndef INSTALLDIR
+INSTALLDIR = C:\Progra~1\Tcl
+!endif
+
+!ifndef MACHINE
+MACHINE = IX86
+!endif
+
+!message ===============================================================================
+
+#----------------------------------------------------------
+# build the helper app we need to overcome nmake's limiting
+# environment.
+#----------------------------------------------------------
+
+!if !exist(nmakehlp.exe)
+!if [$(cc32) -nologo -ML nmakehlp.c -link -subsystem:console > nul]
+!endif
+!endif
+
+#----------------------------------------------------------
+# Test for compiler features
+#----------------------------------------------------------
+
+### test for optimizations
+!if [nmakehlp -c -Otip ]
+!message *** Compiler has 'Optimizations'
+OPTIMIZING = 1
+!else
+!message *** Compiler doesn't have 'Optimizations'
+OPTIMIZING = 0
+!endif
+
+!if "$(MACHINE)" == "IX86"
+### test for pentium errata
+!if [nmakehlp -c -QI0f]
+!message *** Compiler has 'Pentium 0x0f fix'
+PENT_0F_ERRATA = 1
+!else
+!message *** Compiler doesn't have 'Pentium 0x0f fix'
+PENT_0F_ERRATA = 0
+!endif
+### test for -align:4096, when align:512 will do.
+!if [nmakehlp -l -opt:nowin98]
+!message *** Linker has 'Win98 alignment problem'
+ALIGN98_HACK = 1
+!else
+!message *** Linker doesn't have 'Win98 alignment problem'
+ALIGN98_HACK = 0
+!endif
+!else
+PENT_0F_ERRATA = 0
+ALIGN98_HACK = 0
+!endif
+
+!if "$(MACHINE)" == "IA64"
+### test for Itanium errata
+!if [nmakehlp -c -QIA64_Bx]
+!message *** Compiler has 'B-stepping errata workarounds'
+ITAN_B_ERRATA = 1
+!else
+!message *** Compiler doesn't have 'B-stepping errata workarounds'
+ITAN_B_ERRATA = 0
+!endif
+!else
+ITAN_B_ERRATA = 0
+!endif
+
+#----------------------------------------------------------
+# Decode the options requested.
+#----------------------------------------------------------
+
+!if "$(OPTS)" == "" || [nmakehlp -f "$(OPTS)" "none"]
+STATIC_BUILD = 0
+TCL_THREADS = 0
+DEBUG = 0
+PROFILE = 0
+MSVCRT = 0
+LOIMPACT = 0
+TCL_LINKWITHEXTENSIONS = 0
+!else
+!if [nmakehlp -f $(OPTS) "static"]
+!message *** Doing static
+STATIC_BUILD = 1
+!else
+STATIC_BUILD = 0
+!endif
+!if [nmakehlp -f $(OPTS) "msvcrt"]
+!message *** Doing msvcrt
+MSVCRT = 1
+!else
+MSVCRT = 0
+!endif
+!if [nmakehlp -f $(OPTS) "linkexten"]
+!message *** Doing linkexten
+TCL_LINKWITHEXTENSIONS = 1
+!else
+TCL_LINKWITHEXTENSIONS = 0
+!endif
+!if [nmakehlp -f $(OPTS) "threads"]
+!message *** Doing threads
+TCL_THREADS = 1
+!else
+TCL_THREADS = 0
+!endif
+!if [nmakehlp -f $(OPTS) "symbols"]
+!message *** Doing symbols
+DEBUG = 1
+!else
+DEBUG = 0
+!endif
+!if [nmakehlp -f $(OPTS) "profile"]
+!message *** Doing profile
+PROFILE = 1
+!else
+PROFILE = 0
+!endif
+!if [nmakehlp -f $(OPTS) "loimpact"]
+!message *** Doing loimpact
+LOIMPACT = 1
+!else
+LOIMPACT = 0
+!endif
+!endif
+
+
+!if !$(STATIC_BUILD)
+# Make sure we don't build overly fat DLLs.
+MSVCRT = 1
+# We shouldn't statically put the extensions inside the shell when dynamic.
+TCL_LINKWITHEXTENSIONS = 0
+!endif
+
+
+#----------------------------------------------------------
+# Figure-out how to name our intermediate and output directories.
+# We wouldn't want different builds to use the same .obj files
+# by accident.
+#----------------------------------------------------------
+
+SUFX = tsdx
+
+!if $(DEBUG)
+BUILDDIRTOP = Debug
+DBGX = d
+!else
+BUILDDIRTOP = Release
+DBGX =
+SUFX = $(SUFX:d=)
+!endif
+
+TMP_DIRFULL = .\$(BUILDDIRTOP)\$(PROJECT)_ThreadedDynamicStaticX
+
+!if !$(STATIC_BUILD)
+TMP_DIRFULL = $(TMP_DIRFULL:Static=)
+SUFX = $(SUFX:s=)
+EXT = dll
+!if $(MSVCRT)
+TMP_DIRFULL = $(TMP_DIRFULL:X=)
+SUFX = $(SUFX:x=)
+!endif
+!else
+TMP_DIRFULL = $(TMP_DIRFULL:Dynamic=)
+EXT = lib
+!if !$(MSVCRT)
+TMP_DIRFULL = $(TMP_DIRFULL:X=)
+SUFX = $(SUFX:x=)
+!endif
+!endif
+
+!if !$(TCL_THREADS)
+TMP_DIRFULL = $(TMP_DIRFULL:Threaded=)
+SUFX = $(SUFX:t=)
+!endif
+
+!ifndef TMP_DIR
+TMP_DIR = $(TMP_DIRFULL)
+!ifndef OUT_DIR
+OUT_DIR = .\$(BUILDDIRTOP)
+!endif
+!else
+!ifndef OUT_DIR
+OUT_DIR = $(TMP_DIR)
+!endif
+!endif
+
+
+#----------------------------------------------------------
+# Decode the statistics requested.
+#----------------------------------------------------------
+
+!if "$(STATS)" == "" || [nmakehlp -f "$(STATS)" "none"]
+TCL_MEM_DEBUG = 0
+TCL_COMPILE_DEBUG = 0
+!else
+!if [nmakehlp -f $(STATS) "memdbg"]
+!message *** Doing memdbg
+TCL_MEM_DEBUG = 1
+!else
+TCL_MEM_DEBUG = 0
+!endif
+!if [nmakehlp -f $(STATS) "compdbg"]
+!message *** Doing compdbg
+TCL_COMPILE_DEBUG = 1
+!else
+TCL_COMPILE_DEBUG = 0
+!endif
+!endif
+
+
+#----------------------------------------------------------
+# Set our defines armed with our options.
+#----------------------------------------------------------
+
+OPTDEFINES =
+!if $(TCL_MEM_DEBUG)
+OPTDEFINES = -DTCL_MEM_DEBUG
+!endif
+!if $(TCL_COMPILE_DEBUG)
+OPTDEFINES = $(OPTDEFINES) -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS
+!endif
+!if $(TCL_THREADS)
+OPTDEFINES = $(OPTDEFINES) -DTCL_THREADS=1
+!endif
+!if $(STATIC_BUILD)
+OPTDEFINES = $(OPTDEFINES) -DSTATIC_BUILD
+!endif
+
+
+#----------------------------------------------------------
+# Display stats being used.
+#----------------------------------------------------------
+
+!message *** Intermediate directory will be '$(TMP_DIR)'
+!message *** Output directory will be '$(OUT_DIR)'
+!message *** Suffix for binaries will be '$(SUFX)'
+!message *** Optional defines are '$(OPTDEFINES)'
+
+!endif
+
diff --git a/tcl/win/stub16.c b/tcl/win/stub16.c
index 91016d86eac..a4c3ea4f317 100644
--- a/tcl/win/stub16.c
+++ b/tcl/win/stub16.c
@@ -16,7 +16,6 @@
#include <windows.h>
#include <stdio.h>
-#include <string.h>
static HANDLE CreateTempFile(void);
@@ -197,5 +196,3 @@ CreateTempFile()
CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY | FILE_FLAG_DELETE_ON_CLOSE,
NULL);
}
-
-
diff --git a/tcl/win/tcl.dsp b/tcl/win/tcl.dsp
new file mode 100644
index 00000000000..9f109611aa5
--- /dev/null
+++ b/tcl/win/tcl.dsp
@@ -0,0 +1,1600 @@
+# Microsoft Developer Studio Project File - Name="tcl" - Package Owner=<4>
+# Microsoft Developer Studio Generated Build File, Format Version 6.00
+# ** DO NOT EDIT **
+
+# TARGTYPE "Win32 (x86) External Target" 0x0106
+
+CFG=tcl - Win32 Debug Static
+!MESSAGE This is not a valid makefile. To build this project using NMAKE,
+!MESSAGE use the Export Makefile command and run
+!MESSAGE
+!MESSAGE NMAKE /f "tcl.mak".
+!MESSAGE
+!MESSAGE You can specify a configuration when running NMAKE
+!MESSAGE by defining the macro CFG on the command line. For example:
+!MESSAGE
+!MESSAGE NMAKE /f "tcl.mak" CFG="tcl - Win32 Debug Static"
+!MESSAGE
+!MESSAGE Possible choices for configuration are:
+!MESSAGE
+!MESSAGE "tcl - Win32 Release" (based on "Win32 (x86) External Target")
+!MESSAGE "tcl - Win32 Debug" (based on "Win32 (x86) External Target")
+!MESSAGE "tcl - Win32 Debug Static" (based on "Win32 (x86) External Target")
+!MESSAGE "tcl - Win32 Release Static" (based on "Win32 (x86) External Target")
+!MESSAGE
+
+# Begin Project
+# PROP AllowPerConfigDependencies 0
+# PROP Scc_ProjName ""
+# PROP Scc_LocalPath ""
+
+!IF "$(CFG)" == "tcl - Win32 Release"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "Release"
+# PROP BASE Intermediate_Dir "Release\tcl_Dynamic"
+# PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=none MSVCDIR=IDE"
+# PROP BASE Rebuild_Opt "-a"
+# PROP BASE Target_File "Release\tclsh84.exe"
+# PROP BASE Bsc_Name ""
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "Release"
+# PROP Intermediate_Dir "Release\tcl_Dynamic"
+# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=none MSVCDIR=IDE"
+# PROP Rebuild_Opt "-a"
+# PROP Target_File "Release\tclsh84.exe"
+# PROP Bsc_Name ""
+# PROP Target_Dir ""
+
+!ELSEIF "$(CFG)" == "tcl - Win32 Debug"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "Debug"
+# PROP BASE Intermediate_Dir "Debug\tcl_Dynamic"
+# PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols MSVCDIR=IDE"
+# PROP BASE Rebuild_Opt "-a"
+# PROP BASE Target_File "Debug\tclsh84d.exe"
+# PROP BASE Bsc_Name ""
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "Debug"
+# PROP Intermediate_Dir "Debug\tcl_Dynamic"
+# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols MSVCDIR=IDE"
+# PROP Rebuild_Opt "-a"
+# PROP Target_File "Debug\tclsh84d.exe"
+# PROP Bsc_Name ""
+# PROP Target_Dir ""
+
+!ELSEIF "$(CFG)" == "tcl - Win32 Debug Static"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "Debug"
+# PROP BASE Intermediate_Dir "Debug\tcl_Static"
+# PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols,static MSVCDIR=IDE"
+# PROP BASE Rebuild_Opt "-a"
+# PROP BASE Target_File "Debug\tclsh84d.exe"
+# PROP BASE Bsc_Name ""
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "Debug"
+# PROP Intermediate_Dir "Debug\tcl_Static"
+# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols,static MSVCDIR=IDE"
+# PROP Rebuild_Opt "-a"
+# PROP Target_File "Debug\tclsh84sd.exe"
+# PROP Bsc_Name ""
+# PROP Target_Dir ""
+
+!ELSEIF "$(CFG)" == "tcl - Win32 Release Static"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "Release"
+# PROP BASE Intermediate_Dir "Release\tcl_Static"
+# PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=static MSVCDIR=IDE"
+# PROP BASE Rebuild_Opt "-a"
+# PROP BASE Target_File "Release\tclsh84.exe"
+# PROP BASE Bsc_Name ""
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "Release"
+# PROP Intermediate_Dir "Release\tcl_Static"
+# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=static MSVCDIR=IDE"
+# PROP Rebuild_Opt "-a"
+# PROP Target_File "Release\tclsh84s.exe"
+# PROP Bsc_Name ""
+# PROP Target_Dir ""
+
+!ENDIF
+
+# Begin Target
+
+# Name "tcl - Win32 Release"
+# Name "tcl - Win32 Debug"
+# Name "tcl - Win32 Debug Static"
+# Name "tcl - Win32 Release Static"
+
+!IF "$(CFG)" == "tcl - Win32 Release"
+
+!ELSEIF "$(CFG)" == "tcl - Win32 Debug"
+
+!ELSEIF "$(CFG)" == "tcl - Win32 Debug Static"
+
+!ELSEIF "$(CFG)" == "tcl - Win32 Release Static"
+
+!ENDIF
+
+# Begin Group "compat"
+
+# PROP Default_Filter ""
+# Begin Source File
+
+SOURCE=..\compat\dirent.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\dirent2.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\dlfcn.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\fixstrtod.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\float.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\gettod.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\limits.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\memcmp.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\opendir.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\README
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\stdlib.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\strftime.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\string.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\strncasecmp.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\strstr.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\strtod.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\strtol.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\strtoul.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\tclErrno.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\tmpnam.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\unistd.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\compat\waitpid.c
+# End Source File
+# End Group
+# Begin Group "doc"
+
+# PROP Default_Filter ""
+# Begin Source File
+
+SOURCE=..\doc\Access.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\AddErrInfo.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\after.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Alloc.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\AllowExc.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\append.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\AppInit.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\array.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\AssocData.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Async.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\BackgdErr.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Backslash.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\bgerror.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\binary.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\BoolObj.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\break.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\ByteArrObj.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\CallDel.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\case.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\catch.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\cd.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\ChnlStack.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\clock.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\close.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\CmdCmplt.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Concat.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\concat.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\continue.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\CrtChannel.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\CrtChnlHdlr.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\CrtCloseHdlr.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\CrtCommand.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\CrtFileHdlr.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\CrtInterp.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\CrtMathFnc.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\CrtObjCmd.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\CrtSlave.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\CrtTimerHdlr.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\CrtTrace.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\dde.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\DetachPids.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\DoOneEvent.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\DoubleObj.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\DoWhenIdle.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\DString.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\DumpActiveMemory.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Encoding.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\encoding.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Environment.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\eof.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\error.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Eval.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\eval.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\exec.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Exit.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\exit.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\expr.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\ExprLong.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\ExprLongObj.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\fblocked.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\fconfigure.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\fcopy.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\file.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\fileevent.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\filename.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\FileSystem.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\FindExec.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\flush.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\for.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\foreach.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\format.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\GetCwd.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\GetHostName.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\GetIndex.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\GetInt.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\GetOpnFl.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\gets.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\GetStdChan.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\GetVersion.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\glob.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\global.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Hash.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\history.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\http.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\if.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\incr.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\info.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Init.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\InitStubs.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Interp.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\interp.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\IntObj.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\join.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\lappend.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\library.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\lindex.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\LinkVar.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\linsert.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\list.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\ListObj.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\llength.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\load.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\lrange.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\lreplace.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\lsearch.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\lsort.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Macintosh.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\man.macros
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\memory.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\msgcat.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\namespace.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Notifier.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Object.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\ObjectType.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\open.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\OpenFileChnl.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\OpenTcp.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\package.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\packagens.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Panic.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\ParseCmd.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\pid.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\pkgMkIndex.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\PkgRequire.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Preserve.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\PrintDbl.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\proc.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\puts.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\pwd.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\re_syntax.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\read.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\RecEvalObj.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\RecordEval.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\RegExp.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\regexp.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\registry.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\regsub.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\rename.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\resource.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\return.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\safe.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\SaveResult.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\scan.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\seek.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\set.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\SetErrno.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\SetRecLmt.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\SetResult.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\SetVar.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Signal.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Sleep.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\socket.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\source.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\SourceRCFile.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\split.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\SplitList.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\SplitPath.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\StaticPkg.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\StdChannels.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\string.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\StringObj.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\StrMatch.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\subst.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\SubstObj.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\switch.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Tcl.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Tcl_Main.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\TCL_MEM_DEBUG.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\tclsh.1
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\tcltest.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\tclvars.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\tell.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Thread.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\time.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\ToUpper.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\trace.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\TraceVar.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Translate.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\UniCharIsAlpha.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\unknown.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\unset.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\update.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\uplevel.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\UpVar.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\upvar.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\Utf.3
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\variable.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\vwait.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\while.n
+# End Source File
+# Begin Source File
+
+SOURCE=..\doc\WrongNumArgs.3
+# End Source File
+# End Group
+# Begin Group "generic"
+
+# PROP Default_Filter ""
+# Begin Source File
+
+SOURCE=..\generic\README
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\regc_color.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\regc_cvec.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\regc_lex.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\regc_locale.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\regc_nfa.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\regcomp.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\regcustom.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\rege_dfa.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\regerror.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\regerrs.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\regex.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\regexec.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\regfree.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\regfronts.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\regguts.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tcl.decls
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tcl.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclAlloc.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclAsync.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclBasic.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclBinary.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclCkalloc.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclClock.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclCmdAH.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclCmdIL.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclCmdMZ.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclCompCmds.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclCompExpr.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclCompile.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclCompile.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclDate.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclDecls.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclEncoding.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclEnv.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclEvent.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclExecute.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclFCmd.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclFileName.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclGet.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclGetDate.y
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclHash.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclHistory.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclIndexObj.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclInitScript.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclInt.decls
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclInt.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclIntDecls.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclInterp.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclIntPlatDecls.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclIO.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclIO.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclIOCmd.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclIOGT.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclIOSock.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclIOUtil.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclLink.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclListObj.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclLiteral.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclLoad.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclLoadNone.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclMain.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclMath.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclNamesp.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclNotify.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclObj.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclPanic.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclParse.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclParseExpr.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclPipe.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclPkg.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclPlatDecls.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclPort.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclPosixStr.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclPreserve.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclProc.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclRegexp.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclRegexp.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclResolve.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclResult.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclScan.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclStringObj.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclStubInit.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclStubLib.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclTest.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclTestObj.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclTestProcBodyObj.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclThread.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclThreadJoin.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclThreadTest.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclTimer.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclUniData.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclUtf.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclUtil.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\generic\tclVar.c
+# End Source File
+# End Group
+# Begin Group "library"
+
+# PROP Default_Filter ""
+# Begin Source File
+
+SOURCE=..\library\auto.tcl
+# End Source File
+# Begin Source File
+
+SOURCE=..\library\history.tcl
+# End Source File
+# Begin Source File
+
+SOURCE=..\library\init.tcl
+# End Source File
+# Begin Source File
+
+SOURCE=..\library\ldAout.tcl
+# End Source File
+# Begin Source File
+
+SOURCE=..\library\package.tcl
+# End Source File
+# Begin Source File
+
+SOURCE=..\library\parray.tcl
+# End Source File
+# Begin Source File
+
+SOURCE=..\library\safe.tcl
+# End Source File
+# Begin Source File
+
+SOURCE=..\library\tclIndex
+# End Source File
+# Begin Source File
+
+SOURCE=..\library\word.tcl
+# End Source File
+# End Group
+# Begin Group "mac"
+
+# PROP Default_Filter ""
+# End Group
+# Begin Group "tests"
+
+# PROP Default_Filter ""
+# End Group
+# Begin Group "tools"
+
+# PROP Default_Filter ""
+# End Group
+# Begin Group "unix"
+
+# PROP Default_Filter ""
+# End Group
+# Begin Group "win"
+
+# PROP Default_Filter ""
+# Begin Source File
+
+SOURCE=.\aclocal.m4
+# End Source File
+# Begin Source File
+
+SOURCE=.\cat.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\configure
+# End Source File
+# Begin Source File
+
+SOURCE=.\configure.in
+# End Source File
+# Begin Source File
+
+SOURCE=.\makefile.bc
+# End Source File
+# Begin Source File
+
+SOURCE=.\Makefile.in
+# End Source File
+# Begin Source File
+
+SOURCE=.\makefile.vc
+# End Source File
+# Begin Source File
+
+SOURCE=.\mkd.bat
+# End Source File
+# Begin Source File
+
+SOURCE=.\README
+# End Source File
+# Begin Source File
+
+SOURCE=.\README.binary
+# End Source File
+# Begin Source File
+
+SOURCE=.\rmd.bat
+# End Source File
+# Begin Source File
+
+SOURCE=.\rules.vc
+# End Source File
+# Begin Source File
+
+SOURCE=.\stub16.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\tcl.hpj.in
+# End Source File
+# Begin Source File
+
+SOURCE=.\tcl.m4
+# End Source File
+# Begin Source File
+
+SOURCE=.\tcl.rc
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclAppInit.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclConfig.sh.in
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclsh.ico
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclsh.rc
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWin32Dll.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWinChan.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWinConsole.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWinDde.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWinError.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWinFCmd.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWinFile.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWinInit.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWinInt.h
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWinLoad.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWinMtherr.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWinNotify.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWinPipe.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWinPort.h
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWinReg.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWinSerial.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWinSock.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWinTest.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWinThrd.c
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWinThrd.h
+# End Source File
+# Begin Source File
+
+SOURCE=.\tclWinTime.c
+# End Source File
+# End Group
+# End Target
+# End Project
+
diff --git a/tcl/win/tcl.dsw b/tcl/win/tcl.dsw
new file mode 100644
index 00000000000..d7ce3f17fd6
--- /dev/null
+++ b/tcl/win/tcl.dsw
@@ -0,0 +1,30 @@
+Microsoft Developer Studio Workspace File, Format Version 6.00
+# WARNING: DO NOT EDIT OR DELETE THIS WORKSPACE FILE!
+
+###############################################################################
+
+Project: "tcl"=.\tcl.dsp - Package Owner=<4>
+
+Package=<5>
+{{{
+}}}
+
+Package=<4>
+{{{
+}}}
+
+###############################################################################
+
+Global:
+
+Package=<5>
+{{{
+}}}
+
+Package=<3>
+{{{
+}}}
+
+###############################################################################
+
+
diff --git a/tcl/win/tcl.hpj.in b/tcl/win/tcl.hpj.in
new file mode 100644
index 00000000000..88f15e3b0d0
--- /dev/null
+++ b/tcl/win/tcl.hpj.in
@@ -0,0 +1,20 @@
+; This file is maintained by HCW. Do not modify this file directly.
+
+[OPTIONS]
+HCW=0
+LCID=0x409 0x0 0x0 ;English (United States)
+REPORT=Yes
+TITLE=Tcl/Tk Reference Manual
+CNT=tcl84.cnt
+COPYRIGHT=Copyright © 2000 Ajuba Solutions
+HLP=tcl84.hlp
+
+[FILES]
+tcl.rtf
+
+[WINDOWS]
+main="Tcl/Tk Reference Manual",,0
+
+[CONFIG]
+BrowseButtons()
+
diff --git a/tcl/win/tcl.m4 b/tcl/win/tcl.m4
index d2188de98f2..71ce0a98848 100644
--- a/tcl/win/tcl.m4
+++ b/tcl/win/tcl.m4
@@ -20,15 +20,13 @@
AC_DEFUN(SC_PATH_TCLCONFIG, [
AC_MSG_CHECKING([the location of tclConfig.sh])
-# CYGNUS LOCAL
- if test -d ../../tcl8.1/win; then
- TCL_BIN_DIR_DEFAULT=../../tcl8.1/win
+ if test -d ../../tcl8.4$1/win; then
+ TCL_BIN_DIR_DEFAULT=../../tcl8.4$1/win
else
- TCL_BIN_DIR_DEFAULT=../../tcl/win
+ TCL_BIN_DIR_DEFAULT=../../tcl8.4/win
fi
-# END CYGNUS LOCAL
- AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.3 binaries from DIR],
+ AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.4 binaries from DIR],
TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd $TCL_BIN_DIR_DEFAULT; pwd`)
if test ! -d $TCL_BIN_DIR; then
AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR does not exist)
@@ -60,13 +58,13 @@ AC_DEFUN(SC_PATH_TCLCONFIG, [
AC_DEFUN(SC_PATH_TKCONFIG, [
AC_MSG_CHECKING([the location of tkConfig.sh])
- if test -d ../../tk8.3$1/win; then
- TK_BIN_DIR_DEFAULT=../../tk8.3$1/win
+ if test -d ../../tk8.4$1/win; then
+ TK_BIN_DIR_DEFAULT=../../tk8.4$1/win
else
- TK_BIN_DIR_DEFAULT=../../tk8.3/win
+ TK_BIN_DIR_DEFAULT=../../tk8.4/win
fi
- AC_ARG_WITH(tk, [ --with-tk=DIR use Tk 8.3 binaries from DIR],
+ AC_ARG_WITH(tk, [ --with-tk=DIR use Tk 8.4 binaries from DIR],
TK_BIN_DIR=$withval, TK_BIN_DIR=`cd $TK_BIN_DIR_DEFAULT; pwd`)
if test ! -d $TK_BIN_DIR; then
AC_MSG_ERROR(Tk directory $TK_BIN_DIR does not exist)
@@ -108,15 +106,44 @@ AC_DEFUN(SC_LOAD_TCLCONFIG, [
AC_MSG_RESULT([file not found])
fi
- # The eval is required to do the TCL_DBGX substitution in the
- # TCL_LIB_FILE variable.
+ #
+ # If the TCL_BIN_DIR is the build directory (not the install directory),
+ # then set the common variable name to the value of the build variables.
+ # For example, the variable TCL_LIB_SPEC will be set to the value
+ # of TCL_BUILD_LIB_SPEC. An extension should make use of TCL_LIB_SPEC
+ # instead of TCL_BUILD_LIB_SPEC since it will work with both an
+ # installed and uninstalled version of Tcl.
+ #
+
+ if test -f $TCL_BIN_DIR/Makefile ; then
+ TCL_LIB_SPEC=${TCL_BUILD_LIB_SPEC}
+ TCL_STUB_LIB_SPEC=${TCL_BUILD_STUB_LIB_SPEC}
+ TCL_STUB_LIB_PATH=${TCL_BUILD_STUB_LIB_PATH}
+ fi
+
+ #
+ # eval is required to do the TCL_DBGX substitution
+ #
- eval TCL_LIB_FILE=${TCL_LIB_FILE}
- eval TCL_LIB_FLAG=${TCL_LIB_FLAG}
+ eval "TCL_LIB_FILE=\"${TCL_LIB_FILE}\""
+ eval "TCL_LIB_FLAG=\"${TCL_LIB_FLAG}\""
+ eval "TCL_LIB_SPEC=\"${TCL_LIB_SPEC}\""
+ eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\""
+ eval "TCL_STUB_LIB_FLAG=\"${TCL_STUB_LIB_FLAG}\""
+ eval "TCL_STUB_LIB_SPEC=\"${TCL_STUB_LIB_SPEC}\""
+
+ AC_SUBST(TCL_VERSION)
AC_SUBST(TCL_BIN_DIR)
AC_SUBST(TCL_SRC_DIR)
+
AC_SUBST(TCL_LIB_FILE)
+ AC_SUBST(TCL_LIB_FLAG)
+ AC_SUBST(TCL_LIB_SPEC)
+
+ AC_SUBST(TCL_STUB_LIB_FILE)
+ AC_SUBST(TCL_STUB_LIB_FLAG)
+ AC_SUBST(TCL_STUB_LIB_SPEC)
])
#------------------------------------------------------------------------
@@ -137,10 +164,10 @@ AC_DEFUN(SC_LOAD_TCLCONFIG, [
#------------------------------------------------------------------------
AC_DEFUN(SC_LOAD_TKCONFIG, [
- AC_MSG_CHECKING([for existence of $TCLCONFIG])
+ AC_MSG_CHECKING([for existence of $TK_BIN_DIR/tkConfig.sh])
if test -f "$TK_BIN_DIR/tkConfig.sh" ; then
- AC_MSG_CHECKING([loading $TK_BIN_DIR/tkConfig.sh])
+ AC_MSG_RESULT([loading])
. $TK_BIN_DIR/tkConfig.sh
else
AC_MSG_RESULT([could not find $TK_BIN_DIR/tkConfig.sh])
@@ -226,6 +253,7 @@ AC_DEFUN(SC_ENABLE_THREADS, [
TCL_THREADS=0
AC_MSG_RESULT([no (default)])
fi
+ AC_SUBST(TCL_THREADS)
])
#------------------------------------------------------------------------
@@ -239,8 +267,6 @@ AC_DEFUN(SC_ENABLE_THREADS, [
# Requires the following vars to be set in the Makefile:
# CFLAGS_DEBUG
# CFLAGS_OPTIMIZE
-# LDFLAGS_DEBUG
-# LDFLAGS_OPTIMIZE
#
# Results:
#
@@ -248,10 +274,10 @@ AC_DEFUN(SC_ENABLE_THREADS, [
# --enable-symbols
#
# Defines the following vars:
-# CFLAGS_DEFAULT Set to $(CFLAGS_DEBUG) if true
-# Set to $(CFLAGS_OPTIMIZE) if false
-# LDFLAGS_DEFAULT Set to $(LDFLAGS_DEBUG) if true
-# Set to $(LDFLAGS_OPTIMIZE) if false
+# CFLAGS_DEFAULT Sets to $(CFLAGS_DEBUG) if true
+# Sets to $(CFLAGS_OPTIMIZE) if false
+# LDFLAGS_DEFAULT Sets to $(LDFLAGS_DEBUG) if true
+# Sets to $(LDFLAGS_OPTIMIZE) if false
# DBGX Debug library extension
#
#------------------------------------------------------------------------
@@ -274,6 +300,42 @@ AC_DEFUN(SC_ENABLE_SYMBOLS, [
])
+#------------------------------------------------------------------------
+# SC_ENABLE_MEMDEBUG --
+#
+# Specify if the memory debugging code should be used
+#
+# Arguments:
+# none
+#
+# Requires the following vars to be set in the Makefile:
+# None.
+#
+# Results:
+#
+# Adds the following arguments to configure:
+# --enable-memdebug
+#
+# Defines the following @vars@:
+# MEM_DEBUG_FLAGS Sets to -DTCL_MEM_DEBUG if true
+# Sets to "" if false
+#
+#------------------------------------------------------------------------
+
+AC_DEFUN(SC_ENABLE_MEMDEBUG, [
+ AC_MSG_CHECKING([for build with memory debugging])
+ AC_ARG_ENABLE(memdebug, [ --enable-memdebug build with memory debugging [--disable-memdebug]], [tcl_ok=$enableval], [tcl_ok=no])
+ if test "$tcl_ok" = "yes"; then
+ MEM_DEBUG_FLAGS=-DTCL_MEM_DEBUG
+ AC_MSG_RESULT([yes])
+ else
+ MEM_DEBUG_FLAGS=""
+ AC_MSG_RESULT([no])
+ fi
+ AC_SUBST(MEM_DEBUG_FLAGS)
+])
+
+
#--------------------------------------------------------------------
# SC_CONFIG_CFLAGS
#
@@ -289,7 +351,7 @@ AC_DEFUN(SC_ENABLE_SYMBOLS, [
#
# Results:
#
-# Can set the following vars:
+# Can the following vars:
# EXTRA_CFLAGS
# CFLAGS_DEBUG
# CFLAGS_OPTIMIZE
@@ -315,7 +377,6 @@ AC_DEFUN(SC_ENABLE_SYMBOLS, [
#
# LIBSUFFIX
# LIBPREFIX
-# VENDORPREFIX
# LIBRARIES
# EXESUFFIX
# DLLSUFFIX
@@ -323,34 +384,17 @@ AC_DEFUN(SC_ENABLE_SYMBOLS, [
#--------------------------------------------------------------------
AC_DEFUN(SC_CONFIG_CFLAGS, [
- TCL_LIB_VERSIONS_OK=nodots
- AC_CHECK_PROG(CYGPATH, cygpath, cygpath -w, echo)
+ # Step 0: Enable 64 bit support?
- # Check for a bug in gcc's windres that causes the
- # compile to fail when a Windows native path is
- # passed into windres. The mingw toolchain requires
- # Windows native paths while Cygwin should work
- # with both. Avoid the bug by passing a POSIX
- # path when using the Cygwin toolchain.
-
- if test "$GCC" = "yes" && test "$CYGPATH" != "echo" ; then
- conftest=/tmp/conftest.rc
- echo "STRINGTABLE BEGIN" > $conftest
- echo "101 \"name\"" >> $conftest
- echo "END" >> $conftest
-
- AC_MSG_CHECKING([for Windows native path bug in windres])
- cyg_conftest=`$CYGPATH $conftest`
- if AC_TRY_COMMAND($RC -o conftest.res.o $cyg_conftest) ; then
- AC_MSG_RESULT([no])
- else
- AC_MSG_RESULT([yes])
- CYGPATH=echo
- fi
- conftest=
- cyg_conftest=
- fi
+ AC_MSG_CHECKING([if 64bit support is requested])
+ AC_ARG_ENABLE(64bit,[ --enable-64bit enable 64bit support (where applicable)], [do64bit=$enableval], [do64bit=no])
+ AC_MSG_RESULT($do64bit)
+
+ # Set some defaults (may get changed below)
+ EXTRA_CFLAGS=""
+
+ AC_CHECK_PROG(CYGPATH, cygpath, cygpath -w, echo)
if test "$CYGPATH" = "echo" || test "$ac_cv_cygwin" = "yes"; then
DEPARG='"$<"'
@@ -358,34 +402,35 @@ AC_DEFUN(SC_CONFIG_CFLAGS, [
DEPARG='"$(shell $(CYGPATH) $<)"'
fi
- # CYGNUS LOCAL
- VENDORPREFIX="rh"
- # END CYGNUS LOCAL
-
# set various compiler flags depending on whether we are using gcc or cl
AC_MSG_CHECKING([compiler flags])
if test "${GCC}" = "yes" ; then
-
- # CYGNUS LOCAL
- if test "$ac_cv_cygwin" = "yes" ; then
- VENDORPREFIX="cyg"
+ if test "$do64bit" = "yes" ; then
+ AC_MSG_WARN("64bit mode not supported with GCC on Windows")
fi
- # END CYGNUS LOCAL
-
SHLIB_LD=""
SHLIB_LD_LIBS=""
LIBS=""
- LIBS_GUI="-lgdi32 -lcomdlg32"
- STLIB_LD="${AR} cr"
+ LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32"
+ STLIB_LD='${AR} cr'
RC_OUT=-o
RC_TYPE=
RC_INCLUDE=--include
+ RC_DEFINE=--define
RES=res.o
MAKE_LIB="\${STLIB_LD} \[$]@"
POST_MAKE_LIB="\${RANLIB} \[$]@"
MAKE_EXE="\${CC} -o \[$]@"
- LIBPREFIX="lib${VENDORPREFIX}"
+ LIBPREFIX="lib"
+
+ if test "$ac_cv_cygwin" = "yes"; then
+ extra_cflags="-mno-cygwin"
+ extra_ldflags="-mno-cygwin"
+ else
+ extra_cflags=""
+ extra_ldflags=""
+ fi
if test "${SHARED_BUILD}" = "0" ; then
# static
@@ -395,7 +440,6 @@ AC_DEFUN(SC_CONFIG_CFLAGS, [
LIBSUFFIX="s\${DBGX}.a"
LIBRARIES="\${STATIC_LIBRARIES}"
EXESUFFIX="s\${DBGX}.exe"
- DLLSUFFIX=""
else
# dynamic
AC_MSG_RESULT([using shared flags])
@@ -403,23 +447,27 @@ AC_DEFUN(SC_CONFIG_CFLAGS, [
# ad-hoc check to see if CC supports -shared.
if "${CC}" -shared 2>&1 | egrep ': -shared not supported' >/dev/null; then
AC_MSG_ERROR([${CC} does not support the -shared option.
- You will need to upgrade to a newer version of the toolchain.])
+ You will need to upgrade to a newer version of the toolchain.])
fi
runtime=
# Link with gcc since ld does not link to default libs like
- # -luser32 and -lmsvcrt. We also need to add CFLAGS so important
- # flags like -mno-cygwin get passed in to CC.
+ # -luser32 and -lmsvcrt by default. Make sure CFLAGS is
+ # included so -mno-cygwin passed the correct libs to the linker.
SHLIB_LD='${CC} -shared ${CFLAGS}'
# Add SHLIB_LD_LIBS to the Make rule, not here.
MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \[$]@ ${extra_ldflags} \
-Wl,--out-implib,\$(patsubst %.dll,lib%.a,\[$]@)"
LIBSUFFIX="\${DBGX}.a"
- DLLSUFFIX="\${DBGX}.dll"
EXESUFFIX="\${DBGX}.exe"
LIBRARIES="\${SHARED_LIBRARIES}"
fi
+ # DLLSUFFIX is separate because it is the building block for
+ # users of tclConfig.sh that may build shared or static.
+ DLLSUFFIX="\${DBGX}.dll"
+
+ EXTRA_CFLAGS="${extra_cflags}"
CFLAGS_DEBUG=-g
CFLAGS_OPTIMIZE=-O
@@ -443,21 +491,6 @@ AC_DEFUN(SC_CONFIG_CFLAGS, [
LDFLAGS_CONSOLE="-mconsole ${extra_ldflags}"
LDFLAGS_WINDOW="-mwindows -e _WinMain@16 ${extra_ldflags}"
else
- SHLIB_LD="link -dll -nologo"
- SHLIB_LD_LIBS="user32.lib advapi32.lib"
- LIBS="user32.lib advapi32.lib"
- LIBS_GUI="gdi32.lib comdlg32.lib"
- STLIB_LD="lib -nologo"
- RC="rc"
- RC_OUT=-fo
- RC_TYPE=-r
- RC_INCLUDE=-i
- RES=res
- MAKE_LIB="\${STLIB_LD} -out:\[$]@"
- POST_MAKE_LIB=
- MAKE_EXE="\${CC} -Fe\[$]@"
- LIBPREFIX=${VENDORPREFIX}
-
if test "${SHARED_BUILD}" = "0" ; then
# static
AC_MSG_RESULT([using static flags])
@@ -466,7 +499,6 @@ AC_DEFUN(SC_CONFIG_CFLAGS, [
LIBSUFFIX="s\${DBGX}.lib"
LIBRARIES="\${STATIC_LIBRARIES}"
EXESUFFIX="s\${DBGX}.exe"
- DLLSUFFIX=""
else
# dynamic
AC_MSG_RESULT([using shared flags])
@@ -474,33 +506,84 @@ AC_DEFUN(SC_CONFIG_CFLAGS, [
# Add SHLIB_LD_LIBS to the Make rule, not here.
MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\[$]@"
LIBSUFFIX="\${DBGX}.lib"
- DLLSUFFIX="\${DBGX}.dll"
EXESUFFIX="\${DBGX}.exe"
LIBRARIES="\${SHARED_LIBRARIES}"
fi
+ # DLLSUFFIX is separate because it is the building block for
+ # users of tclConfig.sh that may build shared or static.
+ DLLSUFFIX="\${DBGX}.dll"
+
+ # This is a 2-stage check to make sure we have the 64-bit SDK
+ # We have to know where the SDK is installed.
+ if test "$do64bit" = "yes" ; then
+ if test "x${MSSDK}x" = "xx" ; then
+ MSSDK="C:/Progra~1/Microsoft SDK"
+ fi
+ # In order to work in the tortured autoconf environment,
+ # we need to ensure that this path has no spaces
+ MSSDK=$(cygpath -w -s "$MSSDK" | sed -e 's!\\!/!g')
+ if test ! -d "${MSSDK}/bin/win64" ; then
+ AC_MSG_WARN("could not find 64-bit SDK to enable 64bit mode")
+ do64bit="no"
+ fi
+ fi
+
+ if test "$do64bit" = "yes" ; then
+ # All this magic is necessary for the Win64 SDK RC1 - hobbs
+ CC="${MSSDK}/Bin/Win64/cl.exe \
+ -I${MSSDK}/Include/prerelease \
+ -I${MSSDK}/Include/Win64/crt \
+ -I${MSSDK}/Include/Win64/crt/sys \
+ -I${MSSDK}/Include"
+ RC="${MSSDK}/bin/rc.exe"
+ CFLAGS_DEBUG="-nologo -Zi -Od ${runtime}d"
+ CFLAGS_OPTIMIZE="-nologo -O2 -Gs ${runtime}"
+ lflags="-MACHINE:IA64 -LIBPATH:${MSSDK}/Lib/IA64 \
+ -LIBPATH:${MSSDK}/Lib/Prerelease/IA64"
+ STLIB_LD="${MSSDK}/bin/win64/lib.exe -nologo ${lflags}"
+ LINKBIN="${MSSDK}/bin/win64/link.exe ${lflags}"
+ else
+ RC="rc"
+ CFLAGS_DEBUG="-nologo -Z7 -Od -WX ${runtime}d"
+ CFLAGS_OPTIMIZE="-nologo -Oti -Gs -GD ${runtime}"
+ STLIB_LD="lib -nologo"
+ LINKBIN="link -link50compat"
+ fi
+
+ SHLIB_LD="${LINKBIN} -dll -nologo -incremental:no"
+ SHLIB_LD_LIBS="user32.lib advapi32.lib"
+ LIBS="user32.lib advapi32.lib"
+ LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib"
+ RC_OUT=-fo
+ RC_TYPE=-r
+ RC_INCLUDE=-i
+ RC_DEFINE=-d
+ RES=res
+ MAKE_LIB="\${STLIB_LD} -out:\[$]@"
+ POST_MAKE_LIB=
+ MAKE_EXE="\${CC} -Fe\[$]@"
+ LIBPREFIX=""
EXTRA_CFLAGS="-YX"
- CFLAGS_DEBUG="-nologo -Z7 -Od -WX ${runtime}d"
-# CFLAGS_OPTIMIZE="-nologo -O2 -Gs -GD ${runtime}"
- CFLAGS_OPTIMIZE="-nologo -Oti -Gs -GD ${runtime}"
CFLAGS_WARNING="-W3"
- LDFLAGS_DEBUG="-debug:full -debugtype:cv"
+ LDFLAGS_DEBUG="-debug:full -debugtype:both"
LDFLAGS_OPTIMIZE="-release"
-
+
# Specify the CC output file names based on the target name
CC_OBJNAME="-Fo\[$]@"
CC_EXENAME="-Fe\"\$(shell \$(CYGPATH) '\[$]@')\""
# Specify linker flags depending on the type of app being
# built -- Console vs. Window.
- LDFLAGS_CONSOLE="-link -subsystem:console"
- LDFLAGS_WINDOW="-link -subsystem:windows"
+ LDFLAGS_CONSOLE="-link -subsystem:console ${lflags}"
+ LDFLAGS_WINDOW="-link -subsystem:windows ${lflags}"
fi
- # Define the same variables as used in tclConfig.sh so that macros
- # that depend on these variables work for both Tcl and extensions.
- TCL_LIB_SUFFIX=$LIBSUFFIX
- TCL_VENDOR_PREFIX=$VENDORPREFIX
+ # DL_LIBS is empty, but then we match the Unix version
+ AC_SUBST(DL_LIBS)
+ AC_SUBST(CFLAGS_DEBUG)
+ AC_SUBST(CFLAGS_OPTIMIZE)
+ AC_SUBST(CFLAGS_WARNING)
])
#------------------------------------------------------------------------
@@ -521,13 +604,13 @@ AC_DEFUN(SC_CONFIG_CFLAGS, [
#------------------------------------------------------------------------
AC_DEFUN(SC_WITH_TCL, [
- if test -d ../../tcl8.3$1/win; then
- TCL_BIN_DEFAULT=../../tcl8.3$1/win
+ if test -d ../../tcl8.4$1/win; then
+ TCL_BIN_DEFAULT=../../tcl8.4$1/win
else
- TCL_BIN_DEFAULT=../../tcl8.3/win
+ TCL_BIN_DEFAULT=../../tcl8.4/win
fi
- AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.3 binaries from DIR],
+ AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.4 binaries from DIR],
TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd $TCL_BIN_DEFAULT; pwd`)
if test ! -d $TCL_BIN_DIR; then
AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR does not exist)
@@ -540,98 +623,50 @@ AC_DEFUN(SC_WITH_TCL, [
AC_SUBST(TCL_BIN_DIR)
])
-#--------------------------------------------------------------------
-# SC_TIME_HANLDER
-#
-# Checks how the system deals with time.h, what time structures
-# are used on the system, and what fields the structures have.
-#
-# Arguments:
+# FIXME : SC_PROG_TCLSH should really look for the installed tclsh and
+# not the build version. If we want to use the build version in the
+# tk script, it is better to hardcode that!
+
+#------------------------------------------------------------------------
+# SC_PROG_TCLSH
+# Locate a tclsh shell in the following directories:
+# ${exec_prefix}/bin
+# ${prefix}/bin
+# ${TCL_BIN_DIR}
+# ${TCL_BIN_DIR}/../bin
+# ${PATH}
+#
+# Arguments
# none
-#
-# Results:
-#
-# Defines some of the following vars:
-# USE_DELTA_FOR_TZ
-# HAVE_TM_GMTOFF
-# HAVE_TM_TZADJ
-# HAVE_TIMEZONE_VAR
#
-#--------------------------------------------------------------------
-
-AC_DEFUN(SC_TIME_HANDLER, [
- AC_CHECK_HEADERS(sys/time.h)
- AC_HEADER_TIME
- AC_STRUCT_TIMEZONE
-
- AC_MSG_CHECKING([tm_tzadj in struct tm])
- AC_TRY_COMPILE([#include <time.h>], [struct tm tm; tm.tm_tzadj;],
- [AC_DEFINE(HAVE_TM_TZADJ)
- AC_MSG_RESULT(yes)],
- AC_MSG_RESULT(no))
-
- AC_MSG_CHECKING([tm_gmtoff in struct tm])
- AC_TRY_COMPILE([#include <time.h>], [struct tm tm; tm.tm_gmtoff;],
- [AC_DEFINE(HAVE_TM_GMTOFF)
- AC_MSG_RESULT(yes)],
- AC_MSG_RESULT(no))
-
- #
- # Its important to include time.h in this check, as some systems
- # (like convex) have timezone functions, etc.
- #
- have_timezone=no
- AC_MSG_CHECKING([long timezone variable])
- AC_TRY_COMPILE([#include <time.h>],
- [extern long timezone;
- timezone += 1;
- exit (0);],
- [have_timezone=yes
- AC_DEFINE(HAVE_TIMEZONE_VAR)
- AC_MSG_RESULT(yes)],
- AC_MSG_RESULT(no))
-
- #
- # On some systems (eg IRIX 6.2), timezone is a time_t and not a long.
- #
- if test "$have_timezone" = no; then
- AC_MSG_CHECKING([time_t timezone variable])
- AC_TRY_COMPILE([#include <time.h>],
- [extern time_t timezone;
- timezone += 1;
- exit (0);],
- [AC_DEFINE(HAVE_TIMEZONE_VAR)
- AC_MSG_RESULT(yes)],
- AC_MSG_RESULT(no))
- fi
-
- #
- # On some systems (eg Solaris 2.5.1), timezone is not declared in
- # time.h unless you jump through hoops. Instead of that, we just
- # declare it ourselves when necessary.
- #
- if test "$have_timezone" = yes; then
- AC_MSG_CHECKING(for timezone declaration)
- changequote(<<,>>)
- tzrx='^[ ]*extern.*timezone'
- changequote([,])
- AC_EGREP_HEADER($tzrx, time.h, [
- AC_DEFINE(HAVE_TIMEZONE_DECL)
- AC_MSG_RESULT(found)], AC_MSG_RESULT(missing))
- fi
-
- #
- # AIX does not have a timezone field in struct tm. When the AIX bsd
- # library is used, the timezone global and the gettimeofday methods are
- # to be avoided for timezone deduction instead, we deduce the timezone
- # by comparing the localtime result on a known GMT value.
- #
+# Results
+# Subst's the following values:
+# TCLSH_PROG
+#------------------------------------------------------------------------
- if test "`uname -s`" = "AIX" ; then
- AC_CHECK_LIB(bsd, gettimeofday, libbsd=yes)
- if test $libbsd = yes; then
- AC_DEFINE(USE_DELTA_FOR_TZ)
- fi
+AC_DEFUN(SC_PROG_TCLSH, [
+ AC_MSG_CHECKING([for tclsh])
+
+ AC_CACHE_VAL(ac_cv_path_tclsh, [
+ search_path=`echo ${exec_prefix}/bin:${prefix}/bin:${TCL_BIN_DIR}:${TCL_BIN_DIR}/../bin:${PATH} | sed -e 's/:/ /g'`
+ for dir in $search_path ; do
+ for j in `ls -r $dir/tclsh[[8-9]]*.exe 2> /dev/null` \
+ `ls -r $dir/tclsh* 2> /dev/null` ; do
+ if test x"$ac_cv_path_tclsh" = x ; then
+ if test -f "$j" ; then
+ ac_cv_path_tclsh=$j
+ break
+ fi
+ fi
+ done
+ done
+ ])
+
+ if test -f "$ac_cv_path_tclsh" ; then
+ TCLSH_PROG=$ac_cv_path_tclsh
+ AC_MSG_RESULT($TCLSH_PROG)
+ else
+ AC_MSG_ERROR(No tclsh found in PATH: $search_path)
fi
+ AC_SUBST(TCLSH_PROG)
])
-
diff --git a/tcl/win/tcl.rc b/tcl/win/tcl.rc
index 504b68f6a20..8b975e8bf92 100644
--- a/tcl/win/tcl.rc
+++ b/tcl/win/tcl.rc
@@ -1,22 +1,42 @@
// RCS: @(#) $Id$
//
-// Version
+// Version Resource Script
//
-#define VS_VERSION_INFO 1
-
-#define RESOURCE_INCLUDED
+#include <winver.h>
#include <tcl.h>
+//
+// build-up the name suffix that defines the type of build this is.
+//
+#ifdef TCL_THREADS
+#define SUFFIX_THREADS "t"
+#else
+#define SUFFIX_THREADS ""
+#endif
+
+#ifdef DEBUG
+#define SUFFIX_DEBUG "d"
+#else
+#define SUFFIX_DEBUG ""
+#endif
+
+#define SUFFIX SUFFIX_THREADS SUFFIX_DEBUG
+
+
LANGUAGE 0x9, 0x1 /* LANG_ENGLISH, SUBLANG_DEFAULT */
VS_VERSION_INFO VERSIONINFO
FILEVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL
PRODUCTVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL
FILEFLAGSMASK 0x3fL
+#ifdef DEBUG
+ FILEFLAGS VS_FF_DEBUG
+#else
FILEFLAGS 0x0L
- FILEOS 0x4 /* VOS__WINDOWS32 */
- FILETYPE 0x2 /* VFT_DLL */
+#endif
+ FILEOS VOS__WINDOWS32
+ FILETYPE VFT_DLL
FILESUBTYPE 0x0L
BEGIN
BLOCK "StringFileInfo"
@@ -24,10 +44,10 @@ BEGIN
BLOCK "040904b0" /* LANG_ENGLISH/SUBLANG_ENGLISH_US, Unicode CP */
BEGIN
VALUE "FileDescription", "Tcl DLL\0"
- VALUE "OriginalFilename", "tcl" STRINGIFY(TCL_MAJOR_VERSION) STRINGIFY(TCL_MINOR_VERSION) ".dll\0"
- VALUE "CompanyName", "Scriptics Corporation\0"
+ VALUE "OriginalFilename", "tcl" STRINGIFY(JOIN(TCL_MAJOR_VERSION,TCL_MINOR_VERSION)) SUFFIX ".dll\0"
+ VALUE "CompanyName", "ActiveState Corporation\0"
VALUE "FileVersion", TCL_PATCH_LEVEL
- VALUE "LegalCopyright", "Copyright (c) 2000 by Scriptics Corporation\0"
+ VALUE "LegalCopyright", "Copyright \251 2001 by ActiveState Corporation, et al\0"
VALUE "ProductName", "Tcl " TCL_VERSION " for Windows\0"
VALUE "ProductVersion", TCL_PATCH_LEVEL
END
@@ -37,13 +57,3 @@ BEGIN
VALUE "Translation", 0x409, 1200
END
END
-
-
-
-
-
-
-
-
-
-
diff --git a/tcl/win/tclAppInit.c b/tcl/win/tclAppInit.c
index 6870adcf653..c754fc9786d 100644
--- a/tcl/win/tclAppInit.c
+++ b/tcl/win/tclAppInit.c
@@ -299,5 +299,3 @@ setargv(argcPtr, argvPtr)
*argcPtr = argc;
*argvPtr = argv;
}
-
-
diff --git a/tcl/win/tclConfig.sh.in b/tcl/win/tclConfig.sh.in
index 7748a5d9c2d..1f31946d5c9 100644
--- a/tcl/win/tclConfig.sh.in
+++ b/tcl/win/tclConfig.sh.in
@@ -11,6 +11,8 @@
#
# RCS: @(#) $Id$
+TCL_DLL_FILE="@TCL_DLL_FILE@"
+
# Tcl's version number.
TCL_VERSION='@TCL_VERSION@'
TCL_MAJOR_VERSION='@TCL_MAJOR_VERSION@'
@@ -41,9 +43,6 @@ TCL_SHARED_BUILD=@TCL_SHARED_BUILD@
# The name of the Tcl library (may be either a .a file or a shared library):
TCL_LIB_FILE='@TCL_LIB_FILE@'
-# The fullpath of the Tcl library (used for dependency checking)
-TCL_LIB_FULL_PATH='@TCL_LIB_FULL_PATH@'
-
# Flag to indicate whether shared libraries need export files.
TCL_NEEDS_EXP_FILE=@TCL_NEEDS_EXP_FILE@
@@ -84,11 +83,8 @@ TCL_STLIB_LD='@STLIB_LD@'
# explanation.
TCL_SHLIB_LD_LIBS='@SHLIB_LD_LIBS@'
-# Suffix to use in the name of a shared library.
-TCL_SHLIB_SUFFIX='@DLLSUFFIX@'
-
-# Suffix to use in the name of an unshared library.
-TCL_LIB_SUFFIX='@LIBSUFFIX@'
+# Suffix to use for the name of a shared library.
+TCL_SHLIB_SUFFIX='@SHLIB_SUFFIX@'
# Library file(s) to include in tclsh and other base applications
# in order to provide facilities needed by DLOBJ above.
@@ -122,6 +118,10 @@ TCL_BUILD_LIB_SPEC='@TCL_BUILD_LIB_SPEC@'
# installed directory.
TCL_LIB_SPEC='@TCL_LIB_SPEC@'
+# String to pass to the compiler so that an extension can
+# find installed Tcl headers.
+TCL_INCLUDE_SPEC='@TCL_INCLUDE_SPEC@'
+
# Indicates whether a version numbers should be used in -l switches
# ("ok" means it's safe to use switches like -ltcl7.5; "nodots" means
# use switches like -ltcl75). SunOS and FreeBSD require "nodots", for
@@ -177,9 +177,6 @@ TCL_BUILD_STUB_LIB_PATH='@TCL_BUILD_STUB_LIB_PATH@'
# Path to the Tcl stub library in the install directory.
TCL_STUB_LIB_PATH='@TCL_STUB_LIB_PATH@'
-TCL_DLL_FILE="@TCL_DLL_FILE@"
-TCL_STUB_LIB_FILE="@TCL_STUB_LIB_FILE@"
-
-# Vendor prefix to be added to lib names
-TCL_VENDOR_PREFIX=@VENDORPREFIX@
+# Flag, 1: we built Tcl with threads enables, 0 we didn't
+TCL_THREADS=@TCL_THREADS@
diff --git a/tcl/win/tclWin32Dll.c b/tcl/win/tclWin32Dll.c
index 26b53c92e63..6394e0ed900 100644
--- a/tcl/win/tclWin32Dll.c
+++ b/tcl/win/tclWin32Dll.c
@@ -37,6 +37,11 @@ typedef VOID (WINAPI UTUNREGISTER)(HANDLE hModule);
static HINSTANCE hInstance; /* HINSTANCE of this DLL. */
static int platformId; /* Running under NT, or 95/98? */
+#ifdef HAVE_NO_SEH
+static void *ESP;
+static void *EBP;
+#endif /* HAVE_NO_SEH */
+
/*
* The following function tables are used to dispatch to either the
* wide-character or multi-byte versions of the operating system calls,
@@ -78,6 +83,8 @@ static TclWinProcs asciiProcs = {
WCHAR *, TCHAR **)) SearchPathA,
(BOOL (WINAPI *)(CONST TCHAR *)) SetCurrentDirectoryA,
(BOOL (WINAPI *)(CONST TCHAR *, DWORD)) SetFileAttributesA,
+ NULL,
+ NULL,
};
static TclWinProcs unicodeProcs = {
@@ -115,6 +122,8 @@ static TclWinProcs unicodeProcs = {
WCHAR *, TCHAR **)) SearchPathW,
(BOOL (WINAPI *)(CONST TCHAR *)) SetCurrentDirectoryW,
(BOOL (WINAPI *)(CONST TCHAR *, DWORD)) SetFileAttributesW,
+ NULL,
+ NULL,
};
TclWinProcs *tclWinProcs;
@@ -127,14 +136,6 @@ static Tcl_Encoding tclWinTCharEncoding;
BOOL APIENTRY DllMain(HINSTANCE hInst, DWORD reason,
LPVOID reserved);
-/* CYGNUS LOCAL */
-#ifdef __CYGWIN32__
-/* cygwin32 requires an impure pointer variable, which must be
- explicitly initialized when the DLL starts up. */
-struct _reent *_impure_ptr;
-extern struct _reent __declspec(dllimport) reent_data;
-#endif
-/* END CYGNUS LOCAL */
#ifdef __WIN32__
#ifndef STATIC_BUILD
@@ -190,16 +191,6 @@ DllMain(hInst, reason, reserved)
DWORD reason; /* Reason this function is being called. */
LPVOID reserved; /* Not used. */
{
- OSVERSIONINFO os;
-
- /* CYGNUS LOCAL */
-#ifdef __CYGWIN32__
- /* cygwin32 requires the impure data pointer to be initialized
- when the DLL starts up. */
- _impure_ptr = &reent_data;
-#endif
- /* END CYGNUS LOCAL */
-
switch (reason) {
case DLL_PROCESS_ATTACH:
TclWinInit(hInst);
@@ -356,6 +347,8 @@ TclWinNoBackslash(
int
TclpCheckStackSpace()
{
+ int retval = 0;
+
/*
* We can recurse only if there is at least TCL_WIN_STACK_THRESHOLD
* bytes of stack space left. alloca() is cheap on windows; basically
@@ -363,19 +356,56 @@ TclpCheckStackSpace()
* exception if the stack pointer is set below the bottom of the stack.
*/
-#ifndef __GNUC__
+#ifdef HAVE_NO_SEH
+ __asm__ __volatile__ (
+ "movl %esp, _ESP" "\n\t"
+ "movl %ebp, _EBP");
+
+ __asm__ __volatile__ (
+ "pushl $__except_checkstackspace_handler" "\n\t"
+ "pushl %fs:0" "\n\t"
+ "mov %esp, %fs:0");
+#else
__try {
+#endif /* HAVE_NO_SEH */
alloca(TCL_WIN_STACK_THRESHOLD);
- return 1;
- /* CYGNUS LOCAL */
- } __except (1) {}
+ retval = 1;
+#ifdef HAVE_NO_SEH
+ __asm__ __volatile__ (
+ "jmp checkstackspace_pop" "\n"
+ "checkstackspace_reentry:" "\n\t"
+ "movl _ESP, %esp" "\n\t"
+ "movl _EBP, %ebp");
+
+ __asm__ __volatile__ (
+ "checkstackspace_pop:" "\n\t"
+ "mov (%esp), %eax" "\n\t"
+ "mov %eax, %fs:0" "\n\t"
+ "add $8, %esp");
#else
- return alloca(TCL_WIN_STACK_THRESHOLD) != NULL;
-#endif
+ } __except (EXCEPTION_EXECUTE_HANDLER) {}
+#endif /* HAVE_NO_SEH */
- return 0;
+ /*
+ * Avoid using control flow statements in the SEH guarded block!
+ */
+ return retval;
}
-
+#ifdef HAVE_NO_SEH
+static
+__attribute__ ((cdecl))
+EXCEPTION_DISPOSITION
+_except_checkstackspace_handler(
+ struct _EXCEPTION_RECORD *ExceptionRecord,
+ void *EstablisherFrame,
+ struct _CONTEXT *ContextRecord,
+ void *DispatcherContext)
+{
+ __asm__ __volatile__ (
+ "jmp checkstackspace_reentry");
+ return 0; /* Function does not return */
+}
+#endif /* HAVE_NO_SEH */
/*
*----------------------------------------------------------------------
@@ -409,6 +439,10 @@ TclWinGetPlatform()
* tclWinProcs structure to dispatch to either the wide-character
* or multi-byte versions of the operating system calls, depending
* on whether Unicode is the system encoding.
+ *
+ * As well as this, we can also try to load in some additional
+ * procs which may/may not be present depending on the current
+ * Windows version (e.g. Win95 will not have the procs below).
*
* Results:
* None.
@@ -429,9 +463,35 @@ TclWinSetInterfaces(
if (wide) {
tclWinProcs = &unicodeProcs;
tclWinTCharEncoding = Tcl_GetEncoding(NULL, "unicode");
+ if (tclWinProcs->getFileAttributesExProc == NULL) {
+ HINSTANCE hInstance = LoadLibraryA("kernel32");
+ if (hInstance != NULL) {
+ tclWinProcs->getFileAttributesExProc =
+ (BOOL (WINAPI *)(CONST TCHAR *, GET_FILEEX_INFO_LEVELS,
+ LPVOID)) GetProcAddress(hInstance, "GetFileAttributesExW");
+ tclWinProcs->createHardLinkProc =
+ (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR*,
+ LPSECURITY_ATTRIBUTES)) GetProcAddress(hInstance,
+ "CreateHardLinkW");
+ FreeLibrary(hInstance);
+ }
+ }
} else {
tclWinProcs = &asciiProcs;
tclWinTCharEncoding = NULL;
+ if (tclWinProcs->getFileAttributesExProc == NULL) {
+ HINSTANCE hInstance = LoadLibraryA("kernel32");
+ if (hInstance != NULL) {
+ tclWinProcs->getFileAttributesExProc =
+ (BOOL (WINAPI *)(CONST TCHAR *, GET_FILEEX_INFO_LEVELS,
+ LPVOID)) GetProcAddress(hInstance, "GetFileAttributesExA");
+ tclWinProcs->createHardLinkProc =
+ (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR*,
+ LPSECURITY_ATTRIBUTES)) GetProcAddress(hInstance,
+ "CreateHardLinkA");
+ FreeLibrary(hInstance);
+ }
+ }
}
}
@@ -513,6 +573,3 @@ Tcl_WinTCharToUtf(string, len, dsPtr)
return Tcl_ExternalToUtfDString(tclWinTCharEncoding,
(CONST char *) string, len, dsPtr);
}
-
-
-
diff --git a/tcl/win/tclWinChan.c b/tcl/win/tclWinChan.c
index 8b6c0acf7c5..2d4470c49cc 100644
--- a/tcl/win/tclWinChan.c
+++ b/tcl/win/tclWinChan.c
@@ -40,6 +40,8 @@ typedef struct FileInfo {
int flags; /* State flags, see above for a list. */
HANDLE handle; /* Input/output file. */
struct FileInfo *nextPtr; /* Pointer to next registered file. */
+ int dirty; /* Boolean flag. Set if the OS may have data
+ * pending on the channel */
} FileInfo;
typedef struct ThreadSpecificData {
@@ -86,9 +88,11 @@ static ThreadSpecificData *FileInit _ANSI_ARGS_((void));
static int FileInputProc _ANSI_ARGS_((ClientData instanceData,
char *buf, int toRead, int *errorCode));
static int FileOutputProc _ANSI_ARGS_((ClientData instanceData,
- char *buf, int toWrite, int *errorCode));
+ CONST char *buf, int toWrite, int *errorCode));
static int FileSeekProc _ANSI_ARGS_((ClientData instanceData,
long offset, int mode, int *errorCode));
+static Tcl_WideInt FileWideSeekProc _ANSI_ARGS_((ClientData instanceData,
+ Tcl_WideInt offset, int mode, int *errorCode));
static void FileSetupProc _ANSI_ARGS_((ClientData clientData,
int flags));
static void FileWatchProc _ANSI_ARGS_((ClientData instanceData,
@@ -101,7 +105,7 @@ static void FileWatchProc _ANSI_ARGS_((ClientData instanceData,
static Tcl_ChannelType fileChannelType = {
"file", /* Type name. */
- TCL_CHANNEL_VERSION_2, /* v2 channel */
+ TCL_CHANNEL_VERSION_3, /* v3 channel */
FileCloseProc, /* Close proc. */
FileInputProc, /* Input proc. */
FileOutputProc, /* Output proc. */
@@ -114,8 +118,14 @@ static Tcl_ChannelType fileChannelType = {
FileBlockProc, /* Set blocking or non-blocking mode.*/
NULL, /* flush proc. */
NULL, /* handler proc. */
+ FileWideSeekProc, /* Wide seek proc. */
};
+#ifdef HAVE_NO_SEH
+static void *ESP;
+static void *EBP;
+#endif /* HAVE_NO_SEH */
+
/*
*----------------------------------------------------------------------
@@ -431,15 +441,15 @@ FileCloseProc(instanceData, interp)
static int
FileSeekProc(instanceData, offset, mode, errorCodePtr)
- ClientData instanceData; /* File state. */
- long offset; /* Offset to seek to. */
- int mode; /* Relative to where
- * should we seek? */
- int *errorCodePtr; /* To store error code. */
+ ClientData instanceData; /* File state. */
+ long offset; /* Offset to seek to. */
+ int mode; /* Relative to where should we seek? */
+ int *errorCodePtr; /* To store error code. */
{
FileInfo *infoPtr = (FileInfo *) instanceData;
DWORD moveMethod;
- DWORD newPos;
+ DWORD newPos, newPosHigh;
+ DWORD oldPos, oldPosHigh;
*errorCodePtr = 0;
if (mode == SEEK_SET) {
@@ -450,13 +460,94 @@ FileSeekProc(instanceData, offset, mode, errorCodePtr)
moveMethod = FILE_END;
}
- newPos = SetFilePointer(infoPtr->handle, offset, NULL, moveMethod);
- if (newPos == 0xFFFFFFFF) {
- TclWinConvertError(GetLastError());
- *errorCodePtr = errno;
+ /*
+ * Save our current place in case we need to roll-back the seek.
+ */
+ oldPosHigh = (DWORD)0;
+ oldPos = SetFilePointer(infoPtr->handle, (LONG)0, &oldPosHigh,
+ FILE_CURRENT);
+ if (oldPos == INVALID_SET_FILE_POINTER) {
+ int winError = GetLastError();
+ if (winError != NO_ERROR) {
+ TclWinConvertError(winError);
+ *errorCodePtr = errno;
+ return -1;
+ }
+ }
+
+ newPosHigh = (DWORD)(offset < 0 ? -1 : 0);
+ newPos = SetFilePointer(infoPtr->handle, (LONG) offset, &newPosHigh,
+ moveMethod);
+ if (newPos == INVALID_SET_FILE_POINTER) {
+ int winError = GetLastError();
+ if (winError != NO_ERROR) {
+ TclWinConvertError(winError);
+ *errorCodePtr = errno;
+ return -1;
+ }
+ }
+
+ /*
+ * Check for expressability in our return type, and roll-back otherwise.
+ */
+ if (newPosHigh != 0) {
+ *errorCodePtr = EOVERFLOW;
+ SetFilePointer(infoPtr->handle, (LONG)oldPos, &oldPosHigh, FILE_BEGIN);
return -1;
}
- return newPos;
+ return (int) newPos;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileWideSeekProc --
+ *
+ * Seeks on a file-based channel. Returns the new position.
+ *
+ * Results:
+ * -1 if failed, the new position if successful. If failed, it
+ * also sets *errorCodePtr to the error code.
+ *
+ * Side effects:
+ * Moves the location at which the channel will be accessed in
+ * future operations.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_WideInt
+FileWideSeekProc(instanceData, offset, mode, errorCodePtr)
+ ClientData instanceData; /* File state. */
+ Tcl_WideInt offset; /* Offset to seek to. */
+ int mode; /* Relative to where should we seek? */
+ int *errorCodePtr; /* To store error code. */
+{
+ FileInfo *infoPtr = (FileInfo *) instanceData;
+ DWORD moveMethod;
+ DWORD newPos, newPosHigh;
+
+ *errorCodePtr = 0;
+ if (mode == SEEK_SET) {
+ moveMethod = FILE_BEGIN;
+ } else if (mode == SEEK_CUR) {
+ moveMethod = FILE_CURRENT;
+ } else {
+ moveMethod = FILE_END;
+ }
+
+ newPosHigh = (DWORD)(offset >> 32);
+ newPos = SetFilePointer(infoPtr->handle, (LONG) offset, &newPosHigh,
+ moveMethod);
+ if (newPos == INVALID_SET_FILE_POINTER) {
+ int winError = GetLastError();
+ if (winError != NO_ERROR) {
+ TclWinConvertError(winError);
+ *errorCodePtr = errno;
+ return -1;
+ }
+ }
+ return ((Tcl_WideInt) newPos) | (((Tcl_WideInt) newPosHigh) << 32);
}
/*
@@ -533,7 +624,7 @@ FileInputProc(instanceData, buf, bufSize, errorCode)
static int
FileOutputProc(instanceData, buf, toWrite, errorCode)
ClientData instanceData; /* File state. */
- char *buf; /* The data buffer. */
+ CONST char *buf; /* The data buffer. */
int toWrite; /* How many bytes to write? */
int *errorCode; /* Where to store error code. */
{
@@ -557,7 +648,7 @@ FileOutputProc(instanceData, buf, toWrite, errorCode)
*errorCode = errno;
return -1;
}
- FlushFileBuffers(infoPtr->handle);
+ infoPtr->dirty = 1;
return bytesWritten;
}
@@ -653,50 +744,30 @@ FileGetHandleProc(instanceData, direction, handlePtr)
*/
Tcl_Channel
-TclpOpenFileChannel(interp, fileName, modeString, permissions)
+TclpOpenFileChannel(interp, pathPtr, mode, permissions)
Tcl_Interp *interp; /* Interpreter for error reporting;
* can be NULL. */
- char *fileName; /* Name of file to open. */
- char *modeString; /* A list of POSIX open modes or
- * a string such as "rw". */
+ Tcl_Obj *pathPtr; /* Name of file to open. */
+ int mode; /* POSIX mode. */
int permissions; /* If the open involves creating a
* file, with what modes to create
* it? */
{
Tcl_Channel channel = 0;
- int seekFlag, mode, channelPermissions;
+ int channelPermissions;
DWORD accessMode, createMode, shareMode, flags, consoleParams, type;
- TCHAR *nativeName;
- Tcl_DString ds, buffer;
+ CONST TCHAR *nativeName;
DCB dcb;
HANDLE handle;
char channelName[16 + TCL_INTEGER_SPACE];
TclFile readFile = NULL;
TclFile writeFile = NULL;
-#ifdef __CYGWIN__
- char winbuf[MAX_PATH];
-#endif
- mode = TclGetOpenMode(interp, modeString, &seekFlag);
- if (mode == -1) {
- return NULL;
- }
-
- if (Tcl_TranslateFileName(interp, fileName, &ds) == NULL) {
+ nativeName = (TCHAR*) Tcl_FSGetNativePath(pathPtr);
+ if (nativeName == NULL) {
return NULL;
}
- nativeName = Tcl_WinUtfToTChar(Tcl_DStringValue(&ds),
- Tcl_DStringLength(&ds), &buffer);
-
-#ifdef __CYGWIN__
- /* 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. */
- cygwin_conv_to_win32_path(nativeName, winbuf);
- Tcl_DStringFree(&buffer);
- Tcl_DStringAppend(&buffer, winbuf, -1);
-#endif
-
+
switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
case O_RDONLY:
accessMode = GENERIC_READ;
@@ -778,10 +849,10 @@ TclpOpenFileChannel(interp, fileName, modeString, permissions)
}
TclWinConvertError(err);
if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp, "couldn't open \"", fileName, "\": ",
+ Tcl_AppendResult(interp, "couldn't open \"",
+ Tcl_GetString(pathPtr), "\": ",
Tcl_PosixError(interp), (char *) NULL);
}
- Tcl_DStringFree(&buffer);
return NULL;
}
@@ -809,6 +880,20 @@ TclpOpenFileChannel(interp, fileName, modeString, permissions)
switch (type) {
case FILE_TYPE_SERIAL:
+ /*
+ * Reopen channel for OVERLAPPED operation
+ * Normally this shouldn't fail, because the channel exists
+ */
+ handle = TclWinSerialReopen(handle, nativeName, accessMode);
+ if (handle == INVALID_HANDLE_VALUE) {
+ TclWinConvertError(GetLastError());
+ if (interp != (Tcl_Interp *) NULL) {
+ Tcl_AppendResult(interp, "couldn't reopen serial \"",
+ Tcl_GetString(pathPtr), "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
+ }
+ return NULL;
+ }
channel = TclWinOpenSerialChannel(handle, channelName,
channelPermissions);
break;
@@ -840,28 +925,12 @@ TclpOpenFileChannel(interp, fileName, modeString, permissions)
*/
channel = NULL;
- Tcl_AppendResult(interp, "couldn't open \"", fileName, "\": ",
- "bad file type", (char *) NULL);
+ Tcl_AppendResult(interp, "couldn't open \"",
+ Tcl_GetString(pathPtr), "\": ",
+ "bad file type", (char *) NULL);
break;
}
- Tcl_DStringFree(&buffer);
- Tcl_DStringFree(&ds);
-
- if (channel != NULL) {
- if (seekFlag) {
- if (Tcl_Seek(channel, 0, SEEK_END) < 0) {
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp,
- "could not seek to end of file on \"",
- channelName, "\": ", Tcl_PosixError(interp),
- (char *) NULL);
- }
- Tcl_Close(NULL, channel);
- return NULL;
- }
- }
- }
return channel;
}
@@ -891,16 +960,21 @@ Tcl_MakeFileChannel(rawHandle, mode)
char channelName[16 + TCL_INTEGER_SPACE];
Tcl_Channel channel = NULL;
HANDLE handle = (HANDLE) rawHandle;
+ HANDLE dupedHandle;
DCB dcb;
- DWORD consoleParams;
- DWORD type;
+ DWORD consoleParams, type;
TclFile readFile = NULL;
TclFile writeFile = NULL;
+ BOOL result;
if (mode == 0) {
return NULL;
}
+ /*
+ * GetFileType() returns FILE_TYPE_UNKNOWN for invalid handles.
+ */
+
type = GetFileType(handle);
/*
@@ -942,23 +1016,109 @@ Tcl_MakeFileChannel(rawHandle, mode)
case FILE_TYPE_DISK:
case FILE_TYPE_CHAR:
- case FILE_TYPE_UNKNOWN:
channel = TclWinOpenFileChannel(handle, channelName, mode, 0);
break;
+ case FILE_TYPE_UNKNOWN:
default:
/*
- * The handle is of an unknown type, probably /dev/nul equivalent
- * or possibly a closed handle.
+ * The handle is of an unknown type. Test the validity of this OS
+ * handle by duplicating it, then closing the dupe. The Win32 API
+ * doesn't provide an IsValidHandle() function, so we have to emulate
+ * it here. This test will not work on a console handle reliably,
+ * which is why we can't test every handle that comes into this
+ * function in this way.
*/
-
- channel = NULL;
- break;
+ result = DuplicateHandle(GetCurrentProcess(), handle,
+ GetCurrentProcess(), &dupedHandle, 0, FALSE,
+ DUPLICATE_SAME_ACCESS);
+
+ if (result != 0) {
+ /*
+ * Unable to make a duplicate. It's definately invalid at this
+ * point.
+ */
+
+ return NULL;
+ }
+
+ /*
+ * Use structured exception handling (Win32 SEH) to protect the close
+ * of this duped handle which might throw EXCEPTION_INVALID_HANDLE.
+ */
+
+#ifdef HAVE_NO_SEH
+ __asm__ __volatile__ (
+ "movl %esp, _ESP" "\n\t"
+ "movl %ebp, _EBP");
+
+ __asm__ __volatile__ (
+ "pushl $__except_makefilechannel_handler" "\n\t"
+ "pushl %fs:0" "\n\t"
+ "mov %esp, %fs:0");
+
+ result = 0;
+#else
+ __try {
+#endif /* HAVE_NO_SEH */
+ CloseHandle(dupedHandle);
+#ifdef HAVE_NO_SEH
+ __asm__ __volatile__ (
+ "jmp makefilechannel_pop" "\n"
+ "makefilechannel_reentry:" "\n\t"
+ "movl _ESP, %esp" "\n\t"
+ "movl _EBP, %ebp");
+
+ result = 1; /* True when exception was raised */
+
+ __asm__ __volatile__ (
+ "makefilechannel_pop:" "\n\t"
+ "mov (%esp), %eax" "\n\t"
+ "mov %eax, %fs:0" "\n\t"
+ "add $8, %esp");
+
+ if (result)
+ return NULL;
+#else
+ }
+ __except (EXCEPTION_EXECUTE_HANDLER) {
+ /*
+ * Definately an invalid handle. So, therefore, the original
+ * is invalid also.
+ */
+
+ return NULL;
+ }
+#endif /* HAVE_NO_SEH */
+
+ /* Fall through, the handle is valid. */
+
+ /*
+ * Create the undefined channel, anyways, because we know the handle
+ * is valid to something.
+ */
+
+ channel = TclWinOpenFileChannel(handle, channelName, mode, 0);
}
return channel;
}
+#ifdef HAVE_NO_SEH
+static
+__attribute__ ((cdecl))
+EXCEPTION_DISPOSITION
+_except_makefilechannel_handler(
+ struct _EXCEPTION_RECORD *ExceptionRecord,
+ void *EstablisherFrame,
+ struct _CONTEXT *ContextRecord,
+ void *DispatcherContext)
+{
+ __asm__ __volatile__ (
+ "jmp makefilechannel_reentry");
+ return 0; /* Function does not return */
+}
+#endif
/*
*----------------------------------------------------------------------
@@ -987,6 +1147,7 @@ TclpGetDefaultStdChannel(type)
char *bufMode;
DWORD handleId; /* Standard handle to retrieve. */
+
switch (type) {
case TCL_STDIN:
handleId = STD_INPUT_HANDLE;
@@ -1015,15 +1176,15 @@ TclpGetDefaultStdChannel(type)
* is not a console mode application, even though this is not a valid
* handle.
*/
-
+
if ((handle == INVALID_HANDLE_VALUE) || (handle == 0)) {
- return NULL;
+ return (Tcl_Channel) NULL;
}
-
+
channel = Tcl_MakeFileChannel(handle, mode);
if (channel == NULL) {
- return NULL;
+ return (Tcl_Channel) NULL;
}
/*
@@ -1093,7 +1254,7 @@ TclWinOpenFileChannel(handle, channelName, permissions, appendMode)
infoPtr->watchMask = 0;
infoPtr->flags = appendMode;
infoPtr->handle = handle;
-
+ infoPtr->dirty = 0;
wsprintfA(channelName, "file%lx", (int) infoPtr);
infoPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName,
@@ -1111,3 +1272,45 @@ TclWinOpenFileChannel(handle, channelName, permissions, appendMode)
}
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclWinFlushDirtyChannels --
+ *
+ * Flush all dirty channels to disk, so that requesting the
+ * size of any file returns the correct value.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information is actually written to disk now, rather than
+ * later. Don't call this too often, or there will be a
+ * performance hit (i.e. only call when we need to ask for
+ * the size of a file).
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclWinFlushDirtyChannels ()
+{
+ FileInfo *infoPtr;
+ ThreadSpecificData *tsdPtr;
+
+ tsdPtr = FileInit();
+
+ /*
+ * Flush all channels which are dirty, i.e. may have data pending
+ * in the OS
+ */
+
+ for (infoPtr = tsdPtr->firstFilePtr;
+ infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
+ if (infoPtr->dirty) {
+ FlushFileBuffers(infoPtr->handle);
+ infoPtr->dirty = 0;
+ }
+ }
+}
diff --git a/tcl/win/tclWinConsole.c b/tcl/win/tclWinConsole.c
index 4e38631a54f..80cb2ea2e1b 100644
--- a/tcl/win/tclWinConsole.c
+++ b/tcl/win/tclWinConsole.c
@@ -145,8 +145,8 @@ static int ConsoleGetHandleProc(ClientData instanceData,
static ThreadSpecificData *ConsoleInit(void);
static int ConsoleInputProc(ClientData instanceData, char *buf,
int toRead, int *errorCode);
-static int ConsoleOutputProc(ClientData instanceData, char *buf,
- int toWrite, int *errorCode);
+static int ConsoleOutputProc(ClientData instanceData,
+ CONST char *buf, int toWrite, int *errorCode);
static DWORD WINAPI ConsoleReaderThread(LPVOID arg);
static void ConsoleSetupProc(ClientData clientData, int flags);
static void ConsoleWatchProc(ClientData instanceData, int mask);
@@ -503,7 +503,13 @@ ConsoleCloseProc(
*/
if (consolePtr->writeThread) {
- WaitForSingleObject(consolePtr->writable, INFINITE);
+ if (consolePtr->toWrite) {
+ /*
+ * We only need to wait if there is something to write.
+ * This may prevent infinite wait on exit. [python bug 216289]
+ */
+ WaitForSingleObject(consolePtr->writable, INFINITE);
+ }
/*
* Forcibly terminate the background thread. We cannot rely on the
@@ -626,11 +632,11 @@ ConsoleInputProc(
*/
if (bufSize < (infoPtr->bytesRead - infoPtr->offset)) {
- memcpy(buf, &infoPtr->buffer[infoPtr->offset], bufSize);
+ memcpy(buf, &infoPtr->buffer[infoPtr->offset], (size_t) bufSize);
bytesRead = bufSize;
infoPtr->offset += bufSize;
} else {
- memcpy(buf, &infoPtr->buffer[infoPtr->offset], bufSize);
+ memcpy(buf, &infoPtr->buffer[infoPtr->offset], (size_t) bufSize);
bytesRead = infoPtr->bytesRead - infoPtr->offset;
/*
@@ -680,7 +686,7 @@ ConsoleInputProc(
static int
ConsoleOutputProc(
ClientData instanceData, /* Console state. */
- char *buf, /* The data buffer. */
+ CONST char *buf, /* The data buffer. */
int toWrite, /* How many bytes to write? */
int *errorCode) /* Where to store error code. */
{
@@ -724,9 +730,9 @@ ConsoleOutputProc(
ckfree(infoPtr->writeBuf);
}
infoPtr->writeBufLen = toWrite;
- infoPtr->writeBuf = ckalloc(toWrite);
+ infoPtr->writeBuf = ckalloc((unsigned int) toWrite);
}
- memcpy(infoPtr->writeBuf, buf, toWrite);
+ memcpy(infoPtr->writeBuf, buf, (size_t) toWrite);
infoPtr->toWrite = toWrite;
ResetEvent(infoPtr->writable);
SetEvent(infoPtr->startWriter);
@@ -819,7 +825,7 @@ ConsoleEventProc(
mask = 0;
if (infoPtr->watchMask & TCL_WRITABLE) {
if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) {
- mask = TCL_WRITABLE;
+ mask = TCL_WRITABLE;
}
}
@@ -1076,7 +1082,7 @@ ConsoleReaderThread(LPVOID arg)
* that are not KEY_EVENTs
*/
if (ReadConsole(handle, infoPtr->buffer, CONSOLE_BUFFER_SIZE,
- &infoPtr->bytesRead, NULL) != FALSE) {
+ (LPDWORD) &infoPtr->bytesRead, NULL) != FALSE) {
/*
* Data was stored in the buffer.
*/
@@ -1266,4 +1272,3 @@ TclWinOpenConsoleChannel(handle, channelName, permissions)
return infoPtr->channel;
}
-
diff --git a/tcl/win/tclWinDde.c b/tcl/win/tclWinDde.c
index c540f8026ac..4eb981e6e97 100644
--- a/tcl/win/tclWinDde.c
+++ b/tcl/win/tclWinDde.c
@@ -69,7 +69,7 @@ static DWORD ddeInstance; /* The application instance handle given
* to us by DdeInitialize. */
static int ddeIsServer = 0;
-#define TCL_DDE_VERSION "1.1"
+#define TCL_DDE_VERSION "1.2"
#define TCL_DDE_PACKAGE_NAME "dde"
#define TCL_DDE_SERVICE_NAME "TclEval"
@@ -733,7 +733,6 @@ MakeDdeConnection(
{
HSZ ddeTopic, ddeService;
HCONV ddeConv;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
ddeService = DdeCreateStringHandle(ddeInstance, "TclEval", 0);
ddeTopic = DdeCreateStringHandle(ddeInstance, name, 0);
@@ -835,12 +834,13 @@ Tcl_DdeObjCmd(
DDE_EVAL
};
- static char *ddeCommands[] = {"servername", "execute", "poke",
+ static CONST char *ddeCommands[] = {"servername", "execute", "poke",
"request", "services", "eval",
(char *) NULL};
- static char *ddeOptions[] = {"-async", (char *) NULL};
+ static CONST char *ddeOptions[] = {"-async", (char *) NULL};
+ static CONST char *ddeReqOptions[] = {"-binary", (char *) NULL};
int index, argIndex;
- int async = 0;
+ int async = 0, binary = 0;
int result = TCL_OK;
HSZ ddeService = NULL;
HSZ ddeTopic = NULL;
@@ -877,8 +877,7 @@ Tcl_DdeObjCmd(
switch (index) {
case DDE_SERVERNAME:
if ((objc != 3) && (objc != 2)) {
- Tcl_WrongNumArgs(interp, 1, objv,
- "servername ?serverName?");
+ Tcl_WrongNumArgs(interp, 1, objv, "servername ?serverName?");
return TCL_ERROR;
}
firstArg = (objc - 1);
@@ -917,12 +916,29 @@ Tcl_DdeObjCmd(
firstArg = 2;
break;
case DDE_REQUEST:
- if (objc != 5) {
+ if ((objc < 5) || (objc > 6)) {
Tcl_WrongNumArgs(interp, 1, objv,
- "request serviceName topicName value");
+ "request ?-binary? serviceName topicName value");
return TCL_ERROR;
}
- firstArg = 2;
+ if (Tcl_GetIndexFromObj(NULL, objv[2], ddeReqOptions, "option", 0,
+ &argIndex) != TCL_OK) {
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "request ?-binary? serviceName topicName value");
+ return TCL_ERROR;
+ }
+ binary = 0;
+ firstArg = 2;
+ } else {
+ if (objc != 6) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "request ?-binary? serviceName topicName value");
+ return TCL_ERROR;
+ }
+ binary = 1;
+ firstArg = 3;
+ }
break;
case DDE_SERVICES:
if (objc != 4) {
@@ -1003,10 +1019,9 @@ Tcl_DdeObjCmd(
result = TCL_ERROR;
break;
}
- hConv = DdeConnect(ddeInstance, ddeService, ddeTopic,
- NULL);
- DdeFreeStringHandle (ddeInstance, ddeService) ;
- DdeFreeStringHandle (ddeInstance, ddeTopic) ;
+ hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
+ DdeFreeStringHandle(ddeInstance, ddeService);
+ DdeFreeStringHandle(ddeInstance, ddeTopic);
if (hConv == NULL) {
SetDdeError(interp);
@@ -1021,7 +1036,7 @@ Tcl_DdeObjCmd(
DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, hConv, 0,
CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
DdeAbandonTransaction(ddeInstance, hConv,
- ddeResult);
+ ddeResult);
} else {
ddeReturn = DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF,
hConv, 0, CF_TEXT, XTYP_EXECUTE, 30000, NULL);
@@ -1045,8 +1060,8 @@ Tcl_DdeObjCmd(
return TCL_ERROR;
}
hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
- DdeFreeStringHandle (ddeInstance, ddeService) ;
- DdeFreeStringHandle (ddeInstance, ddeTopic) ;
+ DdeFreeStringHandle(ddeInstance, ddeService);
+ DdeFreeStringHandle(ddeInstance, ddeTopic);
if (hConv == NULL) {
SetDdeError(interp);
@@ -1063,7 +1078,12 @@ Tcl_DdeObjCmd(
result = TCL_ERROR;
} else {
dataString = DdeAccessData(ddeData, &dataLength);
- returnObjPtr = Tcl_NewStringObj(dataString, -1);
+ if (binary) {
+ returnObjPtr = Tcl_NewByteArrayObj(dataString,
+ dataLength);
+ } else {
+ returnObjPtr = Tcl_NewStringObj(dataString, -1);
+ }
DdeUnaccessData(ddeData);
DdeFreeDataHandle(ddeData);
Tcl_SetObjResult(interp, returnObjPtr);
@@ -1086,19 +1106,18 @@ Tcl_DdeObjCmd(
dataString = Tcl_GetStringFromObj(objv[firstArg + 3], &length);
hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
- DdeFreeStringHandle (ddeInstance,ddeService) ;
- DdeFreeStringHandle (ddeInstance, ddeTopic) ;
+ DdeFreeStringHandle(ddeInstance, ddeService);
+ DdeFreeStringHandle(ddeInstance, ddeTopic);
if (hConv == NULL) {
SetDdeError(interp);
result = TCL_ERROR;
} else {
- ddeItem = DdeCreateStringHandle(ddeInstance, itemString, \
+ ddeItem = DdeCreateStringHandle(ddeInstance, itemString,
CP_WINANSI);
if (ddeItem != NULL) {
- ddeData = DdeClientTransaction(dataString,length+1, \
- hConv, ddeItem,
- CF_TEXT, XTYP_POKE, 5000, NULL);
+ ddeData = DdeClientTransaction(dataString,length+1,
+ hConv, ddeItem, CF_TEXT, XTYP_POKE, 5000, NULL);
if (ddeData == NULL) {
SetDdeError(interp);
result = TCL_ERROR;
@@ -1121,8 +1140,8 @@ Tcl_DdeObjCmd(
convInfo.cb = sizeof(CONVINFO);
hConvList = DdeConnectList(ddeInstance, ddeService,
ddeTopic, 0, NULL);
- DdeFreeStringHandle (ddeInstance,ddeService) ;
- DdeFreeStringHandle (ddeInstance, ddeTopic) ;
+ DdeFreeStringHandle(ddeInstance,ddeService);
+ DdeFreeStringHandle(ddeInstance, ddeTopic);
hConv = 0;
convListObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
Tcl_DStringInit(&dString);
@@ -1146,7 +1165,8 @@ Tcl_DdeObjCmd(
length + 1, CP_WINANSI);
Tcl_ListObjAppendElement(interp, elementObjPtr,
Tcl_NewStringObj(name, length));
- Tcl_ListObjAppendElement(interp, convListObjPtr, elementObjPtr);
+ Tcl_ListObjAppendElement(interp, convListObjPtr,
+ elementObjPtr);
}
DdeDisconnectList(hConvList);
Tcl_SetObjResult(interp, convListObjPtr);
@@ -1167,13 +1187,13 @@ Tcl_DdeObjCmd(
* deallocated objects.
*/
- for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr
- = riPtr->nextPtr) {
+ for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
+ riPtr = riPtr->nextPtr) {
if (stricmp(serviceName, riPtr->name) == 0) {
break;
}
}
-
+
if (riPtr != NULL) {
/*
* This command is to a local interp. No need to go through
@@ -1185,26 +1205,29 @@ Tcl_DdeObjCmd(
Tcl_Preserve((ClientData) sendInterp);
/*
- * Don't exchange objects between interps. The target interp would
- * compile an object, producing a bytecode structure that refers to
- * other objects owned by the target interp. If the target interp
- * is then deleted, the bytecode structure would be referring to
- * deallocated objects.
+ * Don't exchange objects between interps. The target interp
+ * would compile an object, producing a bytecode structure that
+ * refers to other objects owned by the target interp. If the
+ * target interp is then deleted, the bytecode structure would
+ * be referring to deallocated objects.
*/
if (objc == 1) {
- result = Tcl_EvalObjEx(sendInterp, objv[0], TCL_EVAL_GLOBAL);
+ result = Tcl_EvalObjEx(sendInterp, objv[0],
+ TCL_EVAL_GLOBAL);
} else {
objPtr = Tcl_ConcatObj(objc, objv);
Tcl_IncrRefCount(objPtr);
- result = Tcl_EvalObjEx(sendInterp, objPtr, TCL_EVAL_GLOBAL);
+ result = Tcl_EvalObjEx(sendInterp, objPtr,
+ TCL_EVAL_GLOBAL);
Tcl_DecrRefCount(objPtr);
}
if (interp != sendInterp) {
if (result == TCL_ERROR) {
/*
- * An error occurred, so transfer error information from the
- * destination interpreter back to our interpreter.
+ * An error occurred, so transfer error information
+ * from the destination interpreter back to our
+ * interpreter.
*/
Tcl_ResetResult(interp);
@@ -1223,8 +1246,8 @@ Tcl_DdeObjCmd(
Tcl_Release((ClientData) sendInterp);
} else {
/*
- * This is a non-local request. Send the script to the server and poll
- * it for a result.
+ * This is a non-local request. Send the script to the server
+ * and poll it for a result.
*/
if (MakeDdeConnection(interp, serviceName, &hConv) != TCL_OK) {
@@ -1233,26 +1256,27 @@ Tcl_DdeObjCmd(
objPtr = Tcl_ConcatObj(objc, objv);
string = Tcl_GetStringFromObj(objPtr, &length);
- ddeItemData = DdeCreateDataHandle(ddeInstance, string, length+1, 0, 0,
- CF_TEXT, 0);
+ ddeItemData = DdeCreateDataHandle(ddeInstance, string,
+ length+1, 0, 0, CF_TEXT, 0);
if (async) {
- ddeData = DdeClientTransaction((LPBYTE) ddeItemData, 0xFFFFFFFF, hConv, 0,
+ ddeData = DdeClientTransaction((LPBYTE) ddeItemData,
+ 0xFFFFFFFF, hConv, 0,
CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
DdeAbandonTransaction(ddeInstance, hConv, ddeResult);
} else {
- ddeData = DdeClientTransaction((LPBYTE) ddeItemData, 0xFFFFFFFF, hConv, 0,
+ ddeData = DdeClientTransaction((LPBYTE) ddeItemData,
+ 0xFFFFFFFF, hConv, 0,
CF_TEXT, XTYP_EXECUTE, 30000, NULL);
if (ddeData != 0) {
ddeCookie = DdeCreateStringHandle(ddeInstance,
"$TCLEVAL$EXECUTE$RESULT", CP_WINANSI);
- ddeData = DdeClientTransaction(NULL, 0, hConv, ddeCookie,
- CF_TEXT, XTYP_REQUEST, 30000, NULL);
+ ddeData = DdeClientTransaction(NULL, 0, hConv,
+ ddeCookie, CF_TEXT, XTYP_REQUEST, 30000, NULL);
}
}
-
-
+
Tcl_DecrRefCount(objPtr);
if (ddeData == 0) {
@@ -1264,11 +1288,12 @@ Tcl_DdeObjCmd(
Tcl_Obj *resultPtr;
/*
- * The return handle has a two or four element list in it. The first
- * element is the return code (TCL_OK, TCL_ERROR, etc.). The
- * second is the result of the script. If the return code is TCL_ERROR,
- * then the third element is the value of the variable "errorCode",
- * and the fourth is the value of the variable "errorInfo".
+ * The return handle has a two or four element list in
+ * it. The first element is the return code (TCL_OK,
+ * TCL_ERROR, etc.). The second is the result of the
+ * script. If the return code is TCL_ERROR, then the third
+ * element is the value of the variable "errorCode", and
+ * the fourth is the value of the variable "errorInfo".
*/
resultPtr = Tcl_NewObj();
@@ -1278,7 +1303,8 @@ Tcl_DdeObjCmd(
DdeGetData(ddeData, string, length, 0);
Tcl_SetObjLength(resultPtr, strlen(string));
- if (Tcl_ListObjIndex(NULL, resultPtr, 0, &objPtr) != TCL_OK) {
+ if (Tcl_ListObjIndex(NULL, resultPtr, 0, &objPtr)
+ != TCL_OK) {
Tcl_DecrRefCount(resultPtr);
goto error;
}
@@ -1288,8 +1314,9 @@ Tcl_DdeObjCmd(
}
if (result == TCL_ERROR) {
Tcl_ResetResult(interp);
-
- if (Tcl_ListObjIndex(NULL, resultPtr, 3, &objPtr) != TCL_OK) {
+
+ if (Tcl_ListObjIndex(NULL, resultPtr, 3, &objPtr)
+ != TCL_OK) {
Tcl_DecrRefCount(resultPtr);
goto error;
}
@@ -1300,7 +1327,8 @@ Tcl_DdeObjCmd(
Tcl_ListObjIndex(NULL, resultPtr, 2, &objPtr);
Tcl_SetObjErrorCode(interp, objPtr);
}
- if (Tcl_ListObjIndex(NULL, resultPtr, 1, &objPtr) != TCL_OK) {
+ if (Tcl_ListObjIndex(NULL, resultPtr, 1, &objPtr)
+ != TCL_OK) {
Tcl_DecrRefCount(resultPtr);
goto error;
}
diff --git a/tcl/win/tclWinError.c b/tcl/win/tclWinError.c
index 1c10e2778d3..c5ddbd284f8 100644
--- a/tcl/win/tclWinError.c
+++ b/tcl/win/tclWinError.c
@@ -147,11 +147,11 @@ static char errorTable[] = {
EINVAL, /* 124 */
EINVAL, /* 125 */
EINVAL, /* 126 */
- ESRCH, /* ERROR_PROC_NOT_FOUND 127 */
+ EINVAL, /* ERROR_PROC_NOT_FOUND 127 */
ECHILD, /* ERROR_WAIT_NO_CHILDREN 128 */
ECHILD, /* ERROR_CHILD_NOT_COMPLETE 129 */
EBADF, /* ERROR_DIRECT_ACCESS_HANDLE 130 */
- EINVAL, /* 131 */
+ EINVAL, /* ERROR_NEGATIVE_SEEK 131 */
ESPIPE, /* ERROR_SEEK_ON_DEVICE 132 */
EINVAL, /* 133 */
EINVAL, /* 134 */
@@ -390,5 +390,3 @@ TclWinConvertWSAError(errCode)
Tcl_SetErrno(EINVAL);
}
}
-
-
diff --git a/tcl/win/tclWinFCmd.c b/tcl/win/tclWinFCmd.c
index e55049e6da2..446360b80be 100644
--- a/tcl/win/tclWinFCmd.c
+++ b/tcl/win/tclWinFCmd.c
@@ -28,19 +28,19 @@
*/
static int GetWinFileAttributes _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, CONST char *fileName,
+ int objIndex, Tcl_Obj *fileName,
Tcl_Obj **attributePtrPtr));
static int GetWinFileLongName _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, CONST char *fileName,
+ int objIndex, Tcl_Obj *fileName,
Tcl_Obj **attributePtrPtr));
static int GetWinFileShortName _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, CONST char *fileName,
+ int objIndex, Tcl_Obj *fileName,
Tcl_Obj **attributePtrPtr));
static int SetWinFileAttributes _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, CONST char *fileName,
+ int objIndex, Tcl_Obj *fileName,
Tcl_Obj *attributePtr));
static int CannotSetAttribute _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, CONST char *fileName,
+ int objIndex, Tcl_Obj *fileName,
Tcl_Obj *attributePtr));
/*
@@ -60,12 +60,12 @@ static int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDDEN,
0, FILE_ATTRIBUTE_READONLY, 0, FILE_ATTRIBUTE_SYSTEM};
-char *tclpFileAttrStrings[] = {
+CONST char *tclpFileAttrStrings[] = {
"-archive", "-hidden", "-longname", "-readonly",
"-shortname", "-system", (char *) NULL
};
-const TclFileAttrProcs tclpFileAttrProcs[] = {
+CONST TclFileAttrProcs tclpFileAttrProcs[] = {
{GetWinFileAttributes, SetWinFileAttributes},
{GetWinFileAttributes, SetWinFileAttributes},
{GetWinFileLongName, CannotSetAttribute},
@@ -73,30 +73,37 @@ const TclFileAttrProcs tclpFileAttrProcs[] = {
{GetWinFileShortName, CannotSetAttribute},
{GetWinFileAttributes, SetWinFileAttributes}};
+#ifdef HAVE_NO_SEH
+static void *ESP;
+static void *EBP;
+#endif /* HAVE_NO_SEH */
+
/*
* Prototype for the TraverseWinTree callback function.
*/
-typedef int (TraversalProc)(Tcl_DString *srcPtr, Tcl_DString *dstPtr,
+typedef int (TraversalProc)(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr,
int type, Tcl_DString *errorPtr);
/*
* Declarations for local procedures defined in this file:
*/
-static void StatError(Tcl_Interp *interp, CONST char *fileName);
+static void StatError(Tcl_Interp *interp, Tcl_Obj *fileName);
static int ConvertFileNameFormat(Tcl_Interp *interp,
- int objIndex, CONST char *fileName, int longShort,
+ int objIndex, Tcl_Obj *fileName, int longShort,
Tcl_Obj **attributePtrPtr);
-static int DoCopyFile(Tcl_DString *srcPtr, Tcl_DString *dstPtr);
-static int DoCreateDirectory(Tcl_DString *pathPtr);
-static int DoDeleteFile(Tcl_DString *pathPtr);
+static int DoCopyFile(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr);
+static int DoCreateDirectory(CONST TCHAR *pathPtr);
+static int DoDeleteFile(CONST TCHAR *pathPtr);
+static int DoRemoveJustDirectory(CONST TCHAR *nativeSrc,
+ int ignoreError, Tcl_DString *errorPtr);
static int DoRemoveDirectory(Tcl_DString *pathPtr, int recursive,
Tcl_DString *errorPtr);
-static int DoRenameFile(const TCHAR *nativeSrc, Tcl_DString *dstPtr);
-static int TraversalCopy(Tcl_DString *srcPtr, Tcl_DString *dstPtr,
+static int DoRenameFile(CONST TCHAR *nativeSrc, CONST TCHAR *dstPtr);
+static int TraversalCopy(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr,
int type, Tcl_DString *errorPtr);
-static int TraversalDelete(Tcl_DString *srcPtr, Tcl_DString *dstPtr,
+static int TraversalDelete(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr,
int type, Tcl_DString *errorPtr);
static int TraverseWinTree(TraversalProc *traverseProc,
Tcl_DString *sourcePtr, Tcl_DString *dstPtr,
@@ -106,7 +113,7 @@ static int TraverseWinTree(TraversalProc *traverseProc,
/*
*---------------------------------------------------------------------------
*
- * TclpRenameFile, DoRenameFile --
+ * TclpObjRenameFile, DoRenameFile --
*
* Changes the name of an existing file or directory, from src to dst.
* If src and dst refer to the same file or directory, does nothing
@@ -145,55 +152,77 @@ static int TraverseWinTree(TraversalProc *traverseProc,
*---------------------------------------------------------------------------
*/
-int
-TclpRenameFile(
- CONST char *src, /* Pathname of file or dir to be renamed
- * (UTF-8). */
- CONST char *dst) /* New pathname of file or directory
- * (UTF-8). */
+int
+TclpObjRenameFile(srcPathPtr, destPathPtr)
+ Tcl_Obj *srcPathPtr;
+ Tcl_Obj *destPathPtr;
{
- int result;
- TCHAR *nativeSrc;
- Tcl_DString srcString, dstString;
-
- nativeSrc = Tcl_WinUtfToTChar(src, -1, &srcString);
- Tcl_WinUtfToTChar(dst, -1, &dstString);
-
- result = DoRenameFile(nativeSrc, &dstString);
- Tcl_DStringFree(&srcString);
- Tcl_DStringFree(&dstString);
- return result;
+ return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr),
+ Tcl_FSGetNativePath(destPathPtr));
}
static int
DoRenameFile(
CONST TCHAR *nativeSrc, /* Pathname of file or dir to be renamed
* (native). */
- Tcl_DString *dstPtr) /* New pathname for file or directory
+ CONST TCHAR *nativeDst) /* New pathname for file or directory
* (native). */
{
- const TCHAR *nativeDst;
DWORD srcAttr, dstAttr;
+ int retval = -1;
+
+ /*
+ * The MoveFile API acts differently under Win95/98 and NT
+ * WRT NULL and "". Avoid passing these values.
+ */
- nativeDst = (TCHAR *) Tcl_DStringValue(dstPtr);
+ if (nativeSrc == NULL || nativeSrc[0] == '\0' ||
+ nativeDst == NULL || nativeDst[0] == '\0') {
+ Tcl_SetErrno(ENOENT);
+ return TCL_ERROR;
+ }
/*
- * Would throw an exception under NT if one of the arguments is a
- * char block device.
+ * The MoveFile API would throw an exception under NT
+ * if one of the arguments is a char block device.
*/
- /* CYGNUS LOCAL */
-#ifndef __GNUC__
+#ifdef HAVE_NO_SEH
+ __asm__ __volatile__ (
+ "movl %esp, _ESP" "\n\t"
+ "movl %ebp, _EBP");
+
+ __asm__ __volatile__ (
+ "pushl $__except_dorenamefile_handler" "\n\t"
+ "pushl %fs:0" "\n\t"
+ "mov %esp, %fs:0");
+#else
__try {
-#endif
+#endif /* HAVE_NO_SEH */
if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) {
- return TCL_OK;
+ retval = TCL_OK;
}
- /* CYGNUS LOCAL */
-#ifndef __GNUC__
- } __except (-1) {}
-#endif
- /* END CYGNUS LOCAL */
+#ifdef HAVE_NO_SEH
+ __asm__ __volatile__ (
+ "jmp dorenamefile_pop" "\n"
+ "dorenamefile_reentry:" "\n\t"
+ "movl _ESP, %esp" "\n\t"
+ "movl _EBP, %ebp");
+
+ __asm__ __volatile__ (
+ "dorenamefile_pop:" "\n\t"
+ "mov (%esp), %eax" "\n\t"
+ "mov %eax, %fs:0" "\n\t"
+ "add $8, %esp");
+#else
+ } __except (EXCEPTION_EXECUTE_HANDLER) {}
+#endif /* HAVE_NO_SEH */
+
+ /*
+ * Avoid using control flow statements in the SEH guarded block!
+ */
+ if (retval != -1)
+ return retval;
TclWinConvertError(GetLastError());
@@ -307,7 +336,7 @@ DoRenameFile(
* fails, it's because it wasn't empty.
*/
- if (DoRemoveDirectory(dstPtr, 0, NULL) == TCL_OK) {
+ if (DoRemoveJustDirectory(nativeDst, 0, NULL) == TCL_OK) {
/*
* Now that that empty directory is gone, we can try
* renaming again. If that fails, we'll put this empty
@@ -409,11 +438,26 @@ DoRenameFile(
}
return TCL_ERROR;
}
+#ifdef HAVE_NO_SEH
+static
+__attribute__ ((cdecl))
+EXCEPTION_DISPOSITION
+_except_dorenamefile_handler(
+ struct _EXCEPTION_RECORD *ExceptionRecord,
+ void *EstablisherFrame,
+ struct _CONTEXT *ContextRecord,
+ void *DispatcherContext)
+{
+ __asm__ __volatile__ (
+ "jmp dorenamefile_reentry");
+ return 0; /* Function does not return */
+}
+#endif /* HAVE_NO_SEH */
/*
*---------------------------------------------------------------------------
*
- * TclpCopyFile, DoCopyFile --
+ * TclpObjCopyFile, DoCopyFile --
*
* Copy a single file (not a directory). If dst already exists and
* is not a directory, it is removed.
@@ -438,49 +482,73 @@ DoRenameFile(
*/
int
-TclpCopyFile(
- CONST char *src, /* Pathname of file to be copied (UTF-8). */
- CONST char *dst) /* Pathname of file to copy to (UTF-8). */
+TclpObjCopyFile(srcPathPtr, destPathPtr)
+ Tcl_Obj *srcPathPtr;
+ Tcl_Obj *destPathPtr;
{
- int result;
- Tcl_DString srcString, dstString;
-
- Tcl_WinUtfToTChar(src, -1, &srcString);
- Tcl_WinUtfToTChar(dst, -1, &dstString);
- result = DoCopyFile(&srcString, &dstString);
- Tcl_DStringFree(&srcString);
- Tcl_DStringFree(&dstString);
- return result;
+ return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr),
+ Tcl_FSGetNativePath(destPathPtr));
}
static int
DoCopyFile(
- Tcl_DString *srcPtr, /* Pathname of file to be copied (native). */
- Tcl_DString *dstPtr) /* Pathname of file to copy to (native). */
+ CONST TCHAR *nativeSrc, /* Pathname of file to be copied (native). */
+ CONST TCHAR *nativeDst) /* Pathname of file to copy to (native). */
{
- CONST TCHAR *nativeSrc, *nativeDst;
+ int retval = -1;
- nativeSrc = (TCHAR *) Tcl_DStringValue(srcPtr);
- nativeDst = (TCHAR *) Tcl_DStringValue(dstPtr);
+ /*
+ * The CopyFile API acts differently under Win95/98 and NT
+ * WRT NULL and "". Avoid passing these values.
+ */
+ if (nativeSrc == NULL || nativeSrc[0] == '\0' ||
+ nativeDst == NULL || nativeDst[0] == '\0') {
+ Tcl_SetErrno(ENOENT);
+ return TCL_ERROR;
+ }
+
/*
- * Would throw an exception under NT if one of the arguments is a char
- * block device.
+ * The CopyFile API would throw an exception under NT if one
+ * of the arguments is a char block device.
*/
- /* CYGNUS LOCAL */
-#ifndef __GNUC__
+#ifdef HAVE_NO_SEH
+ __asm__ __volatile__ (
+ "movl %esp, _ESP" "\n\t"
+ "movl %ebp, _EBP");
+
+ __asm__ __volatile__ (
+ "pushl $__except_docopyfile_handler" "\n\t"
+ "pushl %fs:0" "\n\t"
+ "mov %esp, %fs:0");
+#else
__try {
+#endif /* HAVE_NO_SEH */
if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) != FALSE) {
-#endif
- /* END CYGNUS LOCAL */
- return TCL_OK;
-#ifndef __GNUC__
+ retval = TCL_OK;
}
- /* CYGNUS LOCAL */
- } __except (-1) {}
-#endif
- /* END CYGNUS LOCAL */
+#ifdef HAVE_NO_SEH
+ __asm__ __volatile__ (
+ "jmp docopyfile_pop" "\n"
+ "docopyfile_reentry:" "\n\t"
+ "movl _ESP, %esp" "\n\t"
+ "movl _EBP, %ebp");
+
+ __asm__ __volatile__ (
+ "docopyfile_pop:" "\n\t"
+ "mov (%esp), %eax" "\n\t"
+ "mov %eax, %fs:0" "\n\t"
+ "add $8, %esp");
+#else
+ } __except (EXCEPTION_EXECUTE_HANDLER) {}
+#endif /* HAVE_NO_SEH */
+
+ /*
+ * Avoid using control flow statements in the SEH guarded block!
+ */
+ if (retval != -1)
+ return retval;
TclWinConvertError(GetLastError());
if (Tcl_GetErrno() == EBADF) {
@@ -498,6 +566,12 @@ DoCopyFile(
}
if ((srcAttr & FILE_ATTRIBUTE_DIRECTORY) ||
(dstAttr & FILE_ATTRIBUTE_DIRECTORY)) {
+ if (srcAttr & FILE_ATTRIBUTE_REPARSE_POINT) {
+ /* Source is a symbolic link -- copy it */
+ if (TclWinSymLinkCopyDirectory(nativeSrc, nativeDst) == 0) {
+ return TCL_OK;
+ }
+ }
Tcl_SetErrno(EISDIR);
}
if (dstAttr & FILE_ATTRIBUTE_READONLY) {
@@ -518,11 +592,26 @@ DoCopyFile(
}
return TCL_ERROR;
}
+#ifdef HAVE_NO_SEH
+static
+__attribute__ ((cdecl))
+EXCEPTION_DISPOSITION
+_except_docopyfile_handler(
+ struct _EXCEPTION_RECORD *ExceptionRecord,
+ void *EstablisherFrame,
+ struct _CONTEXT *ContextRecord,
+ void *DispatcherContext)
+{
+ __asm__ __volatile__ (
+ "jmp docopyfile_reentry");
+ return 0; /* Function does not return */
+}
+#endif /* HAVE_NO_SEH */
/*
*---------------------------------------------------------------------------
*
- * TclpDeleteFile, DoDeleteFile --
+ * TclpObjDeleteFile, DoDeleteFile --
*
* Removes a single file (not a directory).
*
@@ -544,67 +633,64 @@ DoCopyFile(
*---------------------------------------------------------------------------
*/
-int
-TclpDeleteFile(
- CONST char *path) /* Pathname of file to be removed (UTF-8). */
+int
+TclpObjDeleteFile(pathPtr)
+ Tcl_Obj *pathPtr;
{
- int result;
- Tcl_DString pathString;
-
- Tcl_WinUtfToTChar(path, -1, &pathString);
- result = DoDeleteFile(&pathString);
- Tcl_DStringFree(&pathString);
- return result;
+ return DoDeleteFile(Tcl_FSGetNativePath(pathPtr));
}
static int
DoDeleteFile(
- Tcl_DString *pathPtr) /* Pathname of file to be removed (native). */
+ CONST TCHAR *nativePath) /* Pathname of file to be removed (native). */
{
DWORD attr;
- CONST TCHAR *nativePath;
- nativePath = (TCHAR *) Tcl_DStringValue(pathPtr);
-
+ /*
+ * The DeleteFile API acts differently under Win95/98 and NT
+ * WRT NULL and "". Avoid passing these values.
+ */
+
+ if (nativePath == NULL || nativePath[0] == '\0') {
+ Tcl_SetErrno(ENOENT);
+ return TCL_ERROR;
+ }
+
if ((*tclWinProcs->deleteFileProc)(nativePath) != FALSE) {
return TCL_OK;
}
TclWinConvertError(GetLastError());
- /*
- * Win32s thinks that "" is the same as "." and then reports EISDIR
- * instead of ENOENT.
- */
-
- if (tclWinProcs->useWide) {
- if (((WCHAR *) nativePath)[0] == '\0') {
- Tcl_SetErrno(ENOENT);
- return TCL_ERROR;
- }
- } else {
- if (((char *) nativePath)[0] == '\0') {
- Tcl_SetErrno(ENOENT);
- return TCL_ERROR;
- }
- }
if (Tcl_GetErrno() == EACCES) {
attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
if (attr != 0xffffffff) {
if (attr & FILE_ATTRIBUTE_DIRECTORY) {
- /*
+ if (attr & FILE_ATTRIBUTE_REPARSE_POINT) {
+ /* It is a symbolic link -- remove it */
+ if (TclWinSymLinkDelete(nativePath, 0) == 0) {
+ return TCL_OK;
+ }
+ }
+
+ /*
+ * If we fall through here, it is a directory.
+ *
* Windows NT reports removing a directory as EACCES instead
* of EISDIR.
*/
Tcl_SetErrno(EISDIR);
} else if (attr & FILE_ATTRIBUTE_READONLY) {
- (*tclWinProcs->setFileAttributesProc)(nativePath,
+ int res = (*tclWinProcs->setFileAttributesProc)(nativePath,
attr & ~FILE_ATTRIBUTE_READONLY);
- if ((*tclWinProcs->deleteFileProc)(nativePath) != FALSE) {
+ if ((res != 0) && ((*tclWinProcs->deleteFileProc)(nativePath)
+ != FALSE)) {
return TCL_OK;
}
TclWinConvertError(GetLastError());
- (*tclWinProcs->setFileAttributesProc)(nativePath, attr);
+ if (res != 0) {
+ (*tclWinProcs->setFileAttributesProc)(nativePath, attr);
+ }
}
}
} else if (Tcl_GetErrno() == ENOENT) {
@@ -634,7 +720,7 @@ DoDeleteFile(
/*
*---------------------------------------------------------------------------
*
- * TclpCreateDirectory --
+ * TclpObjCreateDirectory --
*
* Creates the specified directory. All parent directories of the
* specified directory must already exist. The directory is
@@ -656,27 +742,18 @@ DoDeleteFile(
*---------------------------------------------------------------------------
*/
-int
-TclpCreateDirectory(
- CONST char *path) /* Pathname of directory to create (UTF-8). */
+int
+TclpObjCreateDirectory(pathPtr)
+ Tcl_Obj *pathPtr;
{
- int result;
- Tcl_DString pathString;
-
- Tcl_WinUtfToTChar(path, -1, &pathString);
- result = DoCreateDirectory(&pathString);
- Tcl_DStringFree(&pathString);
- return result;
+ return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr));
}
static int
DoCreateDirectory(
- Tcl_DString *pathPtr) /* Pathname of directory to create (native). */
+ CONST TCHAR *nativePath) /* Pathname of directory to create (native). */
{
DWORD error;
- CONST TCHAR *nativePath;
-
- nativePath = (TCHAR *) Tcl_DStringValue(pathPtr);
if ((*tclWinProcs->createDirectoryProc)(nativePath, NULL) == 0) {
error = GetLastError();
TclWinConvertError(error);
@@ -688,7 +765,7 @@ DoCreateDirectory(
/*
*---------------------------------------------------------------------------
*
- * TclpCopyDirectory --
+ * TclpObjCopyDirectory --
*
* Recursively copies a directory. The target directory dst must
* not already exist. Note that this function does not merge two
@@ -711,32 +788,38 @@ DoCreateDirectory(
*---------------------------------------------------------------------------
*/
-int
-TclpCopyDirectory(
- CONST char *src, /* Pathname of directory to be copied
- * (UTF-8). */
- CONST char *dst, /* Pathname of target directory (UTF-8). */
- Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free
- * DString filled with UTF-8 name of file
- * causing error. */
+int
+TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr)
+ Tcl_Obj *srcPathPtr;
+ Tcl_Obj *destPathPtr;
+ Tcl_Obj **errorPtr;
{
- int result;
+ Tcl_DString ds;
Tcl_DString srcString, dstString;
+ int ret;
- Tcl_WinUtfToTChar(src, -1, &srcString);
- Tcl_WinUtfToTChar(dst, -1, &dstString);
+ Tcl_WinUtfToTChar(Tcl_FSGetTranslatedStringPath(NULL,srcPathPtr),
+ -1, &srcString);
+ Tcl_WinUtfToTChar(Tcl_FSGetTranslatedStringPath(NULL,destPathPtr),
+ -1, &dstString);
- result = TraverseWinTree(TraversalCopy, &srcString, &dstString, errorPtr);
+ ret = TraverseWinTree(TraversalCopy, &srcString, &dstString, &ds);
Tcl_DStringFree(&srcString);
Tcl_DStringFree(&dstString);
- return result;
+
+ if (ret != TCL_OK) {
+ *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
+ Tcl_DStringFree(&ds);
+ Tcl_IncrRefCount(*errorPtr);
+ }
+ return ret;
}
/*
*----------------------------------------------------------------------
*
- * TclpRemoveDirectory, DoRemoveDirectory --
+ * TclpObjRemoveDirectory, DoRemoveDirectory --
*
* Removes directory (and its contents, if the recursive flag is set).
*
@@ -762,67 +845,68 @@ TclpCopyDirectory(
*----------------------------------------------------------------------
*/
-int
-TclpRemoveDirectory(
- CONST char *path, /* 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_DString *errorPtr) /* If non-NULL, uninitialized or free
- * DString filled with UTF-8 name of file
- * causing error. */
+int
+TclpObjRemoveDirectory(pathPtr, recursive, errorPtr)
+ Tcl_Obj *pathPtr;
+ int recursive;
+ Tcl_Obj **errorPtr;
{
- int result;
- Tcl_DString pathString;
-
- Tcl_WinUtfToTChar(path, -1, &pathString);
- result = DoRemoveDirectory(&pathString, recursive, errorPtr);
- Tcl_DStringFree(&pathString);
-
- return result;
+ Tcl_DString ds;
+ int ret;
+ if (recursive) {
+ /*
+ * In the recursive case, the string rep is used to construct a
+ * Tcl_DString which may be used extensively, so we can't
+ * optimize this case easily.
+ */
+ Tcl_DString native;
+ Tcl_WinUtfToTChar(Tcl_FSGetTranslatedStringPath(NULL, pathPtr),
+ -1, &native);
+ ret = DoRemoveDirectory(&native, recursive, &ds);
+ Tcl_DStringFree(&native);
+ } else {
+ ret = DoRemoveJustDirectory(Tcl_FSGetNativePath(pathPtr),
+ 0, &ds);
+ }
+ if (ret != TCL_OK) {
+ int len = Tcl_DStringLength(&ds);
+ if (len > 0) {
+ *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
+ Tcl_IncrRefCount(*errorPtr);
+ }
+ Tcl_DStringFree(&ds);
+ }
+ return ret;
}
static int
-DoRemoveDirectory(
- Tcl_DString *pathPtr, /* Pathname of directory to be removed
+DoRemoveJustDirectory(
+ CONST TCHAR *nativePath, /* Pathname of directory to be removed
* (native). */
- int recursive, /* If non-zero, removes directories that
- * are nonempty. Otherwise, will only remove
- * empty directories. */
+ int ignoreError, /* If non-zero, don't initialize the
+ * errorPtr under some circumstances
+ * on return. */
Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free
* DString filled with UTF-8 name of file
* causing error. */
{
- CONST TCHAR *nativePath;
- DWORD attr;
+ /*
+ * The RemoveDirectory API acts differently under Win95/98 and NT
+ * WRT NULL and "". Avoid passing these values.
+ */
- nativePath = (TCHAR *) Tcl_DStringValue(pathPtr);
+ if (nativePath == NULL || nativePath[0] == '\0') {
+ Tcl_SetErrno(ENOENT);
+ goto end;
+ }
if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) {
return TCL_OK;
}
TclWinConvertError(GetLastError());
- /*
- * Win32s thinks that "" is the same as "." and then reports EACCES
- * instead of ENOENT.
- */
-
-
- if (tclWinProcs->useWide) {
- if (((WCHAR *) nativePath)[0] == '\0') {
- Tcl_SetErrno(ENOENT);
- return TCL_ERROR;
- }
- } else {
- if (((char *) nativePath)[0] == '\0') {
- Tcl_SetErrno(ENOENT);
- return TCL_ERROR;
- }
- }
if (Tcl_GetErrno() == EACCES) {
- attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
+ DWORD attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
if (attr != 0xffffffff) {
if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
/*
@@ -834,6 +918,13 @@ DoRemoveDirectory(
goto end;
}
+ if (attr & FILE_ATTRIBUTE_REPARSE_POINT) {
+ /* It is a symbolic link -- remove it */
+ if (TclWinSymLinkDelete(nativePath, 1) != 0) {
+ goto end;
+ }
+ }
+
if (attr & FILE_ATTRIBUTE_READONLY) {
attr &= ~FILE_ATTRIBUTE_READONLY;
if ((*tclWinProcs->setFileAttributesProc)(nativePath, attr) == FALSE) {
@@ -854,13 +945,13 @@ DoRemoveDirectory(
*/
if (TclWinGetPlatformId() != VER_PLATFORM_WIN32_NT) {
- char *path, *find;
+ CONST char *path, *find;
HANDLE handle;
WIN32_FIND_DATAA data;
Tcl_DString buffer;
int len;
- path = (char *) nativePath;
+ path = (CONST char *) nativePath;
Tcl_DStringInit(&buffer);
len = strlen(path);
@@ -899,20 +990,46 @@ DoRemoveDirectory(
Tcl_SetErrno(EEXIST);
}
- if ((recursive != 0) && (Tcl_GetErrno() == EEXIST)) {
- /*
- * The directory is nonempty, but the recursive flag has been
- * specified, so we recursively remove all the files in the directory.
+ if ((ignoreError != 0) && (Tcl_GetErrno() == EEXIST)) {
+ /*
+ * If we're being recursive, this error may actually
+ * be ok, so we don't want to initialise the errorPtr
+ * yet.
*/
-
- return TraverseWinTree(TraversalDelete, pathPtr, NULL, errorPtr);
+ return TCL_ERROR;
}
-
+
end:
if (errorPtr != NULL) {
Tcl_WinTCharToUtf(nativePath, -1, errorPtr);
}
return TCL_ERROR;
+
+}
+
+static int
+DoRemoveDirectory(
+ Tcl_DString *pathPtr, /* Pathname of directory to be removed
+ * (native). */
+ int recursive, /* If non-zero, removes directories that
+ * are nonempty. Otherwise, will only remove
+ * empty directories. */
+ Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free
+ * DString filled with UTF-8 name of file
+ * causing error. */
+{
+ int res = DoRemoveJustDirectory(Tcl_DStringValue(pathPtr), recursive,
+ errorPtr);
+
+ if ((res == TCL_ERROR) && (recursive != 0) && (Tcl_GetErrno() == EEXIST)) {
+ /*
+ * The directory is nonempty, but the recursive flag has been
+ * specified, so we recursively remove all the files in the directory.
+ */
+ return TraverseWinTree(TraversalDelete, pathPtr, NULL, errorPtr);
+ } else {
+ return res;
+ }
}
/*
@@ -944,13 +1061,14 @@ TraverseWinTree(
Tcl_DString *sourcePtr, /* Pathname of source directory to be
* traversed (native). */
Tcl_DString *targetPtr, /* Pathname of directory to traverse in
- * parallel with source directory (native). */
+ * parallel with source directory (native),
+ * may be NULL. */
Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free
* DString filled with UTF-8 name of file
* causing error. */
{
DWORD sourceAttr;
- TCHAR *nativeSource, *nativeErrfile;
+ TCHAR *nativeSource, *nativeTarget, *nativeErrfile;
int result, found, sourceLen, targetLen, oldSourceLen, oldTargetLen;
HANDLE handle;
WIN32_FIND_DATAT data;
@@ -960,6 +1078,8 @@ TraverseWinTree(
oldTargetLen = 0; /* lint. */
nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr);
+ nativeTarget = (TCHAR *) (targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr));
+
oldSourceLen = Tcl_DStringLength(sourcePtr);
sourceAttr = (*tclWinProcs->getFileAttributesProc)(nativeSource);
if (sourceAttr == 0xffffffff) {
@@ -971,7 +1091,7 @@ TraverseWinTree(
* Process the regular file
*/
- return (*traverseProc)(sourcePtr, targetPtr, DOTREE_F, errorPtr);
+ return (*traverseProc)(nativeSource, nativeTarget, DOTREE_F, errorPtr);
}
if (tclWinProcs->useWide) {
@@ -994,7 +1114,7 @@ TraverseWinTree(
nativeSource[oldSourceLen + 1] = '\0';
Tcl_DStringSetLength(sourcePtr, oldSourceLen);
- result = (*traverseProc)(sourcePtr, targetPtr, DOTREE_PRED, errorPtr);
+ result = (*traverseProc)(nativeSource, nativeTarget, DOTREE_PRED, errorPtr);
if (result != TCL_OK) {
FindClose(handle);
return result;
@@ -1096,8 +1216,9 @@ TraverseWinTree(
* files in that directory.
*/
- result = (*traverseProc)(sourcePtr, targetPtr, DOTREE_POSTD,
- errorPtr);
+ result = (*traverseProc)(Tcl_DStringValue(sourcePtr),
+ (targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)),
+ DOTREE_POSTD, errorPtr);
}
end:
if (nativeErrfile != NULL) {
@@ -1130,27 +1251,22 @@ TraverseWinTree(
static int
TraversalCopy(
- Tcl_DString *srcPtr, /* Source pathname to copy. */
- Tcl_DString *dstPtr, /* Destination pathname of copy. */
+ CONST TCHAR *nativeSrc, /* Source pathname to copy. */
+ CONST TCHAR *nativeDst, /* Destination pathname of copy. */
int type, /* Reason for call - see TraverseWinTree() */
Tcl_DString *errorPtr) /* If non-NULL, initialized DString filled
* with UTF-8 name of file causing error. */
{
- TCHAR *nativeDst, *nativeSrc;
- DWORD attr;
-
switch (type) {
case DOTREE_F: {
- if (DoCopyFile(srcPtr, dstPtr) == TCL_OK) {
+ if (DoCopyFile(nativeSrc, nativeDst) == TCL_OK) {
return TCL_OK;
}
break;
}
case DOTREE_PRED: {
- if (DoCreateDirectory(dstPtr) == TCL_OK) {
- nativeSrc = (TCHAR *) Tcl_DStringValue(srcPtr);
- nativeDst = (TCHAR *) Tcl_DStringValue(dstPtr);
- attr = (*tclWinProcs->getFileAttributesProc)(nativeSrc);
+ if (DoCreateDirectory(nativeDst) == TCL_OK) {
+ DWORD attr = (*tclWinProcs->getFileAttributesProc)(nativeSrc);
if ((*tclWinProcs->setFileAttributesProc)(nativeDst, attr) != FALSE) {
return TCL_OK;
}
@@ -1169,7 +1285,6 @@ TraversalCopy(
*/
if (errorPtr != NULL) {
- nativeDst = (TCHAR *) Tcl_DStringValue(dstPtr);
Tcl_WinTCharToUtf(nativeDst, -1, errorPtr);
}
return TCL_ERROR;
@@ -1198,17 +1313,15 @@ TraversalCopy(
static int
TraversalDelete(
- Tcl_DString *srcPtr, /* Source pathname to delete. */
- Tcl_DString *dstPtr, /* Not used. */
+ CONST TCHAR *nativeSrc, /* Source pathname to delete. */
+ CONST TCHAR *dstPtr, /* Not used. */
int type, /* Reason for call - see TraverseWinTree() */
Tcl_DString *errorPtr) /* If non-NULL, initialized DString filled
* with UTF-8 name of file causing error. */
{
- TCHAR *nativeSrc;
-
switch (type) {
case DOTREE_F: {
- if (DoDeleteFile(srcPtr) == TCL_OK) {
+ if (DoDeleteFile(nativeSrc) == TCL_OK) {
return TCL_OK;
}
break;
@@ -1217,7 +1330,7 @@ TraversalDelete(
return TCL_OK;
}
case DOTREE_POSTD: {
- if (DoRemoveDirectory(srcPtr, 0, NULL) == TCL_OK) {
+ if (DoRemoveJustDirectory(nativeSrc, 0, NULL) == TCL_OK) {
return TCL_OK;
}
break;
@@ -1225,7 +1338,6 @@ TraversalDelete(
}
if (errorPtr != NULL) {
- nativeSrc = (TCHAR *) Tcl_DStringValue(srcPtr);
Tcl_WinTCharToUtf(nativeSrc, -1, errorPtr);
}
return TCL_ERROR;
@@ -1251,13 +1363,14 @@ TraversalDelete(
static void
StatError(
Tcl_Interp *interp, /* The interp that has the error */
- CONST char *fileName) /* The name of the file which caused the
+ Tcl_Obj *fileName) /* The name of the file which caused the
* error. */
{
TclWinConvertError(GetLastError());
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "could not read \"", fileName, "\": ", Tcl_PosixError(interp),
- (char *) NULL);
+ "could not read \"", Tcl_GetString(fileName),
+ "\": ", Tcl_PosixError(interp),
+ (char *) NULL);
}
/*
@@ -1283,23 +1396,49 @@ static int
GetWinFileAttributes(
Tcl_Interp *interp, /* The interp we are using for errors. */
int objIndex, /* The index of the attribute. */
- CONST char *fileName, /* The name of the file. */
+ Tcl_Obj *fileName, /* The name of the file. */
Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
{
DWORD result;
- Tcl_DString ds;
- TCHAR *nativeName;
-
- nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds);
+ CONST TCHAR *nativeName;
+ int attr;
+
+ nativeName = Tcl_FSGetNativePath(fileName);
result = (*tclWinProcs->getFileAttributesProc)(nativeName);
- Tcl_DStringFree(&ds);
if (result == 0xffffffff) {
StatError(interp, fileName);
return TCL_ERROR;
}
- *attributePtrPtr = Tcl_NewBooleanObj((int) (result & attributeArray[objIndex]));
+ attr = (int)(result & attributeArray[objIndex]);
+ if ((objIndex == WIN_HIDDEN_ATTRIBUTE) && (attr != 0)) {
+ /*
+ * It is hidden. However there is a bug on some Windows
+ * OSes in which root volumes (drives) formatted as NTFS
+ * are declared hidden when they are not (and cannot be).
+ *
+ * We test for, and fix that case, here.
+ */
+ int len;
+ char *str = Tcl_GetStringFromObj(fileName,&len);
+ if (len < 4) {
+ if (len == 0) {
+ /*
+ * Not sure if this is possible, but we pass it on
+ * anyway
+ */
+ } else if (len == 1 && (str[0] == '/' || str[0] == '\\')) {
+ /* Path is pointing to the root volume */
+ attr = 0;
+ } else if ((str[1] == ':')
+ && (len == 2 || (str[2] == '/' || str[2] == '\\'))) {
+ /* Path is of the form 'x:' or 'x:/' or 'x:\' */
+ attr = 0;
+ }
+ }
+ }
+ *attributePtrPtr = Tcl_NewBooleanObj(attr);
return TCL_OK;
}
@@ -1315,6 +1454,11 @@ GetWinFileAttributes(
* Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object
* will have ref count 0. If the return value is not TCL_OK,
* attributePtrPtr is not touched.
+ *
+ * Warning: if you pass this function a drive name like 'c:' it
+ * will actually return the current working directory on that
+ * drive. To avoid this, make sure the drive name ends in a
+ * slash, like this 'c:/'.
*
* Side effects:
* A new object is allocated if the file is valid.
@@ -1326,33 +1470,38 @@ static int
ConvertFileNameFormat(
Tcl_Interp *interp, /* The interp we are using for errors. */
int objIndex, /* The index of the attribute. */
- CONST char *fileName, /* The name of the file. */
+ Tcl_Obj *fileName, /* The name of the file. */
int longShort, /* 0 to short name, 1 to long name. */
Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
{
int pathc, i;
- char **pathv, **newv;
- char *resultStr;
- Tcl_DString resultDString;
+ Tcl_Obj *splitPath;
int result = TCL_OK;
- Tcl_SplitPath(fileName, &pathc, &pathv);
- newv = (char **) ckalloc(pathc * sizeof(char *));
+ splitPath = Tcl_FSSplitPath(fileName, &pathc);
- if (pathc == 0) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "could not read \"", fileName,
+ if (splitPath == NULL || pathc == 0) {
+ if (interp != NULL) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "could not read \"", Tcl_GetString(fileName),
"\": no such file or directory",
(char *) NULL);
+ }
result = TCL_ERROR;
goto cleanup;
}
for (i = 0; i < pathc; i++) {
- if ((pathv[i][0] == '/')
- || ((strlen(pathv[i]) == 3) && (pathv[i][1] == ':'))
- || (strcmp(pathv[i], ".") == 0)
- || (strcmp(pathv[i], "..") == 0)) {
+ Tcl_Obj *elt;
+ char *pathv;
+ int pathLen;
+ Tcl_ListObjIndex(NULL, splitPath, i, &elt);
+
+ pathv = Tcl_GetStringFromObj(elt, &pathLen);
+ if ((pathv[0] == '/')
+ || ((pathLen == 3) && (pathv[1] == ':'))
+ || (strcmp(pathv, ".") == 0)
+ || (strcmp(pathv, "..") == 0)) {
/*
* Handle "/", "//machine/export", "c:/", "." or ".." by just
* copying the string literally. Uppercase the drive letter,
@@ -1360,20 +1509,31 @@ ConvertFileNameFormat(
*/
simple:
- pathv[i][0] = (char) Tcl_UniCharToUpper(UCHAR(pathv[i][0]));
- newv[i] = (char *) ckalloc(strlen(pathv[i]) + 1);
- lstrcpyA(newv[i], pathv[i]);
+ /* Here we are modifying the string representation in place */
+ /* I believe this is legal, since this won't affect any
+ * file representation this thing may have. */
+ pathv[0] = (char) Tcl_UniCharToUpper(UCHAR(pathv[0]));
} else {
- char *str;
- TCHAR *nativeName;
+ Tcl_Obj *tempPath;
Tcl_DString ds;
+ Tcl_DString dsTemp;
+ TCHAR *nativeName;
+ char *tempString;
+ int tempLen;
WIN32_FIND_DATAT data;
HANDLE handle;
DWORD attr;
- Tcl_DStringInit(&resultDString);
- str = Tcl_JoinPath(i + 1, pathv, &resultDString);
- nativeName = Tcl_WinUtfToTChar(str, -1, &ds);
+ tempPath = Tcl_FSJoinPath(splitPath, i+1);
+ Tcl_IncrRefCount(tempPath);
+ /*
+ * We'd like to call Tcl_FSGetNativePath(tempPath)
+ * but that is likely to lead to infinite loops
+ */
+ Tcl_DStringInit(&ds);
+ tempString = Tcl_GetStringFromObj(tempPath,&tempLen);
+ nativeName = Tcl_WinUtfToTChar(tempString, tempLen, &ds);
+ Tcl_DecrRefCount(tempPath);
handle = (*tclWinProcs->findFirstFileProc)(nativeName, &data);
if (handle == INVALID_HANDLE_VALUE) {
/*
@@ -1386,17 +1546,15 @@ ConvertFileNameFormat(
attr = (*tclWinProcs->getFileAttributesProc)(nativeName);
if ((attr != 0xFFFFFFFF) && (attr & FILE_ATTRIBUTE_DIRECTORY)) {
Tcl_DStringFree(&ds);
- Tcl_DStringFree(&resultDString);
-
goto simple;
}
}
- Tcl_DStringFree(&ds);
- Tcl_DStringFree(&resultDString);
if (handle == INVALID_HANDLE_VALUE) {
- pathc = i - 1;
- StatError(interp, fileName);
+ Tcl_DStringFree(&ds);
+ if (interp != NULL) {
+ StatError(interp, fileName);
+ }
result = TCL_ERROR;
goto cleanup;
}
@@ -1436,26 +1594,31 @@ ConvertFileNameFormat(
* fprintf(stderr, "%d\n", ((WCHAR *) nativeName)[0]);
*/
- Tcl_WinTCharToUtf(nativeName, -1, &ds);
- newv[i] = ckalloc((unsigned int) (Tcl_DStringLength(&ds) + 1));
- lstrcpyA(newv[i], Tcl_DStringValue(&ds));
+ Tcl_DStringInit(&dsTemp);
+ Tcl_WinTCharToUtf(nativeName, -1, &dsTemp);
+ /* Deal with issues of tildes being absolute */
+ if (Tcl_DStringValue(&dsTemp)[0] == '~') {
+ tempPath = Tcl_NewStringObj("./",2);
+ Tcl_AppendToObj(tempPath, Tcl_DStringValue(&dsTemp),
+ Tcl_DStringLength(&dsTemp));
+ } else {
+ tempPath = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp),
+ Tcl_DStringLength(&dsTemp));
+ }
+ Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath);
Tcl_DStringFree(&ds);
+ Tcl_DStringFree(&dsTemp);
FindClose(handle);
}
}
- Tcl_DStringInit(&resultDString);
- resultStr = Tcl_JoinPath(pathc, newv, &resultDString);
- *attributePtrPtr = Tcl_NewStringObj(resultStr,
- Tcl_DStringLength(&resultDString));
- Tcl_DStringFree(&resultDString);
+ *attributePtrPtr = Tcl_FSJoinPath(splitPath, -1);
cleanup:
- for (i = 0; i < pathc; i++) {
- ckfree(newv[i]);
+ if (splitPath != NULL) {
+ Tcl_DecrRefCount(splitPath);
}
- ckfree((char *) newv);
- ckfree((char *) pathv);
+
return result;
}
@@ -1464,7 +1627,7 @@ cleanup:
*
* GetWinFileLongName --
*
- * Returns a Tcl_Obj containing the short version of the file
+ * Returns a Tcl_Obj containing the long version of the file
* name.
*
* Results:
@@ -1482,7 +1645,7 @@ static int
GetWinFileLongName(
Tcl_Interp *interp, /* The interp we are using for errors. */
int objIndex, /* The index of the attribute. */
- CONST char *fileName, /* The name of the file. */
+ Tcl_Obj *fileName, /* The name of the file. */
Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
{
return ConvertFileNameFormat(interp, objIndex, fileName, 1, attributePtrPtr);
@@ -1511,7 +1674,7 @@ static int
GetWinFileShortName(
Tcl_Interp *interp, /* The interp we are using for errors. */
int objIndex, /* The index of the attribute. */
- CONST char *fileName, /* The name of the file. */
+ Tcl_Obj *fileName, /* The name of the file. */
Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
{
return ConvertFileNameFormat(interp, objIndex, fileName, 0, attributePtrPtr);
@@ -1538,27 +1701,25 @@ static int
SetWinFileAttributes(
Tcl_Interp *interp, /* The interp we are using for errors. */
int objIndex, /* The index of the attribute. */
- CONST char *fileName, /* The name of the file. */
+ Tcl_Obj *fileName, /* The name of the file. */
Tcl_Obj *attributePtr) /* The new value of the attribute. */
{
DWORD fileAttributes;
int yesNo;
int result;
- Tcl_DString ds;
- TCHAR *nativeName;
+ CONST TCHAR *nativeName;
- nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds);
+ nativeName = Tcl_FSGetNativePath(fileName);
fileAttributes = (*tclWinProcs->getFileAttributesProc)(nativeName);
if (fileAttributes == 0xffffffff) {
StatError(interp, fileName);
- result = TCL_ERROR;
- goto end;
+ return TCL_ERROR;
}
result = Tcl_GetBooleanFromObj(interp, attributePtr, &yesNo);
if (result != TCL_OK) {
- goto end;
+ return result;
}
if (yesNo) {
@@ -1569,13 +1730,9 @@ SetWinFileAttributes(
if (!(*tclWinProcs->setFileAttributesProc)(nativeName, fileAttributes)) {
StatError(interp, fileName);
- result = TCL_ERROR;
- goto end;
+ return TCL_ERROR;
}
- end:
- Tcl_DStringFree(&ds);
-
return result;
}
@@ -1591,7 +1748,7 @@ SetWinFileAttributes(
* TCL_ERROR
*
* Side effects:
- * The object result is set to a pertinant error message.
+ * The object result is set to a pertinent error message.
*
*----------------------------------------------------------------------
*/
@@ -1600,12 +1757,13 @@ static int
CannotSetAttribute(
Tcl_Interp *interp, /* The interp we are using for errors. */
int objIndex, /* The index of the attribute. */
- CONST char *fileName, /* The name of the file. */
+ Tcl_Obj *fileName, /* The name of the file. */
Tcl_Obj *attributePtr) /* The new value of the attribute. */
{
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"cannot set attribute \"", tclpFileAttrStrings[objIndex],
- "\" for file \"", fileName, "\": attribute is readonly",
+ "\" for file \"", Tcl_GetString(fileName),
+ "\": attribute is readonly",
(char *) NULL);
return TCL_ERROR;
}
@@ -1614,14 +1772,12 @@ CannotSetAttribute(
/*
*---------------------------------------------------------------------------
*
- * TclpListVolumes --
+ * TclpObjListVolumes --
*
* Lists the currently mounted volumes
*
* Results:
- * A standard Tcl result. Will always be TCL_OK, since there is no way
- * that this command can fail. Also, the interpreter's result is set to
- * the list of volumes.
+ * The list of volumes.
*
* Side effects:
* None
@@ -1629,16 +1785,15 @@ CannotSetAttribute(
*---------------------------------------------------------------------------
*/
-int
-TclpListVolumes(
- Tcl_Interp *interp) /* Interpreter for returning volume list. */
+Tcl_Obj*
+TclpObjListVolumes(void)
{
Tcl_Obj *resultPtr, *elemPtr;
char buf[40 * 4]; /* There couldn't be more than 30 drives??? */
int i;
char *p;
- resultPtr = Tcl_GetObjResult(interp);
+ resultPtr = Tcl_NewObj();
/*
* On Win32s:
@@ -1675,8 +1830,7 @@ TclpListVolumes(
Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr);
}
}
- return TCL_OK;
+
+ Tcl_IncrRefCount(resultPtr);
+ return resultPtr;
}
-
-
-
diff --git a/tcl/win/tclWinFile.c b/tcl/win/tclWinFile.c
index 859878e077b..5ec41cf8eed 100644
--- a/tcl/win/tclWinFile.c
+++ b/tcl/win/tclWinFile.c
@@ -14,11 +14,122 @@
* RCS: @(#) $Id$
*/
+//#define _WIN32_WINNT 0x0500
+
#include "tclWinInt.h"
+#include <winioctl.h>
#include <sys/stat.h>
#include <shlobj.h>
#include <lmaccess.h> /* For TclpGetUserHome(). */
+/*
+ * Declarations for 'link' related information. This information
+ * should come with VC++ 6.0, but is not in some older SDKs.
+ * In any case it is not well documented.
+ */
+#ifndef IO_REPARSE_TAG_RESERVED_ONE
+# define IO_REPARSE_TAG_RESERVED_ONE 0x000000001
+#endif
+#ifndef IO_REPARSE_TAG_RESERVED_RANGE
+# define IO_REPARSE_TAG_RESERVED_RANGE 0x000000001
+#endif
+#ifndef IO_REPARSE_TAG_VALID_VALUES
+# define IO_REPARSE_TAG_VALID_VALUES 0x0E000FFFF
+#endif
+#ifndef IO_REPARSE_TAG_HSM
+# define IO_REPARSE_TAG_HSM 0x0C0000004
+#endif
+#ifndef IO_REPARSE_TAG_NSS
+# define IO_REPARSE_TAG_NSS 0x080000005
+#endif
+#ifndef IO_REPARSE_TAG_NSSRECOVER
+# define IO_REPARSE_TAG_NSSRECOVER 0x080000006
+#endif
+#ifndef IO_REPARSE_TAG_SIS
+# define IO_REPARSE_TAG_SIS 0x080000007
+#endif
+#ifndef IO_REPARSE_TAG_DFS
+# define IO_REPARSE_TAG_DFS 0x080000008
+#endif
+
+#ifndef IO_REPARSE_TAG_RESERVED_ZERO
+# define IO_REPARSE_TAG_RESERVED_ZERO 0x00000000
+#endif
+#ifndef FILE_FLAG_OPEN_REPARSE_POINT
+# define FILE_FLAG_OPEN_REPARSE_POINT 0x00200000
+#endif
+#ifndef IO_REPARSE_TAG_MOUNT_POINT
+# define IO_REPARSE_TAG_MOUNT_POINT 0xA0000003
+#endif
+#ifndef IsReparseTagValid
+# define IsReparseTagValid(x) (!((x)&~IO_REPARSE_TAG_VALID_VALUES)&&((x)>IO_REPARSE_TAG_RESERVED_RANGE))
+#endif
+#ifndef IO_REPARSE_TAG_SYMBOLIC_LINK
+# define IO_REPARSE_TAG_SYMBOLIC_LINK IO_REPARSE_TAG_RESERVED_ZERO
+#endif
+#ifndef FILE_SPECIAL_ACCESS
+# define FILE_SPECIAL_ACCESS (FILE_ANY_ACCESS)
+#endif
+#ifndef FSCTL_SET_REPARSE_POINT
+# define FSCTL_SET_REPARSE_POINT CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 41, METHOD_BUFFERED, FILE_SPECIAL_ACCESS)
+# define FSCTL_GET_REPARSE_POINT CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 42, METHOD_BUFFERED, FILE_ANY_ACCESS)
+# define FSCTL_DELETE_REPARSE_POINT CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 43, METHOD_BUFFERED, FILE_SPECIAL_ACCESS)
+#endif
+
+/*
+ * Maximum reparse buffer info size. The max user defined reparse
+ * data is 16KB, plus there's a header.
+ */
+
+#define MAX_REPARSE_SIZE 17000
+
+/*
+ * Undocumented REPARSE_MOUNTPOINT_HEADER_SIZE structure definition.
+ * This is found in winnt.h.
+ *
+ * IMPORTANT: caution when using this structure, since the actual
+ * structures used will want to store a full path in the 'PathBuffer'
+ * field, but there isn't room (there's only a single WCHAR!). Therefore
+ * one must artificially create a larger space of memory and then cast it
+ * to this type. We use the 'DUMMY_REPARSE_BUFFER' struct just below to
+ * deal with this problem.
+ */
+
+#define REPARSE_MOUNTPOINT_HEADER_SIZE 8
+#ifndef REPARSE_DATA_BUFFER_HEADER_SIZE
+typedef struct _REPARSE_DATA_BUFFER {
+ DWORD ReparseTag;
+ WORD ReparseDataLength;
+ WORD Reserved;
+ union {
+ struct {
+ WORD SubstituteNameOffset;
+ WORD SubstituteNameLength;
+ WORD PrintNameOffset;
+ WORD PrintNameLength;
+ WCHAR PathBuffer[1];
+ } SymbolicLinkReparseBuffer;
+ struct {
+ WORD SubstituteNameOffset;
+ WORD SubstituteNameLength;
+ WORD PrintNameOffset;
+ WORD PrintNameLength;
+ WCHAR PathBuffer[1];
+ } MountPointReparseBuffer;
+ struct {
+ BYTE DataBuffer[1];
+ } GenericReparseBuffer;
+ };
+} REPARSE_DATA_BUFFER;
+#endif
+
+typedef struct {
+ REPARSE_DATA_BUFFER dummy;
+ WCHAR dummyBuf[MAX_PATH*3];
+} DUMMY_REPARSE_BUFFER;
+
+/* Other typedefs required by this code */
+
static time_t ToCTime(FILETIME fileTime);
typedef NET_API_STATUS NET_API_FUNCTION NETUSERGETINFOPROC
@@ -30,6 +141,446 @@ typedef NET_API_STATUS NET_API_FUNCTION NETAPIBUFFERFREEPROC
typedef NET_API_STATUS NET_API_FUNCTION NETGETDCNAMEPROC
(LPWSTR servername, LPWSTR domainname, LPBYTE *bufptr);
+/*
+ * Declarations for local procedures defined in this file:
+ */
+
+static int NativeAccess(CONST TCHAR *path, int mode);
+static int NativeStat(CONST TCHAR *path, Tcl_StatBuf *statPtr, int checkLinks);
+static int NativeIsExec(CONST TCHAR *path);
+static int NativeReadReparse(CONST TCHAR* LinkDirectory,
+ REPARSE_DATA_BUFFER* buffer);
+static int NativeWriteReparse(CONST TCHAR* LinkDirectory,
+ REPARSE_DATA_BUFFER* buffer);
+static int NativeMatchType(CONST char *name, int nameLen,
+ CONST TCHAR* nativeName, Tcl_GlobTypeData *types);
+static int WinIsDrive(CONST char *name, int nameLen);
+static Tcl_Obj* WinReadLink(CONST TCHAR* LinkSource);
+static Tcl_Obj* WinReadLinkDirectory(CONST TCHAR* LinkDirectory);
+static int WinLink(CONST TCHAR* LinkSource, CONST TCHAR* LinkTarget,
+ int linkAction);
+static int WinSymLinkDirectory(CONST TCHAR* LinkDirectory,
+ CONST TCHAR* LinkTarget);
+
+
+/*
+ *--------------------------------------------------------------------
+ *
+ * WinLink
+ *
+ * Make a link from source to target.
+ *--------------------------------------------------------------------
+ */
+static int
+WinLink(LinkSource, LinkTarget, linkAction)
+ CONST TCHAR* LinkSource;
+ CONST TCHAR* LinkTarget;
+ int linkAction;
+{
+ WCHAR tempFileName[MAX_PATH];
+ TCHAR* tempFilePart;
+ int attr;
+
+ /* Get the full path referenced by the target */
+ if (!(*tclWinProcs->getFullPathNameProc)(LinkTarget,
+ MAX_PATH, tempFileName, &tempFilePart)) {
+ /* Invalid file */
+ TclWinConvertError(GetLastError());
+ return -1;
+ }
+
+ /* Make sure source file doesn't exist */
+ attr = (*tclWinProcs->getFileAttributesProc)(LinkSource);
+ if (attr != 0xffffffff) {
+ Tcl_SetErrno(EEXIST);
+ return -1;
+ }
+
+ /* Get the full path referenced by the directory */
+ if (!(*tclWinProcs->getFullPathNameProc)(LinkSource,
+ MAX_PATH, tempFileName, &tempFilePart)) {
+ /* Invalid file */
+ TclWinConvertError(GetLastError());
+ return -1;
+ }
+ /* Check the target */
+ attr = (*tclWinProcs->getFileAttributesProc)(LinkTarget);
+ if (attr == 0xffffffff) {
+ /* The target doesn't exist */
+ TclWinConvertError(GetLastError());
+ return -1;
+ } else if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
+ /* It is a file */
+ if (tclWinProcs->createHardLinkProc == NULL) {
+ Tcl_SetErrno(ENOTDIR);
+ return -1;
+ }
+ if (linkAction & TCL_CREATE_HARD_LINK) {
+ if (!(*tclWinProcs->createHardLinkProc)(LinkSource, LinkTarget, NULL)) {
+ TclWinConvertError(GetLastError());
+ return -1;
+ }
+ return 0;
+ } else if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {
+ /* Can't symlink files */
+ Tcl_SetErrno(ENOTDIR);
+ return -1;
+ } else {
+ Tcl_SetErrno(ENODEV);
+ return -1;
+ }
+ } else {
+ if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {
+ return WinSymLinkDirectory(LinkSource, LinkTarget);
+ } else if (linkAction & TCL_CREATE_HARD_LINK) {
+ /* Can't hard link directories */
+ Tcl_SetErrno(EISDIR);
+ return -1;
+ } else {
+ Tcl_SetErrno(ENODEV);
+ return -1;
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------------
+ *
+ * WinReadLink
+ *
+ * What does 'LinkSource' point to? We need the original 'pathPtr'
+ * just so we can construct a path object in the correct filesystem.
+ *--------------------------------------------------------------------
+ */
+static Tcl_Obj*
+WinReadLink(LinkSource)
+ CONST TCHAR* LinkSource;
+{
+ WCHAR tempFileName[MAX_PATH];
+ TCHAR* tempFilePart;
+ int attr;
+
+ /* Get the full path referenced by the target */
+ if (!(*tclWinProcs->getFullPathNameProc)(LinkSource,
+ MAX_PATH, tempFileName, &tempFilePart)) {
+ /* Invalid file */
+ TclWinConvertError(GetLastError());
+ return NULL;
+ }
+
+ /* Make sure source file does exist */
+ attr = (*tclWinProcs->getFileAttributesProc)(LinkSource);
+ if (attr == 0xffffffff) {
+ /* The source doesn't exist */
+ TclWinConvertError(GetLastError());
+ return NULL;
+ } else if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
+ /* It is a file - this is not yet supported */
+ Tcl_SetErrno(ENOTDIR);
+ return NULL;
+ } else {
+ return WinReadLinkDirectory(LinkSource);
+ }
+}
+
+/*
+ *--------------------------------------------------------------------
+ *
+ * WinSymLinkDirectory
+ *
+ * This routine creates a NTFS junction, using the undocumented
+ * FSCTL_SET_REPARSE_POINT structure Win2K uses for mount points
+ * and junctions.
+ *
+ * Assumption that LinkTarget is a valid, existing directory.
+ *
+ * Returns zero on success.
+ *--------------------------------------------------------------------
+ */
+static int
+WinSymLinkDirectory(LinkDirectory, LinkTarget)
+ CONST TCHAR* LinkDirectory;
+ CONST TCHAR* LinkTarget;
+{
+ DUMMY_REPARSE_BUFFER dummy;
+ REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy;
+ int len;
+ WCHAR nativeTarget[MAX_PATH];
+ WCHAR *loop;
+
+ /* Make the native target name */
+ memcpy((VOID*)nativeTarget, (VOID*)L"\\??\\", 4*sizeof(WCHAR));
+ memcpy((VOID*)(nativeTarget + 4), (VOID*)LinkTarget,
+ sizeof(WCHAR)*(1+wcslen((WCHAR*)LinkTarget)));
+ len = wcslen(nativeTarget);
+ /*
+ * We must have backslashes only. This is VERY IMPORTANT.
+ * If we have any forward slashes everything appears to work,
+ * but the resulting symlink is useless!
+ */
+ for (loop = nativeTarget; *loop != 0; loop++) {
+ if (*loop == L'/') *loop = L'\\';
+ }
+ if ((nativeTarget[len-1] == L'\\') && (nativeTarget[len-2] != L':')) {
+ nativeTarget[len-1] = 0;
+ }
+
+ /* Build the reparse info */
+ memset(reparseBuffer, 0, sizeof(DUMMY_REPARSE_BUFFER));
+ reparseBuffer->ReparseTag = IO_REPARSE_TAG_MOUNT_POINT;
+ reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength =
+ wcslen(nativeTarget) * sizeof(WCHAR);
+ reparseBuffer->Reserved = 0;
+ reparseBuffer->SymbolicLinkReparseBuffer.PrintNameLength = 0;
+ reparseBuffer->SymbolicLinkReparseBuffer.PrintNameOffset =
+ reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength
+ + sizeof(WCHAR);
+ memcpy(reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer, nativeTarget,
+ sizeof(WCHAR)
+ + reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength);
+ reparseBuffer->ReparseDataLength =
+ reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength + 12;
+
+ return NativeWriteReparse(LinkDirectory, reparseBuffer);
+}
+
+/*
+ *--------------------------------------------------------------------
+ *
+ * TclWinSymLinkCopyDirectory
+ *
+ * Copy a Windows NTFS junction. This function assumes that
+ * LinkOriginal exists and is a valid junction point, and that
+ * LinkCopy does not exist.
+ *
+ * Returns zero on success.
+ *--------------------------------------------------------------------
+ */
+int
+TclWinSymLinkCopyDirectory(LinkOriginal, LinkCopy)
+ CONST TCHAR* LinkOriginal; /* Existing junction - reparse point */
+ CONST TCHAR* LinkCopy; /* Will become a duplicate junction */
+{
+ DUMMY_REPARSE_BUFFER dummy;
+ REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy;
+
+ if (NativeReadReparse(LinkOriginal, reparseBuffer)) {
+ return -1;
+ }
+ return NativeWriteReparse(LinkCopy, reparseBuffer);
+}
+
+/*
+ *--------------------------------------------------------------------
+ *
+ * TclWinSymLinkDelete
+ *
+ * Delete a Windows NTFS junction. Once the junction information
+ * is deleted, the filesystem object becomes an ordinary directory.
+ * Unless 'linkOnly' is given, that directory is also removed.
+ *
+ * Assumption that LinkOriginal is a valid, existing junction.
+ *
+ * Returns zero on success.
+ *--------------------------------------------------------------------
+ */
+int
+TclWinSymLinkDelete(LinkOriginal, linkOnly)
+ CONST TCHAR* LinkOriginal;
+ int linkOnly;
+{
+ /* It is a symbolic link -- remove it */
+ DUMMY_REPARSE_BUFFER dummy;
+ REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy;
+ HANDLE hFile;
+ int returnedLength;
+ memset(reparseBuffer, 0, sizeof(DUMMY_REPARSE_BUFFER));
+ reparseBuffer->ReparseTag = IO_REPARSE_TAG_MOUNT_POINT;
+ hFile = (*tclWinProcs->createFileProc)(LinkOriginal, GENERIC_WRITE, 0,
+ NULL, OPEN_EXISTING,
+ FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL);
+ if (hFile != INVALID_HANDLE_VALUE) {
+ if (!DeviceIoControl(hFile, FSCTL_DELETE_REPARSE_POINT, reparseBuffer,
+ REPARSE_MOUNTPOINT_HEADER_SIZE,
+ NULL, 0, &returnedLength, NULL)) {
+ /* Error setting junction */
+ TclWinConvertError(GetLastError());
+ CloseHandle(hFile);
+ } else {
+ CloseHandle(hFile);
+ if (!linkOnly) {
+ (*tclWinProcs->removeDirectoryProc)(LinkOriginal);
+ }
+ return 0;
+ }
+ }
+ return -1;
+}
+
+/*
+ *--------------------------------------------------------------------
+ *
+ * WinReadLinkDirectory
+ *
+ * This routine reads a NTFS junction, using the undocumented
+ * FSCTL_GET_REPARSE_POINT structure Win2K uses for mount points
+ * and junctions.
+ *
+ * Assumption that LinkDirectory is a valid, existing directory.
+ *
+ * Returns a Tcl_Obj with refCount of 1 (i.e. owned by the caller).
+ *--------------------------------------------------------------------
+ */
+static Tcl_Obj*
+WinReadLinkDirectory(LinkDirectory)
+ CONST TCHAR* LinkDirectory;
+{
+ int attr;
+ DUMMY_REPARSE_BUFFER dummy;
+ REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy;
+
+ attr = (*tclWinProcs->getFileAttributesProc)(LinkDirectory);
+ if (!(attr & FILE_ATTRIBUTE_REPARSE_POINT)) {
+ Tcl_SetErrno(EINVAL);
+ return NULL;
+ }
+ if (NativeReadReparse(LinkDirectory, reparseBuffer)) {
+ return NULL;
+ }
+
+ switch (reparseBuffer->ReparseTag) {
+ case 0x80000000|IO_REPARSE_TAG_SYMBOLIC_LINK:
+ case IO_REPARSE_TAG_SYMBOLIC_LINK:
+ case IO_REPARSE_TAG_MOUNT_POINT: {
+ Tcl_Obj *retVal;
+ Tcl_DString ds;
+ CONST char *copy;
+ int len;
+
+ Tcl_WinTCharToUtf(
+ (CONST char*)reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer,
+ (int)reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength,
+ &ds);
+
+ copy = Tcl_DStringValue(&ds);
+ len = Tcl_DStringLength(&ds);
+ /*
+ * Certain native path representations on Windows have this special
+ * prefix to indicate that they are to be treated specially. For
+ * example extremely long paths, or symlinks
+ */
+ if (*copy == '\\') {
+ if (0 == strncmp(copy,"\\??\\",4)) {
+ copy += 4;
+ len -= 4;
+ } else if (0 == strncmp(copy,"\\\\?\\",4)) {
+ copy += 4;
+ len -= 4;
+ }
+ }
+ retVal = Tcl_NewStringObj(copy,len);
+ Tcl_IncrRefCount(retVal);
+ Tcl_DStringFree(&ds);
+ return retVal;
+ }
+ }
+ Tcl_SetErrno(EINVAL);
+ return NULL;
+}
+
+/*
+ *--------------------------------------------------------------------
+ *
+ * NativeReadReparse
+ *
+ * Read the junction/reparse information from a given NTFS directory.
+ *
+ * Assumption that LinkDirectory is a valid, existing directory.
+ *
+ * Returns zero on success.
+ *--------------------------------------------------------------------
+ */
+static int
+NativeReadReparse(LinkDirectory, buffer)
+ CONST TCHAR* LinkDirectory; /* The junction to read */
+ REPARSE_DATA_BUFFER* buffer; /* Pointer to buffer. Cannot be NULL */
+{
+ HANDLE hFile;
+ int returnedLength;
+
+ hFile = (*tclWinProcs->createFileProc)(LinkDirectory, GENERIC_READ, 0,
+ NULL, OPEN_EXISTING,
+ FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL);
+ if (hFile == INVALID_HANDLE_VALUE) {
+ /* Error creating directory */
+ TclWinConvertError(GetLastError());
+ return -1;
+ }
+ /* Get the link */
+ if (!DeviceIoControl(hFile, FSCTL_GET_REPARSE_POINT, NULL,
+ 0, buffer, sizeof(DUMMY_REPARSE_BUFFER),
+ &returnedLength, NULL)) {
+ /* Error setting junction */
+ TclWinConvertError(GetLastError());
+ CloseHandle(hFile);
+ return -1;
+ }
+ CloseHandle(hFile);
+
+ if (!IsReparseTagValid(buffer->ReparseTag)) {
+ Tcl_SetErrno(EINVAL);
+ return -1;
+ }
+ return 0;
+}
+
+/*
+ *--------------------------------------------------------------------
+ *
+ * NativeWriteReparse
+ *
+ * Write the reparse information for a given directory.
+ *
+ * Assumption that LinkDirectory does not exist.
+ *--------------------------------------------------------------------
+ */
+static int
+NativeWriteReparse(LinkDirectory, buffer)
+ CONST TCHAR* LinkDirectory;
+ REPARSE_DATA_BUFFER* buffer;
+{
+ HANDLE hFile;
+ int returnedLength;
+
+ /* Create the directory - it must not already exist */
+ if ((*tclWinProcs->createDirectoryProc)(LinkDirectory, NULL) == 0) {
+ /* Error creating directory */
+ TclWinConvertError(GetLastError());
+ return -1;
+ }
+ hFile = (*tclWinProcs->createFileProc)(LinkDirectory, GENERIC_WRITE, 0,
+ NULL, OPEN_EXISTING,
+ FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL);
+ if (hFile == INVALID_HANDLE_VALUE) {
+ /* Error creating directory */
+ TclWinConvertError(GetLastError());
+ return -1;
+ }
+ /* Set the link */
+ if (!DeviceIoControl(hFile, FSCTL_SET_REPARSE_POINT, buffer,
+ buffer->ReparseDataLength
+ + REPARSE_MOUNTPOINT_HEADER_SIZE,
+ NULL, 0, &returnedLength, NULL)) {
+ /* Error setting junction */
+ TclWinConvertError(GetLastError());
+ CloseHandle(hFile);
+ (*tclWinProcs->removeDirectoryProc)(LinkDirectory);
+ return -1;
+ }
+ CloseHandle(hFile);
+ /* We succeeded */
+ return 0;
+}
/*
*---------------------------------------------------------------------------
@@ -76,7 +627,7 @@ TclpFindExecutable(argv0)
*/
(*tclWinProcs->getModuleFileNameProc)(NULL, wName, MAX_PATH);
- Tcl_WinTCharToUtf((TCHAR *) wName, -1, &ds);
+ Tcl_WinTCharToUtf((CONST TCHAR *) wName, -1, &ds);
tclNativeExecutableName = ckalloc((unsigned) (Tcl_DStringLength(&ds) + 1));
strcpy(tclNativeExecutableName, Tcl_DStringValue(&ds));
@@ -89,17 +640,16 @@ TclpFindExecutable(argv0)
/*
*----------------------------------------------------------------------
*
- * TclpMatchFilesTypes --
+ * TclpMatchInDirectory --
*
* This routine is used by the globbing code to search a
* directory for all files which match a given pattern.
*
* Results:
- * If the tail argument is NULL, then the matching files are
- * added to the the interp's result. Otherwise, TclDoGlob is called
- * recursively for each matching subdirectory. The return value
- * is a standard Tcl result indicating whether an error occurred
- * in globbing.
+ *
+ * The return value is a standard Tcl result indicating whether an
+ * error occurred in globbing. Errors are left in interp, good
+ * results are lappended to resultPtr (which must be a valid object)
*
* Side effects:
* None.
@@ -107,330 +657,429 @@ TclpFindExecutable(argv0)
*---------------------------------------------------------------------- */
int
-TclpMatchFilesTypes(
- Tcl_Interp *interp, /* Interpreter to receive results. */
- char *separators, /* Directory separators to pass to TclDoGlob. */
- Tcl_DString *dirPtr, /* Contains path to directory to search. */
- char *pattern, /* Pattern to match against. */
- char *tail, /* Pointer to end of pattern. Tail must
- * point to a location in pattern and must
- * not be static.*/
- GlobTypeData *types) /* Object containing list of acceptable types.
- * May be NULL. */
+TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
+ Tcl_Interp *interp; /* Interpreter to receive errors. */
+ Tcl_Obj *resultPtr; /* List object to lappend 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. */
{
- char drivePat[] = "?:\\";
- const char *message;
- char *dir, *newPattern, *root;
- int matchDotFiles;
- int dirLength, result = TCL_OK;
- Tcl_DString dirString, patternString;
- DWORD attr, volFlags;
- HANDLE handle;
- WIN32_FIND_DATAT data;
- BOOL found;
- Tcl_DString ds;
- TCHAR *nativeName;
- Tcl_Obj *resultPtr;
+ CONST TCHAR *nativeName;
+
+ if (pattern == NULL || (*pattern == '\0')) {
+ Tcl_Obj *norm = Tcl_FSGetNormalizedPath(NULL, pathPtr);
+ if (norm != NULL) {
+ int len;
+ char *str = Tcl_GetStringFromObj(norm,&len);
+ /* Match a file directly */
+ nativeName = (CONST TCHAR*) Tcl_FSGetNativePath(pathPtr);
+ if (NativeMatchType(str, len, nativeName, types)) {
+ Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
+ }
+ }
+ return TCL_OK;
+ } else {
+ char drivePat[] = "?:\\";
+ const char *message;
+ CONST char *dir;
+ char *root;
+ int dirLength;
+ Tcl_DString dirString;
+ DWORD attr, volFlags;
+ HANDLE handle;
+ WIN32_FIND_DATAT data;
+ BOOL found;
+ Tcl_DString ds;
+ Tcl_DString dsOrig;
+ Tcl_Obj *fileNamePtr;
+ int matchSpecialDots;
+
+ /*
+ * Convert the path to normalized form since some interfaces only
+ * accept backslashes. Also, ensure that the directory ends with a
+ * separator character.
+ */
- /*
- * Convert the path to normalized form since some interfaces only
- * accept backslashes. Also, ensure that the directory ends with a
- * separator character.
- */
+ fileNamePtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
+ if (fileNamePtr == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_DStringInit(&dsOrig);
+ Tcl_DStringAppend(&dsOrig, Tcl_GetString(fileNamePtr), -1);
- dirLength = Tcl_DStringLength(dirPtr);
- Tcl_DStringInit(&dirString);
- if (dirLength == 0) {
- Tcl_DStringAppend(&dirString, ".\\", 2);
- } else {
- char *p;
+ dirLength = Tcl_DStringLength(&dsOrig);
+ Tcl_DStringInit(&dirString);
+ if (dirLength == 0) {
+ Tcl_DStringAppend(&dirString, ".\\", 2);
+ } else {
+ char *p;
- Tcl_DStringAppend(&dirString, Tcl_DStringValue(dirPtr),
- Tcl_DStringLength(dirPtr));
- for (p = Tcl_DStringValue(&dirString); *p != '\0'; p++) {
- if (*p == '/') {
- *p = '\\';
+ Tcl_DStringAppend(&dirString, Tcl_DStringValue(&dsOrig),
+ Tcl_DStringLength(&dsOrig));
+ for (p = Tcl_DStringValue(&dirString); *p != '\0'; p++) {
+ if (*p == '/') {
+ *p = '\\';
+ }
+ }
+ p--;
+ /* Make sure we have a trailing directory delimiter */
+ if ((*p != '\\') && (*p != ':')) {
+ Tcl_DStringAppend(&dirString, "\\", 1);
+ Tcl_DStringAppend(&dsOrig, "/", 1);
+ dirLength++;
}
}
- p--;
- if ((*p != '\\') && (*p != ':')) {
- Tcl_DStringAppend(&dirString, "\\", 1);
- }
- }
- dir = Tcl_DStringValue(&dirString);
+ dir = Tcl_DStringValue(&dirString);
- /*
- * First verify that the specified path is actually a directory.
- */
+ /*
+ * First verify that the specified path is actually a directory.
+ */
- nativeName = Tcl_WinUtfToTChar(dir, Tcl_DStringLength(&dirString), &ds);
- attr = (*tclWinProcs->getFileAttributesProc)(nativeName);
- Tcl_DStringFree(&ds);
+ nativeName = Tcl_WinUtfToTChar(dir, Tcl_DStringLength(&dirString), &ds);
+ attr = (*tclWinProcs->getFileAttributesProc)(nativeName);
+ Tcl_DStringFree(&ds);
- if ((attr == 0xffffffff) || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) {
- Tcl_DStringFree(&dirString);
- return TCL_OK;
- }
+ if ((attr == 0xffffffff) || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) {
+ Tcl_DStringFree(&dirString);
+ return TCL_OK;
+ }
- /*
- * Next check the volume information for the directory to see whether
- * comparisons should be case sensitive or not. If the root is null, then
- * we use the root of the current directory. If the root is just a drive
- * specifier, we use the root directory of the given drive.
- */
+ /*
+ * Next check the volume information for the directory to see
+ * whether comparisons should be case sensitive or not. If the
+ * root is null, then we use the root of the current directory.
+ * If the root is just a drive specifier, we use the root
+ * directory of the given drive.
+ */
- switch (Tcl_GetPathType(dir)) {
- case TCL_PATH_RELATIVE:
- found = GetVolumeInformationA(NULL, NULL, 0, NULL, NULL,
- &volFlags, NULL, 0);
- break;
- case TCL_PATH_VOLUME_RELATIVE:
- if (dir[0] == '\\') {
- root = NULL;
- } else {
- root = drivePat;
- *root = dir[0];
- }
- found = GetVolumeInformationA(root, NULL, 0, NULL, NULL,
- &volFlags, NULL, 0);
- break;
- case TCL_PATH_ABSOLUTE:
- if (dir[1] == ':') {
- root = drivePat;
- *root = dir[0];
+ switch (Tcl_GetPathType(dir)) {
+ case TCL_PATH_RELATIVE:
+ found = GetVolumeInformationA(NULL, NULL, 0, NULL, NULL,
+ &volFlags, NULL, 0);
+ break;
+ case TCL_PATH_VOLUME_RELATIVE:
+ if (dir[0] == '\\') {
+ root = NULL;
+ } else {
+ root = drivePat;
+ *root = dir[0];
+ }
found = GetVolumeInformationA(root, NULL, 0, NULL, NULL,
&volFlags, NULL, 0);
- } else if (dir[1] == '\\') {
- char *p;
-
- p = strchr(dir + 2, '\\');
- p = strchr(p + 1, '\\');
- p++;
- nativeName = Tcl_WinUtfToTChar(dir, p - dir, &ds);
- found = (*tclWinProcs->getVolumeInformationProc)(nativeName,
- NULL, 0, NULL, NULL, &volFlags, NULL, 0);
- Tcl_DStringFree(&ds);
- }
- break;
- }
-
- if (found == 0) {
- message = "couldn't read volume information for \"";
- goto error;
- }
-
- /*
- * In Windows, although some volumes may support case sensitivity, Windows
- * doesn't honor case. So in globbing we need to ignore the case
- * of file names.
- */
+ break;
+ case TCL_PATH_ABSOLUTE:
+ if (dir[1] == ':') {
+ root = drivePat;
+ *root = dir[0];
+ found = GetVolumeInformationA(root, NULL, 0, NULL, NULL,
+ &volFlags, NULL, 0);
+ } else if (dir[1] == '\\') {
+ char *p;
+
+ p = strchr(dir + 2, '\\');
+ p = strchr(p + 1, '\\');
+ p++;
+ nativeName = Tcl_WinUtfToTChar(dir, p - dir, &ds);
+ found = (*tclWinProcs->getVolumeInformationProc)(nativeName,
+ NULL, 0, NULL, NULL, &volFlags, NULL, 0);
+ Tcl_DStringFree(&ds);
+ }
+ break;
+ }
- Tcl_DStringInit(&patternString);
- newPattern = Tcl_DStringAppend(&patternString, pattern, tail - pattern);
- Tcl_UtfToLower(newPattern);
+ if (found == 0) {
+ message = "couldn't read volume information for \"";
+ goto error;
+ }
- /*
- * We need to check all files in the directory, so append a *.*
- * to the path.
- */
+ /*
+ * Check to see if the pattern should match the special
+ * . and .. names, referring to the current directory,
+ * or the directory above. We need a special check for
+ * this because paths beginning with a dot are not considered
+ * hidden on Windows, and so otherwise a relative glob like
+ * 'glob -join * *' will actually return './. ../..' etc.
+ */
- dir = Tcl_DStringAppend(&dirString, "*.*", 3);
- nativeName = Tcl_WinUtfToTChar(dir, -1, &ds);
- handle = (*tclWinProcs->findFirstFileProc)(nativeName, &data);
- Tcl_DStringFree(&ds);
+ if ((pattern[0] == '.')
+ || ((pattern[0] == '\\') && (pattern[1] == '.'))) {
+ matchSpecialDots = 1;
+ } else {
+ matchSpecialDots = 0;
+ }
- if (handle == INVALID_HANDLE_VALUE) {
- message = "couldn't read directory \"";
- goto error;
- }
+ /*
+ * We need to check all files in the directory, so append a *.*
+ * to the path.
+ */
- /*
- * Clean up the tail pointer. Leave the tail pointing to the
- * first character after the path separator or NULL.
- */
+ dir = Tcl_DStringAppend(&dirString, "*.*", 3);
+ nativeName = Tcl_WinUtfToTChar(dir, -1, &ds);
+ handle = (*tclWinProcs->findFirstFileProc)(nativeName, &data);
+ Tcl_DStringFree(&ds);
- if (*tail == '\\') {
- tail++;
- }
- if (*tail == '\0') {
- tail = NULL;
- } else {
- tail++;
- }
+ if (handle == INVALID_HANDLE_VALUE) {
+ message = "couldn't read directory \"";
+ goto error;
+ }
- /*
- * Check to see if the pattern needs to compare with dot files.
- */
+ /*
+ * Now iterate over all of the files in the directory.
+ */
- if ((newPattern[0] == '.')
- || ((pattern[0] == '\\') && (pattern[1] == '.'))) {
- matchDotFiles = 1;
- } else {
- matchDotFiles = 0;
- }
+ for (found = 1; found != 0;
+ found = (*tclWinProcs->findNextFileProc)(handle, &data)) {
+ CONST TCHAR *nativeMatchResult;
+ CONST char *name, *fname;
+
+ if (tclWinProcs->useWide) {
+ nativeName = (CONST TCHAR *) data.w.cFileName;
+ } else {
+ nativeName = (CONST TCHAR *) data.a.cFileName;
+ }
+ name = Tcl_WinTCharToUtf(nativeName, -1, &ds);
+
+ if (!matchSpecialDots) {
+ /* If it is exactly '.' or '..' then we ignore it */
+ if (name[0] == '.') {
+ if (name[1] == '\0'
+ || (name[1] == '.' && name[2] == '\0')) {
+ continue;
+ }
+ }
+ }
+
+ /*
+ * Check to see if the file matches the pattern. Note that
+ * we are ignoring the case sensitivity flag because Windows
+ * doesn't honor case even if the volume is case sensitive.
+ * If the volume also doesn't preserve case, then we
+ * previously returned the lower case form of the name. This
+ * didn't seem quite right since there are
+ * non-case-preserving volumes that actually return mixed
+ * case. So now we are returning exactly what we get from
+ * the system.
+ */
- /*
- * Now iterate over all of the files in the directory.
- */
+ nativeMatchResult = NULL;
- resultPtr = Tcl_GetObjResult(interp);
- for (found = 1; found != 0;
- found = (*tclWinProcs->findNextFileProc)(handle, &data)) {
- TCHAR *nativeMatchResult;
- char *name, *fname;
+ if (Tcl_StringCaseMatch(name, pattern, 1) != 0) {
+ nativeMatchResult = nativeName;
+ }
+ Tcl_DStringFree(&ds);
- if (tclWinProcs->useWide) {
- nativeName = (TCHAR *) data.w.cFileName;
- } else {
- nativeName = (TCHAR *) data.a.cFileName;
- }
- name = Tcl_WinTCharToUtf(nativeName, -1, &ds);
+ if (nativeMatchResult == NULL) {
+ continue;
+ }
- /*
- * Check to see if the file matches the pattern. We need to convert
- * the file name to lower case for comparison purposes. Note that we
- * are ignoring the case sensitivity flag because Windows doesn't honor
- * case even if the volume is case sensitive. If the volume also
- * doesn't preserve case, then we previously returned the lower case
- * form of the name. This didn't seem quite right since there are
- * non-case-preserving volumes that actually return mixed case. So now
- * we are returning exactly what we get from the system.
- */
+ /*
+ * If the file matches, then we need to process the remainder
+ * of the path.
+ */
- Tcl_UtfToLower(name);
- nativeMatchResult = NULL;
+ name = Tcl_WinTCharToUtf(nativeMatchResult, -1, &ds);
+ Tcl_DStringAppend(&dsOrig, name, -1);
+ Tcl_DStringFree(&ds);
- if ((matchDotFiles == 0) && (name[0] == '.')) {
+ fname = Tcl_DStringValue(&dsOrig);
+ nativeName = Tcl_WinUtfToTChar(fname, Tcl_DStringLength(&dsOrig),
+ &ds);
+
+ if (NativeMatchType(fname, Tcl_DStringLength(&dsOrig),
+ nativeName, types)) {
+ Tcl_ListObjAppendElement(interp, resultPtr,
+ Tcl_NewStringObj(fname, Tcl_DStringLength(&dsOrig)));
+ }
/*
- * Ignore hidden files.
+ * Free ds here to ensure that nativeName is valid above.
*/
- } else if (Tcl_StringMatch(name, newPattern) != 0) {
- nativeMatchResult = nativeName;
- }
- Tcl_DStringFree(&ds);
- if (nativeMatchResult == NULL) {
- continue;
- }
+ Tcl_DStringFree(&ds);
- /*
- * If the file matches, then we need to process the remainder of the
- * path. If there are more characters to process, then ensure matching
- * files are directories and call TclDoGlob. Otherwise, just add the
- * file to the result.
- */
+ Tcl_DStringSetLength(&dsOrig, dirLength);
+ }
- name = Tcl_WinTCharToUtf(nativeMatchResult, -1, &ds);
- Tcl_DStringAppend(dirPtr, name, -1);
- Tcl_DStringFree(&ds);
+ FindClose(handle);
+ Tcl_DStringFree(&dirString);
+ Tcl_DStringFree(&dsOrig);
- fname = Tcl_DStringValue(dirPtr);
- nativeName = Tcl_WinUtfToTChar(fname, Tcl_DStringLength(dirPtr), &ds);
- attr = (*tclWinProcs->getFileAttributesProc)(nativeName);
- Tcl_DStringFree(&ds);
+ return TCL_OK;
+
+ error:
+ Tcl_DStringFree(&dirString);
+ TclWinConvertError(GetLastError());
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, message, Tcl_DStringValue(&dsOrig), "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
+ Tcl_DStringFree(&dsOrig);
+ return TCL_ERROR;
+ }
- if (tail == NULL) {
- int typeOk = 1;
- if (types != NULL) {
- if (types->perm != 0) {
- if (
- ((types->perm & TCL_GLOB_PERM_RONLY) &&
- !(attr & FILE_ATTRIBUTE_READONLY)) ||
- ((types->perm & TCL_GLOB_PERM_HIDDEN) &&
- !(attr & FILE_ATTRIBUTE_HIDDEN)) ||
- ((types->perm & TCL_GLOB_PERM_R) &&
- (TclpAccess(fname, R_OK) != 0)) ||
- ((types->perm & TCL_GLOB_PERM_W) &&
- (TclpAccess(fname, W_OK) != 0)) ||
- ((types->perm & TCL_GLOB_PERM_X) &&
- (TclpAccess(fname, X_OK) != 0))
- ) {
- typeOk = 0;
- }
+}
+
+/*
+ * Does the given path represent a root volume? We need this special
+ * case because for NTFS root volumes, the getFileAttributesProc returns
+ * a 'hidden' attribute when it should not.
+ */
+static int
+WinIsDrive(
+ CONST char *name, /* Name (UTF-8) */
+ int len) /* Length of name */
+{
+ int remove = 0;
+ while (len > 4) {
+ if ((name[len-1] != '.' || name[len-2] != '.')
+ || (name[len-3] != '/' && name[len-3] != '\\')) {
+ /* We don't have '/..' at the end */
+ if (remove == 0) {
+ break;
+ }
+ remove--;
+ while (len > 0) {
+ len--;
+ if (name[len] == '/' || name[len] == '\\') {
+ break;
}
- if (typeOk && types->type != 0) {
- struct stat buf;
- /*
- * We must match at least one flag to be listed
- */
- typeOk = 0;
- if (TclpLstat(fname, &buf) >= 0) {
- /*
- * In order bcdpfls as in 'find -t'
- */
- if (
- ((types->type & TCL_GLOB_TYPE_BLOCK) &&
- S_ISBLK(buf.st_mode)) ||
- ((types->type & TCL_GLOB_TYPE_CHAR) &&
- S_ISCHR(buf.st_mode)) ||
- ((types->type & TCL_GLOB_TYPE_DIR) &&
- S_ISDIR(buf.st_mode)) ||
- ((types->type & TCL_GLOB_TYPE_PIPE) &&
- S_ISFIFO(buf.st_mode)) ||
- ((types->type & TCL_GLOB_TYPE_FILE) &&
- S_ISREG(buf.st_mode))
-#ifdef S_ISLNK
- || ((types->type & TCL_GLOB_TYPE_LINK) &&
- S_ISLNK(buf.st_mode))
-#endif
-#ifdef S_ISSOCK
- || ((types->type & TCL_GLOB_TYPE_SOCK) &&
- S_ISSOCK(buf.st_mode))
-#endif
- ) {
- typeOk = 1;
- }
- } else {
- /* Posix error occurred */
- }
- }
- }
- if (typeOk) {
- Tcl_ListObjAppendElement(interp, resultPtr,
- Tcl_NewStringObj(fname, Tcl_DStringLength(dirPtr)));
}
- } else if (attr & FILE_ATTRIBUTE_DIRECTORY) {
- Tcl_DStringAppend(dirPtr, "/", 1);
- result = TclDoGlob(interp, separators, dirPtr, tail, types);
- if (result != TCL_OK) {
+ if (len < 4) {
+ len++;
break;
}
+ } else {
+ /* We do have '/..' */
+ len -= 3;
+ remove++;
+ }
+ }
+ if (len < 4) {
+ if (len == 0) {
+ /*
+ * Not sure if this is possible, but we pass it on
+ * anyway
+ */
+ } else if (len == 1 && (name[0] == '/' || name[0] == '\\')) {
+ /* Path is pointing to the root volume */
+ return 1;
+ } else if ((name[1] == ':')
+ && (len == 2 || (name[2] == '/' || name[2] == '\\'))) {
+ /* Path is of the form 'x:' or 'x:/' or 'x:\' */
+ return 1;
}
- Tcl_DStringSetLength(dirPtr, dirLength);
}
-
- FindClose(handle);
- Tcl_DStringFree(&dirString);
- Tcl_DStringFree(&patternString);
-
- return result;
-
- error:
- Tcl_DStringFree(&dirString);
- TclWinConvertError(GetLastError());
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, message, Tcl_DStringValue(dirPtr), "\": ",
- Tcl_PosixError(interp), (char *) NULL);
- return TCL_ERROR;
+ return 0;
}
+
/*
- * TclpMatchFiles --
- *
- * This function is now obsolete. Call the above function
- * 'TclpMatchFilesTypes' instead.
+ * This function needs a special case for a path which is a root
+ * volume, because for NTFS root volumes, the getFileAttributesProc
+ * returns a 'hidden' attribute when it should not.
*/
-int
-TclpMatchFiles(
- Tcl_Interp *interp, /* Interpreter to receive results. */
- char *separators, /* Directory separators to pass to TclDoGlob. */
- Tcl_DString *dirPtr, /* Contains path to directory to search. */
- char *pattern, /* Pattern to match against. */
- char *tail) /* Pointer to end of pattern. Tail must
- * point to a location in pattern and must
- * not be static.*/
+static int
+NativeMatchType(
+ CONST char *name, /* Name */
+ int nameLen, /* Length of name */
+ CONST TCHAR* nativeName, /* Native path to check */
+ Tcl_GlobTypeData *types) /* Type description to match against */
{
- return TclpMatchFilesTypes(interp,separators,dirPtr,pattern,tail,NULL);
+ /*
+ * 'attr' represents the attributes of the file, but we only
+ * want to retrieve this info if it is absolutely necessary
+ * because it is an expensive call. Unfortunately, to deal
+ * with hidden files properly, we must always retrieve it.
+ * There are more modern Win32 APIs available which we should
+ * look into.
+ */
+
+ DWORD attr = (*tclWinProcs->getFileAttributesProc)(nativeName);
+ if (attr == 0xffffffff) {
+ /* File doesn't exist */
+ return 0;
+ }
+
+ if (types == NULL) {
+ /* If invisible, don't return the file */
+ if (attr & FILE_ATTRIBUTE_HIDDEN && !WinIsDrive(name, nameLen)) {
+ return 0;
+ }
+ } else {
+ if (attr & FILE_ATTRIBUTE_HIDDEN && !WinIsDrive(name, nameLen)) {
+ /* If invisible */
+ if ((types->perm == 0) ||
+ !(types->perm & TCL_GLOB_PERM_HIDDEN)) {
+ return 0;
+ }
+ } else {
+ /* Visible */
+ if (types->perm & TCL_GLOB_PERM_HIDDEN) {
+ return 0;
+ }
+ }
+
+ if (types->perm != 0) {
+ if (
+ ((types->perm & TCL_GLOB_PERM_RONLY) &&
+ !(attr & FILE_ATTRIBUTE_READONLY)) ||
+ ((types->perm & TCL_GLOB_PERM_R) &&
+ (NativeAccess(nativeName, R_OK) != 0)) ||
+ ((types->perm & TCL_GLOB_PERM_W) &&
+ (NativeAccess(nativeName, W_OK) != 0)) ||
+ ((types->perm & TCL_GLOB_PERM_X) &&
+ (NativeAccess(nativeName, X_OK) != 0))
+ ) {
+ return 0;
+ }
+ }
+ if (types->type != 0) {
+ Tcl_StatBuf buf;
+
+ if (NativeStat(nativeName, &buf, 0) != 0) {
+ /*
+ * Posix error occurred, either the file
+ * has disappeared, or there is some other
+ * strange error. In any case we don't
+ * return this file.
+ */
+ return 0;
+ }
+ /*
+ * In order bcdpfls as in 'find -t'
+ */
+ if (
+ ((types->type & TCL_GLOB_TYPE_BLOCK) &&
+ S_ISBLK(buf.st_mode)) ||
+ ((types->type & TCL_GLOB_TYPE_CHAR) &&
+ S_ISCHR(buf.st_mode)) ||
+ ((types->type & TCL_GLOB_TYPE_DIR) &&
+ S_ISDIR(buf.st_mode)) ||
+ ((types->type & TCL_GLOB_TYPE_PIPE) &&
+ S_ISFIFO(buf.st_mode)) ||
+ ((types->type & TCL_GLOB_TYPE_FILE) &&
+ S_ISREG(buf.st_mode))
+#ifdef S_ISSOCK
+ || ((types->type & TCL_GLOB_TYPE_SOCK) &&
+ S_ISSOCK(buf.st_mode))
+#endif
+ ) {
+ /* Do nothing -- this file is ok */
+ } else {
+#ifdef S_ISLNK
+ if (types->type & TCL_GLOB_TYPE_LINK) {
+ if (NativeStat(nativeName, &buf, 1) == 0) {
+ if (S_ISLNK(buf.st_mode)) {
+ return 1;
+ }
+ }
+ }
+#endif
+ return 0;
+ }
+ }
+ }
+ return 1;
}
/*
@@ -503,7 +1152,7 @@ TclpGetUserHome(name, bufferPtr)
if (badDomain == 0) {
Tcl_DStringInit(&ds);
wName = Tcl_UtfToUniCharDString(name, nameLen, &ds);
- if ((*netUserGetInfoProc)(wDomain, wName, 1,
+ if ((*netUserGetInfoProc)(wDomain, wName, 1,
(LPBYTE *) &uiPtr) == 0) {
wHomeDir = uiPtr->usri1_home_dir;
if ((wHomeDir != NULL) && (wHomeDir[0] != L'\0')) {
@@ -557,11 +1206,12 @@ TclpGetUserHome(name, bufferPtr)
return result;
}
+
/*
*---------------------------------------------------------------------------
*
- * TclpAccess --
+ * NativeAccess --
*
* This function replaces the library version of access(), fixing the
* following bugs:
@@ -577,18 +1227,14 @@ TclpGetUserHome(name, bufferPtr)
*---------------------------------------------------------------------------
*/
-int
-TclpAccess(
- CONST char *path, /* Path of file to access (UTF-8). */
+static int
+NativeAccess(
+ CONST TCHAR *nativePath, /* Path of file to access (UTF-8). */
int mode) /* Permission setting. */
{
- Tcl_DString ds;
- TCHAR *nativePath;
DWORD attr;
- nativePath = Tcl_WinUtfToTChar(path, -1, &ds);
attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
- Tcl_DStringFree(&ds);
if (attr == 0xffffffff) {
/*
@@ -609,8 +1255,6 @@ TclpAccess(
}
if (mode & X_OK) {
- CONST char *p;
-
if (attr & FILE_ATTRIBUTE_DIRECTORY) {
/*
* Directories are always executable.
@@ -618,18 +1262,8 @@ TclpAccess(
return 0;
}
- p = strrchr(path, '.');
- if (p != NULL) {
- p++;
- if ((stricmp(p, "exe") == 0)
- || (stricmp(p, "com") == 0)
- || (stricmp(p, "bat") == 0)) {
- /*
- * File that ends with .exe, .com, or .bat is executable.
- */
-
- return 0;
- }
+ if (NativeIsExec(nativePath)) {
+ return 0;
}
Tcl_SetErrno(EACCES);
return -1;
@@ -638,10 +1272,46 @@ TclpAccess(
return 0;
}
+static int
+NativeIsExec(nativePath)
+ CONST TCHAR *nativePath;
+{
+ CONST char *p, *path;
+ Tcl_DString ds;
+
+ /*
+ * This is really not efficient. We should be able to examine
+ * the native path directly without converting to UTF.
+ */
+ Tcl_DStringInit(&ds);
+ path = Tcl_WinTCharToUtf(nativePath, -1, &ds);
+
+ p = strrchr(path, '.');
+ if (p != NULL) {
+ p++;
+ /*
+ * Note: in the old code, stat considered '.pif' files as
+ * executable, whereas access did not.
+ */
+ if ((stricmp(p, "exe") == 0)
+ || (stricmp(p, "com") == 0)
+ || (stricmp(p, "bat") == 0)) {
+ /*
+ * File that ends with .exe, .com, or .bat is executable.
+ */
+
+ Tcl_DStringFree(&ds);
+ return 1;
+ }
+ }
+ Tcl_DStringFree(&ds);
+ return 0;
+}
+
/*
*----------------------------------------------------------------------
*
- * TclpChdir --
+ * TclpObjChdir --
*
* This function replaces the library version of chdir().
*
@@ -654,22 +1324,15 @@ TclpAccess(
*----------------------------------------------------------------------
*/
-int
-TclpChdir(path)
- CONST char *path; /* Path to new working directory (UTF-8). */
+int
+TclpObjChdir(pathPtr)
+ Tcl_Obj *pathPtr; /* Path to new working directory. */
{
int result;
- Tcl_DString ds;
- TCHAR *nativePath;
+ CONST TCHAR *nativePath;
- nativePath = Tcl_WinUtfToTChar(path, -1, &ds);
+ nativePath = (CONST TCHAR *) Tcl_FSGetNativePath(pathPtr);
result = (*tclWinProcs->setCurrentDirectoryProc)(nativePath);
- Tcl_DStringFree(&ds);
-
-#ifdef __CYGWIN__
- /* We use chdir on Cygwin which follows POSIX return code. */
- result = !result;
-#endif
if (result == 0) {
TclWinConvertError(GetLastError());
@@ -715,7 +1378,7 @@ TclpReadlink(path, linkPtr)
Tcl_DStringFree(&ds);
if (length < 0) {
- return NULL;
+ return NULL;
}
Tcl_ExternalToUtfDString(NULL, link, length, linkPtr);
@@ -744,7 +1407,7 @@ TclpReadlink(path, linkPtr)
*----------------------------------------------------------------------
*/
-char *
+CONST char *
TclpGetCwd(interp, bufferPtr)
Tcl_Interp *interp; /* If non-NULL, used for error reporting. */
Tcl_DString *bufferPtr; /* Uninitialized or free DString filled
@@ -764,7 +1427,7 @@ TclpGetCwd(interp, bufferPtr)
}
/*
- * Watch for the wierd Windows c:\\UNC syntax.
+ * Watch for the weird Windows c:\\UNC syntax.
*/
if (tclWinProcs->useWide) {
@@ -799,10 +1462,40 @@ TclpGetCwd(interp, bufferPtr)
return Tcl_DStringValue(bufferPtr);
}
+int
+TclpObjStat(pathPtr, statPtr)
+ Tcl_Obj *pathPtr; /* Path of file to stat */
+ Tcl_StatBuf *statPtr; /* Filled with results of stat call. */
+{
+#ifdef OLD_API
+ Tcl_Obj *transPtr;
+ /*
+ * Eliminate file names containing wildcard characters, or subsequent
+ * call to FindFirstFile() will expand them, matching some other file.
+ */
+
+ transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
+ if (transPtr == NULL || (strpbrk(Tcl_GetString(transPtr), "?*") != NULL)) {
+ Tcl_SetErrno(ENOENT);
+ return -1;
+ }
+#endif
+
+ /*
+ * Ensure correct file sizes by forcing the OS to write any
+ * pending data to disk. This is done only for channels which are
+ * dirty, i.e. have been written to since the last flush here.
+ */
+
+ TclWinFlushDirtyChannels ();
+
+ return NativeStat((CONST TCHAR*) Tcl_FSGetNativePath(pathPtr), statPtr, 0);
+}
+
/*
*----------------------------------------------------------------------
*
- * TclpStat --
+ * NativeStat --
*
* This function replaces the library version of stat(), fixing
* the following bugs:
@@ -822,115 +1515,177 @@ TclpGetCwd(interp, bufferPtr)
*----------------------------------------------------------------------
*/
-int
-TclpStat(path, statPtr)
- CONST char *path; /* Path of file to stat (UTF-8). */
- struct stat *statPtr; /* Filled with results of stat call. */
+static int
+NativeStat(nativePath, statPtr, checkLinks)
+ CONST TCHAR *nativePath; /* Path of file to stat */
+ Tcl_StatBuf *statPtr; /* Filled with results of stat call. */
+ int checkLinks; /* If non-zero, behave like 'lstat' */
{
Tcl_DString ds;
- TCHAR *nativePath;
- WIN32_FIND_DATAT data;
- HANDLE handle;
DWORD attr;
WCHAR nativeFullPath[MAX_PATH];
TCHAR *nativePart;
- char *p, *fullPath;
+ CONST char *fullPath;
int dev, mode;
+
+ if (tclWinProcs->getFileAttributesExProc == NULL) {
+ /*
+ * We don't have the faster attributes proc, so we're
+ * probably running on Win95
+ */
+ WIN32_FIND_DATAT data;
+ HANDLE handle;
+
+ handle = (*tclWinProcs->findFirstFileProc)(nativePath, &data);
+ if (handle == INVALID_HANDLE_VALUE) {
+ /*
+ * FindFirstFile() doesn't work on root directories, so call
+ * GetFileAttributes() to see if the specified file exists.
+ */
- /*
- * Eliminate file names containing wildcard characters, or subsequent
- * call to FindFirstFile() will expand them, matching some other file.
- */
+ attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
+ if (attr == 0xffffffff) {
+ Tcl_SetErrno(ENOENT);
+ return -1;
+ }
- if (strpbrk(path, "?*") != NULL) {
- Tcl_SetErrno(ENOENT);
- return -1;
- }
+ /*
+ * Make up some fake information for this file. It has the
+ * correct file attributes and a time of 0.
+ */
- nativePath = Tcl_WinUtfToTChar(path, -1, &ds);
- handle = (*tclWinProcs->findFirstFileProc)(nativePath, &data);
- if (handle == INVALID_HANDLE_VALUE) {
- /*
- * FindFirstFile() doesn't work on root directories, so call
- * GetFileAttributes() to see if the specified file exists.
- */
+ memset(&data, 0, sizeof(data));
+ data.a.dwFileAttributes = attr;
+ } else {
+ FindClose(handle);
+ }
- attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
- if (attr == 0xffffffff) {
- Tcl_DStringFree(&ds);
+
+ (*tclWinProcs->getFullPathNameProc)(nativePath, MAX_PATH, nativeFullPath,
+ &nativePart);
+
+ fullPath = Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds);
+
+ dev = -1;
+ if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) {
+ CONST char *p;
+ DWORD dw;
+ CONST TCHAR *nativeVol;
+ Tcl_DString volString;
+
+ p = strchr(fullPath + 2, '\\');
+ p = strchr(p + 1, '\\');
+ if (p == NULL) {
+ /*
+ * Add terminating backslash to fullpath or
+ * GetVolumeInformation() won't work.
+ */
+
+ fullPath = Tcl_DStringAppend(&ds, "\\", 1);
+ p = fullPath + Tcl_DStringLength(&ds);
+ } else {
+ p++;
+ }
+ nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString);
+ dw = (DWORD) -1;
+ (*tclWinProcs->getVolumeInformationProc)(nativeVol, NULL, 0, &dw,
+ NULL, NULL, NULL, 0);
+ /*
+ * GetFullPathName() turns special devices like "NUL" into
+ * "\\.\NUL", but GetVolumeInformation() returns failure for
+ * "\\.\NUL". This will cause "NUL" to get a drive number of
+ * -1, which makes about as much sense as anything since the
+ * special devices don't live on any drive.
+ */
+
+ dev = dw;
+ Tcl_DStringFree(&volString);
+ } else if ((fullPath[0] != '\0') && (fullPath[1] == ':')) {
+ dev = Tcl_UniCharToLower(fullPath[0]) - 'a';
+ }
+ Tcl_DStringFree(&ds);
+
+ attr = data.a.dwFileAttributes;
+
+ statPtr->st_size = ((Tcl_WideInt)data.a.nFileSizeLow) |
+ (((Tcl_WideInt)data.a.nFileSizeHigh) << 32);
+ statPtr->st_atime = ToCTime(data.a.ftLastAccessTime);
+ statPtr->st_mtime = ToCTime(data.a.ftLastWriteTime);
+ statPtr->st_ctime = ToCTime(data.a.ftCreationTime);
+ } else {
+ WIN32_FILE_ATTRIBUTE_DATA data;
+ if((*tclWinProcs->getFileAttributesExProc)(nativePath,
+ GetFileExInfoStandard,
+ &data) != TRUE) {
Tcl_SetErrno(ENOENT);
return -1;
}
- /*
- * Make up some fake information for this file. It has the
- * correct file attributes and a time of 0.
- */
+
+ (*tclWinProcs->getFullPathNameProc)(nativePath, MAX_PATH,
+ nativeFullPath, &nativePart);
- memset(&data, 0, sizeof(data));
- data.a.dwFileAttributes = attr;
- } else {
- FindClose(handle);
- }
+ fullPath = Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds);
- (*tclWinProcs->getFullPathNameProc)(nativePath, MAX_PATH, nativeFullPath,
- &nativePart);
+ dev = -1;
+ if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) {
+ CONST char *p;
+ DWORD dw;
+ CONST TCHAR *nativeVol;
+ Tcl_DString volString;
- Tcl_DStringFree(&ds);
- fullPath = Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds);
-
- dev = -1;
- if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) {
- char *p;
- DWORD dw;
- TCHAR *nativeVol;
- Tcl_DString volString;
-
- p = strchr(fullPath + 2, '\\');
- p = strchr(p + 1, '\\');
- if (p == NULL) {
+ p = strchr(fullPath + 2, '\\');
+ p = strchr(p + 1, '\\');
+ if (p == NULL) {
+ /*
+ * Add terminating backslash to fullpath or
+ * GetVolumeInformation() won't work.
+ */
+
+ fullPath = Tcl_DStringAppend(&ds, "\\", 1);
+ p = fullPath + Tcl_DStringLength(&ds);
+ } else {
+ p++;
+ }
+ nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString);
+ dw = (DWORD) -1;
+ (*tclWinProcs->getVolumeInformationProc)(nativeVol, NULL, 0, &dw,
+ NULL, NULL, NULL, 0);
/*
- * Add terminating backslash to fullpath or
- * GetVolumeInformation() won't work.
+ * GetFullPathName() turns special devices like "NUL" into
+ * "\\.\NUL", but GetVolumeInformation() returns failure for
+ * "\\.\NUL". This will cause "NUL" to get a drive number of
+ * -1, which makes about as much sense as anything since the
+ * special devices don't live on any drive.
*/
- fullPath = Tcl_DStringAppend(&ds, "\\", 1);
- p = fullPath + Tcl_DStringLength(&ds);
- } else {
- p++;
+ dev = dw;
+ Tcl_DStringFree(&volString);
+ } else if ((fullPath[0] != '\0') && (fullPath[1] == ':')) {
+ dev = Tcl_UniCharToLower(fullPath[0]) - 'a';
}
- nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString);
- dw = (DWORD) -1;
- (*tclWinProcs->getVolumeInformationProc)(nativeVol, NULL, 0, &dw,
- NULL, NULL, NULL, 0);
- /*
- * GetFullPathName() turns special devices like "NUL" into "\\.\NUL",
- * but GetVolumeInformation() returns failure for "\\.\NUL". This
- * will cause "NUL" to get a drive number of -1, which makes about
- * as much sense as anything since the special devices don't live on
- * any drive.
- */
-
- dev = dw;
- Tcl_DStringFree(&volString);
- } else if ((fullPath[0] != '\0') && (fullPath[1] == ':')) {
- dev = Tcl_UniCharToLower(fullPath[0]) - 'a';
+ Tcl_DStringFree(&ds);
+
+ attr = data.dwFileAttributes;
+
+ statPtr->st_size = ((Tcl_WideInt)data.nFileSizeLow) |
+ (((Tcl_WideInt)data.nFileSizeHigh) << 32);
+ statPtr->st_atime = ToCTime(data.ftLastAccessTime);
+ statPtr->st_mtime = ToCTime(data.ftLastWriteTime);
+ statPtr->st_ctime = ToCTime(data.ftCreationTime);
}
- Tcl_DStringFree(&ds);
- attr = data.a.dwFileAttributes;
- mode = (attr & FILE_ATTRIBUTE_DIRECTORY) ? S_IFDIR | S_IEXEC : S_IFREG;
+ if (checkLinks && (attr & FILE_ATTRIBUTE_REPARSE_POINT)) {
+ /* It is a link */
+ mode = S_IFLNK;
+ } else {
+ mode = (attr & FILE_ATTRIBUTE_DIRECTORY) ? S_IFDIR | S_IEXEC : S_IFREG;
+ }
mode |= (attr & FILE_ATTRIBUTE_READONLY) ? S_IREAD : S_IREAD | S_IWRITE;
- p = strrchr(path, '.');
- if (p != NULL) {
- if ((lstrcmpiA(p, ".exe") == 0)
- || (lstrcmpiA(p, ".com") == 0)
- || (lstrcmpiA(p, ".bat") == 0)
- || (lstrcmpiA(p, ".pif") == 0)) {
- mode |= S_IEXEC;
- }
+ if (NativeIsExec(nativePath)) {
+ mode |= S_IEXEC;
}
-
+
/*
* Propagate the S_IREAD, S_IWRITE, S_IEXEC bits to the group and
* other positions.
@@ -946,10 +1701,6 @@ TclpStat(path, statPtr)
statPtr->st_uid = 0;
statPtr->st_gid = 0;
statPtr->st_rdev = (dev_t) dev;
- statPtr->st_size = data.a.nFileSizeLow;
- statPtr->st_atime = ToCTime(data.a.ftLastAccessTime);
- statPtr->st_mtime = ToCTime(data.a.ftLastWriteTime);
- statPtr->st_ctime = ToCTime(data.a.ftCreationTime);
return 0;
}
@@ -1082,5 +1833,392 @@ TclWinResolveShortcut(bufferPtr)
return 0;
}
#endif
+
+Tcl_Obj*
+TclpObjGetCwd(interp)
+ Tcl_Interp *interp;
+{
+ Tcl_DString ds;
+ if (TclpGetCwd(interp, &ds) != NULL) {
+ Tcl_Obj *cwdPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
+ Tcl_IncrRefCount(cwdPtr);
+ Tcl_DStringFree(&ds);
+ return cwdPtr;
+ } else {
+ return NULL;
+ }
+}
+
+int
+TclpObjAccess(pathPtr, mode)
+ Tcl_Obj *pathPtr;
+ int mode;
+{
+ return NativeAccess((CONST TCHAR*) Tcl_FSGetNativePath(pathPtr), mode);
+}
+
+int
+TclpObjLstat(pathPtr, statPtr)
+ Tcl_Obj *pathPtr;
+ Tcl_StatBuf *statPtr;
+{
+ /*
+ * Ensure correct file sizes by forcing the OS to write any
+ * pending data to disk. This is done only for channels which are
+ * dirty, i.e. have been written to since the last flush here.
+ */
+
+ TclWinFlushDirtyChannels ();
+
+ return NativeStat((CONST TCHAR*) Tcl_FSGetNativePath(pathPtr), statPtr, 1);
+}
+
+#ifdef S_IFLNK
+
+Tcl_Obj*
+TclpObjLink(pathPtr, toPtr, linkAction)
+ Tcl_Obj *pathPtr;
+ Tcl_Obj *toPtr;
+ int linkAction;
+{
+ if (toPtr != NULL) {
+ int res;
+ TCHAR* LinkTarget = (TCHAR*)Tcl_FSGetNativePath(toPtr);
+ TCHAR* LinkSource = (TCHAR*)Tcl_FSGetNativePath(pathPtr);
+ if (LinkSource == NULL || LinkTarget == NULL) {
+ return NULL;
+ }
+ res = WinLink(LinkSource, LinkTarget, linkAction);
+ if (res == 0) {
+ return toPtr;
+ } else {
+ return NULL;
+ }
+ } else {
+ TCHAR* LinkSource = (TCHAR*)Tcl_FSGetNativePath(pathPtr);
+ if (LinkSource == NULL) {
+ return NULL;
+ }
+ return WinReadLink(LinkSource);
+ }
+}
+
+#endif
+
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpFilesystemPathType --
+ *
+ * This function is part of the native filesystem support, and
+ * returns the path type of the given path. Returns NTFS or FAT
+ * or whatever is returned by the 'volume information' proc.
+ *
+ * Results:
+ * NULL at present.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+Tcl_Obj*
+TclpFilesystemPathType(pathObjPtr)
+ Tcl_Obj* pathObjPtr;
+{
+#define VOL_BUF_SIZE 32
+ int found;
+ char volType[VOL_BUF_SIZE];
+ char* firstSeparator;
+ CONST char *path;
+
+ Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathObjPtr);
+ if (normPath == NULL) return NULL;
+ path = Tcl_GetString(normPath);
+ if (path == NULL) return NULL;
+
+ firstSeparator = strchr(path, '/');
+ if (firstSeparator == NULL) {
+ found = tclWinProcs->getVolumeInformationProc(
+ Tcl_FSGetNativePath(pathObjPtr), NULL, 0, NULL, NULL,
+ NULL, (WCHAR *)volType, VOL_BUF_SIZE);
+ } else {
+ Tcl_Obj *driveName = Tcl_NewStringObj(path, firstSeparator - path+1);
+ Tcl_IncrRefCount(driveName);
+ found = tclWinProcs->getVolumeInformationProc(
+ Tcl_FSGetNativePath(driveName), NULL, 0, NULL, NULL,
+ NULL, (WCHAR *)volType, VOL_BUF_SIZE);
+ Tcl_DecrRefCount(driveName);
+ }
+
+ if (found == 0) {
+ return NULL;
+ } else {
+ Tcl_DString ds;
+ Tcl_Obj *objPtr;
+
+ Tcl_WinTCharToUtf(volType, -1, &ds);
+ objPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),Tcl_DStringLength(&ds));
+ Tcl_DStringFree(&ds);
+ return objPtr;
+ }
+#undef VOL_BUF_SIZE
+}
+
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpObjNormalizePath --
+ *
+ * This function scans through a path specification and replaces it,
+ * in place, with a normalized version. This means using the
+ * 'longname', and expanding any symbolic links contained within the
+ * path.
+ *
+ * Results:
+ * The new 'nextCheckpoint' value, giving as far as we could
+ * understand in the path.
+ *
+ * Side effects:
+ * The pathPtr string, which must contain a valid path, is
+ * possibly modified in place.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
+ Tcl_Interp *interp;
+ Tcl_Obj *pathPtr;
+ int nextCheckpoint;
+{
+ char *lastValidPathEnd = NULL;
+ /* This will hold the normalized string */
+ Tcl_DString dsNorm;
+ char *path;
+ char *currentPathEndPosition;
+
+ Tcl_DStringInit(&dsNorm);
+ path = Tcl_GetString(pathPtr);
+ if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_WINDOWS) {
+ /*
+ * We're on Win95, 98 or ME. There are two assumptions
+ * in this block of code. First that the native (NULL)
+ * encoding is basically ascii, and second that symbolic
+ * links are not possible. Both of these assumptions
+ * appear to be true of these operating systems.
+ */
+ Tcl_Obj *temp = NULL;
+ int isDrive = 1;
+ Tcl_DString ds;
+
+ currentPathEndPosition = path + nextCheckpoint;
+ while (1) {
+ char cur = *currentPathEndPosition;
+ if ((cur == '/' || cur == 0) && (path != currentPathEndPosition)) {
+ /* Reached directory separator, or end of string */
+ CONST char *nativePath = Tcl_UtfToExternalDString(NULL, path,
+ currentPathEndPosition - path, &ds);
+ /*
+ * Now we convert the tail of the current path to its
+ * 'long form', and append it to 'dsNorm' which holds
+ * the current normalized path, if the file exists.
+ */
+ if (isDrive) {
+ if (GetFileAttributesA(nativePath)
+ == 0xffffffff) {
+ /* File doesn't exist */
+ Tcl_DStringFree(&ds);
+ break;
+ }
+ if (nativePath[0] >= 'a') {
+ ((char*)nativePath)[0] -= ('a' - 'A');
+ }
+ Tcl_DStringAppend(&dsNorm,nativePath,Tcl_DStringLength(&ds));
+ } else {
+ WIN32_FIND_DATA fData;
+ HANDLE handle;
+
+ handle = FindFirstFileA(nativePath, &fData);
+ if (handle == INVALID_HANDLE_VALUE) {
+ if (GetFileAttributesA(nativePath)
+ == 0xffffffff) {
+ /* File doesn't exist */
+ Tcl_DStringFree(&ds);
+ break;
+ }
+ /* This is usually the '/' in 'c:/' at end of string */
+ Tcl_DStringAppend(&dsNorm,"/", 1);
+ } else {
+ char *nativeName;
+ if (fData.cFileName[0] != '\0') {
+ nativeName = fData.cFileName;
+ } else {
+ nativeName = fData.cAlternateFileName;
+ }
+ FindClose(handle);
+ Tcl_DStringAppend(&dsNorm,"/", 1);
+ Tcl_DStringAppend(&dsNorm,nativeName,-1);
+ }
+ }
+ Tcl_DStringFree(&ds);
+ lastValidPathEnd = currentPathEndPosition;
+ if (cur == 0) {
+ break;
+ }
+ /*
+ * If we get here, we've got past one directory
+ * delimiter, so we know it is no longer a drive
+ */
+ isDrive = 0;
+ }
+ currentPathEndPosition++;
+ }
+ } else {
+ /* We're on WinNT or 2000 or XP */
+ Tcl_Obj *temp = NULL;
+ int isDrive = 1;
+ Tcl_DString ds;
+
+ currentPathEndPosition = path + nextCheckpoint;
+ while (1) {
+ char cur = *currentPathEndPosition;
+ if ((cur == '/' || cur == 0) && (path != currentPathEndPosition)) {
+ /* Reached directory separator, or end of string */
+ WIN32_FILE_ATTRIBUTE_DATA data;
+ CONST char *nativePath = Tcl_WinUtfToTChar(path,
+ currentPathEndPosition - path, &ds);
+ if ((*tclWinProcs->getFileAttributesExProc)(nativePath,
+ GetFileExInfoStandard, &data) != TRUE) {
+ /* File doesn't exist */
+ Tcl_DStringFree(&ds);
+ break;
+ }
+
+ /*
+ * File 'nativePath' does exist if we get here. We
+ * now want to check if it is a symlink and otherwise
+ * continue with the rest of the path.
+ */
+
+ /*
+ * Check for symlinks, except at last component
+ * of path (we don't follow final symlinks). Also
+ * a drive (C:/) for example, may sometimes have
+ * the reparse flag set for some reason I don't
+ * understand. We therefore don't perform this
+ * check for drives.
+ */
+ if (cur != 0 && !isDrive && (data.dwFileAttributes
+ & FILE_ATTRIBUTE_REPARSE_POINT)) {
+ Tcl_Obj *to = WinReadLinkDirectory(nativePath);
+ if (to != NULL) {
+ /* Read the reparse point ok */
+ /* Tcl_GetStringFromObj(to, &pathLen); */
+ nextCheckpoint = 0; /* pathLen */
+ Tcl_AppendToObj(to, currentPathEndPosition, -1);
+ /* Convert link to forward slashes */
+ for (path = Tcl_GetString(to); *path != 0; path++) {
+ if (*path == '\\') *path = '/';
+ }
+ path = Tcl_GetString(to);
+ currentPathEndPosition = path + nextCheckpoint;
+ if (temp != NULL) {
+ Tcl_DecrRefCount(temp);
+ }
+ temp = to;
+ /* Reset variables so we can restart normalization */
+ isDrive = 1;
+ Tcl_DStringFree(&dsNorm);
+ Tcl_DStringInit(&dsNorm);
+ Tcl_DStringFree(&ds);
+ continue;
+ }
+ }
+ /*
+ * Now we convert the tail of the current path to its
+ * 'long form', and append it to 'dsNorm' which holds
+ * the current normalized path
+ */
+ if (isDrive) {
+ WCHAR drive = ((WCHAR*)nativePath)[0];
+ if (drive >= L'a') {
+ drive -= (L'a' - L'A');
+ ((WCHAR*)nativePath)[0] = drive;
+ }
+ Tcl_DStringAppend(&dsNorm,nativePath,Tcl_DStringLength(&ds));
+ } else {
+ WIN32_FIND_DATAW fData;
+ HANDLE handle;
+
+ handle = FindFirstFileW((WCHAR*)nativePath, &fData);
+ if (handle == INVALID_HANDLE_VALUE) {
+ /* This is usually the '/' in 'c:/' at end of string */
+ Tcl_DStringAppend(&dsNorm,(CONST char*)L"/",
+ sizeof(WCHAR));
+ } else {
+ WCHAR *nativeName;
+ if (fData.cFileName[0] != '\0') {
+ nativeName = fData.cFileName;
+ } else {
+ nativeName = fData.cAlternateFileName;
+ }
+ FindClose(handle);
+ Tcl_DStringAppend(&dsNorm,(CONST char*)L"/",
+ sizeof(WCHAR));
+ Tcl_DStringAppend(&dsNorm,(TCHAR*)nativeName,
+ wcslen(nativeName)*sizeof(WCHAR));
+ }
+ }
+ Tcl_DStringFree(&ds);
+ lastValidPathEnd = currentPathEndPosition;
+ if (cur == 0) {
+ break;
+ }
+ /*
+ * If we get here, we've got past one directory
+ * delimiter, so we know it is no longer a drive
+ */
+ isDrive = 0;
+ }
+ currentPathEndPosition++;
+ }
+ }
+ /* Common code path for all Windows platforms */
+ nextCheckpoint = currentPathEndPosition - path;
+ if (lastValidPathEnd != NULL) {
+ /*
+ * Concatenate the normalized string in dsNorm with the
+ * tail of the path which we didn't recognise. The
+ * string in dsNorm is in the native encoding, so we
+ * have to convert it to Utf.
+ */
+ Tcl_DString dsTemp;
+ Tcl_WinTCharToUtf(Tcl_DStringValue(&dsNorm),
+ Tcl_DStringLength(&dsNorm), &dsTemp);
+ nextCheckpoint = Tcl_DStringLength(&dsTemp);
+ if (*lastValidPathEnd != 0) {
+ /* Not the end of the string */
+ int len;
+ char *path;
+ Tcl_Obj *tmpPathPtr;
+ tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp),
+ nextCheckpoint);
+ Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, -1);
+ path = Tcl_GetStringFromObj(tmpPathPtr, &len);
+ Tcl_SetStringObj(pathPtr, path, len);
+ Tcl_DecrRefCount(tmpPathPtr);
+ } else {
+ /* End of string was reached above */
+ Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&dsTemp),
+ nextCheckpoint);
+ }
+ Tcl_DStringFree(&dsTemp);
+ }
+ Tcl_DStringFree(&dsNorm);
+ return nextCheckpoint;
+}
diff --git a/tcl/win/tclWinInit.c b/tcl/win/tclWinInit.c
index b96154aa7fb..de0b59dff2e 100644
--- a/tcl/win/tclWinInit.c
+++ b/tcl/win/tclWinInit.c
@@ -11,20 +11,10 @@
*/
#include "tclWinInt.h"
-#include <winreg.h>
#include <winnt.h>
#include <winbase.h>
/*
- * The following macro can be defined at compile time to specify
- * the root of the Tcl registry keys.
- */
-
-#ifndef TCL_REGISTRY_KEY
-#define TCL_REGISTRY_KEY "Software\\Scriptics\\Tcl\\" TCL_VERSION
-#endif
-
-/*
* The following declaration is a workaround for some Microsoft brain damage.
* The SYSTEM_INFO structure is different in various releases, even though the
* layout is the same. So we overlay our own structure on top of it so we
@@ -52,6 +42,21 @@ typedef struct {
#ifndef PROCESSOR_ARCHITECTURE_PPC
#define PROCESSOR_ARCHITECTURE_PPC 3
#endif
+#ifndef PROCESSOR_ARCHITECTURE_SHX
+#define PROCESSOR_ARCHITECTURE_SHX 4
+#endif
+#ifndef PROCESSOR_ARCHITECTURE_ARM
+#define PROCESSOR_ARCHITECTURE_ARM 5
+#endif
+#ifndef PROCESSOR_ARCHITECTURE_IA64
+#define PROCESSOR_ARCHITECTURE_IA64 6
+#endif
+#ifndef PROCESSOR_ARCHITECTURE_ALPHA64
+#define PROCESSOR_ARCHITECTURE_ALPHA64 7
+#endif
+#ifndef PROCESSOR_ARCHITECTURE_MSIL
+#define PROCESSOR_ARCHITECTURE_MSIL 8
+#endif
#ifndef PROCESSOR_ARCHITECTURE_UNKNOWN
#define PROCESSOR_ARCHITECTURE_UNKNOWN 0xFFFF
#endif
@@ -67,16 +72,15 @@ static char* platforms[NUMPLATFORMS] = {
"Win32s", "Windows 95", "Windows NT"
};
-#define NUMPROCESSORS 4
+#define NUMPROCESSORS 9
static char* processors[NUMPROCESSORS] = {
- "intel", "mips", "alpha", "ppc"
+ "intel", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil"
};
-/*
- * Thread id used for asynchronous notification from signal handlers.
- */
-
-static DWORD mainThreadId;
+/* Used to store the encoding used for binary files */
+static Tcl_Encoding binaryEncoding = NULL;
+/* Has the basic library path encoding issue been fixed */
+static int libraryPathEncodingFixed = 0;
/*
* The Init script (common to Windows and Unix platforms) is
@@ -88,7 +92,6 @@ static DWORD mainThreadId;
static void AppendEnvironment(Tcl_Obj *listPtr, CONST char *lib);
static void AppendDllPath(Tcl_Obj *listPtr, HMODULE hModule,
CONST char *lib);
-static void AppendRegistry(Tcl_Obj *listPtr, CONST char *lib);
static int ToUtf(CONST WCHAR *wSrc, char *dst);
/*
@@ -129,16 +132,6 @@ TclpInitPlatform()
SetErrorMode(SetErrorMode(0) | SEM_FAILCRITICALERRORS);
- /*
- * Save the id of the first thread to intialize the Tcl library. This
- * thread will be used to handle notifications from async event
- * procedures. This is not strictly correct. A better solution involves
- * using a designated "main" notifier that is kept up to date as threads
- * come and go.
- */
-
- mainThreadId = GetCurrentThreadId();
-
#ifdef STATIC_BUILD
/*
* If we are in a statically linked executable, then we need to
@@ -179,10 +172,10 @@ TclpInitLibraryPath(path)
{
#define LIBRARY_SIZE 32
Tcl_Obj *pathPtr, *objPtr;
- char *str;
+ CONST char *str;
Tcl_DString ds;
int pathc;
- char **pathv;
+ CONST char **pathv;
char installLib[LIBRARY_SIZE], developLib[LIBRARY_SIZE];
Tcl_DStringInit(&ds);
@@ -195,11 +188,8 @@ TclpInitLibraryPath(path)
* executable is run from a develpment directory.
*/
- /* CYGNUS LOCAL */
- sprintf(installLib, "share/tcl%s", TCL_VERSION);
- /* END CYGNUS LOCAL */
- sprintf(developLib, "../tcl%s/library",
- ((TCL_RELEASE_LEVEL < 2) ? TCL_PATCH_LEVEL : TCL_VERSION));
+ sprintf(installLib, "lib/tcl%s", TCL_VERSION);
+ sprintf(developLib, "../tcl%s/library", TCL_PATCH_LEVEL);
/*
* Look for the library relative to default encoding dir.
@@ -235,59 +225,76 @@ TclpInitLibraryPath(path)
* This code looks in the following directories:
*
* <bindir>/../<installLib>
- * (e.g. /usr/local/bin/../lib/tcl8.2)
+ * (e.g. /usr/local/bin/../lib/tcl8.4)
* <bindir>/../../<installLib>
- * (e.g. /usr/local/TclPro/solaris-sparc/bin/../../lib/tcl8.2)
+ * (e.g. /usr/local/TclPro/solaris-sparc/bin/../../lib/tcl8.4)
* <bindir>/../library
- * (e.g. /usr/src/tcl8.2/unix/../library)
+ * (e.g. /usr/src/tcl8.4.0/unix/../library)
* <bindir>/../../library
- * (e.g. /usr/src/tcl8.2/unix/solaris-sparc/../../library)
+ * (e.g. /usr/src/tcl8.4.0/unix/solaris-sparc/../../library)
* <bindir>/../../<developLib>
- * (e.g. /usr/src/tcl8.2/unix/../../tcl8.2/library)
- * <bindir>/../../../<devlopLib>
- * (e.g. /usr/src/tcl8.2/unix/solaris-sparc/../../../tcl8.2/library)
+ * (e.g. /usr/src/tcl8.4.0/unix/../../tcl8.4.0/library)
+ * <bindir>/../../../<developLib>
+ * (e.g. /usr/src/tcl8.4.0/unix/solaris-sparc/../../../tcl8.4.0/library)
*/
+ /*
+ * The variable path holds an absolute path. Take care not to
+ * overwrite pathv[0] since that might produce a relative path.
+ */
+
if (path != NULL) {
Tcl_SplitPath(path, &pathc, &pathv);
- if (pathc > 1) {
+ if (pathc > 2) {
+ str = pathv[pathc - 2];
pathv[pathc - 2] = installLib;
path = Tcl_JoinPath(pathc - 1, pathv, &ds);
+ pathv[pathc - 2] = str;
objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
Tcl_DStringFree(&ds);
}
- if (pathc > 2) {
+ if (pathc > 3) {
+ str = pathv[pathc - 3];
pathv[pathc - 3] = installLib;
path = Tcl_JoinPath(pathc - 2, pathv, &ds);
+ pathv[pathc - 3] = str;
objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
Tcl_DStringFree(&ds);
}
- if (pathc > 1) {
+ if (pathc > 2) {
+ str = pathv[pathc - 2];
pathv[pathc - 2] = "library";
path = Tcl_JoinPath(pathc - 1, pathv, &ds);
+ pathv[pathc - 2] = str;
objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
Tcl_DStringFree(&ds);
}
- if (pathc > 2) {
+ if (pathc > 3) {
+ str = pathv[pathc - 3];
pathv[pathc - 3] = "library";
path = Tcl_JoinPath(pathc - 2, pathv, &ds);
+ pathv[pathc - 3] = str;
objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
Tcl_DStringFree(&ds);
}
- if (pathc > 1) {
+ if (pathc > 3) {
+ str = pathv[pathc - 3];
pathv[pathc - 3] = developLib;
path = Tcl_JoinPath(pathc - 2, pathv, &ds);
+ pathv[pathc - 3] = str;
objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
Tcl_DStringFree(&ds);
}
- if (pathc > 3) {
+ if (pathc > 4) {
+ str = pathv[pathc - 4];
pathv[pathc - 4] = developLib;
path = Tcl_JoinPath(pathc - 3, pathv, &ds);
+ pathv[pathc - 4] = str;
objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
Tcl_DStringFree(&ds);
@@ -326,9 +333,8 @@ AppendEnvironment(
WCHAR wBuf[MAX_PATH];
char buf[MAX_PATH * TCL_UTF_MAX];
Tcl_Obj *objPtr;
- char *str;
Tcl_DString ds;
- char **pathv;
+ CONST char **pathv;
/*
* The "L" preceeding the TCL_LIBRARY string is used to tell VC++
@@ -355,6 +361,7 @@ AppendEnvironment(
*/
if ((pathc > 0) && (lstrcmpiA(lib + 4, pathv[pathc - 1]) != 0)) {
+ CONST char *str;
/*
* TCL_LIBRARY is set but refers to a different tcl
* installation than the current version. Try fiddling with the
@@ -363,7 +370,7 @@ AppendEnvironment(
* version string.
*/
- pathv[pathc - 1] = (char *) (lib + 4);
+ pathv[pathc - 1] = (lib + 4);
Tcl_DStringInit(&ds);
str = Tcl_JoinPath(pathc, pathv, &ds);
objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds));
@@ -452,7 +459,7 @@ ToUtf(
wSrc++;
}
*dst = '\0';
- return dst - start;
+ return (int) (dst - start);
}
@@ -464,13 +471,18 @@ ToUtf(
* Based on the locale, determine the encoding of the operating
* system and the default encoding for newly opened files.
*
- * Called at process initialization time.
+ * Called at process initialization time, and part way through
+ * startup, we verify that the initial encodings were correctly
+ * setup. Depending on Tcl's environment, there may not have been
+ * enough information first time through (above).
*
* Results:
* None.
*
* Side effects:
- * The Tcl library path is converted from native encoding to UTF-8.
+ * The Tcl library path is converted from native encoding to UTF-8,
+ * on the first call, and the encodings may be changed on first or
+ * second call.
*
*---------------------------------------------------------------------------
*/
@@ -480,45 +492,52 @@ TclpSetInitialEncodings()
{
CONST char *encoding;
char buf[4 + TCL_INTEGER_SPACE];
- int platformId;
- Tcl_Obj *pathPtr;
-
- platformId = TclWinGetPlatformId();
-
- TclWinSetInterfaces(platformId == VER_PLATFORM_WIN32_NT);
- wsprintfA(buf, "cp%d", GetACP());
- Tcl_SetSystemEncoding(NULL, buf);
-
- if (platformId != VER_PLATFORM_WIN32_NT) {
- pathPtr = TclGetLibraryPath();
- if (pathPtr != NULL) {
- int i, objc;
- Tcl_Obj **objv;
-
- objc = 0;
- Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
- for (i = 0; i < objc; i++) {
- int length;
- char *string;
- Tcl_DString ds;
-
- string = Tcl_GetStringFromObj(objv[i], &length);
- Tcl_ExternalToUtfDString(NULL, string, length, &ds);
- Tcl_SetStringObj(objv[i], Tcl_DStringValue(&ds),
- Tcl_DStringLength(&ds));
- Tcl_DStringFree(&ds);
+ if (libraryPathEncodingFixed == 0) {
+ int platformId;
+ platformId = TclWinGetPlatformId();
+ TclWinSetInterfaces(platformId == VER_PLATFORM_WIN32_NT);
+
+ wsprintfA(buf, "cp%d", GetACP());
+ Tcl_SetSystemEncoding(NULL, buf);
+
+ if (platformId != VER_PLATFORM_WIN32_NT) {
+ Tcl_Obj *pathPtr = TclGetLibraryPath();
+ if (pathPtr != NULL) {
+ int i, objc;
+ Tcl_Obj **objv;
+
+ objc = 0;
+ Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
+ for (i = 0; i < objc; i++) {
+ int length;
+ char *string;
+ Tcl_DString ds;
+
+ string = Tcl_GetStringFromObj(objv[i], &length);
+ Tcl_ExternalToUtfDString(NULL, string, length, &ds);
+ Tcl_SetStringObj(objv[i], Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds));
+ Tcl_DStringFree(&ds);
+ }
}
}
+
+ libraryPathEncodingFixed = 1;
+ } else {
+ wsprintfA(buf, "cp%d", GetACP());
+ Tcl_SetSystemEncoding(NULL, buf);
}
- /*
- * Keep this encoding preloaded. The IO package uses it for gets on a
- * binary channel.
- */
-
- encoding = "iso8859-1";
- Tcl_GetEncoding(NULL, encoding);
+ /* This is only ever called from the startup thread */
+ if (binaryEncoding == NULL) {
+ /*
+ * Keep this encoding preloaded. The IO package uses it for
+ * gets on a binary channel.
+ */
+ encoding = "iso8859-1";
+ binaryEncoding = Tcl_GetEncoding(NULL, encoding);
+ }
}
/*
@@ -534,8 +553,7 @@ TclpSetInitialEncodings()
* None.
*
* Side effects:
- * Sets "tclDefaultLibrary", "tcl_platform", and "env(HOME)" Tcl
- * variables.
+ * Sets "tcl_platform", and "env(HOME)" Tcl variables.
*
*----------------------------------------------------------------------
*/
@@ -544,7 +562,7 @@ void
TclpSetVariables(interp)
Tcl_Interp *interp; /* Interp to initialize. */
{
- char *ptr;
+ CONST char *ptr;
char buffer[TCL_INTEGER_SPACE * 2];
SYSTEM_INFO sysInfo;
OemId *oemId;
@@ -558,12 +576,6 @@ TclpSetVariables(interp)
GetSystemInfo(&sysInfo);
/*
- * Initialize the tclDefaultLibrary variable from the registry.
- */
-
- Tcl_SetVar(interp, "tclDefaultLibrary", "", TCL_GLOBAL_ONLY);
-
- /*
* Define the tcl_platform array.
*/
@@ -624,7 +636,7 @@ TclpSetVariables(interp)
Tcl_DStringSetLength(&ds, 100);
if (TclGetEnv("USERNAME", &ds) == NULL) {
- if (GetUserName(Tcl_DStringValue(&ds), &Tcl_DStringLength(&ds)) == 0) {
+ if (GetUserName(Tcl_DStringValue(&ds), (LPDWORD) &Tcl_DStringLength(&ds)) == 0) {
Tcl_DStringSetLength(&ds, 0);
}
}
@@ -691,7 +703,7 @@ TclpFindVariable(name, lengthPtr)
if (p1 == NULL) {
continue;
}
- length = p1 - envUpper;
+ length = (int) (p1 - envUpper);
Tcl_DStringSetLength(&envString, length+1);
Tcl_UtfToUpper(envUpper);
@@ -779,14 +791,14 @@ Tcl_SourceRCFile(interp)
Tcl_Interp *interp; /* Interpreter to source rc file into. */
{
Tcl_DString temp;
- char *fileName;
+ CONST char *fileName;
Tcl_Channel errChannel;
fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);
if (fileName != NULL) {
Tcl_Channel c;
- char *fullName;
+ CONST char *fullName;
Tcl_DStringInit(&temp);
fullName = Tcl_TranslateFileName(interp, fileName, &temp);
@@ -817,34 +829,3 @@ Tcl_SourceRCFile(interp)
Tcl_DStringFree(&temp);
}
}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpAsyncMark --
- *
- * Wake up the main thread from a signal handler.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Sends a message to the main thread.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclpAsyncMark(async)
- Tcl_AsyncHandler async; /* Token for handler. */
-{
- /*
- * Need a way to kick the Windows event loop and tell it to go look at
- * asynchronous events.
- */
-
- PostThreadMessage(mainThreadId, WM_USER, 0, 0);
-}
-
-
-
diff --git a/tcl/win/tclWinInt.h b/tcl/win/tclWinInt.h
index e375dd87480..ef1333ee0d9 100644
--- a/tcl/win/tclWinInt.h
+++ b/tcl/win/tclWinInt.h
@@ -89,10 +89,13 @@ typedef struct TclWinProcs {
CONST TCHAR *, DWORD, WCHAR *, TCHAR **);
BOOL (WINAPI *setCurrentDirectoryProc)(CONST TCHAR *);
BOOL (WINAPI *setFileAttributesProc)(CONST TCHAR *, DWORD);
+ BOOL (WINAPI *getFileAttributesExProc)(CONST TCHAR *,
+ GET_FILEEX_INFO_LEVELS, LPVOID);
+ BOOL (WINAPI *createHardLinkProc)(CONST TCHAR*, CONST TCHAR*,
+ LPSECURITY_ATTRIBUTES);
} TclWinProcs;
EXTERN TclWinProcs *tclWinProcs;
-EXTERN Tcl_Encoding tclWinTCharEncoding;
/*
* Declarations of functions that are not accessible by way of the
@@ -100,12 +103,26 @@ EXTERN Tcl_Encoding tclWinTCharEncoding;
*/
EXTERN void TclWinInit(HINSTANCE hInst);
+EXTERN int TclWinSymLinkCopyDirectory(CONST TCHAR* LinkOriginal,
+ CONST TCHAR* LinkCopy);
+EXTERN int TclWinSymLinkDelete(CONST TCHAR* LinkOriginal,
+ int linkOnly);
+#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
+EXTERN void TclWinFreeAllocCache(void);
+EXTERN void TclFreeAllocCache(void *);
+EXTERN Tcl_Mutex *TclpNewAllocMutex(void);
+EXTERN void *TclpGetAllocCache(void);
+EXTERN void TclpSetAllocCache(void *);
+#endif /* TCL_THREADS */
+
+/* Needed by tclWinFile.c and tclWinFCmd.c */
+#ifndef FILE_ATTRIBUTE_REPARSE_POINT
+#define FILE_ATTRIBUTE_REPARSE_POINT 0x00000400
+#endif
+
+#include "tclIntPlatDecls.h"
# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLIMPORT
-#include "tclIntPlatDecls.h"
-
#endif /* _TCLWININT */
-
-
diff --git a/tcl/win/tclWinLoad.c b/tcl/win/tclWinLoad.c
index c27cfd3f3c2..1d2b5d6a36e 100644
--- a/tcl/win/tclWinLoad.c
+++ b/tcl/win/tclWinLoad.c
@@ -19,11 +19,10 @@
/*
*----------------------------------------------------------------------
*
- * TclpLoadFile --
+ * TclpDlopen --
*
* Dynamically loads a binary code file into memory and returns
- * the addresses of two procedures within that file, if they
- * are defined.
+ * a handle to the new code.
*
* Results:
* A standard Tcl completion code. If an error occurs, an error
@@ -36,28 +35,28 @@
*/
int
-TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
+TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr)
Tcl_Interp *interp; /* Used for error reporting. */
- char *fileName; /* Name of the file containing the desired
- * code. */
- 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
+ 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
- * TclpUnloadFile() to unload the file. */
+ * (*unloadProcPtr)() to unload the file. */
+ Tcl_FSUnloadFileProc **unloadProcPtr;
+ /* Filled with address of Tcl_FSUnloadFileProc
+ * function which should be used for
+ * this file. */
{
HINSTANCE handle;
- TCHAR *nativeName;
+ CONST TCHAR *nativeName;
Tcl_DString ds;
+ char *fileName = Tcl_GetString(pathPtr);
nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds);
handle = (*tclWinProcs->loadLibraryProc)(nativeName);
Tcl_DStringFree(&ds);
- *clientDataPtr = (ClientData) handle;
+ *loadHandle = (Tcl_LoadHandle) handle;
if (handle == NULL) {
DWORD lastError = GetLastError();
@@ -87,8 +86,12 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
case ERROR_MOD_NOT_FOUND:
case ERROR_DLL_NOT_FOUND:
Tcl_AppendResult(interp, "this library or a dependent library",
- " could not be found in library path", (char *)
- NULL);
+ " could not be found in library path",
+ (char *) NULL);
+ break;
+ case ERROR_PROC_NOT_FOUND:
+ Tcl_AppendResult(interp, "could not find specified procedure",
+ (char *) NULL);
break;
case ERROR_INVALID_DLL:
Tcl_AppendResult(interp, "this library or a dependent library",
@@ -104,29 +107,51 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
(char *) NULL);
}
return TCL_ERROR;
+ } else {
+ *unloadProcPtr = &TclpUnloadFile;
}
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+{
+ Tcl_PackageInitProc *proc = NULL;
+ HINSTANCE handle = (HINSTANCE)loadHandle;
/*
* For each symbol, check for both Symbol and _Symbol, since Borland
* generates C symbols with a leading '_' by default.
*/
- *proc1Ptr = (Tcl_PackageInitProc *) GetProcAddress(handle, sym1);
- if (*proc1Ptr == NULL) {
+ proc = (Tcl_PackageInitProc *) GetProcAddress(handle, symbol);
+ if (proc == NULL) {
+ Tcl_DString ds;
+ Tcl_DStringInit(&ds);
Tcl_DStringAppend(&ds, "_", 1);
- sym1 = Tcl_DStringAppend(&ds, sym1, -1);
- *proc1Ptr = (Tcl_PackageInitProc *) GetProcAddress(handle, sym1);
+ symbol = Tcl_DStringAppend(&ds, symbol, -1);
+ proc = (Tcl_PackageInitProc *) GetProcAddress(handle, symbol);
Tcl_DStringFree(&ds);
}
-
- *proc2Ptr = (Tcl_PackageInitProc *) GetProcAddress(handle, sym2);
- if (*proc2Ptr == NULL) {
- Tcl_DStringAppend(&ds, "_", 1);
- sym2 = Tcl_DStringAppend(&ds, sym2, -1);
- *proc2Ptr = (Tcl_PackageInitProc *) GetProcAddress(handle, sym2);
- Tcl_DStringFree(&ds);
- }
- return TCL_OK;
+ return proc;
}
/*
@@ -148,15 +173,15 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr)
*/
void
-TclpUnloadFile(clientData)
- ClientData clientData; /* ClientData returned by a previous call
- * to TclpLoadFile(). The clientData is
+TclpUnloadFile(loadHandle)
+ Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call
+ * to TclpDlopen(). The loadHandle is
* a token that represents the loaded
* file. */
{
HINSTANCE handle;
- handle = (HINSTANCE) clientData;
+ handle = (HINSTANCE) loadHandle;
FreeLibrary(handle);
}
@@ -182,12 +207,10 @@ TclpUnloadFile(clientData)
int
TclGuessPackageName(fileName, bufPtr)
- char *fileName; /* Name of file containing package (already
+ 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. */
{
return 0;
}
-
-
diff --git a/tcl/win/tclWinMtherr.c b/tcl/win/tclWinMtherr.c
index f307a8c2b03..a6299dff860 100644
--- a/tcl/win/tclWinMtherr.c
+++ b/tcl/win/tclWinMtherr.c
@@ -40,15 +40,14 @@ int
_matherr(xPtr)
struct exception *xPtr; /* Describes error that occurred. */
{
- if (!TclMathInProgress()) {
- return 0;
- }
- if ((xPtr->type == DOMAIN) || (xPtr->type == SING)) {
+ if ((xPtr->type == DOMAIN)
+#ifdef __BORLANDC__
+ || (xPtr->type == TLOSS)
+#endif
+ || (xPtr->type == SING)) {
errno = EDOM;
} else {
errno = ERANGE;
}
return 1;
}
-
-
diff --git a/tcl/win/tclWinNotify.c b/tcl/win/tclWinNotify.c
index 46915158b34..4701e16e9f9 100644
--- a/tcl/win/tclWinNotify.c
+++ b/tcl/win/tclWinNotify.c
@@ -14,14 +14,11 @@
*/
#include "tclWinInt.h"
-#include <winsock.h>
/*
* The follwing static indicates whether this module has been initialized.
*/
-static int initialized = 0;
-
#define INTERVAL_TIMER 1 /* Handle of interval timer. */
#define WM_WAKEUP WM_USER /* Message that is send by
@@ -150,6 +147,20 @@ Tcl_FinalizeNotifier(clientData)
{
ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;
+ /*
+ * Only finalize the notifier if a notifier was installed in the
+ * current thread; there is a route in which this is not
+ * guaranteed to be true (when tclWin32Dll.c:DllMain() is called
+ * with the flag DLL_PROCESS_DETACH by the OS, which could be
+ * doing so from a thread that's never previously been involved
+ * with Tcl, e.g. the task manager) so this check is important.
+ *
+ * Fixes Bug #217982 reported by Hugh Vu and Gene Leache.
+ */
+ if (tsdPtr == NULL) {
+ return;
+ }
+
DeleteCriticalSection(&tsdPtr->crit);
CloseHandle(tsdPtr->event);
@@ -468,7 +479,7 @@ Tcl_WaitForEvent(
* propagate the quit message and start unwinding.
*/
- PostQuitMessage(msg.wParam);
+ PostQuitMessage((int) msg.wParam);
status = -1;
} else if (result == -1) {
/*
@@ -510,7 +521,39 @@ void
Tcl_Sleep(ms)
int ms; /* Number of milliseconds to sleep. */
{
- Sleep(ms);
-}
+ /*
+ * Simply calling 'Sleep' for the requisite number of milliseconds
+ * can make the process appear to wake up early because it isn't
+ * synchronized with the CPU performance counter that is used in
+ * tclWinTime.c. This behavior is probably benign, but messes
+ * up some of the corner cases in the test suite. We get around
+ * this problem by repeating the 'Sleep' call as many times
+ * as necessary to make the clock advance by the requisite amount.
+ */
+ Tcl_Time now; /* Current wall clock time */
+ Tcl_Time desired; /* Desired wakeup time */
+ int sleepTime = ms; /* Time to sleep */
+ Tcl_GetTime( &now );
+ desired.sec = now.sec + ( ms / 1000 );
+ desired.usec = now.usec + 1000 * ( ms % 1000 );
+ if ( desired.usec > 1000000 ) {
+ ++desired.sec;
+ desired.usec -= 1000000;
+ }
+
+ for ( ; ; ) {
+ Sleep( sleepTime );
+ Tcl_GetTime( &now );
+ if ( now.sec > desired.sec ) {
+ break;
+ } else if ( ( now.sec == desired.sec )
+ && ( now.usec >= desired.usec ) ) {
+ break;
+ }
+ sleepTime = ( ( 1000 * ( desired.sec - now.sec ) )
+ + ( ( desired.usec - now.usec ) / 1000 ) );
+ }
+
+}
diff --git a/tcl/win/tclWinPipe.c b/tcl/win/tclWinPipe.c
index 3f4d6a64ef6..bad7c6ffa53 100644
--- a/tcl/win/tclWinPipe.c
+++ b/tcl/win/tclWinPipe.c
@@ -123,6 +123,8 @@ typedef struct PipeInfo {
HANDLE startReader; /* Auto-reset event used by the main thread to
* signal when the reader thread should attempt
* to read from the pipe. */
+ HANDLE stopReader; /* Manual-reset event used to alert the reader
+ * thread to fall-out and exit */
DWORD writeError; /* An error caused by the last background
* write. Set to 0 if no error has been
* detected. This word is shared with the
@@ -178,7 +180,7 @@ typedef struct PipeEvent {
static int ApplicationType(Tcl_Interp *interp,
const char *fileName, char *fullName);
static void BuildCommandLine(const char *executable, int argc,
- char **argv, Tcl_DString *linePtr);
+ CONST char **argv, Tcl_DString *linePtr);
static BOOL HasConsole(void);
static int PipeBlockModeProc(ClientData instanceData, int mode);
static void PipeCheckProc(ClientData clientData, int flags);
@@ -191,8 +193,8 @@ static int PipeGetHandleProc(ClientData instanceData,
static void PipeInit(void);
static int PipeInputProc(ClientData instanceData, char *buf,
int toRead, int *errorCode);
-static int PipeOutputProc(ClientData instanceData, char *buf,
- int toWrite, int *errorCode);
+static int PipeOutputProc(ClientData instanceData,
+ CONST char *buf, int toWrite, int *errorCode);
static DWORD WINAPI PipeReaderThread(LPVOID arg);
static void PipeSetupProc(ClientData clientData, int flags);
static void PipeWatchProc(ClientData instanceData, int mask);
@@ -576,7 +578,7 @@ TclpOpenFile(path, mode)
HANDLE handle;
DWORD accessMode, createMode, shareMode, flags;
Tcl_DString ds;
- TCHAR *nativePath;
+ CONST TCHAR *nativePath;
/*
* Map the access bits to the NT access mode.
@@ -765,6 +767,34 @@ TclpCreateTempFile(contents)
/*
*----------------------------------------------------------------------
*
+ * TclpTempFileName --
+ *
+ * This function returns a unique filename.
+ *
+ * Results:
+ * Returns a valid Tcl_Obj* with refCount 0, or NULL on failure.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj*
+TclpTempFileName()
+{
+ WCHAR fileName[MAX_PATH];
+
+ if (TempFileName(fileName) == 0) {
+ return NULL;
+ }
+
+ return TclpNativeToNormalized((ClientData) fileName);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclpCreatePipe --
*
* Creates an anonymous pipe.
@@ -832,7 +862,8 @@ TclpCloseFile(
|| ((GetStdHandle(STD_INPUT_HANDLE) != filePtr->handle)
&& (GetStdHandle(STD_OUTPUT_HANDLE) != filePtr->handle)
&& (GetStdHandle(STD_ERROR_HANDLE) != filePtr->handle))) {
- if (CloseHandle(filePtr->handle) == FALSE) {
+ if (filePtr->handle != NULL &&
+ CloseHandle(filePtr->handle) == FALSE) {
TclWinConvertError(GetLastError());
ckfree((char *) filePtr);
return -1;
@@ -918,7 +949,7 @@ TclpCreateProcess(
* Error messages from the child process
* itself are sent to errorFile. */
int argc, /* Number of arguments in following array. */
- char **argv, /* Array of argument strings. argv[0]
+ CONST char **argv, /* Array of argument strings. argv[0]
* contains the name of the executable
* converted to native format (using the
* Tcl_TranslateFileName call). Additional
@@ -1196,7 +1227,7 @@ TclpCreateProcess(
if ((*tclWinProcs->createProcessProc)(NULL,
(TCHAR *) Tcl_DStringValue(&cmdLine), NULL, NULL, TRUE,
- createFlags, NULL, NULL, &startInfo, &procInfo) == 0) {
+ (DWORD) createFlags, NULL, NULL, &startInfo, &procInfo) == 0) {
TclWinConvertError(GetLastError());
Tcl_AppendResult(interp, "couldn't execute \"", argv[0],
"\": ", Tcl_PosixError(interp), (char *) NULL);
@@ -1329,7 +1360,7 @@ ApplicationType(interp, originalName, fullName)
DWORD attr, read;
IMAGE_DOS_HEADER header;
Tcl_DString nameBuf, ds;
- TCHAR *nativeName;
+ CONST TCHAR *nativeName;
WCHAR nativeFullPath[MAX_PATH];
static char extensions[][5] = {"", ".com", ".exe", ".bat"};
@@ -1400,7 +1431,7 @@ ApplicationType(interp, originalName, fullName)
*/
CloseHandle(hFile);
- if ((ext != NULL) && (strcmp(ext, ".com") == 0)) {
+ if ((ext != NULL) && (stricmp(ext, ".com") == 0)) {
applType = APPL_DOS;
break;
}
@@ -1493,7 +1524,7 @@ BuildCommandLine(
CONST char *executable, /* Full path of executable (including
* extension). Replacement for argv[0]. */
int argc, /* Number of arguments. */
- char **argv, /* Argument strings in UTF. */
+ CONST char **argv, /* Argument strings in UTF. */
Tcl_DString *linePtr) /* Initialized Tcl_DString that receives the
* command line (TCHAR). */
{
@@ -1518,10 +1549,10 @@ BuildCommandLine(
}
quote = 0;
- if (argv[i][0] == '\0') {
+ if (arg[0] == '\0') {
quote = 1;
} else {
- for (start = argv[i]; *start != '\0'; start++) {
+ for (start = arg; *start != '\0'; start++) {
if (isspace(*start)) { /* INTL: ISO space. */
quote = 1;
break;
@@ -1561,6 +1592,11 @@ BuildCommandLine(
Tcl_DStringAppend(&ds, "\\\"", 2);
start = special + 1;
}
+ if (*special == '{') {
+ Tcl_DStringAppend(&ds, start, special - start);
+ Tcl_DStringAppend(&ds, "\\{", 2);
+ start = special + 1;
+ }
if (*special == '\0') {
break;
}
@@ -1571,6 +1607,7 @@ BuildCommandLine(
Tcl_DStringAppend(&ds, "\"", 1);
}
}
+ Tcl_DStringFree(linePtr);
Tcl_WinUtfToTChar(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), linePtr);
Tcl_DStringFree(&ds);
}
@@ -1647,7 +1684,8 @@ TclpCreateCommandChannel(
infoPtr->readable = CreateEvent(NULL, TRUE, TRUE, NULL);
infoPtr->startReader = CreateEvent(NULL, FALSE, FALSE, NULL);
- infoPtr->readThread = CreateThread(NULL, 8000, PipeReaderThread,
+ infoPtr->stopReader = CreateEvent(NULL, TRUE, FALSE, NULL);
+ infoPtr->readThread = CreateThread(NULL, 512, PipeReaderThread,
infoPtr, 0, &id);
SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST);
infoPtr->validMask |= TCL_READABLE;
@@ -1656,12 +1694,12 @@ TclpCreateCommandChannel(
}
if (writeFile != NULL) {
/*
- * Start the background writeer thwrite.
+ * Start the background writer thread.
*/
infoPtr->writable = CreateEvent(NULL, TRUE, TRUE, NULL);
infoPtr->startWriter = CreateEvent(NULL, FALSE, FALSE, NULL);
- infoPtr->writeThread = CreateThread(NULL, 8000, PipeWriterThread,
+ infoPtr->writeThread = CreateThread(NULL, 512, PipeWriterThread,
infoPtr, 0, &id);
SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST);
infoPtr->validMask |= TCL_WRITABLE;
@@ -1806,6 +1844,7 @@ PipeClose2Proc(
int errorCode, result;
PipeInfo *infoPtr, **nextPtrPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ DWORD exitCode;
errorCode = 0;
if ((!flags || (flags == TCL_CLOSE_READ))
@@ -1818,29 +1857,59 @@ PipeClose2Proc(
if (pipePtr->readThread) {
/*
- * Forcibly terminate the background thread. We cannot rely on the
- * thread to cleanly terminate itself because we have no way of
- * closing the pipe handle without blocking in the case where the
- * thread is in the middle of an I/O operation. Note that we need
- * to guard against terminating the thread while it is in the
- * middle of Tcl_ThreadAlert because it won't be able to release
- * the notifier lock.
+ * The thread may already have closed on it's own. Check it's
+ * exit code.
*/
- Tcl_MutexLock(&pipeMutex);
- TerminateThread(pipePtr->readThread, 0);
+ GetExitCodeThread(pipePtr->readThread, &exitCode);
- /*
- * Wait for the thread to terminate. This ensures that we are
- * completely cleaned up before we leave this function.
- */
+ if (exitCode == STILL_ACTIVE) {
+ /*
+ * Set the stop event so that if the reader thread is blocked
+ * in PipeReaderThread on WaitForMultipleEvents, it will exit
+ * cleanly.
+ */
- WaitForSingleObject(pipePtr->readThread, INFINITE);
- Tcl_MutexUnlock(&pipeMutex);
+ SetEvent(pipePtr->stopReader);
+
+ /*
+ * Wait at most 10 milliseconds for the reader thread to close.
+ */
+
+ WaitForSingleObject(pipePtr->readThread, 10);
+ GetExitCodeThread(pipePtr->readThread, &exitCode);
+
+ if (exitCode == STILL_ACTIVE) {
+ /*
+ * The thread must be blocked waiting for the pipe to
+ * become readable in ReadFile(). There isn't a clean way
+ * to exit the thread from this condition. We should
+ * terminate the child process instead to get the reader
+ * thread to fall out of ReadFile with a FALSE. (below) is
+ * not the correct way to do this, but will stay here until
+ * a better solution is found.
+ *
+ * Note that we need to guard against terminating the
+ * thread while it is in the middle of Tcl_ThreadAlert
+ * because it won't be able to release the notifier lock.
+ */
+
+ Tcl_MutexLock(&pipeMutex);
+
+ /* BUG: this leaks memory */
+ TerminateThread(pipePtr->readThread, 0);
+
+ /* Wait for the thread to terminate. */
+ WaitForSingleObject(pipePtr->readThread, INFINITE);
+
+ Tcl_MutexUnlock(&pipeMutex);
+ }
+ }
CloseHandle(pipePtr->readThread);
CloseHandle(pipePtr->readable);
CloseHandle(pipePtr->startReader);
+ CloseHandle(pipePtr->stopReader);
pipePtr->readThread = NULL;
}
if (TclpCloseFile(pipePtr->readFile) != 0) {
@@ -2069,7 +2138,7 @@ PipeInputProc(
static int
PipeOutputProc(
ClientData instanceData, /* Pipe state. */
- char *buf, /* The data buffer. */
+ CONST char *buf, /* The data buffer. */
int toWrite, /* How many bytes to write? */
int *errorCode) /* Where to store error code. */
{
@@ -2114,9 +2183,9 @@ PipeOutputProc(
ckfree(infoPtr->writeBuf);
}
infoPtr->writeBufLen = toWrite;
- infoPtr->writeBuf = ckalloc(toWrite);
+ infoPtr->writeBuf = ckalloc((unsigned int) toWrite);
}
- memcpy(infoPtr->writeBuf, buf, toWrite);
+ memcpy(infoPtr->writeBuf, buf, (size_t) toWrite);
infoPtr->toWrite = toWrite;
ResetEvent(infoPtr->writable);
SetEvent(infoPtr->startWriter);
@@ -2359,7 +2428,7 @@ Tcl_WaitPid(
int options)
{
ProcInfo *infoPtr, **prevPtrPtr;
- int flags;
+ DWORD flags;
Tcl_Pid result;
DWORD ret;
@@ -2418,16 +2487,6 @@ Tcl_WaitPid(
}
} else if (ret != WAIT_FAILED) {
GetExitCodeProcess(infoPtr->hProcess, (DWORD*)statPtr);
-#ifdef __CYGWIN__
- /* A Cygwin program that exits because of a signal will set
- the exit status to 0x10000 | (sig << 8). Fix that back
- into a standard Unix wait status. */
- if ((*statPtr & 0x10000) != 0
- && (*statPtr & 0xff00) != 0
- && (*statPtr & ~ 0x1ff00) == 0) {
- *statPtr = (*statPtr >> 8) & 0xff;
- } else
-#endif
*statPtr = ((*statPtr << 8) & 0xff00);
result = pid;
} else {
@@ -2671,7 +2730,9 @@ WaitForRead(
* Side effects:
* Signals the main thread when input become available. May
* cause the main thread to wake up by posting a message. May
- * consume one byte from the pipe for each wait operation.
+ * consume one byte from the pipe for each wait operation. Will
+ * cause a memory leak of ~4k, if forcefully terminated with
+ * TerminateThread().
*
*----------------------------------------------------------------------
*/
@@ -2683,13 +2744,28 @@ PipeReaderThread(LPVOID arg)
HANDLE *handle = ((WinFile *) infoPtr->readFile)->handle;
DWORD count, err;
int done = 0;
+ HANDLE wEvents[2];
+ DWORD dwWait;
+
+ wEvents[0] = infoPtr->stopReader;
+ wEvents[1] = infoPtr->startReader;
while (!done) {
/*
- * Wait for the main thread to signal before attempting to wait.
+ * Wait for the main thread to signal before attempting to wait
+ * on the pipe becoming readable.
*/
- WaitForSingleObject(infoPtr->startReader, INFINITE);
+ dwWait = WaitForMultipleObjects(2, wEvents, FALSE, INFINITE);
+
+ if (dwWait != (WAIT_OBJECT_0 + 1)) {
+ /*
+ * The start event was not signaled. It might be the stop event
+ * or an error, so exit.
+ */
+
+ return 0;
+ }
/*
* Try waiting for 0 bytes. This will block until some data is
@@ -2832,6 +2908,3 @@ PipeWriterThread(LPVOID arg)
return 0;
}
-
-
-
diff --git a/tcl/win/tclWinPort.h b/tcl/win/tclWinPort.h
index 1ea45fe6b9a..227672679f3 100644
--- a/tcl/win/tclWinPort.h
+++ b/tcl/win/tclWinPort.h
@@ -21,17 +21,13 @@
#endif
#ifdef CHECK_UNICODE_CALLS
-
-#define _UNICODE
-#define UNICODE
-
-#define __TCHAR_DEFINED
-typedef float *_TCHAR;
-
-#define _TCHAR_DEFINED
-typedef float *TCHAR;
-
-#endif
+# define _UNICODE
+# define UNICODE
+# define __TCHAR_DEFINED
+ typedef float *_TCHAR;
+# define _TCHAR_DEFINED
+ typedef float *TCHAR;
+#endif /* CHECK_UNICODE_CALLS */
/*
*---------------------------------------------------------------------------
@@ -60,28 +56,32 @@ typedef float *TCHAR;
#ifndef __MWERKS__
#include <sys/stat.h>
#include <sys/timeb.h>
-#include <sys/utime.h>
-#endif
+# ifdef __BORLANDC__
+# include <utime.h>
+# else
+# include <sys/utime.h>
+# endif /* __BORLANDC__ */
+#endif /* __MWERKS__ */
#include <time.h>
-#include <winsock2.h>
-
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN
+#include <winsock2.h>
+
#ifdef BUILD_tcl
-# undef TCL_STORAGE_CLASS
-# define TCL_STORAGE_CLASS DLLEXPORT
-#endif
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
+#endif /* BUILD_tcl */
/*
* Define EINPROGRESS in terms of WSAEINPROGRESS.
*/
#ifndef EINPROGRESS
-#define EINPROGRESS WSAEINPROGRESS
+# define EINPROGRESS WSAEINPROGRESS
#endif
/*
@@ -89,7 +89,7 @@ typedef float *TCHAR;
*/
#ifndef ENOTSUP
-#define ENOTSUP -1030507
+# define ENOTSUP -1030507
#endif
/*
@@ -98,109 +98,123 @@ typedef float *TCHAR;
*/
#ifndef EWOULDBLOCK
-#define EWOULDBLOCK EAGAIN
+# define EWOULDBLOCK EAGAIN
#endif
#ifndef EALREADY
-#define EALREADY 149 /* operation already in progress */
+# define EALREADY 149 /* operation already in progress */
#endif
#ifndef ENOTSOCK
-#define ENOTSOCK 95 /* Socket operation on non-socket */
+# define ENOTSOCK 95 /* Socket operation on non-socket */
#endif
#ifndef EDESTADDRREQ
-#define EDESTADDRREQ 96 /* Destination address required */
+# define EDESTADDRREQ 96 /* Destination address required */
#endif
#ifndef EMSGSIZE
-#define EMSGSIZE 97 /* Message too long */
+# define EMSGSIZE 97 /* Message too long */
#endif
#ifndef EPROTOTYPE
-#define EPROTOTYPE 98 /* Protocol wrong type for socket */
+# define EPROTOTYPE 98 /* Protocol wrong type for socket */
#endif
#ifndef ENOPROTOOPT
-#define ENOPROTOOPT 99 /* Protocol not available */
+# define ENOPROTOOPT 99 /* Protocol not available */
#endif
#ifndef EPROTONOSUPPORT
-#define EPROTONOSUPPORT 120 /* Protocol not supported */
+# define EPROTONOSUPPORT 120 /* Protocol not supported */
#endif
#ifndef ESOCKTNOSUPPORT
-#define ESOCKTNOSUPPORT 121 /* Socket type not supported */
+# define ESOCKTNOSUPPORT 121 /* Socket type not supported */
#endif
#ifndef EOPNOTSUPP
-#define EOPNOTSUPP 122 /* Operation not supported on socket */
+# define EOPNOTSUPP 122 /* Operation not supported on socket */
#endif
#ifndef EPFNOSUPPORT
-#define EPFNOSUPPORT 123 /* Protocol family not supported */
+# define EPFNOSUPPORT 123 /* Protocol family not supported */
#endif
#ifndef EAFNOSUPPORT
-#define EAFNOSUPPORT 124 /* Address family not supported */
+# define EAFNOSUPPORT 124 /* Address family not supported */
#endif
#ifndef EADDRINUSE
-#define EADDRINUSE 125 /* Address already in use */
+# define EADDRINUSE 125 /* Address already in use */
#endif
#ifndef EADDRNOTAVAIL
-#define EADDRNOTAVAIL 126 /* Can't assign requested address */
+# define EADDRNOTAVAIL 126 /* Can't assign requested address */
#endif
#ifndef ENETDOWN
-#define ENETDOWN 127 /* Network is down */
+# define ENETDOWN 127 /* Network is down */
#endif
#ifndef ENETUNREACH
-#define ENETUNREACH 128 /* Network is unreachable */
+# define ENETUNREACH 128 /* Network is unreachable */
#endif
#ifndef ENETRESET
-#define ENETRESET 129 /* Network dropped connection on reset */
+# define ENETRESET 129 /* Network dropped connection on reset */
#endif
#ifndef ECONNABORTED
-#define ECONNABORTED 130 /* Software caused connection abort */
+# define ECONNABORTED 130 /* Software caused connection abort */
#endif
#ifndef ECONNRESET
-#define ECONNRESET 131 /* Connection reset by peer */
+# define ECONNRESET 131 /* Connection reset by peer */
#endif
#ifndef ENOBUFS
-#define ENOBUFS 132 /* No buffer space available */
+# define ENOBUFS 132 /* No buffer space available */
#endif
#ifndef EISCONN
-#define EISCONN 133 /* Socket is already connected */
+# define EISCONN 133 /* Socket is already connected */
#endif
#ifndef ENOTCONN
-#define ENOTCONN 134 /* Socket is not connected */
+# define ENOTCONN 134 /* Socket is not connected */
#endif
#ifndef ESHUTDOWN
-#define ESHUTDOWN 143 /* Can't send after socket shutdown */
+# define ESHUTDOWN 143 /* Can't send after socket shutdown */
#endif
#ifndef ETOOMANYREFS
-#define ETOOMANYREFS 144 /* Too many references: can't splice */
+# define ETOOMANYREFS 144 /* Too many references: can't splice */
#endif
#ifndef ETIMEDOUT
-#define ETIMEDOUT 145 /* Connection timed out */
+# define ETIMEDOUT 145 /* Connection timed out */
#endif
#ifndef ECONNREFUSED
-#define ECONNREFUSED 146 /* Connection refused */
+# define ECONNREFUSED 146 /* Connection refused */
#endif
#ifndef ELOOP
-#define ELOOP 90 /* Symbolic link loop */
+# define ELOOP 90 /* Symbolic link loop */
#endif
#ifndef EHOSTDOWN
-#define EHOSTDOWN 147 /* Host is down */
+# define EHOSTDOWN 147 /* Host is down */
#endif
#ifndef EHOSTUNREACH
-#define EHOSTUNREACH 148 /* No route to host */
+# define EHOSTUNREACH 148 /* No route to host */
#endif
#ifndef ENOTEMPTY
-#define ENOTEMPTY 93 /* directory not empty */
+# define ENOTEMPTY 93 /* directory not empty */
#endif
#ifndef EUSERS
-#define EUSERS 94 /* Too many users (for UFS) */
+# define EUSERS 94 /* Too many users (for UFS) */
#endif
#ifndef EDQUOT
-#define EDQUOT 49 /* Disc quota exceeded */
+# define EDQUOT 69 /* Disc quota exceeded */
#endif
#ifndef ESTALE
-#define ESTALE 151 /* Stale NFS file handle */
+# define ESTALE 151 /* Stale NFS file handle */
#endif
#ifndef EREMOTE
-#define EREMOTE 66 /* The object is remote */
+# define EREMOTE 66 /* The object is remote */
#endif
/*
+ * It is very hard to determine how Windows reacts to attempting to
+ * set a file pointer outside the input datatype's representable
+ * region. So we fake the error code ourselves.
+ */
+
+#ifndef EOVERFLOW
+# ifdef EFBIG
+# define EOVERFLOW EFBIG /* The object couldn't fit in the datatype */
+# else /* !EFBIG */
+# define EOVERFLOW EINVAL /* Better than nothing! */
+# endif /* EFBIG */
+#endif /* !EOVERFLOW */
+
+/*
* Supply definitions for macros to query wait status, if not already
* defined in header files above.
*/
@@ -209,7 +223,7 @@ typedef float *TCHAR;
# define WAIT_STATUS_TYPE union wait
#else
# define WAIT_STATUS_TYPE int
-#endif
+#endif /* TCL_UNION_WAIT */
#ifndef WIFEXITED
# define WIFEXITED(stat) (((*((int *) &(stat))) & 0xff) == 0)
@@ -269,41 +283,53 @@ typedef float *TCHAR;
* defined.
*/
+#ifndef S_IFLNK
+#define S_IFLNK 0120000 /* Symbolic Link */
+#endif
+
#ifndef S_ISREG
# ifdef S_IFREG
# define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
# else
# define S_ISREG(m) 0
# endif
-# endif
+#endif /* !S_ISREG */
#ifndef S_ISDIR
# ifdef S_IFDIR
# define S_ISDIR(m) (((m) & S_IFMT) == S_IFDIR)
# else
# define S_ISDIR(m) 0
# endif
-# endif
+#endif /* !S_ISDIR */
#ifndef S_ISCHR
# ifdef S_IFCHR
# define S_ISCHR(m) (((m) & S_IFMT) == S_IFCHR)
# else
# define S_ISCHR(m) 0
# endif
-# endif
+#endif /* !S_ISCHR */
#ifndef S_ISBLK
# ifdef S_IFBLK
# define S_ISBLK(m) (((m) & S_IFMT) == S_IFBLK)
# else
# define S_ISBLK(m) 0
# endif
-# endif
+#endif /* !S_ISBLK */
#ifndef S_ISFIFO
# ifdef S_IFIFO
# define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
# else
# define S_ISFIFO(m) 0
# endif
-# endif
+#endif /* !S_ISFIFO */
+#ifndef S_ISLNK
+# ifdef S_IFLNK
+# define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
+# else
+# define S_ISLNK(m) 0
+# endif
+#endif /* !S_ISLNK */
+
/*
* Define MAXPATHLEN in terms of MAXPATH if available
@@ -323,10 +349,10 @@ typedef float *TCHAR;
#if ! TCL_PID_T
# define pid_t int
-#endif
+#endif /* !TCL_PID_T */
#if ! TCL_UID_T
# define uid_t int
-#endif
+#endif /* !TCL_UID_T */
/*
* Visual C++ has some odd names for common functions, so we need to
@@ -344,16 +370,29 @@ typedef float *TCHAR;
# endif
#endif /* _MSC_VER || __MINGW32__ */
+/*
+ * Borland's timezone and environ functions.
+ */
+
+#ifdef __BORLANDC__
+# define timezone _timezone
+# define environ _environ
+#endif /* __BORLANDC__ */
+
#ifdef __CYGWIN__
-/* On cygwin32, the environment is imported from the cygwin32 DLL. */
-__declspec(dllimport) extern char **__cygwin_environ;
+/* On cygwin32, the environment is imported from the cygwin32 DLL. */
+ DLLIMPORT extern char **__cygwin_environ;
# define environ __cygwin_environ
-# define putenv TclCygwinPutenv
# define timezone _timezone
-extern int chdir (const char*);
#endif /* __CYGWIN__ */
/*
+ * There is no platform-specific panic routine for Windows in the Tcl internals.
+ */
+
+#define TclpPanic ((Tcl_PanicProc *) NULL)
+
+/*
*---------------------------------------------------------------------------
* The following macros and declarations represent the interface between
* generic and windows-specific parts of Tcl. Some of the macros may
@@ -382,6 +421,14 @@ extern int chdir (const char*);
#define USE_PUTENV 1
/*
+ * Msvcrt's putenv() copies the string rather than takes ownership of it.
+ */
+
+#if defined(_MSC_VER) || defined(__MINGW32__)
+# define HAVE_PUTENV_THAT_COPIES 1
+#endif
+
+/*
* The following defines wrap the system memory allocation routines for
* use by tclAlloc.c.
*/
@@ -403,6 +450,9 @@ extern int chdir (const char*);
#define getsockopt TclWinGetSockOpt
#define ntohs TclWinNToHS
#define setsockopt TclWinSetSockOpt
+/* This type is not defined in the Windows headers */
+#define socklen_t int
+
/*
* The following macros have trivial definitions, allowing generic code to
@@ -417,12 +467,14 @@ extern int chdir (const char*);
*/
#define TclpExit exit
-#define TclpLstat TclpStat
/*
* Declarations for Windows-only functions.
*/
+EXTERN HANDLE TclWinSerialReopen _ANSI_ARGS_(( HANDLE handle,
+ CONST TCHAR *name, DWORD access));
+
EXTERN Tcl_Channel TclWinOpenSerialChannel _ANSI_ARGS_((HANDLE handle,
char *channelName, int permissions));
@@ -446,18 +498,28 @@ typedef CRITICAL_SECTION TclpMutex;
EXTERN void TclpMutexInit _ANSI_ARGS_((TclpMutex *mPtr));
EXTERN void TclpMutexLock _ANSI_ARGS_((TclpMutex *mPtr));
EXTERN void TclpMutexUnlock _ANSI_ARGS_((TclpMutex *mPtr));
-#else
+#else /* !TCL_THREADS */
typedef int TclpMutex;
#define TclpMutexInit(a)
#define TclpMutexLock(a)
#define TclpMutexUnlock(a)
#endif /* TCL_THREADS */
+#ifdef TCL_WIDE_INT_TYPE
+EXTERN Tcl_WideInt strtoll _ANSI_ARGS_((CONST char *string,
+ char **endPtr, int base));
+EXTERN Tcl_WideUInt strtoull _ANSI_ARGS_((CONST char *string,
+ char **endPtr, int base));
+#endif /* TCL_WIDE_INT_TYPE */
+
+#ifndef INVALID_SET_FILE_POINTER
+#define INVALID_SET_FILE_POINTER 0xFFFFFFFF
+#endif /* INVALID_SET_FILE_POINTER */
+
#include "tclPlatDecls.h"
#include "tclIntPlatDecls.h"
-# undef TCL_STORAGE_CLASS
-# define TCL_STORAGE_CLASS DLLIMPORT
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
#endif /* _TCLWINPORT */
-
diff --git a/tcl/win/tclWinReg.c b/tcl/win/tclWinReg.c
index 8967e03d930..9b1d85d09ed 100644
--- a/tcl/win/tclWinReg.c
+++ b/tcl/win/tclWinReg.c
@@ -17,10 +17,6 @@
#include <tclPort.h>
#include <stdlib.h>
-#define WIN32_LEAN_AND_MEAN
-#include <windows.h>
-#undef WIN32_LEAN_AND_MEAN
-
/*
* TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
* Registry_Init declaration is in the source file itself, which is only
@@ -49,7 +45,7 @@
* to the system predefined keys.
*/
-static char *rootKeyNames[] = {
+static CONST char *rootKeyNames[] = {
"HKEY_LOCAL_MACHINE", "HKEY_USERS", "HKEY_CLASSES_ROOT",
"HKEY_CURRENT_USER", "HKEY_CURRENT_CONFIG",
"HKEY_PERFORMANCE_DATA", "HKEY_DYN_DATA", NULL
@@ -67,7 +63,7 @@ static HKEY rootKeys[] = {
* mapping.
*/
-static char *typeNames[] = {
+static CONST char *typeNames[] = {
"none", "sz", "expand_sz", "binary", "dword",
"dword_big_endian", "link", "multi_sz", "resource_list", NULL
};
@@ -84,7 +80,7 @@ static DWORD lastType = REG_RESOURCE_LIST;
typedef struct RegWinProcs {
int useWide;
- LONG (WINAPI *regConnectRegistryProc)(TCHAR *, HKEY, PHKEY);
+ LONG (WINAPI *regConnectRegistryProc)(CONST TCHAR *, HKEY, PHKEY);
LONG (WINAPI *regCreateKeyExProc)(HKEY, CONST TCHAR *, DWORD, TCHAR *,
DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *, DWORD *);
LONG (WINAPI *regDeleteKeyProc)(HKEY, CONST TCHAR *);
@@ -110,7 +106,7 @@ static RegWinProcs *regWinProcs;
static RegWinProcs asciiProcs = {
0,
- (LONG (WINAPI *)(TCHAR *, HKEY, PHKEY)) RegConnectRegistryA,
+ (LONG (WINAPI *)(CONST TCHAR *, HKEY, PHKEY)) RegConnectRegistryA,
(LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, TCHAR *,
DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *,
DWORD *)) RegCreateKeyExA,
@@ -135,7 +131,7 @@ static RegWinProcs asciiProcs = {
static RegWinProcs unicodeProcs = {
1,
- (LONG (WINAPI *)(TCHAR *, HKEY, PHKEY)) RegConnectRegistryW,
+ (LONG (WINAPI *)(CONST TCHAR *, HKEY, PHKEY)) RegConnectRegistryW,
(LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, TCHAR *,
DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *,
DWORD *)) RegCreateKeyExW,
@@ -183,7 +179,8 @@ static DWORD OpenSubKey(char *hostName, HKEY rootKey,
static int ParseKeyName(Tcl_Interp *interp, char *name,
char **hostNamePtr, HKEY *rootKeyPtr,
char **keyNamePtr);
-static DWORD RecursiveDeleteKey(HKEY hStartKey, TCHAR * pKeyName);
+static DWORD RecursiveDeleteKey(HKEY hStartKey,
+ CONST TCHAR * pKeyName);
static int RegistryObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj * CONST objv[]);
@@ -258,8 +255,9 @@ RegistryObjCmd(
int index;
char *errString;
- static char *subcommands[] = { "delete", "get", "keys", "set", "type",
- "values", (char *) NULL };
+ static CONST char *subcommands[] = {
+ "delete", "get", "keys", "set", "type", "values", (char *) NULL
+ };
enum SubCmdIdx { DeleteIdx, GetIdx, KeysIdx, SetIdx, TypeIdx, ValuesIdx };
if (objc < 2) {
@@ -356,6 +354,7 @@ DeleteKey(
Tcl_Obj *keyNameObj) /* Name of key to delete. */
{
char *tail, *buffer, *hostName, *keyName;
+ CONST char *nativeTail;
HKEY rootKey, subkey;
DWORD result;
int length;
@@ -367,7 +366,7 @@ DeleteKey(
*/
keyName = Tcl_GetStringFromObj(keyNameObj, &length);
- buffer = ckalloc(length + 1);
+ buffer = ckalloc((unsigned int) length + 1);
strcpy(buffer, keyName);
if (ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName)
@@ -408,8 +407,8 @@ DeleteKey(
* Now we recursively delete the key and everything below it.
*/
- tail = Tcl_WinUtfToTChar(tail, -1, &buf);
- result = RecursiveDeleteKey(subkey, tail);
+ nativeTail = Tcl_WinUtfToTChar(tail, -1, &buf);
+ result = RecursiveDeleteKey(subkey, nativeTail);
Tcl_DStringFree(&buf);
if (result != ERROR_SUCCESS && result != ERROR_FILE_NOT_FOUND) {
@@ -583,6 +582,7 @@ GetType(
DWORD type;
Tcl_DString ds;
char *valueName;
+ CONST char *nativeValue;
int length;
/*
@@ -601,8 +601,8 @@ GetType(
resultPtr = Tcl_GetObjResult(interp);
valueName = Tcl_GetStringFromObj(valueNameObj, &length);
- valueName = Tcl_WinUtfToTChar(valueName, length, &ds);
- result = (*regWinProcs->regQueryValueExProc)(key, valueName, NULL, &type,
+ nativeValue = Tcl_WinUtfToTChar(valueName, length, &ds);
+ result = (*regWinProcs->regQueryValueExProc)(key, nativeValue, NULL, &type,
NULL, NULL);
Tcl_DStringFree(&ds);
RegCloseKey(key);
@@ -621,7 +621,7 @@ GetType(
*/
if (type > lastType || type < 0) {
- Tcl_SetIntObj(resultPtr, type);
+ Tcl_SetIntObj(resultPtr, (int) type);
} else {
Tcl_SetStringObj(resultPtr, typeNames[type], -1);
}
@@ -654,6 +654,7 @@ GetValue(
{
HKEY key;
char *valueName;
+ CONST char *nativeValue;
DWORD result, length, type;
Tcl_Obj *resultPtr;
Tcl_DString data, buf;
@@ -680,14 +681,14 @@ GetValue(
Tcl_DStringInit(&data);
length = TCL_DSTRING_STATIC_SIZE - 1;
- Tcl_DStringSetLength(&data, length);
+ Tcl_DStringSetLength(&data, (int) length);
resultPtr = Tcl_GetObjResult(interp);
valueName = Tcl_GetStringFromObj(valueNameObj, &nameLen);
- valueName = Tcl_WinUtfToTChar(valueName, nameLen, &buf);
+ nativeValue = Tcl_WinUtfToTChar(valueName, nameLen, &buf);
- result = (*regWinProcs->regQueryValueExProc)(key, valueName, NULL, &type,
+ result = (*regWinProcs->regQueryValueExProc)(key, nativeValue, NULL, &type,
(BYTE *) Tcl_DStringValue(&data), &length);
while (result == ERROR_MORE_DATA) {
/*
@@ -696,9 +697,9 @@ GetValue(
* Required for HKEY_PERFORMANCE_DATA
*/
length *= 2;
- Tcl_DStringSetLength(&data, length);
- result = (*regWinProcs->regQueryValueExProc)(key, valueName, NULL,
- &type, (BYTE *) Tcl_DStringValue(&data), &length);
+ Tcl_DStringSetLength(&data, (int) length);
+ result = (*regWinProcs->regQueryValueExProc)(key, (char *) nativeValue,
+ NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length);
}
Tcl_DStringFree(&buf);
RegCloseKey(key);
@@ -719,7 +720,7 @@ GetValue(
*/
if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) {
- Tcl_SetIntObj(resultPtr, ConvertDWORD(type,
+ Tcl_SetIntObj(resultPtr, (int) ConvertDWORD(type,
*((DWORD*) Tcl_DStringValue(&data))));
} else if (type == REG_MULTI_SZ) {
char *p = Tcl_DStringValue(&data);
@@ -754,7 +755,7 @@ GetValue(
* Save binary data as a byte array.
*/
- Tcl_SetByteArrayObj(resultPtr, Tcl_DStringValue(&data), length);
+ Tcl_SetByteArrayObj(resultPtr, Tcl_DStringValue(&data), (int) length);
}
Tcl_DStringFree(&data);
return result;
@@ -822,7 +823,7 @@ GetValueNames(
Tcl_DStringInit(&buffer);
Tcl_DStringSetLength(&buffer,
- (regWinProcs->useWide) ? maxSize*2 : maxSize);
+ (int) ((regWinProcs->useWide) ? maxSize*2 : maxSize));
index = 0;
result = TCL_OK;
@@ -847,7 +848,7 @@ GetValueNames(
size *= 2;
}
- Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&buffer), size, &ds);
+ Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&buffer), (int) size, &ds);
name = Tcl_DStringValue(&ds);
if (!pattern || Tcl_StringMatch(name, pattern)) {
result = Tcl_ListObjAppendElement(interp, resultPtr,
@@ -901,7 +902,7 @@ OpenKey(
DWORD result;
keyName = Tcl_GetStringFromObj(keyNameObj, &length);
- buffer = ckalloc(length + 1);
+ buffer = ckalloc((unsigned int) length + 1);
strcpy(buffer, keyName);
result = ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName);
@@ -956,7 +957,7 @@ OpenSubKey(
*/
if (hostName) {
- hostName = Tcl_WinUtfToTChar(hostName, -1, &buf);
+ hostName = (char *) Tcl_WinUtfToTChar(hostName, -1, &buf);
result = (*regWinProcs->regConnectRegistryProc)(hostName, rootKey,
&rootKey);
Tcl_DStringFree(&buf);
@@ -970,7 +971,7 @@ OpenSubKey(
* that this key must be closed by the caller.
*/
- keyName = Tcl_WinUtfToTChar(keyName, -1, &buf);
+ keyName = (char *) Tcl_WinUtfToTChar(keyName, -1, &buf);
if (flags & REG_CREATE) {
DWORD create;
result = (*regWinProcs->regCreateKeyExProc)(rootKey, keyName, 0, "",
@@ -1106,7 +1107,7 @@ ParseKeyName(
static DWORD
RecursiveDeleteKey(
HKEY startKey, /* Parent of key to be deleted. */
- char *keyName) /* Name of key to be deleted in external
+ CONST char *keyName) /* Name of key to be deleted in external
* encoding, not UTF. */
{
DWORD result, size, maxSize;
@@ -1135,7 +1136,7 @@ RecursiveDeleteKey(
Tcl_DStringInit(&subkey);
Tcl_DStringSetLength(&subkey,
- (regWinProcs->useWide) ? maxSize * 2 : maxSize);
+ (int) ((regWinProcs->useWide) ? maxSize * 2 : maxSize));
while (result == ERROR_SUCCESS) {
/*
@@ -1204,7 +1205,7 @@ SetValue(
}
valueName = Tcl_GetStringFromObj(valueNameObj, &length);
- valueName = Tcl_WinUtfToTChar(valueName, length, &nameBuf);
+ valueName = (char *) Tcl_WinUtfToTChar(valueName, length, &nameBuf);
resultPtr = Tcl_GetObjResult(interp);
if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) {
@@ -1260,7 +1261,7 @@ SetValue(
Tcl_DString buf;
char *data = Tcl_GetStringFromObj(dataObj, &length);
- data = Tcl_WinUtfToTChar(data, length, &buf);
+ data = (char *) Tcl_WinUtfToTChar(data, length, &buf);
/*
* Include the null in the length, padding if needed for Unicode.
@@ -1272,7 +1273,7 @@ SetValue(
length = Tcl_DStringLength(&buf) + 1;
result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, type,
- (BYTE*)data, length);
+ (BYTE*)data, (DWORD) length);
Tcl_DStringFree(&buf);
} else {
char *data;
@@ -1283,7 +1284,7 @@ SetValue(
data = Tcl_GetByteArrayFromObj(dataObj, &length);
result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, type,
- (BYTE *)data, length);
+ (BYTE *)data, (DWORD) length);
}
Tcl_DStringFree(&nameBuf);
RegCloseKey(key);
@@ -1346,7 +1347,7 @@ AppendSystemError(
if (error == ERROR_CALL_NOT_IMPLEMENTED) {
msg = "function not supported under Win32s";
} else {
- sprintf(msgBuf, "unknown error: %d", error);
+ sprintf(msgBuf, "unknown error: %ld", error);
msg = msgBuf;
}
} else {
@@ -1371,7 +1372,7 @@ AppendSystemError(
}
}
- sprintf(id, "%d", error);
+ sprintf(id, "%ld", error);
Tcl_SetErrorCode(interp, "WINDOWS", id, msg, (char *) NULL);
Tcl_AppendToObj(resultPtr, msg, length);
@@ -1412,6 +1413,3 @@ ConvertDWORD(
localType = (*((char*)(&order)) == 1) ? REG_DWORD : REG_DWORD_BIG_ENDIAN;
return (type != localType) ? SWAPLONG(value) : value;
}
-
-
-
diff --git a/tcl/win/tclWinSerial.c b/tcl/win/tclWinSerial.c
index 43f00f6328d..4f9b84cc345 100644
--- a/tcl/win/tclWinSerial.c
+++ b/tcl/win/tclWinSerial.c
@@ -1,5 +1,5 @@
/*
- * Tclwinserial.c --
+ * tclWinSerial.c --
*
* This file implements the Windows-specific serial port functions,
* and the "serial" channel driver.
@@ -8,7 +8,8 @@
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- * Changes by Rolf.Schroedter@dlr.de June 25-27, 1999
+ *
+ * Serial functionality implemented by Rolf.Schroedter@dlr.de
*
* RCS: @(#) $Id$
*/
@@ -27,6 +28,14 @@
static int initialized = 0;
/*
+ * The serialMutex locks around access to the initialized variable, and it is
+ * used to protect background threads from being terminated while they are
+ * using APIs that hold locks.
+ */
+
+TCL_DECLARE_MUTEX(serialMutex)
+
+/*
* Bit masks used in the flags field of the SerialInfo structure below.
*/
@@ -39,8 +48,6 @@ static int initialized = 0;
#define SERIAL_EOF (1<<2) /* Serial has reached EOF. */
#define SERIAL_ERROR (1<<4)
-#define SERIAL_WRITE (1<<5) /* enables fileevent writable
- * one time after write operation */
/*
* Default time to block between checking status on the serial port.
@@ -50,9 +57,9 @@ static int initialized = 0;
/*
* Define Win32 read/write error masks returned by ClearCommError()
*/
-#define SERIAL_READ_ERRORS ( CE_RXOVER | CE_OVERRUN | CE_RXPARITY \
- | CE_FRAME | CE_BREAK )
-#define SERIAL_WRITE_ERRORS ( CE_TXFULL )
+#define SERIAL_READ_ERRORS ( CE_RXOVER | CE_OVERRUN | CE_RXPARITY \
+ | CE_FRAME | CE_BREAK )
+#define SERIAL_WRITE_ERRORS ( CE_TXFULL | CE_PTO )
/*
* This structure describes per-instance data for a serial based channel.
@@ -69,13 +76,50 @@ typedef struct SerialInfo {
* TCL_WRITABLE, or TCL_EXCEPTION: indicates
* which events should be reported. */
int flags; /* State flags, see above for a list. */
- int writable; /* flag that the channel is readable */
int readable; /* flag that the channel is readable */
+ int writable; /* flag that the channel is writable */
int blockTime; /* max. blocktime in msec */
- DWORD error; /* pending error code returned by
- * ClearCommError() */
- DWORD lastError; /* last error code, can be fetched with
- * fconfigure chan -lasterror */
+ unsigned int lastEventTime; /* Time in milliseconds since last readable event */
+ /* Next readable event only after blockTime */
+ DWORD error; /* pending error code returned by
+ * ClearCommError() */
+ DWORD lastError; /* last error code, can be fetched with
+ * fconfigure chan -lasterror */
+ DWORD sysBufRead; /* Win32 system buffer size for read ops,
+ * default=4096 */
+ DWORD sysBufWrite; /* Win32 system buffer size for write ops,
+ * default=4096 */
+
+ Tcl_ThreadId threadId; /* Thread to which events should be reported.
+ * This value is used by the reader/writer
+ * threads. */
+ OVERLAPPED osRead; /* OVERLAPPED structure for read operations */
+ OVERLAPPED osWrite; /* OVERLAPPED structure for write operations */
+ HANDLE writeThread; /* Handle to writer thread. */
+ CRITICAL_SECTION csWrite; /* Writer thread synchronisation */
+ HANDLE evWritable; /* Manual-reset event to signal when the
+ * writer thread has finished waiting for
+ * the current buffer to be written. */
+ HANDLE evStartWriter; /* Auto-reset event used by the main thread to
+ * signal when the writer thread should attempt
+ * to write to the serial. */
+ DWORD writeError; /* An error caused by the last background
+ * write. Set to 0 if no error has been
+ * detected. This word is shared with the
+ * writer thread so access must be
+ * synchronized with the evWritable object.
+ */
+ char *writeBuf; /* Current background output buffer.
+ * Access is synchronized with the evWritable
+ * object. */
+ int writeBufLen; /* Size of write buffer. Access is
+ * synchronized with the evWritable
+ * object. */
+ int toWrite; /* Current amount to be written. Access is
+ * synchronized with the evWritable object. */
+ int writeQueue; /* Number of bytes pending in output queue.
+ * Offset to DCB.cbInQue.
+ * Used to query [fconfigure -queue] */
} SerialInfo;
typedef struct ThreadSpecificData {
@@ -103,19 +147,14 @@ typedef struct SerialEvent {
* pointer. */
} SerialEvent;
-COMMTIMEOUTS timeout_sync = { /* Timouts for blocking mode */
- MAXDWORD, /* ReadIntervalTimeout */
- MAXDWORD, /* ReadTotalTimeoutMultiplier */
- MAXDWORD-1, /* ReadTotalTimeoutConstant,
- MAXDWORD-1 works for both Win95/NT */
- 0, /* WriteTotalTimeoutMultiplier */
- 0, /* WriteTotalTimeoutConstant */
-};
+/*
+ * We don't use timeouts.
+ */
-COMMTIMEOUTS timeout_async = { /* Timouts for non-blocking mode */
+static COMMTIMEOUTS no_timeout = {
0, /* ReadIntervalTimeout */
0, /* ReadTotalTimeoutMultiplier */
- 1, /* ReadTotalTimeoutConstant */
+ 0, /* ReadTotalTimeoutConstant */
0, /* WriteTotalTimeoutMultiplier */
0, /* WriteTotalTimeoutConstant */
};
@@ -135,17 +174,18 @@ static int SerialGetHandleProc(ClientData instanceData,
static ThreadSpecificData *SerialInit(void);
static int SerialInputProc(ClientData instanceData, char *buf,
int toRead, int *errorCode);
-static int SerialOutputProc(ClientData instanceData, char *buf,
+static int SerialOutputProc(ClientData instanceData, CONST char *buf,
int toWrite, int *errorCode);
static void SerialSetupProc(ClientData clientData, int flags);
static void SerialWatchProc(ClientData instanceData, int mask);
static void ProcExitHandler(ClientData clientData);
static int SerialGetOptionProc _ANSI_ARGS_((ClientData instanceData,
- Tcl_Interp *interp, char *optionName,
+ Tcl_Interp *interp, CONST char *optionName,
Tcl_DString *dsPtr));
static int SerialSetOptionProc _ANSI_ARGS_((ClientData instanceData,
- Tcl_Interp *interp, char *optionName,
- char *value));
+ Tcl_Interp *interp, CONST char *optionName,
+ CONST char *value));
+static DWORD WINAPI SerialWriterThread(LPVOID arg);
/*
* This structure describes the channel type structure for command serial
@@ -153,22 +193,22 @@ static int SerialSetOptionProc _ANSI_ARGS_((ClientData instanceData,
*/
static Tcl_ChannelType serialChannelType = {
- "serial", /* Type name. */
- TCL_CHANNEL_VERSION_2, /* v2 channel */
- SerialCloseProc, /* Close proc. */
- SerialInputProc, /* Input proc. */
- SerialOutputProc, /* Output proc. */
- NULL, /* Seek proc. */
- SerialSetOptionProc, /* Set option proc. */
- SerialGetOptionProc, /* Get option proc. */
- SerialWatchProc, /* Set up notifier to watch the channel. */
- SerialGetHandleProc, /* Get an OS handle from channel. */
- NULL, /* close2proc. */
- SerialBlockProc, /* Set blocking or non-blocking mode.*/
- NULL, /* flush proc. */
- NULL, /* handler proc. */
+ "serial", /* Type name. */
+ TCL_CHANNEL_VERSION_2, /* v2 channel */
+ SerialCloseProc, /* Close proc. */
+ SerialInputProc, /* Input proc. */
+ SerialOutputProc, /* Output proc. */
+ NULL, /* Seek proc. */
+ SerialSetOptionProc, /* Set option proc. */
+ SerialGetOptionProc, /* Get option proc. */
+ SerialWatchProc, /* Set up notifier to watch the channel. */
+ SerialGetHandleProc, /* Get an OS handle from channel. */
+ NULL, /* close2proc. */
+ SerialBlockProc, /* Set blocking or non-blocking mode.*/
+ NULL, /* flush proc. */
+ NULL, /* handler proc. */
};
-
+
/*
*----------------------------------------------------------------------
*
@@ -196,10 +236,12 @@ SerialInit()
*/
if (!initialized) {
+ Tcl_MutexLock(&serialMutex);
if (!initialized) {
initialized = 1;
Tcl_CreateExitHandler(ProcExitHandler, NULL);
}
+ Tcl_MutexUnlock(&serialMutex);
}
tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
@@ -211,7 +253,7 @@ SerialInit()
}
return tsdPtr;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -233,9 +275,24 @@ static void
SerialExitHandler(
ClientData clientData) /* Old window proc */
{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ SerialInfo *infoPtr;
+
+ /*
+ * Clear all eventually pending output.
+ * Otherwise Tcl's exit could totally block,
+ * because it performs a blocking flush on all open channels.
+ * Note that serial write operations may be blocked due to handshake.
+ */
+ for (infoPtr = tsdPtr->firstSerialPtr; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
+ PurgeComm(infoPtr->handle, PURGE_TXABORT | PURGE_RXABORT | PURGE_TXCLEAR
+ | PURGE_RXCLEAR);
+
+ }
Tcl_DeleteEventSource(SerialSetupProc, SerialCheckProc, NULL);
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -257,9 +314,11 @@ static void
ProcExitHandler(
ClientData clientData) /* Old window proc */
{
+ Tcl_MutexLock(&serialMutex);
initialized = 0;
+ Tcl_MutexUnlock(&serialMutex);
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -272,7 +331,7 @@ ProcExitHandler(
*----------------------------------------------------------------------
*/
-void
+static void
SerialBlockTime(
int msec) /* milli-seconds */
{
@@ -285,6 +344,29 @@ SerialBlockTime(
/*
*----------------------------------------------------------------------
*
+ * SerialGetMilliseconds --
+ *
+ * Get current time in milliseconds,
+ * Don't care about integer overruns
+ *
+ * Results:
+ * None.
+ *----------------------------------------------------------------------
+ */
+
+static unsigned int
+SerialGetMilliseconds(
+ void)
+{
+ Tcl_Time time;
+
+ TclpGetTime(&time);
+
+ return (time.sec * 1000 + time.usec / 1000);
+}
+/*
+ *----------------------------------------------------------------------
+ *
* SerialSetupProc --
*
* This procedure is invoked before Tcl_DoOneEvent blocks waiting
@@ -320,7 +402,13 @@ SerialSetupProc(
for (infoPtr = tsdPtr->firstSerialPtr; infoPtr != NULL;
infoPtr = infoPtr->nextPtr) {
- if( infoPtr->watchMask & (TCL_WRITABLE | TCL_READABLE) ) {
+ if (infoPtr->watchMask & TCL_WRITABLE) {
+ if (WaitForSingleObject(infoPtr->evWritable, 0) != WAIT_TIMEOUT) {
+ block = 0;
+ msec = min( msec, infoPtr->blockTime );
+ }
+ }
+ if( infoPtr->watchMask & TCL_READABLE ) {
block = 0;
msec = min( msec, infoPtr->blockTime );
}
@@ -330,7 +418,7 @@ SerialSetupProc(
SerialBlockTime(msec);
}
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -358,6 +446,7 @@ SerialCheckProc(
int needEvent;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
COMSTAT cStat;
+ unsigned int time;
if (!(flags & TCL_FILE_EVENTS)) {
return;
@@ -377,47 +466,42 @@ SerialCheckProc(
needEvent = 0;
/*
- * If any READABLE or WRITABLE watch mask is set
- * call ClearCommError to poll cbInQue,cbOutQue
+ * If WRITABLE watch mask is set
+ * look for infoPtr->evWritable object
+ */
+ if (infoPtr->watchMask & TCL_WRITABLE) {
+ if (WaitForSingleObject(infoPtr->evWritable, 0) != WAIT_TIMEOUT) {
+ infoPtr->writable = 1;
+ needEvent = 1;
+ }
+ }
+
+ /*
+ * If READABLE watch mask is set
+ * call ClearCommError to poll cbInQue
* Window errors are ignored here
*/
- if( infoPtr->watchMask & (TCL_WRITABLE | TCL_READABLE) ) {
+ if( infoPtr->watchMask & TCL_READABLE ) {
if( ClearCommError( infoPtr->handle, &infoPtr->error, &cStat ) ) {
- /*
- * Look for empty output buffer. If empty, poll.
- */
-
- if( infoPtr->watchMask & TCL_WRITABLE ) {
- /*
- * force fileevent after serial write error
- */
- if (((infoPtr->flags & SERIAL_WRITE) != 0) &&
- ((cStat.cbOutQue == 0) ||
- (infoPtr->error & SERIAL_WRITE_ERRORS))) {
- /*
- * allow only one fileevent after each callback
- */
-
- infoPtr->flags &= ~SERIAL_WRITE;
- infoPtr->writable = 1;
- needEvent = 1;
- }
- }
-
/*
* Look for characters already pending in windows queue.
- * If they are, poll.
+ * If they are, poll.
*/
if( infoPtr->watchMask & TCL_READABLE ) {
- /*
- * force fileevent after serial read error
- */
- if( (cStat.cbInQue > 0) ||
- (infoPtr->error & SERIAL_READ_ERRORS) ) {
+ /*
+ * force fileevent after serial read error
+ */
+ if( (cStat.cbInQue > 0) ||
+ (infoPtr->error & SERIAL_READ_ERRORS) ) {
infoPtr->readable = 1;
- needEvent = 1;
+ time = SerialGetMilliseconds();
+ if ((unsigned int) (time - infoPtr->lastEventTime)
+ >= (unsigned int) infoPtr->blockTime) {
+ needEvent = 1;
+ infoPtr->lastEventTime = time;
+ }
}
}
}
@@ -426,7 +510,6 @@ SerialCheckProc(
/*
* Queue an event if the serial is signaled for reading or writing.
*/
-
if (needEvent) {
infoPtr->flags |= SERIAL_PENDING;
evPtr = (SerialEvent *) ckalloc(sizeof(SerialEvent));
@@ -436,7 +519,7 @@ SerialCheckProc(
}
}
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -459,32 +542,24 @@ SerialBlockProc(
int mode) /* TCL_MODE_BLOCKING or
* TCL_MODE_NONBLOCKING. */
{
- COMMTIMEOUTS *timeout;
int errorCode = 0;
SerialInfo *infoPtr = (SerialInfo *) instanceData;
/*
- * Serial IO on Windows can not be switched between blocking & nonblocking,
- * hence we have to emulate the behavior. This is done in the input
- * function by checking against a bit in the state. We set or unset the
- * bit here to cause the input function to emulate the correct behavior.
+ * Only serial READ can be switched between blocking & nonblocking
+ * using COMMTIMEOUTS.
+ * Serial write emulates blocking & nonblocking by the SerialWriterThread.
*/
if (mode == TCL_MODE_NONBLOCKING) {
infoPtr->flags |= SERIAL_ASYNC;
- timeout = &timeout_async;
} else {
infoPtr->flags &= ~(SERIAL_ASYNC);
- timeout = &timeout_sync;
- }
- if (SetCommTimeouts(infoPtr->handle, timeout) == FALSE) {
- TclWinConvertError(GetLastError());
- errorCode = errno;
}
return errorCode;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -512,7 +587,47 @@ SerialCloseProc(
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
errorCode = 0;
+
+ if (serialPtr->validMask & TCL_READABLE) {
+ PurgeComm(serialPtr->handle, PURGE_RXABORT | PURGE_RXCLEAR);
+ CloseHandle(serialPtr->osRead.hEvent);
+ }
serialPtr->validMask &= ~TCL_READABLE;
+
+ if (serialPtr->validMask & TCL_WRITABLE) {
+
+ /*
+ * Generally we cannot wait for a pending write operation
+ * because it may hang due to handshake
+ * WaitForSingleObject(serialPtr->evWritable, INFINITE);
+ */
+ /*
+ * Forcibly terminate the background thread. We cannot rely on the
+ * thread to cleanly terminate itself because we have no way of
+ * closing the handle without blocking in the case where the
+ * thread is in the middle of an I/O operation. Note that we need
+ * to guard against terminating the thread while it is in the
+ * middle of Tcl_ThreadAlert because it won't be able to release
+ * the notifier lock.
+ */
+
+ Tcl_MutexLock(&serialMutex);
+ TerminateThread(serialPtr->writeThread, 0);
+ Tcl_MutexUnlock(&serialMutex);
+
+ /*
+ * Wait for the thread to terminate. This ensures that we are
+ * completely cleaned up before we leave this function.
+ */
+
+ WaitForSingleObject(serialPtr->writeThread, INFINITE);
+ CloseHandle(serialPtr->writeThread);
+ CloseHandle(serialPtr->evWritable);
+ CloseHandle(serialPtr->evStartWriter);
+ serialPtr->writeThread = NULL;
+
+ PurgeComm(serialPtr->handle, PURGE_TXABORT | PURGE_TXCLEAR);
+ }
serialPtr->validMask &= ~TCL_WRITABLE;
/*
@@ -525,10 +640,10 @@ SerialCloseProc(
|| ((GetStdHandle(STD_INPUT_HANDLE) != serialPtr->handle)
&& (GetStdHandle(STD_OUTPUT_HANDLE) != serialPtr->handle)
&& (GetStdHandle(STD_ERROR_HANDLE) != serialPtr->handle))) {
- if (CloseHandle(serialPtr->handle) == FALSE) {
- TclWinConvertError(GetLastError());
- errorCode = errno;
- }
+ if (CloseHandle(serialPtr->handle) == FALSE) {
+ TclWinConvertError(GetLastError());
+ errorCode = errno;
+ }
}
serialPtr->watchMask &= serialPtr->validMask;
@@ -550,7 +665,10 @@ SerialCloseProc(
* Wrap the error file into a channel and give it to the cleanup
* routine.
*/
-
+ if (serialPtr->writeBuf != NULL) {
+ ckfree(serialPtr->writeBuf);
+ serialPtr->writeBuf = NULL;
+ }
ckfree((char*) serialPtr);
if (errorCode == 0) {
@@ -558,7 +676,133 @@ SerialCloseProc(
}
return errorCode;
}
-
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * blockingRead --
+ *
+ * Perform a blocking read into the buffer given. Returns
+ * count of how many bytes were actually read, and an error indication.
+ *
+ * Results:
+ * A count of how many bytes were read is returned and an error
+ * indication is returned.
+ *
+ * Side effects:
+ * Reads input from the actual channel.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+blockingRead(
+ SerialInfo *infoPtr, /* Serial info structure */
+ LPVOID buf, /* The input buffer pointer */
+ DWORD bufSize, /* The number of bytes to read */
+ LPDWORD lpRead, /* Returns number of bytes read */
+ LPOVERLAPPED osPtr ) /* OVERLAPPED structure */
+{
+ /*
+ * Perform overlapped blocking read.
+ * 1. Reset the overlapped event
+ * 2. Start overlapped read operation
+ * 3. Wait for completion
+ */
+
+ /*
+ * Set Offset to ZERO, otherwise NT4.0 may report an error
+ */
+ osPtr->Offset = osPtr->OffsetHigh = 0;
+ ResetEvent(osPtr->hEvent);
+ if (! ReadFile(infoPtr->handle, buf, bufSize, lpRead, osPtr) ) {
+ if (GetLastError() != ERROR_IO_PENDING) {
+ /* ReadFile failed, but it isn't delayed. Report error */
+ return FALSE;
+ } else {
+ /* Read is pending, wait for completion, timeout ? */
+ if (! GetOverlappedResult(infoPtr->handle, osPtr, lpRead, TRUE) ) {
+ return FALSE;
+ }
+ }
+ } else {
+ /* ReadFile completed immediately. */
+ }
+ return TRUE;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * blockingWrite --
+ *
+ * Perform a blocking write from the buffer given. Returns
+ * count of how many bytes were actually written, and an error indication.
+ *
+ * Results:
+ * A count of how many bytes were written is returned and an error
+ * indication is returned.
+ *
+ * Side effects:
+ * Writes output to the actual channel.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+blockingWrite(
+ SerialInfo *infoPtr, /* Serial info structure */
+ LPVOID buf, /* The output buffer pointer */
+ DWORD bufSize, /* The number of bytes to write */
+ LPDWORD lpWritten, /* Returns number of bytes written */
+ LPOVERLAPPED osPtr ) /* OVERLAPPED structure */
+{
+ int result;
+ /*
+ * Perform overlapped blocking write.
+ * 1. Reset the overlapped event
+ * 2. Remove these bytes from the output queue counter
+ * 3. Start overlapped write operation
+ * 3. Remove these bytes from the output queue counter
+ * 4. Wait for completion
+ * 5. Adjust the output queue counter
+ */
+ ResetEvent(osPtr->hEvent);
+
+ EnterCriticalSection(&infoPtr->csWrite);
+ infoPtr->writeQueue -= bufSize;
+ /*
+ * Set Offset to ZERO, otherwise NT4.0 may report an error
+ */
+ osPtr->Offset = osPtr->OffsetHigh = 0;
+ result = WriteFile(infoPtr->handle, buf, bufSize, lpWritten, osPtr);
+ LeaveCriticalSection(&infoPtr->csWrite);
+
+ if (result == FALSE ) {
+ int err = GetLastError();
+ switch (err) {
+ case ERROR_IO_PENDING:
+ /* Write is pending, wait for completion */
+ if (! GetOverlappedResult(infoPtr->handle, osPtr, lpWritten, TRUE) ) {
+ return FALSE;
+ }
+ break;
+ case ERROR_COUNTER_TIMEOUT:
+ /* Write timeout handled in SerialOutputProc */
+ break;
+ default:
+ /* WriteFile failed, but it isn't delayed. Report error */
+ return FALSE;
+ }
+ } else {
+ /* WriteFile completed immediately. */
+ }
+
+ EnterCriticalSection(&infoPtr->csWrite);
+ infoPtr->writeQueue += (*lpWritten - bufSize);
+ LeaveCriticalSection(&infoPtr->csWrite);
+
+ return TRUE;
+}
+
/*
*----------------------------------------------------------------------
*
@@ -586,16 +830,15 @@ SerialInputProc(
{
SerialInfo *infoPtr = (SerialInfo *) instanceData;
DWORD bytesRead = 0;
- DWORD err;
COMSTAT cStat;
*errorCode = 0;
- /*
+ /*
* Check if there is a CommError pending from SerialCheckProc
*/
if( infoPtr->error & SERIAL_READ_ERRORS ){
- goto commError;
+ goto commError;
}
/*
@@ -605,18 +848,18 @@ SerialInputProc(
if( ClearCommError( infoPtr->handle, &infoPtr->error, &cStat ) ) {
/*
- * Check for errors here, but not in the evSetup/Check procedures
- */
+ * Check for errors here, but not in the evSetup/Check procedures
+ */
if( infoPtr->error & SERIAL_READ_ERRORS ) {
- goto commError;
+ goto commError;
}
if( infoPtr->flags & SERIAL_ASYNC ) {
- /*
- * NON_BLOCKING mode:
- * Avoid blocking by reading more bytes than available
- * in input buffer
- */
+ /*
+ * NON_BLOCKING mode:
+ * Avoid blocking by reading more bytes than available
+ * in input buffer
+ */
if( cStat.cbInQue > 0 ) {
if( (DWORD) bufSize > cStat.cbInQue ) {
@@ -627,10 +870,10 @@ SerialInputProc(
return -1;
}
} else {
- /*
- * BLOCKING mode:
- * Tcl trys to read a full buffer of 4 kBytes here
- */
+ /*
+ * BLOCKING mode:
+ * Tcl trys to read a full buffer of 4 kBytes here
+ */
if( cStat.cbInQue > 0 ) {
if( (DWORD) bufSize > cStat.cbInQue ) {
@@ -646,27 +889,28 @@ SerialInputProc(
return bytesRead = 0;
}
- if (ReadFile(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
- NULL) == FALSE) {
- err = GetLastError();
- if (err != ERROR_IO_PENDING) {
- goto error;
- }
+ /*
+ * Perform blocking read. Doesn't block in non-blocking mode,
+ * because we checked the number of available bytes.
+ */
+ if (blockingRead(infoPtr, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
+ &infoPtr->osRead) == FALSE) {
+ goto error;
}
return bytesRead;
- error:
+error:
TclWinConvertError(GetLastError());
*errorCode = errno;
return -1;
- commError:
+commError:
infoPtr->lastError = infoPtr->error; /* save last error code */
- infoPtr->error = 0; /* reset error code */
- *errorCode = EIO; /* to return read-error only once */
+ infoPtr->error = 0; /* reset error code */
+ *errorCode = EIO; /* to return read-error only once */
return -1;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -688,51 +932,120 @@ SerialInputProc(
static int
SerialOutputProc(
ClientData instanceData, /* Serial state. */
- char *buf, /* The data buffer. */
+ CONST char *buf, /* The data buffer. */
int toWrite, /* How many bytes to write? */
int *errorCode) /* Where to store error code. */
{
SerialInfo *infoPtr = (SerialInfo *) instanceData;
- DWORD bytesWritten, err;
+ int bytesWritten, timeout;
*errorCode = 0;
/*
+ * At EXIT Tcl trys to flush all open channels in blocking mode.
+ * We avoid blocking output after ExitProc or CloseHandler(chan)
+ * has been called by checking the corrresponding variables.
+ */
+ if( ! initialized || TclInExit() ) {
+ return toWrite;
+ }
+
+ /*
* Check if there is a CommError pending from SerialCheckProc
*/
if( infoPtr->error & SERIAL_WRITE_ERRORS ){
- infoPtr->lastError = infoPtr->error; /* save last error code */
- infoPtr->error = 0; /* reset error code */
- *errorCode = EIO; /* to return read-error only once */
- return -1;
+ infoPtr->lastError = infoPtr->error; /* save last error code */
+ infoPtr->error = 0; /* reset error code */
+ errno = EIO;
+ goto error;
}
+ timeout = (infoPtr->flags & SERIAL_ASYNC) ? 0 : INFINITE;
+ if (WaitForSingleObject(infoPtr->evWritable, timeout) == WAIT_TIMEOUT) {
+ /*
+ * The writer thread is blocked waiting for a write to complete
+ * and the channel is in non-blocking mode.
+ */
+
+ errno = EWOULDBLOCK;
+ goto error1;
+ }
/*
* Check for a background error on the last write.
- * Allow one write-fileevent after each callback
*/
- if( toWrite ) {
- infoPtr->flags |= SERIAL_WRITE;
+ if (infoPtr->writeError) {
+ TclWinConvertError(infoPtr->writeError);
+ infoPtr->writeError = 0;
+ goto error1;
}
- if (WriteFile(infoPtr->handle, (LPVOID) buf, (DWORD) toWrite,
- &bytesWritten, NULL) == FALSE) {
- err = GetLastError();
- if (err != ERROR_IO_PENDING) {
- TclWinConvertError(GetLastError());
+ /*
+ * Remember the number of bytes in output queue
+ */
+ EnterCriticalSection(&infoPtr->csWrite);
+ infoPtr->writeQueue += toWrite;
+ LeaveCriticalSection(&infoPtr->csWrite);
+
+ if (infoPtr->flags & SERIAL_ASYNC) {
+ /*
+ * The serial is non-blocking, so copy the data into the output
+ * buffer and restart the writer thread.
+ */
+
+ if (toWrite > infoPtr->writeBufLen) {
+ /*
+ * Reallocate the buffer to be large enough to hold the data.
+ */
+
+ if (infoPtr->writeBuf) {
+ ckfree(infoPtr->writeBuf);
+ }
+ infoPtr->writeBufLen = toWrite;
+ infoPtr->writeBuf = ckalloc(toWrite);
+ }
+ memcpy(infoPtr->writeBuf, buf, toWrite);
+ infoPtr->toWrite = toWrite;
+ ResetEvent(infoPtr->evWritable);
+ SetEvent(infoPtr->evStartWriter);
+ bytesWritten = toWrite;
+
+ } else {
+ /*
+ * In the blocking case, just try to write the buffer directly.
+ * This avoids an unnecessary copy.
+ */
+ if (! blockingWrite(infoPtr, (LPVOID) buf, (DWORD) toWrite,
+ &bytesWritten, &infoPtr->osWrite) ) {
+ goto writeError;
+ }
+ if (bytesWritten != toWrite) {
+ /* Write timeout */
+ infoPtr->lastError |= CE_PTO;
+ errno = EIO;
goto error;
}
}
return bytesWritten;
+writeError:
+ TclWinConvertError(GetLastError());
+
error:
+ /*
+ * Reset the output queue counter on error during blocking output
+ */
+/*
+ EnterCriticalSection(&infoPtr->csWrite);
+ infoPtr->writeQueue = 0;
+ LeaveCriticalSection(&infoPtr->csWrite);
+*/
+ error1:
*errorCode = errno;
return -1;
-
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -820,7 +1133,7 @@ SerialEventProc(
Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask & mask);
return 1;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -864,9 +1177,9 @@ SerialWatchProc(
SerialBlockTime(infoPtr->blockTime);
} else {
if (oldMask) {
- /*
- * Remove the serial port from the list of watched serial ports.
- */
+ /*
+ * Remove the serial port from the list of watched serial ports.
+ */
for (nextPtrPtr = &(tsdPtr->firstSerialPtr), ptr = *nextPtrPtr;
ptr != NULL;
@@ -879,7 +1192,7 @@ SerialWatchProc(
}
}
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -909,7 +1222,134 @@ SerialGetHandleProc(
*handlePtr = (ClientData) infoPtr->handle;
return TCL_OK;
}
-
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialWriterThread --
+ *
+ * This function runs in a separate thread and writes data
+ * onto a serial.
+ *
+ * Results:
+ * Always returns 0.
+ *
+ * Side effects:
+ * Signals the main thread when an output operation is completed.
+ * May cause the main thread to wake up by posting a message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static DWORD WINAPI
+SerialWriterThread(LPVOID arg)
+{
+
+ SerialInfo *infoPtr = (SerialInfo *)arg;
+ HANDLE *handle = infoPtr->handle;
+ DWORD bytesWritten, toWrite;
+ char *buf;
+ OVERLAPPED myWrite; /* have an own OVERLAPPED in this thread */
+
+ for (;;) {
+ /*
+ * Wait for the main thread to signal before attempting to write.
+ */
+
+ WaitForSingleObject(infoPtr->evStartWriter, INFINITE);
+
+ buf = infoPtr->writeBuf;
+ toWrite = infoPtr->toWrite;
+
+ myWrite.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL);
+
+ /*
+ * Loop until all of the bytes are written or an error occurs.
+ */
+
+ while (toWrite > 0) {
+ /*
+ * Check for pending writeError
+ * Ignore all write operations until the user has been notified
+ */
+ if (infoPtr->writeError) {
+ break;
+ }
+ if (blockingWrite(infoPtr, (LPVOID) buf, (DWORD) toWrite,
+ &bytesWritten, &myWrite) == FALSE) {
+ infoPtr->writeError = GetLastError();
+ break;
+ }
+ if (bytesWritten != toWrite) {
+ /* Write timeout */
+ infoPtr->writeError = ERROR_WRITE_FAULT;
+ break;
+ }
+ toWrite -= bytesWritten;
+ buf += bytesWritten;
+ }
+
+ CloseHandle(myWrite.hEvent);
+ /*
+ * Signal the main thread by signalling the evWritable event and
+ * then waking up the notifier thread.
+ */
+ SetEvent(infoPtr->evWritable);
+
+ /*
+ * Alert the foreground thread. Note that we need to treat this like
+ * a critical section so the foreground thread does not terminate
+ * this thread while we are holding a mutex in the notifier code.
+ */
+
+ Tcl_MutexLock(&serialMutex);
+ Tcl_ThreadAlert(infoPtr->threadId);
+ Tcl_MutexUnlock(&serialMutex);
+ }
+ return 0; /* NOT REACHED */
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclWinSerialReopen --
+ *
+ * Reopens the serial port with the OVERLAPPED FLAG set
+ *
+ * Results:
+ * Returns the new handle, or INVALID_HANDLE_VALUE
+ * Normally there shouldn't be any error,
+ * because the same channel has previously been succeesfully opened.
+ *
+ * Side effects:
+ * May close the original handle
+ *
+ *----------------------------------------------------------------------
+ */
+
+HANDLE
+TclWinSerialReopen(handle, name, access)
+ HANDLE handle;
+ CONST TCHAR *name;
+ DWORD access;
+{
+ ThreadSpecificData *tsdPtr;
+
+ tsdPtr = SerialInit();
+
+ /*
+ * Multithreaded I/O needs the overlapped flag set
+ * otherwise ClearCommError blocks under Windows NT/2000 until serial
+ * output is finished
+ */
+ if (CloseHandle(handle) == FALSE) {
+ return INVALID_HANDLE_VALUE;
+ }
+ handle = (*tclWinProcs->createFileProc)(name, access,
+ 0, 0, OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0);
+ return handle;
+}
/*
*----------------------------------------------------------------------
*
@@ -936,19 +1376,10 @@ TclWinOpenSerialChannel(handle, channelName, permissions)
{
SerialInfo *infoPtr;
ThreadSpecificData *tsdPtr;
+ DWORD id;
tsdPtr = SerialInit();
- SetupComm(handle, 4096, 4096);
- PurgeComm(handle, PURGE_TXABORT | PURGE_RXABORT | PURGE_TXCLEAR
- | PURGE_RXCLEAR);
-
- /*
- * default is blocking
- */
-
- SetCommTimeouts(handle, &timeout_sync);
-
infoPtr = (SerialInfo *) ckalloc((unsigned) sizeof(SerialInfo));
memset(infoPtr, 0, sizeof(SerialInfo));
@@ -965,10 +1396,40 @@ TclWinOpenSerialChannel(handle, channelName, permissions)
infoPtr->channel = Tcl_CreateChannel(&serialChannelType, channelName,
(ClientData) infoPtr, permissions);
-
- infoPtr->readable = infoPtr->writable = 0;
+ infoPtr->readable = 0;
+ infoPtr->writable = 1;
+ infoPtr->toWrite = infoPtr->writeQueue = 0;
infoPtr->blockTime = SERIAL_DEFAULT_BLOCKTIME;
+ infoPtr->lastEventTime = 0;
infoPtr->lastError = infoPtr->error = 0;
+ infoPtr->threadId = Tcl_GetCurrentThread();
+ infoPtr->sysBufRead = infoPtr->sysBufWrite = 4096;
+
+ SetupComm(handle, infoPtr->sysBufRead, infoPtr->sysBufWrite);
+ PurgeComm(handle, PURGE_TXABORT | PURGE_RXABORT | PURGE_TXCLEAR
+ | PURGE_RXCLEAR);
+
+ /*
+ * default is blocking
+ */
+ SetCommTimeouts(handle, &no_timeout);
+
+
+ if (permissions & TCL_READABLE) {
+ infoPtr->osRead.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL);
+ }
+ if (permissions & TCL_WRITABLE) {
+ /*
+ * Initially the channel is writable
+ * and the writeThread is idle.
+ */
+ infoPtr->osWrite.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL);
+ infoPtr->evWritable = CreateEvent(NULL, TRUE, TRUE, NULL);
+ infoPtr->evStartWriter = CreateEvent(NULL, FALSE, FALSE, NULL);
+ InitializeCriticalSection(&infoPtr->csWrite);
+ infoPtr->writeThread = CreateThread(NULL, 8000, SerialWriterThread,
+ infoPtr, 0, &id);
+ }
/*
* Files have default translation of AUTO and ^Z eof char, which
@@ -980,7 +1441,7 @@ TclWinOpenSerialChannel(handle, channelName, permissions)
return infoPtr->channel;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -996,30 +1457,56 @@ SerialErrorStr(error, dsPtr)
Tcl_DString *dsPtr; /* Where to store string */
{
if( (error & CE_RXOVER) != 0) {
- Tcl_DStringAppendElement(dsPtr, "RXOVER");
+ Tcl_DStringAppendElement(dsPtr, "RXOVER");
}
if( (error & CE_OVERRUN) != 0) {
- Tcl_DStringAppendElement(dsPtr, "OVERRUN");
+ Tcl_DStringAppendElement(dsPtr, "OVERRUN");
}
if( (error & CE_RXPARITY) != 0) {
- Tcl_DStringAppendElement(dsPtr, "RXPARITY");
+ Tcl_DStringAppendElement(dsPtr, "RXPARITY");
}
if( (error & CE_FRAME) != 0) {
- Tcl_DStringAppendElement(dsPtr, "FRAME");
+ Tcl_DStringAppendElement(dsPtr, "FRAME");
}
if( (error & CE_BREAK) != 0) {
- Tcl_DStringAppendElement(dsPtr, "BREAK");
+ Tcl_DStringAppendElement(dsPtr, "BREAK");
}
if( (error & CE_TXFULL) != 0) {
- Tcl_DStringAppendElement(dsPtr, "TXFULL");
+ Tcl_DStringAppendElement(dsPtr, "TXFULL");
+ }
+ if( (error & CE_PTO) != 0) { /* PTO used to signal WRITE-TIMEOUT */
+ Tcl_DStringAppendElement(dsPtr, "TIMEOUT");
}
if( (error & ~(SERIAL_READ_ERRORS | SERIAL_WRITE_ERRORS)) != 0) {
- char buf[TCL_INTEGER_SPACE + 1];
- wsprintfA(buf, "%d", error);
- Tcl_DStringAppendElement(dsPtr, buf);
+ char buf[TCL_INTEGER_SPACE + 1];
+ wsprintfA(buf, "%d", error);
+ Tcl_DStringAppendElement(dsPtr, buf);
}
}
-
+/*
+ *----------------------------------------------------------------------
+ *
+ * SerialModemStatusStr --
+ *
+ * Converts a Win32 modem status list of readable flags
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+SerialModemStatusStr(status, dsPtr)
+ DWORD status; /* Win32 modem status */
+ Tcl_DString *dsPtr; /* Where to store string */
+{
+ Tcl_DStringAppendElement(dsPtr, "CTS");
+ Tcl_DStringAppendElement(dsPtr, (status & MS_CTS_ON) ? "1" : "0");
+ Tcl_DStringAppendElement(dsPtr, "DSR");
+ Tcl_DStringAppendElement(dsPtr, (status & MS_DSR_ON) ? "1" : "0");
+ Tcl_DStringAppendElement(dsPtr, "RING");
+ Tcl_DStringAppendElement(dsPtr, (status & MS_RING_ON) ? "1" : "0");
+ Tcl_DStringAppendElement(dsPtr, "DCD");
+ Tcl_DStringAppendElement(dsPtr, (status & MS_RLSD_ON) ? "1" : "0");
+}
+
/*
*----------------------------------------------------------------------
*
@@ -1036,63 +1523,324 @@ SerialErrorStr(error, dsPtr)
*
*----------------------------------------------------------------------
*/
-
static int
SerialSetOptionProc(instanceData, interp, optionName, value)
ClientData instanceData; /* File state. */
Tcl_Interp *interp; /* For error reporting - can be NULL. */
- char *optionName; /* Which option to set? */
- char *value; /* New value for option. */
+ CONST char *optionName; /* Which option to set? */
+ CONST char *value; /* New value for option. */
{
SerialInfo *infoPtr;
DCB dcb;
- int len;
- BOOL result;
+ BOOL result, flag;
+ size_t len, vlen;
Tcl_DString ds;
- TCHAR *native;
+ CONST TCHAR *native;
+ int argc;
+ char **argv;
infoPtr = (SerialInfo *) instanceData;
+ /*
+ * Parse options
+ */
len = strlen(optionName);
- if ((len > 1) && (strncmp(optionName, "-mode", len) == 0)) {
- if (GetCommState(infoPtr->handle, &dcb)) {
- native = Tcl_WinUtfToTChar(value, -1, &ds);
- result = (*tclWinProcs->buildCommDCBProc)(native, &dcb);
- Tcl_DStringFree(&ds);
-
- if ((result == FALSE) ||
- (SetCommState(infoPtr->handle, &dcb) == FALSE)) {
- /*
- * one should separate the 2 errors...
- */
-
- if (interp) {
- Tcl_AppendResult(interp,
- "bad value for -mode: should be ",
- "baud,parity,data,stop", NULL);
- }
- return TCL_ERROR;
- } else {
- return TCL_OK;
- }
- } else {
- if (interp) {
- Tcl_AppendResult(interp, "can't get comm state", NULL);
- }
- return TCL_ERROR;
- }
- } else if ((len > 1) &&
- (strncmp(optionName, "-pollinterval", len) == 0)) {
- if ( Tcl_GetInt(interp, value, &(infoPtr->blockTime)) != TCL_OK ) {
- return TCL_ERROR;
- }
- } else {
- return Tcl_BadChannelOption(interp, optionName,
- "mode pollinterval");
+ vlen = strlen(value);
+
+ /*
+ * Option -mode baud,parity,databits,stopbits
+ */
+ if ((len > 2) && (strncmp(optionName, "-mode", len) == 0)) {
+
+ if (! GetCommState(infoPtr->handle, &dcb)) {
+ if (interp) {
+ Tcl_AppendResult(interp,
+ "can't get comm state", (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+ native = Tcl_WinUtfToTChar(value, -1, &ds);
+ result = (*tclWinProcs->buildCommDCBProc)(native, &dcb);
+ Tcl_DStringFree(&ds);
+
+ if (result == FALSE) {
+ if (interp) {
+ Tcl_AppendResult(interp,
+ "bad value for -mode: should be baud,parity,data,stop",
+ (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ /* Default settings for serial communications */
+ dcb.fBinary = TRUE;
+ dcb.fErrorChar = FALSE;
+ dcb.fNull = FALSE;
+ dcb.fAbortOnError = FALSE;
+
+ if (! SetCommState(infoPtr->handle, &dcb) ) {
+ if (interp) {
+ Tcl_AppendResult(interp,
+ "can't set comm state", (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+ return TCL_OK;
}
- return TCL_OK;
+
+ /*
+ * Option -handshake none|xonxoff|rtscts|dtrdsr
+ */
+ if ((len > 1) && (strncmp(optionName, "-handshake", len) == 0)) {
+
+ if (! GetCommState(infoPtr->handle, &dcb)) {
+ if (interp) {
+ Tcl_AppendResult(interp,
+ "can't get comm state", (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+ /*
+ * Reset all handshake options
+ * DTR and RTS are ON by default
+ */
+ dcb.fOutX = dcb.fInX = FALSE;
+ dcb.fOutxCtsFlow = dcb.fOutxDsrFlow = dcb.fDsrSensitivity = FALSE;
+ dcb.fDtrControl = DTR_CONTROL_ENABLE;
+ dcb.fRtsControl = RTS_CONTROL_ENABLE;
+ dcb.fTXContinueOnXoff = FALSE;
+
+ /*
+ * Adjust the handshake limits.
+ * Yes, the XonXoff limits seem to influence even hardware handshake
+ */
+ dcb.XonLim = (WORD) (infoPtr->sysBufRead*1/2);
+ dcb.XoffLim = (WORD) (infoPtr->sysBufRead*1/4);
+
+ if (strnicmp(value, "NONE", vlen) == 0) {
+ /* leave all handshake options disabled */
+ } else if (strnicmp(value, "XONXOFF", vlen) == 0) {
+ dcb.fOutX = dcb.fInX = TRUE;
+ } else if (strnicmp(value, "RTSCTS", vlen) == 0) {
+ dcb.fOutxCtsFlow = TRUE;
+ dcb.fRtsControl = RTS_CONTROL_HANDSHAKE;
+ } else if (strnicmp(value, "DTRDSR", vlen) == 0) {
+ dcb.fOutxDsrFlow = TRUE;
+ dcb.fDtrControl = DTR_CONTROL_HANDSHAKE;
+ } else {
+ if (interp) {
+ Tcl_AppendResult(interp, "bad value for -handshake: ",
+ "must be one of xonxoff, rtscts, dtrdsr or none",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ if (! SetCommState(infoPtr->handle, &dcb)) {
+ if (interp) {
+ Tcl_AppendResult(interp,
+ "can't set comm state", (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+ }
+
+ /*
+ * Option -xchar {\x11 \x13}
+ */
+ if ((len > 1) && (strncmp(optionName, "-xchar", len) == 0)) {
+
+ if (! GetCommState(infoPtr->handle, &dcb)) {
+ if (interp) {
+ Tcl_AppendResult(interp,
+ "can't get comm state", (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ if (argc == 2) {
+ dcb.XonChar = argv[0][0];
+ dcb.XoffChar = argv[1][0];
+ } else {
+ if (interp) {
+ Tcl_AppendResult(interp,
+ "bad value for -xchar: should be a list of two elements",
+ (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ if (! SetCommState(infoPtr->handle, &dcb)) {
+ if (interp) {
+ Tcl_AppendResult(interp,
+ "can't set comm state", (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+ }
+
+ /*
+ * Option -ttycontrol {DTR 1 RTS 0 BREAK 0}
+ */
+ if ((len > 4) && (strncmp(optionName, "-ttycontrol", len) == 0)) {
+
+ if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ if ((argc % 2) == 1) {
+ if (interp) {
+ Tcl_AppendResult(interp,
+ "bad value for -ttycontrol: should be a list of signal,value pairs",
+ (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+ while (argc > 1) {
+ if (Tcl_GetBoolean(interp, argv[1], &flag) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ if (strnicmp(argv[0], "DTR", strlen(argv[0])) == 0) {
+ if (! EscapeCommFunction(infoPtr->handle, flag ? SETDTR : CLRDTR)) {
+ if (interp) {
+ Tcl_AppendResult(interp,
+ "can't set DTR signal", (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+ } else if (strnicmp(argv[0], "RTS", strlen(argv[0])) == 0) {
+ if (! EscapeCommFunction(infoPtr->handle, flag ? SETRTS : CLRRTS)) {
+ if (interp) {
+ Tcl_AppendResult(interp,
+ "can't set RTS signal", (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+ } else if (strnicmp(argv[0], "BREAK", strlen(argv[0])) == 0) {
+ if (! EscapeCommFunction(infoPtr->handle, flag ? SETBREAK : CLRBREAK)) {
+ if (interp) {
+ Tcl_AppendResult(interp,
+ "can't set BREAK signal", (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+ } else {
+ if (interp) {
+ Tcl_AppendResult(interp,
+ "bad signal for -ttycontrol: must be DTR, RTS or BREAK",
+ (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+ argc -= 2, argv += 2;
+ } /* while (argc > 1) */
+
+ return TCL_OK;
+ }
+
+ /*
+ * Option -sysbuffer {read_size write_size}
+ * Option -sysbuffer read_size
+ */
+ if ((len > 1) && (strncmp(optionName, "-sysbuffer", len) == 0)) {
+
+ /*
+ * -sysbuffer 4096 or -sysbuffer {64536 4096}
+ */
+ size_t inSize = -1, outSize = -1;
+
+ if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ if (argc == 1) {
+ inSize = atoi(argv[0]);
+ outSize = infoPtr->sysBufWrite;
+ } else if (argc == 2) {
+ inSize = atoi(argv[0]);
+ outSize = atoi(argv[1]);
+ }
+ if ( (inSize <= 0) || (outSize <= 0) ) {
+ if (interp) {
+ Tcl_AppendResult(interp,
+ "bad value for -sysbuffer: should be a list of one or two integers > 0",
+ (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+ if (! SetupComm(infoPtr->handle, inSize, outSize)) {
+ if (interp) {
+ Tcl_AppendResult(interp,
+ "can't setup comm buffers", (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+ infoPtr->sysBufRead = inSize;
+ infoPtr->sysBufWrite = outSize;
+
+ /*
+ * Adjust the handshake limits.
+ * Yes, the XonXoff limits seem to influence even hardware handshake
+ */
+ if (! GetCommState(infoPtr->handle, &dcb)) {
+ if (interp) {
+ Tcl_AppendResult(interp,
+ "can't get comm state", (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+ dcb.XonLim = (WORD) (infoPtr->sysBufRead*1/2);
+ dcb.XoffLim = (WORD) (infoPtr->sysBufRead*1/4);
+ if (! SetCommState(infoPtr->handle, &dcb)) {
+ if (interp) {
+ Tcl_AppendResult(interp,
+ "can't set comm state", (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+ }
+
+ /*
+ * Option -pollinterval msec
+ */
+ if ((len > 1) && (strncmp(optionName, "-pollinterval", len) == 0)) {
+
+ if ( Tcl_GetInt(interp, value, &(infoPtr->blockTime)) != TCL_OK ) {
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+ }
+
+ /*
+ * Option -timeout msec
+ */
+ if ((len > 2) && (strncmp(optionName, "-timeout", len) == 0)) {
+ int msec;
+ COMMTIMEOUTS tout = {0,0,0,0,0};
+
+ if ( Tcl_GetInt(interp, value, &msec) != TCL_OK ) {
+ return TCL_ERROR;
+ }
+ tout.ReadTotalTimeoutConstant = msec;
+ if (! SetCommTimeouts(infoPtr->handle, &tout)) {
+ if (interp) {
+ Tcl_AppendResult(interp,
+ "can't set comm timeouts", (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+ }
+
+ return Tcl_BadChannelOption(interp, optionName,
+ "mode handshake pollinterval sysbuffer timeout ttycontrol xchar");
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -1117,61 +1865,60 @@ static int
SerialGetOptionProc(instanceData, interp, optionName, dsPtr)
ClientData instanceData; /* File state. */
Tcl_Interp *interp; /* For error reporting - can be NULL. */
- char *optionName; /* Option to get. */
+ CONST char *optionName; /* Option to get. */
Tcl_DString *dsPtr; /* Where to store value(s). */
{
SerialInfo *infoPtr;
DCB dcb;
- int len;
+ size_t len;
int valid = 0; /* flag if valid option parsed */
-
+
infoPtr = (SerialInfo *) instanceData;
-
+
if (optionName == NULL) {
len = 0;
} else {
len = strlen(optionName);
}
-
+
/*
- * get option -mode
- */
-
+ * get option -mode
+ */
+
if (len == 0) {
Tcl_DStringAppendElement(dsPtr, "-mode");
}
if ((len == 0) ||
- ((len > 1) && (strncmp(optionName, "-mode", len) == 0))) {
- valid = 1;
- if (GetCommState(infoPtr->handle, &dcb) == 0) {
- /*
- * shouldn't we flag an error instead ?
- */
-
- Tcl_DStringAppendElement(dsPtr, "");
-
- } else {
- char parity;
- char *stop;
- char buf[2 * TCL_INTEGER_SPACE + 16];
-
- parity = 'n';
- if (dcb.Parity < 4) {
- parity = "noems"[dcb.Parity];
+ ((len > 2) && (strncmp(optionName, "-mode", len) == 0))) {
+
+ char parity;
+ char *stop;
+ char buf[2 * TCL_INTEGER_SPACE + 16];
+
+ if (! GetCommState(infoPtr->handle, &dcb)) {
+ if (interp) {
+ Tcl_AppendResult(interp,
+ "can't get comm state", (char *) NULL);
}
-
- stop = (dcb.StopBits == ONESTOPBIT) ? "1" :
- (dcb.StopBits == ONE5STOPBITS) ? "1.5" : "2";
-
- wsprintfA(buf, "%d,%c,%d,%s", dcb.BaudRate, parity,
- dcb.ByteSize, stop);
- Tcl_DStringAppendElement(dsPtr, buf);
+ return TCL_ERROR;
+ }
+
+ valid = 1;
+ parity = 'n';
+ if (dcb.Parity <= 4) {
+ parity = "noems"[dcb.Parity];
}
+ stop = (dcb.StopBits == ONESTOPBIT) ? "1" :
+ (dcb.StopBits == ONE5STOPBITS) ? "1.5" : "2";
+
+ wsprintfA(buf, "%d,%c,%d,%s", dcb.BaudRate, parity,
+ dcb.ByteSize, stop);
+ Tcl_DStringAppendElement(dsPtr, buf);
}
-
+
/*
- * get option -pollinterval
- */
+ * get option -pollinterval
+ */
if (len == 0) {
Tcl_DStringAppendElement(dsPtr, "-pollinterval");
@@ -1179,28 +1926,136 @@ SerialGetOptionProc(instanceData, interp, optionName, dsPtr)
if ((len == 0) ||
((len > 1) && (strncmp(optionName, "-pollinterval", len) == 0))) {
char buf[TCL_INTEGER_SPACE + 1];
-
+
valid = 1;
wsprintfA(buf, "%d", infoPtr->blockTime);
Tcl_DStringAppendElement(dsPtr, buf);
}
+
+ /*
+ * get option -sysbuffer
+ */
+
+ if (len == 0) {
+ Tcl_DStringAppendElement(dsPtr, "-sysbuffer");
+ Tcl_DStringStartSublist(dsPtr);
+ }
+ if ((len == 0) ||
+ ((len > 1) && (strncmp(optionName, "-sysbuffer", len) == 0))) {
+
+ char buf[TCL_INTEGER_SPACE + 1];
+ valid = 1;
+ wsprintfA(buf, "%d", infoPtr->sysBufRead);
+ Tcl_DStringAppendElement(dsPtr, buf);
+ wsprintfA(buf, "%d", infoPtr->sysBufWrite);
+ Tcl_DStringAppendElement(dsPtr, buf);
+ }
+ if (len == 0) {
+ Tcl_DStringEndSublist(dsPtr);
+ }
+
/*
- * get option -lasterror
- * option is readonly and returned by [fconfigure chan -lasterror]
- * but not returned by unnamed [fconfigure chan]
- */
+ * get option -xchar
+ */
+
+ if (len == 0) {
+ Tcl_DStringAppendElement(dsPtr, "-xchar");
+ Tcl_DStringStartSublist(dsPtr);
+ }
+ if ((len == 0) ||
+ ((len > 1) && (strncmp(optionName, "-xchar", len) == 0))) {
+
+ char buf[4];
+ valid = 1;
+
+ if (! GetCommState(infoPtr->handle, &dcb)) {
+ if (interp) {
+ Tcl_AppendResult(interp,
+ "can't get comm state", (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+ sprintf(buf, "%c", dcb.XonChar);
+ Tcl_DStringAppendElement(dsPtr, buf);
+ sprintf(buf, "%c", dcb.XoffChar);
+ Tcl_DStringAppendElement(dsPtr, buf);
+ }
+ if (len == 0) {
+ Tcl_DStringEndSublist(dsPtr);
+ }
+ /*
+ * get option -lasterror
+ * option is readonly and returned by [fconfigure chan -lasterror]
+ * but not returned by unnamed [fconfigure chan]
+ */
+
if ( (len > 1) && (strncmp(optionName, "-lasterror", len) == 0) ) {
- valid = 1;
- SerialErrorStr(infoPtr->lastError, dsPtr);
+ valid = 1;
+ SerialErrorStr(infoPtr->lastError, dsPtr);
}
+
+ /*
+ * get option -queue
+ * option is readonly and returned by [fconfigure chan -queue]
+ */
+
+ if ((len > 1) && (strncmp(optionName, "-queue", len) == 0)) {
+ char buf[TCL_INTEGER_SPACE + 1];
+ COMSTAT cStat;
+ int error;
+ int inBuffered, outBuffered, count;
+
+ valid = 1;
+
+ /*
+ * Query the pending data in Tcl's internal queues
+ */
+ inBuffered = Tcl_InputBuffered(infoPtr->channel);
+ outBuffered = Tcl_OutputBuffered(infoPtr->channel);
+ /*
+ * Query the number of bytes in our output queue:
+ * 1. The bytes pending in the output thread
+ * 2. The bytes in the system drivers buffer
+ * The writer thread should not interfere this action.
+ */
+ EnterCriticalSection(&infoPtr->csWrite);
+ ClearCommError( infoPtr->handle, &error, &cStat );
+ count = (int)cStat.cbOutQue + infoPtr->writeQueue;
+ LeaveCriticalSection(&infoPtr->csWrite);
+
+ wsprintfA(buf, "%d", inBuffered + cStat.cbInQue);
+ Tcl_DStringAppendElement(dsPtr, buf);
+ wsprintfA(buf, "%d", outBuffered + count);
+ Tcl_DStringAppendElement(dsPtr, buf);
+ }
+
+ /*
+ * get option -ttystatus
+ * option is readonly and returned by [fconfigure chan -ttystatus]
+ * but not returned by unnamed [fconfigure chan]
+ */
+ if ( (len > 4) && (strncmp(optionName, "-ttystatus", len) == 0) ) {
+
+ DWORD status;
+
+ if (! GetCommModemStatus(infoPtr->handle, &status)) {
+ if (interp) {
+ Tcl_AppendResult(interp,
+ "can't get tty status", (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+ valid = 1;
+ SerialModemStatusStr(status, dsPtr);
+ }
+
if (valid) {
return TCL_OK;
} else {
return Tcl_BadChannelOption(interp, optionName,
- "mode pollinterval lasterror");
+ "mode pollinterval lasterror queue sysbuffer ttystatus xchar");
}
}
-
diff --git a/tcl/win/tclWinSock.c b/tcl/win/tclWinSock.c
index c8f9b5c5385..814982be1f9 100644
--- a/tcl/win/tclWinSock.c
+++ b/tcl/win/tclWinSock.c
@@ -171,11 +171,11 @@ static WNDCLASSA windowClass;
*/
static SocketInfo * CreateSocket _ANSI_ARGS_((Tcl_Interp *interp,
- int port, char *host, int server, char *myaddr,
- int myport, int async));
+ int port, CONST char *host, int server,
+ CONST char *myaddr, int myport, int async));
static int CreateSocketAddress _ANSI_ARGS_(
(struct sockaddr_in *sockaddrPtr,
- char *host, int port));
+ CONST char *host, int port));
static void InitSockets _ANSI_ARGS_((void));
static SocketInfo * NewSocketInfo _ANSI_ARGS_((SOCKET socket));
static void SocketCheckProc _ANSI_ARGS_((ClientData clientData,
@@ -195,12 +195,12 @@ static int TcpBlockProc _ANSI_ARGS_((ClientData instanceData,
static int TcpCloseProc _ANSI_ARGS_((ClientData instanceData,
Tcl_Interp *interp));
static int TcpGetOptionProc _ANSI_ARGS_((ClientData instanceData,
- Tcl_Interp *interp, char *optionName,
+ Tcl_Interp *interp, CONST char *optionName,
Tcl_DString *optionValue));
static int TcpInputProc _ANSI_ARGS_((ClientData instanceData,
char *buf, int toRead, int *errorCode));
static int TcpOutputProc _ANSI_ARGS_((ClientData instanceData,
- char *buf, int toWrite, int *errorCode));
+ CONST char *buf, int toWrite, int *errorCode));
static void TcpWatchProc _ANSI_ARGS_((ClientData instanceData,
int mask));
static int TcpGetHandleProc _ANSI_ARGS_((ClientData instanceData,
@@ -226,7 +226,7 @@ static Tcl_ChannelType tcpChannelType = {
TcpWatchProc, /* Set up notifier to watch this channel. */
TcpGetHandleProc, /* Get an OS handle from channel. */
NULL, /* close2proc. */
- TcpBlockProc, /* Set blocking/non-blocking mode. */
+ TcpBlockProc, /* Set socket into (non-)blocking mode. */
NULL, /* flush proc. */
NULL, /* handler proc. */
};
@@ -836,9 +836,9 @@ SocketEventProc(evPtr, flags)
if ((*winSock.select)(0, &readFds, NULL, NULL, &timeout) != 0) {
mask |= TCL_READABLE;
} else {
+ infoPtr->readyEvents &= ~(FD_READ);
SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
(WPARAM) SELECT, (LPARAM) infoPtr);
- infoPtr->readyEvents &= ~(FD_READ);
}
}
if (events & (FD_WRITE | FD_CONNECT)) {
@@ -1014,10 +1014,10 @@ static SocketInfo *
CreateSocket(interp, port, host, server, myaddr, myport, async)
Tcl_Interp *interp; /* For error reporting; can be NULL. */
int port; /* Port number to open. */
- char *host; /* Name of host on which to open port. */
+ CONST char *host; /* Name of host on which to open port. */
int server; /* 1 if socket should be a server socket,
* else 0 for a client socket. */
- char *myaddr; /* Optional client-side address */
+ CONST char *myaddr; /* Optional client-side address */
int myport; /* Optional client-side port */
int async; /* If nonzero, connect client socket
* asynchronously. */
@@ -1211,7 +1211,7 @@ error:
static int
CreateSocketAddress(sockaddrPtr, host, port)
struct sockaddr_in *sockaddrPtr; /* Socket address */
- char *host; /* Host. NULL implies INADDR_ANY */
+ CONST char *host; /* Host. NULL implies INADDR_ANY */
int port; /* Port number */
{
struct hostent *hostent; /* Host database entry */
@@ -1355,8 +1355,8 @@ Tcl_Channel
Tcl_OpenTcpClient(interp, port, host, myaddr, myport, async)
Tcl_Interp *interp; /* For error reporting; can be NULL. */
int port; /* Port number to open. */
- char *host; /* Host on which to open port. */
- char *myaddr; /* Client-side address */
+ CONST char *host; /* Host on which to open port. */
+ CONST char *myaddr; /* Client-side address */
int myport; /* Client-side port */
int async; /* If nonzero, should connect
* client socket asynchronously. */
@@ -1471,7 +1471,7 @@ Tcl_OpenTcpServer(interp, port, host, acceptProc, acceptProcData)
Tcl_Interp *interp; /* For error reporting - may be
* NULL. */
int port; /* Port number to open. */
- char *host; /* Name of local host. */
+ CONST char *host; /* Name of local host. */
Tcl_TcpAcceptProc *acceptProc; /* Callback for accepting connections
* from new clients. */
ClientData acceptProcData; /* Data for the callback. */
@@ -1765,7 +1765,7 @@ TcpInputProc(instanceData, buf, toRead, errorCodePtr)
static int
TcpOutputProc(instanceData, buf, toWrite, errorCodePtr)
ClientData instanceData; /* The socket state. */
- char *buf; /* Where to get data. */
+ CONST char *buf; /* Where to get data. */
int toWrite; /* Maximum number of bytes to write. */
int *errorCodePtr; /* Where to store error codes. */
{
@@ -1881,7 +1881,7 @@ static int
TcpGetOptionProc(instanceData, interp, optionName, dsPtr)
ClientData instanceData; /* Socket state. */
Tcl_Interp *interp; /* For error reporting - can be NULL */
- char *optionName; /* Name of the option to
+ CONST char *optionName; /* Name of the option to
* retrieve the value for, or
* NULL to get all options and
* their values. */
@@ -1946,9 +1946,14 @@ TcpGetOptionProc(instanceData, interp, optionName, dsPtr)
}
Tcl_DStringAppendElement(dsPtr,
(*winSock.inet_ntoa)(peername.sin_addr));
- hostEntPtr = (*winSock.gethostbyaddr)(
- (char *) &(peername.sin_addr), sizeof(peername.sin_addr),
- AF_INET);
+
+ if (peername.sin_addr.s_addr == 0) {
+ hostEntPtr = (struct hostent *) NULL;
+ } else {
+ hostEntPtr = (*winSock.gethostbyaddr)(
+ (char *) &(peername.sin_addr), sizeof(peername.sin_addr),
+ AF_INET);
+ }
if (hostEntPtr != (struct hostent *) NULL) {
Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
} else {
@@ -1992,9 +1997,13 @@ TcpGetOptionProc(instanceData, interp, optionName, dsPtr)
}
Tcl_DStringAppendElement(dsPtr,
(*winSock.inet_ntoa)(sockname.sin_addr));
- hostEntPtr = (*winSock.gethostbyaddr)(
- (char *) &(sockname.sin_addr), sizeof(peername.sin_addr),
- AF_INET);
+ if (sockname.sin_addr.s_addr == 0) {
+ hostEntPtr = (struct hostent *) NULL;
+ } else {
+ hostEntPtr = (*winSock.gethostbyaddr)(
+ (char *) &(sockname.sin_addr), sizeof(peername.sin_addr),
+ AF_INET);
+ }
if (hostEntPtr != (struct hostent *) NULL) {
Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
} else {
@@ -2054,26 +2063,29 @@ TcpWatchProc(instanceData, mask)
SocketInfo *infoPtr = (SocketInfo *) instanceData;
/*
- * Update the watch events mask.
+ * Update the watch events mask. Only if the socket is not a
+ * server socket. Fix for SF Tcl Bug #557878.
*/
-
- infoPtr->watchEvents = 0;
- if (mask & TCL_READABLE) {
- infoPtr->watchEvents |= (FD_READ|FD_CLOSE|FD_ACCEPT);
- }
- if (mask & TCL_WRITABLE) {
- infoPtr->watchEvents |= (FD_WRITE|FD_CONNECT);
- }
- /*
- * If there are any conditions already set, then tell the notifier to poll
- * rather than block.
- */
+ if (!infoPtr->acceptProc) {
+ infoPtr->watchEvents = 0;
+ if (mask & TCL_READABLE) {
+ infoPtr->watchEvents |= (FD_READ|FD_CLOSE|FD_ACCEPT);
+ }
+ if (mask & TCL_WRITABLE) {
+ infoPtr->watchEvents |= (FD_WRITE|FD_CONNECT);
+ }
+
+ /*
+ * If there are any conditions already set, then tell the notifier to poll
+ * rather than block.
+ */
- if (infoPtr->readyEvents & infoPtr->watchEvents) {
- Tcl_Time blockTime = { 0, 0 };
- Tcl_SetMaxBlockTime(&blockTime);
- }
+ if (infoPtr->readyEvents & infoPtr->watchEvents) {
+ Tcl_Time blockTime = { 0, 0 };
+ Tcl_SetMaxBlockTime(&blockTime);
+ }
+ }
}
/*
@@ -2146,7 +2158,7 @@ SocketThread(LPVOID arg)
*/
#ifdef _WIN64
- SetWindowLongPtr(tsdPtr->hwnd, GWLP_USERDATA, (LONG) tsdPtr);
+ SetWindowLongPtr(tsdPtr->hwnd, GWLP_USERDATA, (LONG_PTR) tsdPtr);
#else
SetWindowLong(tsdPtr->hwnd, GWL_USERDATA, (LONG) tsdPtr);
#endif
@@ -2318,7 +2330,7 @@ SocketProc(hwnd, message, wParam, lParam)
*----------------------------------------------------------------------
*/
-char *
+CONST char *
Tcl_GetHostName()
{
DWORD length;
@@ -2454,4 +2466,3 @@ TclWinGetServByName(const char * name, const char * proto)
}
-
diff --git a/tcl/win/tclWinTest.c b/tcl/win/tclWinTest.c
index a66f7b3c50f..0147ee88d8b 100644
--- a/tcl/win/tclWinTest.c
+++ b/tcl/win/tclWinTest.c
@@ -11,6 +11,7 @@
* RCS: @(#) $Id$
*/
+#define USE_COMPAT_CONST
#include "tclWinInt.h"
/*
@@ -22,6 +23,10 @@ static int TesteventloopCmd _ANSI_ARGS_((ClientData dummy,
static int TestvolumetypeCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]));
+static int TestwinclockCmd _ANSI_ARGS_(( ClientData dummy,
+ Tcl_Interp* interp,
+ int objc,
+ Tcl_Obj *CONST objv[] ));
/*
*----------------------------------------------------------------------
@@ -52,6 +57,8 @@ TclplatformtestInit(interp)
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateObjCommand(interp, "testvolumetype", TestvolumetypeCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "testwinclock", TestwinclockCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
return TCL_OK;
}
@@ -188,5 +195,74 @@ TestvolumetypeCmd(clientData, interp, objc, objv)
return TCL_OK;
#undef VOL_BUF_SIZE
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestclockCmd --
+ *
+ * Command that returns the seconds and microseconds portions of
+ * the system clock and of the Tcl clock so that they can be
+ * compared to validate that the Tcl clock is staying in sync.
+ *
+ * Usage:
+ * testclock
+ *
+ * Parameters:
+ * None.
+ *
+ * Results:
+ * Returns a standard Tcl result comprising a four-element list:
+ * the seconds and microseconds portions of the system clock,
+ * and the seconds and microseconds portions of the Tcl clock.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+TestwinclockCmd( ClientData dummy,
+ /* Unused */
+ Tcl_Interp* interp,
+ /* Tcl interpreter */
+ int objc,
+ /* Argument count */
+ Tcl_Obj *CONST objv[] )
+ /* Argument vector */
+{
+ CONST static FILETIME posixEpoch = { 0xD53E8000, 0x019DB1DE };
+ /* The Posix epoch, expressed as a
+ * Windows FILETIME */
+ Tcl_Time tclTime; /* Tcl clock */
+ FILETIME sysTime; /* System clock */
+ Tcl_Obj* result; /* Result of the command */
+ LARGE_INTEGER t1, t2;
+ if ( objc != 1 ) {
+ Tcl_WrongNumArgs( interp, 1, objv, "" );
+ return TCL_ERROR;
+ }
+
+ Tcl_GetTime( &tclTime );
+ GetSystemTimeAsFileTime( &sysTime );
+ t1.LowPart = posixEpoch.dwLowDateTime;
+ t1.HighPart = posixEpoch.dwHighDateTime;
+ t2.LowPart = sysTime.dwLowDateTime;
+ t2.HighPart = sysTime.dwHighDateTime;
+ t2.QuadPart -= t1.QuadPart;
+
+ result = Tcl_NewObj();
+ Tcl_ListObjAppendElement
+ ( interp, result, Tcl_NewIntObj( (int) (t2.QuadPart / 10000000 ) ) );
+ Tcl_ListObjAppendElement
+ ( interp, result,
+ Tcl_NewIntObj( (int) ( (t2.QuadPart / 10 ) % 1000000 ) ) );
+ Tcl_ListObjAppendElement( interp, result, Tcl_NewIntObj( tclTime.sec ) );
+ Tcl_ListObjAppendElement( interp, result, Tcl_NewIntObj( tclTime.usec ) );
+
+ Tcl_SetObjResult( interp, result );
+
+ return TCL_OK;
+}
diff --git a/tcl/win/tclWinThrd.c b/tcl/win/tclWinThrd.c
index 35fa53ffb48..edd6ff1e27d 100644
--- a/tcl/win/tclWinThrd.c
+++ b/tcl/win/tclWinThrd.c
@@ -44,6 +44,15 @@ static CRITICAL_SECTION allocLock;
static Tcl_Mutex allocLockPtr = (Tcl_Mutex) &allocLock;
/*
+ * The joinLock serializes Create- and ExitThread. This is necessary to
+ * prevent a race where a new joinable thread exits before the creating
+ * thread had the time to create the necessary data structures in the
+ * emulation layer.
+ */
+
+static CRITICAL_SECTION joinLock;
+
+/*
* Condition variables are implemented with a combination of a
* per-thread Windows Event and a per-condition waiting queue.
* The idea is that each thread has its own Event that it waits
@@ -93,8 +102,6 @@ typedef struct WinCondition {
struct ThreadSpecificData *lastPtr;
} WinCondition;
-static void FinalizeConditionEvent(ClientData data);
-
/*
*----------------------------------------------------------------------
@@ -124,19 +131,32 @@ Tcl_CreateThread(idPtr, proc, clientData, stackSize, flags)
{
HANDLE tHandle;
-#ifdef __CYGWIN__
+ EnterCriticalSection(&joinLock);
+
+#if defined(__MSVCRT__) || defined(__BORLANDC__)
+ tHandle = (HANDLE) _beginthreadex(NULL, (unsigned) stackSize, proc,
+ clientData, 0, (unsigned *)idPtr);
+#else
tHandle = CreateThread(NULL, (DWORD) stackSize,
- (LPTHREAD_START_ROUTINE) proc, (LPVOID) clientData,
- (DWORD) 0, (LPDWORD)idPtr);
+ (LPTHREAD_START_ROUTINE) proc, (LPVOID) clientData,
+ (DWORD) 0, (LPDWORD)idPtr);
+#endif
+
if (tHandle == NULL) {
-#else
- tHandle = (HANDLE) _beginthreadex(NULL, (unsigned)stackSize, proc,
- clientData, (unsigned) 0, (unsigned *)idPtr);
- if (tHandle == 0) {
-#endif /* __CYGWIN__ */
+ LeaveCriticalSection(&joinLock);
return TCL_ERROR;
} else {
+ if (flags & TCL_THREAD_JOINABLE) {
+ TclRememberJoinableThread (*idPtr);
+ }
+
+ /*
+ * The only purpose of this is to decrement the reference count so the
+ * OS resources will be reaquired when the thread closes.
+ */
+
CloseHandle(tHandle);
+ LeaveCriticalSection(&joinLock);
return TCL_OK;
}
}
@@ -144,6 +164,33 @@ Tcl_CreateThread(idPtr, proc, clientData, stackSize, flags)
/*
*----------------------------------------------------------------------
*
+ * Tcl_JoinThread --
+ *
+ * This procedure waits upon the exit of the specified thread.
+ *
+ * Results:
+ * TCL_OK if the wait was successful, TCL_ERROR else.
+ *
+ * Side effects:
+ * The result area is set to the exit code of the thread we
+ * waited upon.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_JoinThread(id, result)
+ Tcl_ThreadId id; /* Id of the thread to wait upon */
+ int* result; /* Reference to the storage the result
+ * of the thread we wait upon will be
+ * written into. */
+{
+ return TclJoinThread (id, result);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclpThreadExit --
*
* This procedure terminates the current thread.
@@ -161,11 +208,15 @@ void
TclpThreadExit(status)
int status;
{
-#ifdef __CYGWIN__
- ExitThread((DWORD) status);
-#else
+ EnterCriticalSection(&joinLock);
+ TclSignalExitThread (Tcl_GetCurrentThread (), status);
+ LeaveCriticalSection(&joinLock);
+
+#if defined(__MSVCRT__) || defined(__BORLANDC__)
_endthreadex((unsigned) status);
-#endif /* __CYGWIN__ */
+#else
+ ExitThread((DWORD) status);
+#endif
}
@@ -222,6 +273,7 @@ TclpInitLock()
* more threads that create interpreters in parallel.
*/
init = 1;
+ InitializeCriticalSection(&joinLock);
InitializeCriticalSection(&initLock);
InitializeCriticalSection(&masterLock);
}
@@ -284,6 +336,7 @@ TclpMasterLock()
* more threads that create interpreters in parallel.
*/
init = 1;
+ InitializeCriticalSection(&joinLock);
InitializeCriticalSection(&initLock);
InitializeCriticalSection(&masterLock);
}
@@ -314,7 +367,12 @@ Tcl_Mutex *
Tcl_GetAllocMutex()
{
#ifdef TCL_THREADS
- InitializeCriticalSection(&allocLock);
+ static int once = 0;
+
+ if (!once) {
+ InitializeCriticalSection(&allocLock);
+ once = 1;
+ }
return &allocLockPtr;
#else
return NULL;
@@ -323,6 +381,10 @@ Tcl_GetAllocMutex()
#ifdef TCL_THREADS
+
+/* locally used prototype */
+static void FinalizeConditionEvent(ClientData data);
+
/*
*----------------------------------------------------------------------
*
@@ -439,6 +501,7 @@ TclpFinalizeMutex(mutexPtr)
{
CRITICAL_SECTION *csPtr = *(CRITICAL_SECTION **)mutexPtr;
if (csPtr != NULL) {
+ DeleteCriticalSection(csPtr);
ckfree((char *)csPtr);
*mutexPtr = NULL;
}
@@ -571,6 +634,9 @@ TclpFinalizeThreadData(keyPtr)
VOID *result;
DWORD *indexPtr;
+#ifdef USE_THREAD_ALLOC
+ TclWinFreeAllocCache();
+#endif
if (*keyPtr != NULL) {
indexPtr = *(DWORD **)keyPtr;
result = (VOID *)TlsGetValue(*indexPtr);
@@ -620,7 +686,7 @@ TclpFinalizeThreadDataKey(keyPtr)
* Tcl_ConditionWait --
*
* This procedure is invoked to wait on a condition variable.
- * The mutex is automically released as part of the wait, and
+ * The mutex is atomically released as part of the wait, and
* automatically grabbed when the condition is signaled.
*
* The mutex must be held when this procedure is called.
@@ -658,7 +724,7 @@ Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
}
/*
- * Self initialize the two parts of the contition.
+ * Self initialize the two parts of the condition.
* The per-condition and per-thread parts need to be
* handled independently.
*/
@@ -683,7 +749,7 @@ Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
if (doExit) {
/*
* Create a per-thread exit handler to clean up the condEvent.
- * We must be careful do do this outside the Master Lock
+ * We must be careful to do this outside the Master Lock
* because Tcl_CreateThreadExitHandler uses its own
* ThreadSpecificData, and initializing that may drop
* back into the Master Lock.
@@ -907,8 +973,72 @@ TclpFinalizeCondition(condPtr)
*/
if (winCondPtr != NULL) {
+ DeleteCriticalSection(&winCondPtr->condLock);
ckfree((char *)winCondPtr);
*condPtr = NULL;
}
}
+
+/*
+ * Additions by AOL for specialized thread memory allocator.
+ */
+#ifdef USE_THREAD_ALLOC
+static DWORD key;
+
+Tcl_Mutex *
+TclpNewAllocMutex(void)
+{
+ struct lock {
+ Tcl_Mutex tlock;
+ CRITICAL_SECTION wlock;
+ } *lockPtr;
+
+ lockPtr = malloc(sizeof(struct lock));
+ if (lockPtr == NULL) {
+ panic("could not allocate lock");
+ }
+ lockPtr->tlock = (Tcl_Mutex) &lockPtr->wlock;
+ InitializeCriticalSection(&lockPtr->wlock);
+ return &lockPtr->tlock;
+}
+
+void *
+TclpGetAllocCache(void)
+{
+ static int once = 0;
+
+ if (!once) {
+ /*
+ * We need to make sure that TclWinFreeAllocCache is called
+ * on each thread that calls this, but only on threads that
+ * call this.
+ */
+ key = TlsAlloc();
+ once = 1;
+ if (key == TLS_OUT_OF_INDEXES) {
+ panic("could not allocate thread local storage");
+ }
+ }
+ return TlsGetValue(key);
+}
+
+void
+TclpSetAllocCache(void *ptr)
+{
+ TlsSetValue(key, ptr);
+}
+
+void
+TclWinFreeAllocCache(void)
+{
+ void *ptr;
+
+ ptr = TlsGetValue(key);
+ if (ptr != NULL) {
+ TlsSetValue(key, NULL);
+ TclFreeAllocCache(ptr);
+ }
+}
+
+#endif /* USE_THREAD_ALLOC */
#endif /* TCL_THREADS */
diff --git a/tcl/win/tclWinThrd.h b/tcl/win/tclWinThrd.h
index 7ecec1fe8df..2572d1b6eea 100644
--- a/tcl/win/tclWinThrd.h
+++ b/tcl/win/tclWinThrd.h
@@ -19,5 +19,3 @@
#endif /* TCL_THREADS */
#endif /* _TCLWINTHRD */
-
-
diff --git a/tcl/win/tclWinTime.c b/tcl/win/tclWinTime.c
index 746739c98b5..95446529830 100644
--- a/tcl/win/tclWinTime.c
+++ b/tcl/win/tclWinTime.c
@@ -38,10 +38,77 @@ typedef struct ThreadSpecificData {
static Tcl_ThreadDataKey dataKey;
/*
+ * Calibration interval for the high-resolution timer, in msec
+ */
+
+static CONST unsigned long clockCalibrateWakeupInterval = 10000;
+ /* FIXME: 10 s -- should be about 10 min! */
+
+/*
+ * Data for managing high-resolution timers.
+ */
+
+typedef struct TimeInfo {
+
+ CRITICAL_SECTION cs; /* Mutex guarding this structure */
+
+ int initialized; /* Flag == 1 if this structure is
+ * initialized. */
+
+ int perfCounterAvailable; /* Flag == 1 if the hardware has a
+ * performance counter */
+
+ HANDLE calibrationThread; /* Handle to the thread that keeps the
+ * virtual clock calibrated. */
+
+ HANDLE readyEvent; /* System event used to
+ * trigger the requesting thread
+ * when the clock calibration procedure
+ * is initialized for the first time */
+
+ /*
+ * The following values are used for calculating virtual time.
+ * Virtual time is always equal to:
+ * lastFileTime + (current perf counter - lastCounter)
+ * * 10000000 / curCounterFreq
+ * and lastFileTime and lastCounter are updated any time that
+ * virtual time is returned to a caller.
+ */
+
+ ULARGE_INTEGER lastFileTime;
+ LARGE_INTEGER lastCounter;
+ LARGE_INTEGER curCounterFreq;
+
+ /*
+ * The next two values are used only in the calibration thread, to track
+ * the frequency of the performance counter.
+ */
+
+ LONGLONG lastPerfCounter; /* Performance counter the last time
+ * that UpdateClockEachSecond was called */
+ LONGLONG lastSysTime; /* System clock at the last time
+ * that UpdateClockEachSecond was called */
+ LONGLONG estPerfCounterFreq;
+ /* Current estimate of the counter frequency
+ * using the system clock as the standard */
+
+} TimeInfo;
+
+static TimeInfo timeInfo = {
+ NULL, 0, 0, NULL, NULL, 0, 0, 0, 0, 0
+};
+
+CONST static FILETIME posixEpoch = { 0xD53E8000, 0x019DB1DE };
+
+/*
* Declarations for functions defined later in this file.
*/
static struct tm * ComputeGMT _ANSI_ARGS_((const time_t *tp));
+
+static DWORD WINAPI CalibrationThread _ANSI_ARGS_(( LPVOID arg ));
+
+static void UpdateTimeEachSecond _ANSI_ARGS_(( void ));
/*
*----------------------------------------------------------------------
@@ -63,7 +130,9 @@ static struct tm * ComputeGMT _ANSI_ARGS_((const time_t *tp));
unsigned long
TclpGetSeconds()
{
- return (unsigned long) time((time_t *) NULL);
+ Tcl_Time t;
+ Tcl_GetTime( &t );
+ return t.sec;
}
/*
@@ -89,7 +158,18 @@ TclpGetSeconds()
unsigned long
TclpGetClicks()
{
- return GetTickCount();
+ /*
+ * Use the Tcl_GetTime abstraction to get the time in microseconds,
+ * as nearly as we can, and return it.
+ */
+
+ Tcl_Time now; /* Current Tcl time */
+ unsigned long retval; /* Value to return */
+
+ Tcl_GetTime( &now );
+ retval = ( now.sec * 1000000 ) + now.usec;
+ return retval;
+
}
/*
@@ -125,7 +205,7 @@ TclpGetTimeZone (currentTime)
/*
*----------------------------------------------------------------------
*
- * TclpGetTime --
+ * Tcl_GetTime --
*
* Gets the current system time in seconds and microseconds
* since the beginning of the epoch: 00:00 UCT, January 1, 1970.
@@ -134,20 +214,143 @@ TclpGetTimeZone (currentTime)
* Returns the current time in timePtr.
*
* Side effects:
- * None.
+ * On the first call, initializes a set of static variables to
+ * keep track of the base value of the performance counter, the
+ * corresponding wall clock (obtained through ftime) and the
+ * frequency of the performance counter. Also spins a thread
+ * whose function is to wake up periodically and monitor these
+ * values, adjusting them as necessary to correct for drift
+ * in the performance counter's oscillator.
*
*----------------------------------------------------------------------
*/
void
-TclpGetTime(timePtr)
+Tcl_GetTime(timePtr)
Tcl_Time *timePtr; /* Location to store time information. */
{
+
struct timeb t;
- ftime(&t);
- timePtr->sec = t.time;
- timePtr->usec = t.millitm * 1000;
+ /* Initialize static storage on the first trip through. */
+
+ /*
+ * Note: Outer check for 'initialized' is a performance win
+ * since it avoids an extra mutex lock in the common case.
+ */
+
+ if ( !timeInfo.initialized ) {
+ TclpInitLock();
+ if ( !timeInfo.initialized ) {
+ timeInfo.perfCounterAvailable
+ = QueryPerformanceFrequency( &timeInfo.curCounterFreq );
+
+ /*
+ * Some hardware abstraction layers use the CPU clock
+ * in place of the real-time clock as a performance counter
+ * reference. This results in:
+ * - inconsistent results among the processors on
+ * multi-processor systems.
+ * - unpredictable changes in performance counter frequency
+ * on "gearshift" processors such as Transmeta and
+ * SpeedStep.
+ *
+ * There seems to be no way to test whether the performance
+ * counter is reliable, but a useful heuristic is that
+ * if its frequency is 1.193182 MHz or 3.579545 MHz, it's
+ * derived from a colorburst crystal and is therefore
+ * the RTC rather than the TSC.
+ *
+ * A sloppier but serviceable heuristic is that the RTC crystal
+ * is normally less than 15 MHz while the TSC crystal is
+ * virtually assured to be greater than 100 MHz. Since Win98SE
+ * appears to fiddle with the definition of the perf counter
+ * frequency (perhaps in an attempt to calibrate the clock?)
+ * we use the latter rule rather than an exact match.
+ */
+
+ if ( timeInfo.perfCounterAvailable
+ /* The following lines would do an exact match on
+ * crystal frequency:
+ * && timeInfo.curCounterFreq.QuadPart != (LONGLONG) 1193182
+ * && timeInfo.curCounterFreq.QuadPart != (LONGLONG) 3579545
+ */
+ && timeInfo.curCounterFreq.QuadPart > (LONGLONG) 15000000 ) {
+ timeInfo.perfCounterAvailable = FALSE;
+ }
+
+ /*
+ * If the performance counter is available, start a thread to
+ * calibrate it.
+ */
+
+ if ( timeInfo.perfCounterAvailable ) {
+ DWORD id;
+ InitializeCriticalSection( &timeInfo.cs );
+ timeInfo.readyEvent = CreateEvent( NULL, FALSE, FALSE, NULL );
+ timeInfo.calibrationThread = CreateThread( NULL,
+ 8192,
+ CalibrationThread,
+ (LPVOID) NULL,
+ 0,
+ &id );
+ SetThreadPriority( timeInfo.calibrationThread,
+ THREAD_PRIORITY_HIGHEST );
+ WaitForSingleObject( timeInfo.readyEvent, INFINITE );
+ CloseHandle( timeInfo.readyEvent );
+ }
+ timeInfo.initialized = TRUE;
+ }
+ TclpInitUnlock();
+ }
+
+ if ( timeInfo.perfCounterAvailable ) {
+
+ /*
+ * Query the performance counter and use it to calculate the
+ * current time.
+ */
+
+ LARGE_INTEGER curCounter;
+ /* Current performance counter */
+
+ LONGLONG curFileTime;
+ /* Current estimated time, expressed
+ * as 100-ns ticks since the Windows epoch */
+
+ static LARGE_INTEGER posixEpoch;
+ /* Posix epoch expressed as 100-ns ticks
+ * since the windows epoch */
+
+ LONGLONG usecSincePosixEpoch;
+ /* Current microseconds since Posix epoch */
+
+ posixEpoch.LowPart = 0xD53E8000;
+ posixEpoch.HighPart = 0x019DB1DE;
+
+ EnterCriticalSection( &timeInfo.cs );
+
+ QueryPerformanceCounter( &curCounter );
+ curFileTime = timeInfo.lastFileTime.QuadPart
+ + ( ( curCounter.QuadPart - timeInfo.lastCounter.QuadPart )
+ * 10000000 / timeInfo.curCounterFreq.QuadPart );
+ timeInfo.lastFileTime.QuadPart = curFileTime;
+ timeInfo.lastCounter.QuadPart = curCounter.QuadPart;
+ usecSincePosixEpoch = ( curFileTime - posixEpoch.QuadPart ) / 10;
+ timePtr->sec = (time_t) ( usecSincePosixEpoch / 1000000 );
+ timePtr->usec = (unsigned long ) ( usecSincePosixEpoch % 1000000 );
+
+ LeaveCriticalSection( &timeInfo.cs );
+
+
+ } else {
+
+ /* High resolution timer is not available. Just use ftime */
+
+ ftime(&t);
+ timePtr->sec = t.time;
+ timePtr->usec = t.millitm * 1000;
+ }
}
/*
@@ -440,5 +643,216 @@ ComputeGMT(tp)
return tmPtr;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CalibrationThread --
+ *
+ * Thread that manages calibration of the hi-resolution time
+ * derived from the performance counter, to keep it synchronized
+ * with the system clock.
+ *
+ * Parameters:
+ * arg -- Client data from the CreateThread call. This parameter
+ * points to the static TimeInfo structure.
+ *
+ * Return value:
+ * None. This thread embeds an infinite loop.
+ *
+ * Side effects:
+ * At an interval of clockCalibrateWakeupInterval ms, this thread
+ * performs virtual time discipline.
+ *
+ * Note: When this thread is entered, TclpInitLock has been called
+ * to safeguard the static storage. There is therefore no synchronization
+ * in the body of this procedure.
+ *
+ *----------------------------------------------------------------------
+ */
+static DWORD WINAPI
+CalibrationThread( LPVOID arg )
+{
+ FILETIME curFileTime;
+ /* Get initial system time and performance counter */
+
+ GetSystemTimeAsFileTime( &curFileTime );
+ QueryPerformanceCounter( &timeInfo.lastCounter );
+ QueryPerformanceFrequency( &timeInfo.curCounterFreq );
+ timeInfo.lastFileTime.LowPart = curFileTime.dwLowDateTime;
+ timeInfo.lastFileTime.HighPart = curFileTime.dwHighDateTime;
+
+ /* Initialize the working storage for the calibration callback */
+
+ timeInfo.lastPerfCounter = timeInfo.lastCounter.QuadPart;
+ timeInfo.estPerfCounterFreq = timeInfo.curCounterFreq.QuadPart;
+
+ /*
+ * Wake up the calling thread. When it wakes up, it will release the
+ * initialization lock.
+ */
+
+ SetEvent( timeInfo.readyEvent );
+
+ /* Run the calibration once a second */
+
+ for ( ; ; ) {
+ Sleep( 1000 );
+ UpdateTimeEachSecond();
+ }
+
+ /* lint */
+ return (DWORD) 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateTimeEachSecond --
+ *
+ * Callback from the waitable timer in the clock calibration thread
+ * that updates system time.
+ *
+ * Parameters:
+ * info -- Pointer to the static TimeInfo structure
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Performs virtual time calibration discipline.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateTimeEachSecond()
+{
+
+ LARGE_INTEGER curPerfCounter;
+ /* Current value returned from
+ * QueryPerformanceCounter */
+
+ LONGLONG perfCounterDiff; /* Difference between the current value
+ * and the value of 1 second ago */
+
+ FILETIME curSysTime; /* Current system time */
+
+ LARGE_INTEGER curFileTime; /* File time at the time this callback
+ * was scheduled. */
+
+ LONGLONG fileTimeDiff; /* Elapsed time on the system clock
+ * since the last time this procedure
+ * was called */
+
+ LONGLONG instantFreq; /* Instantaneous estimate of the
+ * performance counter frequency */
+
+ LONGLONG delta; /* Increment to add to the estimated
+ * performance counter frequency in the
+ * loop filter */
+
+ LONGLONG fuzz; /* Tolerance for the perf counter frequency */
+
+ LONGLONG lowBound; /* Lower bound for the frequency assuming
+ * 1000 ppm tolerance */
+
+ LONGLONG hiBound; /* Upper bound for the frequency */
+
+ /*
+ * Get current performance counter and system time.
+ */
+
+ QueryPerformanceCounter( &curPerfCounter );
+ GetSystemTimeAsFileTime( &curSysTime );
+ curFileTime.LowPart = curSysTime.dwLowDateTime;
+ curFileTime.HighPart = curSysTime.dwHighDateTime;
+
+ EnterCriticalSection( &timeInfo.cs );
+
+ /*
+ * Find out how many ticks of the performance counter and the
+ * system clock have elapsed since we got into this procedure.
+ * Estimate the current frequency.
+ */
+
+ perfCounterDiff = curPerfCounter.QuadPart - timeInfo.lastPerfCounter;
+ timeInfo.lastPerfCounter = curPerfCounter.QuadPart;
+ fileTimeDiff = curFileTime.QuadPart - timeInfo.lastSysTime;
+ timeInfo.lastSysTime = curFileTime.QuadPart;
+ instantFreq = ( 10000000 * perfCounterDiff / fileTimeDiff );
+
+ /*
+ * Consider this a timing glitch if instant frequency varies
+ * significantly from the current estimate.
+ */
+
+ fuzz = timeInfo.estPerfCounterFreq >> 10;
+ lowBound = timeInfo.estPerfCounterFreq - fuzz;
+ hiBound = timeInfo.estPerfCounterFreq + fuzz;
+ if ( instantFreq < lowBound || instantFreq > hiBound ) {
+ LeaveCriticalSection( &timeInfo.cs );
+ return;
+ }
+
+ /*
+ * Update the current estimate of performance counter frequency.
+ * This code is equivalent to the loop filter of a phase locked
+ * loop.
+ */
+
+ delta = ( instantFreq - timeInfo.estPerfCounterFreq ) >> 6;
+ timeInfo.estPerfCounterFreq += delta;
+
+ /*
+ * Update the current virtual time.
+ */
+
+ timeInfo.lastFileTime.QuadPart
+ += ( ( curPerfCounter.QuadPart - timeInfo.lastCounter.QuadPart )
+ * 10000000 / timeInfo.curCounterFreq.QuadPart );
+ timeInfo.lastCounter.QuadPart = curPerfCounter.QuadPart;
+
+ delta = curFileTime.QuadPart - timeInfo.lastFileTime.QuadPart;
+ if ( delta > 10000000 || delta < -10000000 ) {
+
+ /*
+ * If the virtual time slip exceeds one second, then adjusting
+ * the counter frequency is hopeless (it'll take over fifteen
+ * minutes to line up with the system clock). The most likely
+ * cause of this large a slip is a sudden change to the system
+ * clock, perhaps because it was being corrected by wristwatch
+ * and eyeball. Accept the system time, and set the performance
+ * counter frequency to the current estimate.
+ */
+
+ timeInfo.lastFileTime.QuadPart = curFileTime.QuadPart;
+ timeInfo.curCounterFreq.QuadPart = timeInfo.estPerfCounterFreq;
+
+ } else {
+
+ /*
+ * Compute a counter frequency that will cause virtual time to line
+ * up with system time one second from now, assuming that the
+ * performance counter continues to tick at timeInfo.estPerfCounterFreq.
+ */
+
+ timeInfo.curCounterFreq.QuadPart
+ = 10000000 * timeInfo.estPerfCounterFreq / ( delta + 10000000 );
+
+ /*
+ * Limit frequency excursions to 1000 ppm from estimate
+ */
+
+ if ( timeInfo.curCounterFreq.QuadPart < lowBound ) {
+ timeInfo.curCounterFreq.QuadPart = lowBound;
+ } else if ( timeInfo.curCounterFreq.QuadPart > hiBound ) {
+ timeInfo.curCounterFreq.QuadPart = hiBound;
+ }
+ }
+
+ LeaveCriticalSection( &timeInfo.cs );
+
+}
diff --git a/tcl/win/tclsh.rc b/tcl/win/tclsh.rc
index 0df2ed58566..a76568adf00 100644
--- a/tcl/win/tclsh.rc
+++ b/tcl/win/tclsh.rc
@@ -1,22 +1,48 @@
// RCS: @(#) $Id$
//
-// Version
+// Version Resource Script
//
-#define VS_VERSION_INFO 1
-
-#define RESOURCE_INCLUDED
+#include <winver.h>
#include <tcl.h>
+//
+// build-up the name suffix that defines the type of build this is.
+//
+#ifdef TCL_THREADS
+#define SUFFIX_THREADS "t"
+#else
+#define SUFFIX_THREADS ""
+#endif
+
+#ifdef STATIC_BUILD
+#define SUFFIX_STATIC "s"
+#else
+#define SUFFIX_STATIC ""
+#endif
+
+#ifdef DEBUG
+#define SUFFIX_DEBUG "d"
+#else
+#define SUFFIX_DEBUG ""
+#endif
+
+#define SUFFIX SUFFIX_THREADS SUFFIX_STATIC SUFFIX_DEBUG
+
+
LANGUAGE 0x9, 0x1 /* LANG_ENGLISH, SUBLANG_DEFAULT */
VS_VERSION_INFO VERSIONINFO
FILEVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL
PRODUCTVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL
FILEFLAGSMASK 0x3fL
+#ifdef DEBUG
+ FILEFLAGS VS_FF_DEBUG
+#else
FILEFLAGS 0x0L
- FILEOS 0x4 /* VOS__WINDOWS32 */
- FILETYPE 0x2 /* VFT_DLL */
+#endif
+ FILEOS VOS__WINDOWS32
+ FILETYPE VFT_APP
FILESUBTYPE 0x0L
BEGIN
BLOCK "StringFileInfo"
@@ -24,10 +50,10 @@ BEGIN
BLOCK "040904b0"
BEGIN
VALUE "FileDescription", "Tclsh Application\0"
- VALUE "OriginalFilename", "tclsh" STRINGIFY(TCL_MAJOR_VERSION) STRINGIFY(TCL_MINOR_VERSION) ".exe\0"
- VALUE "CompanyName", "Scriptics Corporation\0"
+ VALUE "OriginalFilename", "tclsh" STRINGIFY(JOIN(TCL_MAJOR_VERSION,TCL_MINOR_VERSION)) SUFFIX ".exe\0"
+ VALUE "CompanyName", "ActiveState Corporation\0"
VALUE "FileVersion", TCL_PATCH_LEVEL
- VALUE "LegalCopyright", "Copyright (c) 2000 by Scriptics Corporation\0"
+ VALUE "LegalCopyright", "Copyright \251 2000 by ActiveState Corporation, et al\0"
VALUE "ProductName", "Tcl " TCL_VERSION " for Windows\0"
VALUE "ProductVersion", TCL_PATCH_LEVEL
END
@@ -43,5 +69,3 @@ END
//
tclsh ICON DISCARDABLE "tclsh.ico"
-
-